{ "cells": [ { "cell_type": "markdown", "metadata": {}, "source": [ "# Preamble" ] }, { "cell_type": "code", "execution_count": 151, "metadata": {}, "outputs": [], "source": [ "libraries = c(\"dplyr\",\"magrittr\",\"tidyr\",\"ggplot2\",\"readxl\",\"glue\",\n", " \"grid\",\"gridExtra\",\"zoo\",\"RColorBrewer\",\n", " \"kableExtra\",\"foreach\",\"doParallel\",\"doRNG\")\n", "for(x in libraries) { library(x,character.only=TRUE,warn.conflicts=FALSE) }\n", "\n", "# to show the plots as svg-graphics in Jupyter\n", "# options(jupyter.plot_mimetypes = \"image/svg+xml\")\n", "options(jupyter.plot_mimetypes = \"image/png\") \n", "\n", "if (Sys.info()[['sysname']]=='Windows') {\n", " windowsFonts(Times = windowsFont(\"Times New Roman\"))\n", " theme_set(theme_bw(base_size=11,base_family='Times')) \n", "} else { theme_set(theme_bw(base_size=11)) }\n", "\n", "'%&%' = function(x,y)paste0(x,y)\n", "\n", "# registering cluster\n", "cl = parallel::makeCluster(4)\n", "doParallel::registerDoParallel(cl)" ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "# (Fig 1) Epicurve" ] }, { "cell_type": "code", "execution_count": 2, "metadata": {}, "outputs": [ { "data": { "text/html": [ "\n", "\n", "\n", "\t\n", "\t\n", "\t\n", "\t\n", "\t\n", "\t\n", "\n", "
onsetconfirmedprefecture
2018-04-292018-05-12Aichi
2018-05-092018-05-12Aichi
2018-05-122018-05-13Aichi
2018-05-122018-05-18Aichi
2018-05-062018-05-08Tokyo
2018-04-192018-05-02Kanagawa
\n" ], "text/latex": [ "\\begin{tabular}{r|lll}\n", " onset & confirmed & prefecture\\\\\n", "\\hline\n", "\t 2018-04-29 & 2018-05-12 & Aichi \\\\\n", "\t 2018-05-09 & 2018-05-12 & Aichi \\\\\n", "\t 2018-05-12 & 2018-05-13 & Aichi \\\\\n", "\t 2018-05-12 & 2018-05-18 & Aichi \\\\\n", "\t 2018-05-06 & 2018-05-08 & Tokyo \\\\\n", "\t 2018-04-19 & 2018-05-02 & Kanagawa \\\\\n", "\\end{tabular}\n" ], "text/markdown": [ "\n", "onset | confirmed | prefecture | \n", "|---|---|---|---|---|---|\n", "| 2018-04-29 | 2018-05-12 | Aichi | \n", "| 2018-05-09 | 2018-05-12 | Aichi | \n", "| 2018-05-12 | 2018-05-13 | Aichi | \n", "| 2018-05-12 | 2018-05-18 | Aichi | \n", "| 2018-05-06 | 2018-05-08 | Tokyo | \n", "| 2018-04-19 | 2018-05-02 | Kanagawa | \n", "\n", "\n" ], "text/plain": [ " onset confirmed prefecture\n", "1 2018-04-29 2018-05-12 Aichi \n", "2 2018-05-09 2018-05-12 Aichi \n", "3 2018-05-12 2018-05-13 Aichi \n", "4 2018-05-12 2018-05-18 Aichi \n", "5 2018-05-06 2018-05-08 Tokyo \n", "6 2018-04-19 2018-05-02 Kanagawa " ] }, "metadata": {}, "output_type": "display_data" } ], "source": [ "filename = \"data.xlsx\"\n", "\n", "read_excel(filename, sheet = \"Okinawa\", range = cell_cols(\"G:H\"), col_types = rep(\"date\",2), col_names = TRUE) -> df_epicurve\n", "colnames(df_epicurve) = c(\"onset\",\"confirmed\")\n", "df_epicurve %<>% mutate(prefecture=\"Okinawa\")\n", "\n", "read_excel(filename, sheet = \"Aichi\", range = cell_cols(\"G:H\"), col_types = rep(\"date\",2), col_names = TRUE) -> df_epicurve_\n", "colnames(df_epicurve_) = c(\"onset\",\"confirmed\")\n", "df_epicurve_ %<>% mutate(prefecture=\"Aichi\")\n", "df_epicurve %<>% rbind(df_epicurve_)\n", "\n", "read_excel(filename, sheet = \"Tokyo\", range = cell_cols(\"G:H\"), col_types = rep(\"date\",2), col_names = TRUE) -> df_epicurve_\n", "colnames(df_epicurve_) = c(\"onset\",\"confirmed\")\n", "df_epicurve_ %<>% mutate(prefecture=\"Tokyo\")\n", "df_epicurve %<>% rbind(df_epicurve_)\n", "\n", "read_excel(filename, sheet = \"Kanagawa\", range = cell_cols(\"G:H\"), col_types = rep(\"date\",2), col_names = TRUE) -> df_epicurve_\n", "colnames(df_epicurve_) = c(\"onset\",\"confirmed\")\n", "df_epicurve_ %<>% mutate(prefecture=\"Kanagawa\")\n", "df_epicurve %<>% rbind(df_epicurve_)\n", "\n", "df_epicurve %<>% \n", " mutate(onset=as.Date(onset), confirmed=as.Date(confirmed))\n", "\n", "df_epicurve %>% tail" ] }, { "cell_type": "code", "execution_count": 3, "metadata": {}, "outputs": [ { "data": { "text/html": [ "\n", "\n", "\n", "\t\n", "\t\n", "\t\n", "\t\n", "\t\n", "\t\n", "\t\n", "\t\n", "\t\n", "\t\n", "\n", "
dateAichiKanagawaOkinawaTokyo
2018-03-140 0 0 0
2018-03-150 0 0 0
2018-03-160 0 0 0
2018-03-170 0 0 0
2018-03-180 0 0 0
2018-03-190 0 0 0
2018-03-200 0 1 0
2018-03-210 0 0 0
2018-03-220 0 0 0
2018-03-230 0 0 0
\n" ], "text/latex": [ "\\begin{tabular}{r|lllll}\n", " date & Aichi & Kanagawa & Okinawa & Tokyo\\\\\n", "\\hline\n", "\t 2018-03-14 & 0 & 0 & 0 & 0 \\\\\n", "\t 2018-03-15 & 0 & 0 & 0 & 0 \\\\\n", "\t 2018-03-16 & 0 & 0 & 0 & 0 \\\\\n", "\t 2018-03-17 & 0 & 0 & 0 & 0 \\\\\n", "\t 2018-03-18 & 0 & 0 & 0 & 0 \\\\\n", "\t 2018-03-19 & 0 & 0 & 0 & 0 \\\\\n", "\t 2018-03-20 & 0 & 0 & 1 & 0 \\\\\n", "\t 2018-03-21 & 0 & 0 & 0 & 0 \\\\\n", "\t 2018-03-22 & 0 & 0 & 0 & 0 \\\\\n", "\t 2018-03-23 & 0 & 0 & 0 & 0 \\\\\n", "\\end{tabular}\n" ], "text/markdown": [ "\n", "date | Aichi | Kanagawa | Okinawa | Tokyo | \n", "|---|---|---|---|---|---|---|---|---|---|\n", "| 2018-03-14 | 0 | 0 | 0 | 0 | \n", "| 2018-03-15 | 0 | 0 | 0 | 0 | \n", "| 2018-03-16 | 0 | 0 | 0 | 0 | \n", "| 2018-03-17 | 0 | 0 | 0 | 0 | \n", "| 2018-03-18 | 0 | 0 | 0 | 0 | \n", "| 2018-03-19 | 0 | 0 | 0 | 0 | \n", "| 2018-03-20 | 0 | 0 | 1 | 0 | \n", "| 2018-03-21 | 0 | 0 | 0 | 0 | \n", "| 2018-03-22 | 0 | 0 | 0 | 0 | \n", "| 2018-03-23 | 0 | 0 | 0 | 0 | \n", "\n", "\n" ], "text/plain": [ " date Aichi Kanagawa Okinawa Tokyo\n", "1 2018-03-14 0 0 0 0 \n", "2 2018-03-15 0 0 0 0 \n", "3 2018-03-16 0 0 0 0 \n", "4 2018-03-17 0 0 0 0 \n", "5 2018-03-18 0 0 0 0 \n", "6 2018-03-19 0 0 0 0 \n", "7 2018-03-20 0 0 1 0 \n", "8 2018-03-21 0 0 0 0 \n", "9 2018-03-22 0 0 0 0 \n", "10 2018-03-23 0 0 0 0 " ] }, "metadata": {}, "output_type": "display_data" } ], "source": [ "Df_epicurve = data.frame(date=seq(as.Date('2018-03-14'),as.Date('2018-05-27'),by='1 day'))\n", "\n", "df_epicurve %>% \n", " group_by(prefecture,onset) %>%\n", " count %>%\n", " rename(i=n,date=onset) %>%\n", " ungroup %>%\n", " mutate(date=as.Date(date)) %>%\n", " spread(prefecture,i) %>%\n", " right_join(Df_epicurve,by=\"date\") %>%\n", " mutate_if(is.numeric, funs(ifelse(is.na(.), 0, .))) -> df_onset\n", "\n", "df_epicurve %>% \n", " group_by(prefecture,confirmed) %>%\n", " count %>%\n", " rename(i=n,date=confirmed) %>%\n", " ungroup %>%\n", " mutate(date=as.Date(date)) %>%\n", " spread(prefecture,i) %>%\n", " right_join(Df_epicurve,by=\"date\") %>%\n", " mutate_if(is.numeric, funs(ifelse(is.na(.), 0, .))) -> df_confirmed\n", "\n", "df_confirmed %>% head(10)" ] }, { "cell_type": "code", "execution_count": 4, "metadata": {}, "outputs": [ { "data": { "image/png": "iVBORw0KGgoAAAANSUhEUgAAA0gAAANICAIAAAByhViMAAAABmJLR0QA/wD/AP+gvaeTAAAg\nAElEQVR4nOzdX2wb6X3o/WdIifLasr2WvZvKTTfAAekIjpBeaOsaw+w2DU7qQzoSlKKQsVcC\nzguTPTUCcYHK6IWK7aJCEawOErK7eg9I4y2gomiwulgIUk3CzUkb7Ias0VgNGgiuYc7NbhCp\nu1078fqP/lGc9+KJJ2P+GXEockgOv58LYzR/f/OMyfnxeeZ5RtF1XQAAAKDzeVodAAAAABqD\nxA4AAMAlSOwAAABcgsQOAADAJUjsAAAAXILEDgAAwCVI7AAAAFyCxA4AAMAlSOwAAABcgsQO\nAADAJUjsAAAAXILEDgAAwCVI7AAAAFyCxA4AAMAlSOwAAABcgsQOAADAJUjsAAAAXILEDgAA\nwCVI7AAAAFyCxA4AAMAlSOwAAABcgsQOAADAJawSO0VRMpmMY6EAAADgIKomdjKlm52ddTAY\nAAAA1E/Rdb3igmAwmMvlhBD5fN7v9zsbFQAAAGyrXGOXyWRkVieEmJubczAeAAAA1KlyYre0\ntGRMp1Ipp4IBAABA/Sokdpqmra2tmefQhQIAAKD9VXjGLpFIyIlYLCYnVFXNZrOOxgUAAACb\nKiR2iqLouq5pWiAQMGbShQIAAKDNlTbFZjKZSCQihPD7/XJCogsFAABAmyutsQsGgwsLC7Jy\nLpPJhMNhY1G1gVEAAADQDp6psdM0bXh42GhyDYVCqqoaS41n7wAAANCGnkns5ubmxsfHzXMm\nJiaM6cXFRYeCAgAAgH3PNMUqimK9Nl0oAAAA2tava+wSiUQ8HtfL0IUCAACgI/y6xk6OclK+\nBl0oAAAAOsKvauwSiYS5Zs6spAtFNBp1Ii4AAADY5BFCJBKJWCy2tramaVrFlYaHh43pVCrF\nG8YAAADakKKqai6XM88yN7ZGo9FUKlW+WSQSSSaTTY8OAAAANav8XB0AAAA6TukrxQAAANCh\nSOwAAABcgsQOAADAJUjsAAAAXILEDgAAwCVI7AAAAFyCxA4AAMAlSOwAAABcgsQOAADAJUjs\nAAAAXILEDgAAwCVI7AAAAFyip9UBPOMb3/jGf/7nf7Y6CgAA3Oz9998/fPhwq6NAU7RXYieE\nePHFF7/85S87cKC9vb1CoaAois/nc+BwaIadnR1d13t6erxeb6tj6Rbb29tCiN7eXo+H+v72\nJb/fhBB9fX2tjqVbdMo95ac//eknn3zS6ijQRG2X2H3pS1/69re/7cCBNjc3Hz9+rCjKyZMn\nHTgcmuHevXu6rvf39x86dKjVsXQFXdfv3bsnhDh69CgZQzvb2tp69OiREOLUqVOtjqVbyHuK\nx+MZGBhodSxWpqenSezcjd/cAAAALkFiBwAA4BIkdgAAAC5BYgcAAOASJHYAAAAu4Vxit7Gx\nMTY2NjY2trGx4dhBAQAAuodDw52srKxcu3YtmUwODg46c0QAAIBu40Rit7q6eu3ateXlZQeO\nBQAA0LWcSOzefffdCxcujI2NCSHeeOONkZERY9FHH3109+5d489isVgsFuXQ9s0mh2XXdd2Z\nw6F5CoWCCy6ioijVFum63qhNDsjY7e7ubjP2j0aR32/i6ZtC4IBOuacUi8VWh4Dmanpit7q6\neufOnUuXLl25cmVlZeXNN980N8i+//778XjcWPnkyZOFQuHhw4fNjsrM4cOh4ba2tra2tlod\nxYEoinL0+AlfT4VnXncKxUcPflGeqNWxSQO5oMy7BN9vDtN1vc3L3Ej64VZNT+zW19eHhoZk\nLd3o6Oi1a9fW19d50g4wUxTF1+O59PaP7j/eMc8fOOJ791tfURSlYmJndxMAgOs5/a7YoaGh\n9fV1ozV2YmJCNtFKr732ms/nc+blrZubm0+ePFEUpc3f6wcL9+/f13X9yJEj7nhX7KOtwsPN\nZ5o4fV6PEOLEiRMN3OQgdF2/f/++EKK/v593xbazra2tx48fCyF4F7Zj5D3F4/E06dPXKD6f\nr9UhoLmantidPn36zp07JXOMaZ/PZ/5PJp8ZsnhyqIGMozhzODSPoijuvoh1nF2zC8T1Zd7p\n+H5zHmWONtH0cexGRkaGhobm5+eFEKurq3JOsw8KAADQhZxoin3rrbfGxsZu3LghhGDQEwAA\ngCZx6Bk78jkAAIBm412xAAAALkFiBwAA4BIkdgAAAC5BYgcAAOASJHYAAAAuQWIHAADgEiR2\nAAAALkFiBwAA4BIkdgAAAC5BYgcAAOASJHYAAAAuQWIHAADgEiR2AAAALkFiBwAA4BIkdgAA\nAC5BYgcAAOASJHYAAAAuQWIHAADgEiR2AAAALkFiBwAA4BIkdgAAAC5BYgcAAOASJHYAAAAu\nQWIHAADgEiR2AAAALkFiBwAA4BIkdgAAAC5BYgcAAOASJHYAAAAuQWIHAADgEiR2AAAALkFi\nBwAA4BIkdgAAAC5BYgcAAOASJHYAAAAuQWIHAADgEj2tDuAZxWJxd3f3wYMHzhxLCKHrujOH\nQzlFUQ4d7vf1VPh1sVMobj15pOu69R7kCpubm9vb200J0b76TkpRlGPHjlXb52effVa+VR2b\nHJyxzydPnmxtbTV8/4qiHDpyyOf1lS/a2dvpLehKX1+FqLa3H25vN+N8O5f8fhNC8P3mmE65\np+zu7rY6BDRXeyV2iqJ4PB6fr8LXesPt7u7u7e0JIZw5HMopiuLr8Vx6+0f3H++Y5w8c8b37\nra8Ufb59b9WFQkHX9Z6enp6edvmfXN9JKYpisU9fpa3q2OTgdF0vFApCiCaVuaIoPq/vf/3f\n6IPtX5rnH+97/v/896Twio9f/Wrx00/NizynTn3u/R/6dJ3EzqxQKPD95rBOuad4PLTUuVy7\n3A4lRVG8Xu9zzz3nzOF2dnYURXHscKjo0Vbh4eYzvyB9Xo8Q4tChQ/tu++TJEyFEb29vLSs7\n6SAnVa6OrZpUILquyzL3+Xx9lSrPGuJJ4fGj3UfmOb3e3l8F8PCz4rPVIUqfTzTtfDvX1taW\nrMbm+81JHXFP8Xq9rQ4BzUXmDgAA4BIkdgAAAC5BYgcAAOASJHYAAAAuQWIHAADgEiR2AAAA\nLkFiBwAA4BIkdgAAAC5BYgcAAOASJHYAAAAuQWIHAADgEiR2AAAALkFiBwAA4BIkdgAAAC5B\nYgcAAOASJHYAAAAuQWIHAADgEiR2AAAALkFiBwAA4BIkdgAAAC5hL7HTnpJ/JhKJYDCYSCSa\nEBgAAADssZfYXb9+PRAIzM3NCSESiUQsFhNCLC4uRqPRpkQHAACAmvXY3SCfz/v9fk3TYrGY\nqqrZbFYIoShKMplsQngAAAColb0au1gs5vf7hRDXr18XQszMzDQlKAAAANhnL7FTVTWTyRjV\ndaFQSAiRSCTS6XRzwgMAAECt7CV2CwsLs7OzgUBAVdWFhQUhRDAYjMViS0tLzQkPAAB0nUwm\nEwwGFUVRFCWTybQ6nE5iL7Hz+/3ZbFbX9Ww2K9tk5Z88YAcAQHcyMjCzYDBYd0KWyWTC4fDC\nwoKu65FIZHZ2to6ddG23Ttvj2GmaFgwGg8Gg/JPhTgAA6GayikcIEYlEdF3XdT2fzw8PD4fD\n4fqyq6WlJVVVZf1RMpmU3TRt0TQtlUrVcWgXsNcrVibR5jnZbFZRFCHE1NRUI+MCAACdQ1VV\nY9rv9yeTybW1tVQqNT4+Lp/Ir93a2toBg5mcnDzgHjqXvRq72dlZmY+XzF9cXGxcSAAAoONN\nTEwIIe7evatpWjQaldVA5ka/RCJhtNvKdx9kMhlFUXK5XC6Xk4uqrSnJVsSSRcFgMJfLCSGM\n+eZdyWlZlVh7YB3EXmKXy+UqPk4nSxAAAEC6ffu2EOLMmTOTk5OyYTSTyczMzMicIZFI3L59\nW7bb5nK5QCAghAiFQrquq6qqqqps1a22phBC07RAIDAzM2MskhV12Ww2EokIIeQestmsuTYx\nn88b07UH1kFsD3dSkrrKRyPNRQYAALpcNBpNpVJyZDQj0wqFQjJ1E0LEYjFZVeT3++PxuHia\nUZSrtubk5GQ8HpftvH6/PxKJVKtmGh4eNqb9fr+RtBwwsPZkL7GbmZmR7xOTjEfuZHUrAADo\nWmtra0a7ZyqVikQi1fo9yFTJ6EIr31B69+7d2tfUNC2Xy505c8ZYM5lMlj8qZlftgbUte50n\nZF4sW6ON5up4PE7PCQAAutzw8LCt4c9qz8PK12zqo28HTxBbyPZwJ7Ku0oysDgAA2FV7E2e1\nNZv0foTOanstYS+x056SfyYSCcaxAwAAtsgeCeFw2EihNE2rmE5UW1M+KpdKpcxbZTKZGnOy\naiOq1B5Y27KX2F2/fj0QCMjH7BKJhGx7XlxcrHEEwqtXr66urtYRJQAAaGe5XM5i/LmSRUa/\nhHA4LJ9mCwQCFy9eFELIh+dyuZysRbJYc2ZmRggRi8WMR+LC4XDJmHkyJzt79qx42nor5+Ry\nOTm4Se2BdQrbTbH5fD6ZTGqaFovFVFXNZrPZbLaW8Z1XVlbu3LlTV5AAAKBNyQ4TQgg5+Fx5\nXY95YDmj0W9qakqmUEIIVVXz+bzf789kMsbwIoFAQO6q4ppCiFAolE6njS6ucpGcnp6eloeT\nOdnU1JSqqnKH8vmxSCSysLBQe2ANLbDmstd5IhaLyRK5fv26eJos12JjY0MIMTQ0ZDM8AADQ\n1vZ95Ve1Faampkoe0zfGHNl3TWP9iq+18Pv9Jfsxx2BM1x5YB7GX2KmqKrNpWV0nSzORSKTT\naesN33vvvStXrnzwwQcl8zc2Nn72s58Zf+q6XiwWd3d3bUVVn729PTnhzOFcw+gNbSY/PxaL\nqunt7a22qPbrsre3Z165jjDqU+1A9Z1UHVtZb9KMcjA2LynzBurt7X3huRf7vH3mmcd8x623\nangwjf1/Xvex6lbx+82xj0Z36pR7SrFYbHUIaC57id3CwsLk5GQul1NVdWFhQTytX41EIhZv\ngpufn//DP/zDiot+8IMfGBWeQoiTJ08WCoUHDx7YiuogdF138nAdTVGUo8dP9PZUaL7fKRSF\nENUWPXzwi4o3D4/HMzAwUO1wDx8+rPELaHNzc3Nzc98Iq4VRB0VRBvr7lb6+8kX6zo7FhtVO\nqo6isN5EV7xNLYcnT54ccA8VeTye/uP9//v3vlO+aHdvt9dbNZGt/X/Lvqwu7vb2rre3gQVr\nfaz7jx4d/ErJ7zcHDgSpWCy2+T2lUCi0OgQ0l73Ezu/3l9Rb7lsBu7q6ev78+cHBQduhoc0o\niuLr8Vx6+0f3Hz+Tuwwc8b37ra8IIaotUhTFmduGdYQNDENRFKWv7+NXv1r89FPzfM+pU597\n/4cNOcQBOVMOzeDz+v7r4mjx3j3zTM/Jky9cX3EmAOuL62vo/3PrYymPHzvzP7aBBwLQcvYS\nO6l8VMC5ublqYxLevHnzxo0bxp9vvvnm5cuXR0dH5Z8TExNjY2PG0tdee83n8508ebKOqOza\n3Nx88uSJoigW1R4o92ir8HDzmYYGn9djvejEiRN1HKiWre7fv6/r+pEjRw4dOrRvhPWFYUF/\n+Fnx2Z/mSp/PepPmFUW5ZpSDruv3798XQvT39/dVqv5piL31n+998l/mOd7tLetNnLy4DS/Y\nasc6yEltbW09fvxYCGH+Om3GgWCQ9xSPx9Pm5enz7fM1hU5nL7Ez3iFWrlpid+XKlStXrsjp\nq1evXrp0aWRkxFjq8/nM/8lK3mnRVMZRnDlcN6uvhGvfSvZIb1IYjdXsonBsbzWWuWPaIZiG\nx3CQHdr6fmuH0nMB7iloE/YSu9nZWVVVh4eH5TvgjPmyXzEAAABayF5il8vljEcxxsfHZYcJ\nTdM6bpQXAAAA97E9QLE0PT09Ozsrp/1+vzFt7a233jK3wwIAAKCB7CV2kUhEvhzW7/cPDw8H\ng8FMJhONRuXAzQAAAGghe4md7CGxuLhoTIfD4VQqZR6LDgAAAC1he7iTii/lAAAAQMvZfsYu\nk8kkEgnjT9ka29CQAAAAUA97iV0ikQiHw7IpVspms7Ozs+ZUDwAAAC1hryk2FovF4/GLFy+a\nZ8qeE1NTU42MCwAAdI7yt+3Vzng1JQ7O9jN2FRM4esUCANDNyt+2Vzvj1ZQ4OHtFqapqyYti\n5QN2qqo2MigAAADYZy+xm5mZCQQCmUxG0zRN06LRqHx17MTERHPCAwAAQK3sJXahUCidTofD\n4UAgEAgEUqmUECIej/OAHQAAaBVN0xRFKR+mQ75VoSUhtYrtVu1QKKQ/i6wOAAA4IBqNKk9F\no1E5U9O0QCDQ2sDaB48rAgCADqAoihDCqFcy5vj9/nw+X3GTbDbbbdVPJHYAAKDdBYNBVVXl\n60ylZDKpqmowGBRC+P3+1oXWXkjsAABAW9M0LZfLlffUnJiYyOVyJeN1BINBRVGCwaDx4J0x\nIRcZbbiJRMJo2JXP58kVFEWRmxjTmUxG7rPiVm1l/8ROtmc7EAoAAEA52dJ65syZkvlyTkk7\n7MTERD6fX1hYkA/eGU/ghcPhhYWFfD6fSqXk4B6xWCyfz+u6HolEZmdnhRDZbFYIkU6n/X6/\nbO3N5/N+vz8UCkUikWw2W3GrtrJ/YpdKpeLxuAOhAAAAHITRMmtkZsaETNeMRls5X/45Pj5u\n7CEejy8tLclpVVXn5ubk9NmzZy22ah81NcUaDx5Wq7qjSg8AADSJrHK7e/duyXw5x+gSGw6H\nc7lcLb0lzJV8iqLIQXmlixcvyiq9TCazsLAgpxOJRMn7VEu2ah/7J3aRSMS6CbkNG5gBAIBr\n+P1+VVUXFxdL5i8uLqqqalTCpdPpSCRiPEK3L/lEna7r6XTafKxIJDI3N7e0tGRMC1P/jIpb\ntY/93xU7PT1tHh6GyjkAAOAw+cxcNBo1OsZGo9FcLiebWQ3JZFJRlLNnz+5bb5fJZEo21zTN\naGMNh8MybzNPW2/VJvZP7OTwMNevX799+3YqlYpEIiUrrK2t5XK55oQHAADwq4fbZG2ZnBOJ\nRIwES86UGVgkEonFYrFYTL7IPhwOv/jii3Iin88bHSlka6y5umpyclJ2npBdJUKhUMm0/LPa\nVm1i/8ROCOH3+2Xmm0qlzEPIGKjGAwAAzVYthTJXoYVCoYq5SvmaJbV9ZiUD5lXbQxuyN45d\ntebk9mxmBgAA6Cr2EjujKrLG+QAAAHBMPW+ekGM3B4PBaDRaMtwzAAAAWqWmZ+zMgsGg0VUi\nl8ulUilVVdvqsUEAAIDuZC+xk12L0+m0ue01Go0mEolaxgMEAACu9BvPHzrUW+cL6J8/4mts\nMN3MXmKXSqVKsjohRDKZDAaDJHYAAHSt/+/y+VaHACHqeMauYj8JxrEDAABoOXs1dqqqlo+w\nHI1G5RiAAACgO3386leLn35a37aeU6c+9/4PGxpO97KX2M3MzAQCgUgkMj4+LoS4e/duLBYT\njGMHAEB30x9+VnzwoL5tlT6esWsYe4ldKBRKp9PhcDiVShkzy5+6AwAAgPNsD3cSCoXa/GUa\nAAAA3anOnskAAABoNyR2AACg4wWDwUQiUXGRpmmKomQymdo36VwkdgAAoGPILK32N5pqmhYI\nBJoaUlux/YwdAMn7m59XnnvOPMczcLJVwTjG6/UKIRRFac3R3VjmrjwpoHnm5uaEENevXy95\nM0K1t5v6/X5d1yt+a7nyhajtldjpul4oFB4+fOjAsfb29uQRnTlcu1EUxXfosK+nQpXtTqEo\nhKi4qD6PHj2q2OFGUZT+/v5qW+0UitXC29l6Inco/93a2trd3d13hxXDsC4H40AlPB7P4Z6e\nF/5huXyRvrOj+Kr22692UruFYm/1Aq8WucXJWqh2OSwYpaQoyokTJ8yLLEqpDtYnpW9vVy7z\n7e0nhUKxWHQgBgsW/2N793aVvr7yRfr2thCiGSclv9+EEPL7rY6PBuzqlHtKoVBodQgNEIlE\nFhcXeeVVRfYSO5nwNvUrQFEUj8eJBmLjG9OZw7UbRVF8PZ5Lb//o/uMd8/yBI753v/UVIUT5\nov/2Qn/y/zlXx7E8Hk+1xM5iK4vwCk93qCiKrusej0deROsdVgzDuhwK1SNX+vr+Z+rmL548\ns9WJw76/iVi9VMe6zO1GbrGJ3b1Zq6+U6mB9UhZlruztNeqDXHfBWl3cnr7ysVuNEVmbcVIl\n3291fDRgV6fcU1pV3d4oiURienpaCBEIBDKZjDHammxvNcZfCwaD8p1YkUgkmUwam8v5cmbJ\nJq5h+80TCwsL5fPNhXsQiqJ4vd4jR44cfFf72tzc3N3dVRTFmcO1p0dbhYebu+Y5Pq+n2qLH\n23X+zjt8+HBjwzN2uLW1JYTw+XyHDh06SBj7Hqiijx9s3Xu0bZ6zs7t//YpFmVdTdwE2dm/1\nlVJjVStzJ2OwYHFxy8duNUZkbcZJGdXYtXy/tUnpdbpOuafIpyk61+3bt2VFnaqqS0tLMvco\neYouGAzOzMyEQqFMJhMOh6enp+Ubs8LhcD6fF0IEAoFvfvObLsvnDPZ+WGSz2Xw+X/LEoqZp\ns7OzDY0KAADgGZlMRr74SggxMTFhvCtBPkVnrCOevtdejrxrvAc1nU77/X75p67rbq2orqcp\nFgAAwGFLS0vmF1+JSg2Gd+/edTaotmMvsYvH47FYLBKJmGeura3JlmwAAIAmOXv2rLmaLRqN\nzs7OliR2Z86c6fKcxF5id/HixcXFRfNziFIwGGxcSAAAAM+IRqOy24Rhenq6pAuFeNoIG41G\nZa6iaVo+n3fr43QV2Uvs/H7/wsKCTOPk6C/BYHBiYsKVI8EAAIB2IJ8ES6VS+XxePiRndJgI\nh8OqqsrVZPcIOWqdbLRVVTWbzcq8RS41tnrxxReNmcZzeC5gL7GTHUzMc7LZrCxuhpMBAADN\nUN7RwdxhYt/1zdVPbu0zYbDXK3Z2djYSiZQXyuLiYuNCAgAAQD3s1djlcrmKra5d/qAiAABA\nO7BXY6eqaskgdnLAGKN5GwAAAK1iL7GbmZmRL9+VjEfuJiYmGhwXAAAAbLLXFCs7DMveEsZg\nxfF4nJ4TAAB0M+9vfl557rn6tvUMnGxsMN3MXmInnr6goxmhAACADvXCPyy3OgQIYbcpFgAA\nAG3Ldo2dpmlzc3Nra2vyz5mZma4a0BkAAJT7X/83+mD7l/Vte7zv+f/z30tfaoX61DlAsXmU\n50gkUv6SMQAA0D2eFB4/2n1U37a93t7GBtPNbA9QrKpqPp/PPpXP59fW1hKJRJPiAwAAQI3s\nJXa5XG5hYcH8SjW/35/NZnnzBAAAQMvZS+wikUjFF+Xy5gkAAICWs5fYJZPJaDRaMjORSPDm\nCQAAgJbbP7FTnpVKpUrmxGKxmZkZB2IFAABdKBqNGlmHfJdpMBiUf5bXN3W5/XvFxuPxWCwW\niUSqrXD27FlGPAEAAE2STCbHx8fD4bDxioSJiYmJiQlefFVu/8Tu4sWLi4uLDGgCAADagRyL\ng6yuov2bYmW/VwdCAQAAsFYtq0skEiXNtZqmyWnZbms02pavaaxsCAaDFdc0moDN62ualslk\nLLZyUj2vFNOeJU+m4ZEBAACYyeSsPKvTNC0Wi+XzeV3XI5HI7OyspmmBQEAIEQ6HFxYW8vl8\nKpWSeUvJmnIPgUAgnU7LmZFIJJvNVlxTVnWl02m/3y/bhfP5vN/vD4VCFls5yV5iJ5PQwLPk\nuygAAACaam1tLRaLlb8WQaZZckS28fFxY454moQZg7WVrymE0DRNCCETwfHxcfne1IprCiHi\n8fjS0pKcVlV1bm5OTp89e9ZiK8fYe6VYLBZTVbWkD+zS0lIqlWpoVAAAAKWy2WwikYjFYqLK\nM3ayCbHaKGyydq18Tb/fr6rq9evXp6am7t69Ozw8bLHPixcvxmKx6enpfD6/sLAQCASmp6ev\nX79+8eLF2iNpHnuJnXhaCWlGl1gAAOAMmc+V53bBYDCXy+m6nslkrBtAK64pUzS5W6PvbcU1\n/X5/JBKRFXXJZFJOnz171kgZa4+kGWy/eUJWV5ZoSWUjAADoQlNTU+l0OhaLGf0hMpmMzKWM\ndSqmKxZrTk5O6k/tu8/x8fFUKiWTHzl95swZu5E0ib0au2QymUgkpqamzFHm83nz0DIAAAAN\nFI1G5UNfiqKk0+lQKCSfckulUqlUSlVV2Zxo7so5OTkpJ8LhcD6fNzpS5PP58jXLN5dHqbam\n7CohVzBPi6fNmBW3coa9xC6TycRiMVlRCQAA4IBkMlkynm75HOsKJvPSimtOTEwY6ZemaXNz\nc6FQyGKf5qPbiqTZ7CV24XBYVdWShwrX1tZyuVxDowIAAHBIyXvJrl+/3rnPmDWg84QQQo7I\nBwAA0HGSyaSiKMYQH/F4vHM7htpL7OLxuKZpRr8PQ8kAKAAAAB3ENV0F7CV2U1NTsvOEeaam\naXSeAACgm73w3It93r76tj3mO97YYLqZvcRO9vKg8wQAADD737/3nVaHACHqaIqNxWKRSMQ8\nk84TAAAA7cBeYnfx4sXFxcWSbr1iv84Tq6urb775phBiaGjorbfeshsiAABoc+/+yfLmg636\ntn3u+KFL/+9YY+PpWvYSO7/fX7FXrMXIexsbGzdv3lxeXhZCjI2Nzc/PX7lyxW6UAACgne08\n2d1+tFPftt5eb2OD6Wb2EruKr8WYnJycmZmp1jF4fX3dyOQuX778wQcf2A0RAAAAtbCX2Mk3\ncpSbnZ2tltiNjIwY06dPn/7CF75gXrqxsfGzn/3M+FPX9WKxuLu7ayuq+uzt7ckJZw7Xhnp7\ne505kEUJ1xfD7u6u7Mfj9Xrl/5lCoSCE0HXdYofVwqhjE+utGq6OyOvYm2R+DY5h34It30p2\nk6+2t/oOZKG+k6q2fm9vr/c3P68895x5pmfgZB2BGerYYX1fTfJki8Wi1+sVQpg/GtViqHgF\nxcFGf2j4DhurGeF1yj2lWCy2OgQ0l+0Biiu+eaJkTjU3b948f/68ec4PfvCDeDxu/Hny5MlC\nofDgwQO7UdVN13UnD9c+PB7PwMCAM8d6+PBhxa+SumPQFW9vj0cI8fzzz/6jNwUAACAASURB\nVJvn7xasvrAqhmEdQ8Mjr08dkdvdmxBCUZSjx0/Igi1hXbDG5TDbKRSFEBX3tlMo9u7tKn0V\nhkXQd+psx6njpHYKxYcPflF+L/d4PCeOHHnhH5Yrhqf4fHWEp29v17HDaidVjflke3p6Dh8+\nbCzaKRSrxrC93SNE5cuxvX3/0SO76Y6iKM8ffb5iy9rezt4vH/6ytemdoigD/f0NPN8SxWKx\nze8pMteHi9lL7Iz37JplMplqNXlmGxsb4tkKPKA+vh7Ppbd/dP/xM0nAwBHfu9/6SqtCcgFF\nUeor2PKtjE2q7q2n7+NXv1r89FPzIs+pU597/4cHPxEz65NSFKXiXVzp6/ufqZu/ePLMJicO\n+/4mcr585ZrCaPQOKx/F+gr2WMVQ7XIojx/Xkdh5fd7y5+jl0/HVytwxiqIofVX/+9VxvmhP\nmqYFAoF0Ot25L5Com73ErmIniVAoFAwGLfpPSN/97nfLu8SOj4///u//vvFnNBrt7e09ceKE\nrajqs7W1tbm5qShKSa0PGu748caPPPloq/Bw85n2Dp+3Qq3MAcNoRuR1aGwY1nuro2DLtzI2\nsdib/vCz4rMVG0pfPZVhUn0nZbHVxw+27j3aNs/Z2T1QA1YdO6zvuluUuUUM1S5H3f/3yp+j\nl3V4bfKZavj5iqf3FI/H0ybnWI2Tj5E0UCKRqDiGbjweL3lpgnia1TkSVzuy3RRbLpFI7DuO\n3fz8/Ouvv14+v7+/v7+/3zxHURT5aEizeTy/+rJz5nDdrE1KuI4wOjdyx/bWJuo7qTYvinYI\nr+ExtMNJWThIeJ1yT6n4fGFHkNVvMmmTFauZTObu3bvla/r9/nw+37W5XT1vnihXMmRxiZWV\nlfPnzw8ODgohVldXBQ2yAADAjvJG1VAoVDGxE0KUv9S+ezSg88T4+LhFG/b8/PyNGzfMc+SY\ndgAAALUob28tmR8MBmXjYT6fL8nq5CJVVYUQch1z33w5bbF5x2lA5wlrV65cYURiAADQJNFo\ndGJiIpvNJhIJo6HWMDExsbCwINM1RVHS6bScH4/HL168uO/mHWf/x6LN7GZ1AAAAzaNpWiqV\nkimarMBLJBLGUvnKU6MSLh6PLy0tyenbt2/7/X7rzTtRTTV2Le+gDgAAUC6fz5v/lE2uUjgc\nFs/WSU1NTSmKMj4+LoSQ/1ps3qFqbYpVFMX6bI16TgAAAGfI3q/mZ+POnDkjJ9Lp9NLSUjQa\nTSaTxvrxeHx2dlY8TfgsNu9QtSZ2FR8nNMaVccHDhgAAoCNommZkHX6/X1VV+WpTTdNyuZy5\nQ2cymVQU5ezZs0Y3i6mpqVgsZrz1ynrzTlTTM3aqqpLVAQCAFopGo7KCLRAImJ+Ey2azuVxO\nUZRAICCbVmWP13A4nMlkIpFILBYzj9dmdJuotnlHq6nGrrzPRDQaTaVSgqwOAAA4IplMmhtV\nzUp6Apj/DIVCJVvdvn27ZPwUN3UksNcrVpJZnaqquq6T1QEAgE6RyWRktwm3sp3YGVkdQ58A\nAIBOkUgkFEVZWlrq9KforNkboNgYvpmsDgAAdJCpqalqb7BwExs1djKri0QiFR+5a2hUAAAA\nsK3WGjsjq6v43GIqlar2PCMAAHC9/heO9PR569v20LFDjQ2mm9X65gk5sba2Jt/OYSbfmwsA\nALrWN+f+R6tDgBC119hVq6sTQmiaJseVAQAAQAvV+ozd9PR0tUVy1OYGxQMAAIA61VRjt+/A\nfXSSBQAAaLl6BigGAABAGyKxAwAAcAkSOwAAAJcgsQMAAHAJEjsAAACXILEDAABwCRI7AAAA\nlyCxAwAAcAkSOwAAAJcgsQMAAHAJEjsAAACXILEDAABwCRI7AAAAlyCxAwAAcAkSOwAAAJcg\nsQMAAHAJEjsAAACXILEDAABwCRI7AAAAlyCxAwAAcAkSOwAAAJfoaXUAz9B1vVAoPHr06ID7\nURRFUZSK+9d1XU4XCgU55+CH60SKohw5csSZYz158qTaosOHDzsTg0UYFjE8fvzY+A9j5mTp\niboir2Nvde+wHdR3UhWvr8MX14LFSVXT8CtY7SNgQRZg/wtHevq85vmHjh0SVU5KHqLal3Z9\ni6qFbX196zhfw97enuiEe4q898HF2iuxE9VzMlt76PEd8vVUqIzcKRQLO1slXwcHPFyHcvKs\nq12O3ULRmQAO+3p2CsWK9zzrGKqVkmOlV3fkFlp+OZqhvpOqeB3b5wvhOa9X6esrn79TKDp2\nBesoDY/Hs7ez9825/1G+SN/ervifWd/e3vX2VvvS7t3brVgO1lsZX/UlrM+oIVe/ff4LVdTm\n4eHg2iuxUxTF6/U25Ofypbd/dP/xjnnOwBHfu9/6iq/nV18rm5ubu7u77fPr3MV8PZ5ql8OZ\nAPp6PfXF0PIarLojt9Dyy9EMHXp9rSl9fR+/+tXip5+aZ/acOfPC0nuOXcG6i+i/Lo4W790z\nz+nx+0/+3d+Wn5Hn1KnPvf9DX/UvbdFToRz23cr4qrflIP8lOuWe4vV6918Jnay9ErsGerRV\neLi5a57j8/JAYcu0w+Vohxjq0/DIO7coLLjypPSHnxUfPHhmzqOHohNOdm/953uf/Jd5jtJ/\nRFQ6I6XPJycsTqq+rYDuxAcAAADAJUjsAAAAXILEDgAAwCVI7AAAAFyCxA4AAMAlSOwAAABc\ngsQOAADAJUjsAAAAXILEDgAAwCVI7AAAAFyCxA4AAMAlSOwAAABcgsQOAADAJUjsAAAAXILE\nDgAAwCVI7AAAAFyCxA4AAMAlSOwAAABcgsQOAADAJUjsAAAAXILEDgAAwCVI7AAAAFyCxA4A\nAMAlSOwAAABcgsQOAADAJUjsAAAAXILEDgAAwCVI7AAAAFyCxA4AAMAlSOwAAABcgsQOAADA\nJUjsAAAAXILEDgAAwCVI7AAAAFyCxA4AAMAlHErsrl69OjY2dvXqVWcOBwAA0IWcSOzm5+df\neeWV5eXlV155ZX5+3oEjAgAAdCEnErsbN268/PLLQojR0dEbN25sbGw4cFAAAIBu09PsA6yu\nrg4NDQ0ODso/h4aG1tfXjT/v37//8ccfGyvruq7reqFQOOBBe3qqnpex82KxWDKn21iUEiSL\n/xuUngtUu75cXEN9X4/tUID1fXgPcjvolHuKruutDgHN1fSP3/r6evmckZEROZ1Op+PxuLHo\n5MmTu7u7v/zlLw9yRI/HMzAw8BvPHzrU+0x95PNHfEKIzz77zPj4CSF0XT/g4TqUdSkJIcoX\nvXi8r+J8i03aZFHdkZf8bzHUUXoOR97aRbVs4v3NzyvPPWde5Bk4ue+ixkZe8fo6dnHrKyXv\n4GlnDiTLvNpHwIIswGqR13dx69jK+sPbwPMtUSwW2/yesru72+oQ0FxKs5P3lZWVDz744K23\n3pJ/Xr169ZVXXhkdHZV//t3f/V1JYjc0NPTnf/7nBzmioihHj5/w9VRoZd4pFB8++AW/V8R+\npSSEqLaojk3aZFEdm1T731J36TkWecsXWW/Su7er9PWVL9K3t4UQ1RbtensbG3nF6+vwxbVY\nVK2UGv5fwuJy3H/0yO4XpqIoA/391XZYx8W1CM9iK4sPr0V4dZxvx/nLv/zLbDb7/vvvHz58\nuNWxoCmaXmN3+vRpiznhcNiovRNC/Omf/mlvb+/zzz9/4MMWC4VKv9WEOH78uJze3t7e3NxU\nFMWY032qlpIQotqiOjZp3qLPPvtM1/XDhw/39vY2I3LL/xv1lF59i9qnzHVd/+yzz4QQ+5a5\n9d72vF5RsbnK65WbVVzkaXSZV7++zl1ci0XVSqmW/xK7u7tPnjwRT8+x7stR39fjnqh6Eeu4\nuBbhWWxlEblFeAe5Hch7isfjOXbsWN07cYD85MLFnEjs7ty5Y/x5584dc2I3MDAwMDBg/Kko\niqIozjyfYVRHt8PjIKiPfCjTsf8zkAUuhPB4PJR5OysUCvJKcZkc0yn3FEVRWh0CmqvpvWIH\nBwcvXLiwsrIihFhZWblw4YLRcwIAAAAN5MRwJ1euXPnggw/GxsY++OCDK1euOHBEAACALuRQ\njbHReQIAAABNwrtiAQAAXILEDgAAwCVI7AAAAFyCxA4AAMAlSOwAAABcou3GUfz3f//3P/mT\nP3HgQMVicW9vTzAMdyeTI4J6vV6Ph58oDqHMOwLfb87rlDLXNK3VIaC52i6xu3///r/+67+2\nOgoAAIDO016J3auvvnr//n1njvXRRx/dvXu3t7f3937v95w5Ihrun//5n/f29oaGhj7/+c+3\nOpauUCwW/+mf/kkIMTw8/Bu/8RutDgdV/fznP/+P//gPj8fzta99rdWxdIsPP/wwn8/7fL5X\nX3211bHsw+fztfl7z3AQinyfYBf6+7//++985zvHjx//wQ9+0OpYUKdXXnllc3Pzz/7sz/7o\nj/6o1bF0hZ2dHVVVhRB/9Vd/9Qd/8AetDgdVLS0tzc7O9vb2/su//EurY+kWf/u3f/vXf/3X\nJ0+evHHjRqtjQVfjKRkAAACXILEDAABwCe9f/MVftDqG1vB6vZ///OfPnTs3PDzc6lhQp76+\nvt/5nd8ZGRk5depUq2PpCoqiHDp06Hd/93dHRkaef/75VoeDqrxe7+nTp8+dO/fbv/3brY6l\nW3i93t/6rd86d+7cl770pVbHgq7Wvc/YAQAAuAxNsQAAAC5BYgcAAOASJHYAAAAuQWIHAADg\nEiR2AACxuro6Pz/f6ii6C2WOZiCxA4But7GxcfPmzVZH0V0oczRJ945jZ9fq6uof//Ef9/f3\nf/GLX2x1LKgHV9B5lHmnOHr06Llz5z7++ONjx44dPXq01eF0BcocTcI4djVZWVk5ffr0yMhI\nqwNBnbiCzqPMO8Lq6urNmzevXLki/5yfnzem0SSUOZqqp9UBdIZr164JIZLJ5ODgYKtjQT24\ngs6jzNvf6urqm2++KYT48MMP33rrrVaH0xUoczQbz9jtb3V1dXl5+cKFC9FotNWxoB5cQedR\n5h1hfX19eXl5eXn5zp07Y2NjY2NjH3744crKSqvjcjPKHM1GjV1V8/PzN27cEEJcvnx5ZGRE\nVpWPjY0tLy+3OjTUynwRuYLOoMw7yOjoqJyQF2hjY0Mm4sZ8NBxljmajxu4Zxs+m1dXV8+fP\nLy8vJ5PJa9euyflXrly5cOHC2NjYxsYGfdTb3+rq6o0bN5LJ5NDQ0LVr1+SDLFzBpqLMO8L8\n/LysKyqpKBocHFxeXr506dLq6mqrYnMryhzO0fHU6OioMf3OO+8sLy/rur68vLy+vj46Oion\n1tfX33nnHfOaaE+3bt26devW+vq6/NO4iLqucwWbhDJvZ/JC6E8vk/7sBaq2Mg6CMkdLUGP3\nK1evXhWmGrvz58/LR78/+uijwcFBWW8nK8xfeukl2pXa35tvvimfUJYGBwffeOONDz74QHAF\nm4Yyb1tjY2NGS9/NmzfX19eFELdu3TJaJDY2NjY2Noz1P/roo9YE6iKUOVqFxO5XLl26JBuP\nZG43MjKyvLy8sbHx0ksvCSEGBwcvX7584cKFwcFBnoRofysrK8vLy0NDQ9/97neNmSMjI1/4\nwhcEz7I0B2Xetmr/1SrJx/lbEqprUOZoIQYo/pXTp09///vf/+Y3v3nt2jVjPNW7d+9+5zvf\n+epXv/rDH/7w5Zdf/trXvtbqMFETefm+/vWvf//73//+97//9a9/Xc7/8Y9/fO7cuZaG5lqU\nedsaGBj4+OOP//Ef/1F+s50+ffq1117b2Nh4/PjxF7/4xaNHj/b397/wwgvy+21jY0PTtNdf\nf50hcw+CMkcLMUDxr62srLz88su3bt26du3a5cuXZR2D7OJ34cIFBpBsQ0YHTItmvqtXr965\nc0dO0xp4cJR5J7p69eorr7xi/maTo6klk8lbt269/PLLjDXYcJQ5WoUau187duzYrVu3RkdH\n+/v7jXq7c+fOvfbaa1Q5tKdz58795Cc/+fTTT7/3ve9973vfO3PmzOnTp0vW+frXv/6Tn/zk\n1KlTf/M3f9OSIF2GMu9EW1tbMpMwvtlOnz59//79eDxu1BuhsShztEqX1thtbGxU/LVkvNpl\nZWXF/EsLbUvWsw4ODhq1RENDQ+XjuctHXhjnvSEo846zsbEhf7XyzeYYyhyt0qWJ3djYmJwo\nuSGZ324pP42CtqS2Z6TjxlCfBvP1lVlIxRQEdlHmbYtfrc6jzNFWuvHNE3Ic/KtXr37hC1+4\nceOGTPLkR250dHR+fl4mdi+//LKgN1/n2NjY+O53v2sezL38a5T3ljYWZd6GjDy7JJ9+6aWX\nVldXR0ZG5AW6du3atWvX+NXaEJQ52krX1dgZP63kPUl+CM3PehufzJWVFbK6jrC6unrz5s2S\nN2pz+ZqKMm9PJb9a5UxzVzCjnlW2ErYyVregzNFuui6xMzPndsLUqPTGG2/ISjt0CuPbU6rW\nMoIGoszbDb9anUeZow11dWInynI7SVaetyok1MF4nL/VgXQRyryd8avVeZQ52kS3v3licHDw\n9ddfl933DHwIO87o6Oh7770nhDC/ogcHND8/b7GUMm9nJd9s8k3zPN3VVJQ52kRXJHYV708b\nGxuy24T8NMpp6zsZWmJ1ddViqXEdP/zwQ6OzMw5ubGzMeGCoBGXeEfjV6jzKHG1BdzvZ17Vk\n5vr6+ujo6K1bt4w58rFWZ0NDTd55551ql8a4juvr68vLyw4H5mKjo6PT09MVF1HmHUFeJvPE\nO++80+qgXKJaSVLmaBMuT+wq3p+Wl5dLsjqdT2Abu3Xr1vT0dHluV/E64uDW19erfRwo8/Zh\ncRVKfrjyq7WBKtYU6JQ52ombO09sbGy89957vOO1oxkdWWRHMx5YcYbsGGEeeZhBhtuNfGlv\n+SdCjoVrfmC/pP8y6jY2Nlbxg0CZo624ObET3J/chdzOMUaHPmN4YTlMF/eq9rG6uvruu+/y\niXAMNQXoFC5P7Lg/uQy5nWPKh92iEqJ9UJPdEtQUoCO4LbErH4KO+1PHWV1dffPNN+V0+R2L\nO1kz1DJ24+rq6unTpxm4rt3wiXAMNQXoCG4b7uTmzZsl4y+UD/Z9/vx5Rt5qWxsbGzdv3pTj\nP124cGFsbKxkDJq33npraGhobGyMgTYaqPyDU259fZ2sroVWV1fHnjLPNz4RrQrMxUrGWhoc\nHLx8+fLy8rLxQaC6Dm3IbYnd+fPn9/2O4/7UztbX11966SU5feXKlTfeeOPGjRslud3rr78u\nv15bEaA77fvBWVlZcTIelLD+wUNu1yTUFKATuSqxk81J1t9x3J/a3wcffGBMj4yMyNzOfOHe\ne+893rrYQNYfHDkc8UcffUSZt9C+P3ioyW4GagrQidz2jJ2h/LkT+XjEhQsXeB6izY2NjZVc\nJjmagPFcC5qHB7bak+wDa274k4+iXr582Ui4NzY25PBpLYrRbWrpoSJ/cFLmaCuuqrEzK69+\nkG/uI6trf5cvXy6pohsdHb1w4cKtW7daGFWXoFGvPY2MjNy5c8dcRTcyMnL58uVr164Z7YDU\nZDeW0Z2o4oeCmmy0LdfW2ElUP3QoOfgqtRGtwgenDcl6a/OHQggxPz//0ksv8blwAB8KdAqX\nJ3bi6adRVBo4A+1M5nZGm+zGxsb6+jqv03YMH5w2xA+e1iK3Q0dwf2LHF1/nMkaNEgwE6jg+\nOO2JHzytxQ8etD/3J3YMRwzUgQ9O2+IHTwvxgwftz/2JHQAADcEPHrQ/EjsAAACXcO1wJwAA\nAN2GxA4AAMAlSOwAAABcgsQOAADAJUjsAAAAXILEDnBIJpMJBoOKoiiKkslkzIui0aiiKHI6\nkUhUnIamacb4bWayYBOJhPMhNYo8tYrXOhqNaprmfEgAOhSJHVxFqSQYDNq6O1bMHg4ok8mE\nw+GFhQVd1yORyOzsbLXVYrFY+bTr7VvmmUxmcnJyenq6ZH4ikQiHw7lcrmmhNZFx1pOTk6lU\nquI609PTk5OTJb8EAKAqHXCXdDothIjH4yVzhBCRSGTfzfP5fDM+F5FIRFXVGtc0AjBPu9i+\nZZ5Opy1KT25uvuIdoeSsra+1ECKdTjsSF4DO1tOSbBJonkAgUDInFArpuh4MBlOp1NmzZ6em\npiw2n5ycbEZUa2trzditO+xb5uFw2MjOXcPW/7R0Oh0Oh3XGkwewH5pi0S0WFhaEEEbjpqZp\nxhNvwWBQzgwGg7JRT86XM+WDbnI1i/bckh0aa2YyGUVRcrlcLpcz79ZMrmMRvPkZLDlhxGwd\npAxJtkSbmzurza/xpPaNp9r+y+OsWOYlp6aqaigUqhhYyXHLY5Yzze3y5ggrHrHa2Rl7Limx\nOkrJ4qwrlmcoFFJVtaOfIwTgkFZXGQINZtEwp6qqeNqkJZ62zMr1jVbakhaxeDxuXs3iI2Ps\nOZ/PywPl83nzoas1Jhp1UeUBGNNyh8Z5lcRcLchIJGKUQyQSMZ9jxfm1n5R1PNX2bxGnRcGq\nqloSofkSG4EZR6x4ZeVqJZeg5BqZj1jx7GRRyOtlbhitu5REWVOsec2S/8O1t+YD6GYkdnAb\ni8TOfO80r2O+5ZfcbkuSPFHlUaeS9KjkFq5bJnZ69efqLJ63M6c71YIsida8fsX5tk7KOp5q\nx60Yp0ViJw9aUuYlgZU8VVntypYkZPF43OKxPIuzK/kPVncpVUzsKq5pBFwtEwUAA02x6FK6\nrk9NTclGtGp9KmVXRKMVTzbj3r17t3xN+fSe8aff749EItX6OTaWRZCqqobDYaNHcDKZlJtU\nm1+i7pOquP/aC9PMqNszaJqWSqXGx8eNOSVPVVa7srI10+iPvLi4ePHiRfG0Hdxgt/+pY5f+\nzJkzolKBAIAZiR26iOzBIG+Q8sY/OTm5sLBgNJlVVPJjqLzvRcUH78w3ewdUDDKbzcokIxAI\nmJ/9qjbf7CAnZbH/fQtzX/tmNhZXdmZmJpfLaZomQ/L7/XaPXn6s8pkOX3oAMCOxQ7fQNE3W\n38jH8AOBwPDwcDab3ffuvm8VjtzD7du3GxRpPaoFmUwm8/l8JBLJ5XLmmq1q8w0HPKlq+2/U\neGwWVX0WV1Ze+rm5ubm5uYmJCWOmOdcs6aVhrR0uPQCYkdihW8jRJeSDVjK9KB/ttoTMSMLh\nsJGOaJpWsWdieevb7du35UNRzWYRpOy86ff7k8mkPHFZw1Rtfom6T6ri/msvzPKzM6dxMvFa\nXFysuP6+VzYej6dSqVQqVUdlYUWOXXpZCBWzcAD4tQY/swe0msUAxcZM8zpyWlXVfD4vK5nk\n50IuLb9DV3x6XbYPyp0Y+yxZWm1b/Wn3ydqndV2Xh5PT1YI0P4BvDqnafFsnZRFPtf1Xi7Ok\nzMsLp2I3gpJeCOJpx9VqV9Yc6r5DVVucndxtSV+KOkqp5KxLelKb1zTWp1csgH2R2MFVKv56\nkZlBSVIlb6vyflw+0oT5FmukI8bNuyJjqAt51zfWLBlZtzylMPYvRwmpOG1+Vsx8muW5nTnI\neDxuRFXL/NpPyjoei/1XjNM68Y3H4+UJTcl+xLPdVCteWYMxcEk1FmdnfsLPnNvVUUrms973\n+sq9ddzbNQA4T9EZyhxAe1MUJZ1O23r6zUIwGMxmsw3ZlWPku4b5ugawL56xA9Du5Au1GrKr\nRCJhdJvoIK58qRqAZuBdsQDaXSgUSqfTiqLk8/n6xihJJBLG2+Q6q95L07TJyckGVlgCcDdq\n7AB0gFAolM/n5+bm6ttcDl5Y8pBcR5ibm1tYWCCrA1AjnrEDAABwCWrsAAAAXILEDgAAwCVI\n7AAAAFyCxA4AAMAlSOwAAABcgsQOAADAJUjsAAAAXILEDgAAwCVI7AAAAFyCxA4AAMAlSOwA\nAABcgsQOAADAJUjsAAAAXILEDgAAwCVI7AAAAFyCxA4AAMAlSOwAAABcgsQOAADAJUjsAAAA\nXILEDgAAwCVI7AAAAFyCxA4AAMAlSOwAAABcgsQOAADAJUjsAAAAXMKTSCSU/QSDwUQi0epQ\nAQAAYMUzNTWl63o6nTbPzefzuq7n8/lIJCKEyOVysVgsGAy2KEgAAADsT9F1/VdTimLMzefz\nfr9fTicSiVgsJqdVVc1msw6HCAAAgFrs/4zdxYsXjelcLqdpWjPjAQAAQJ32T+yMqjspn883\nLRgAAADUb//ErqSKLhAINC0YAAAA1G//xG5ubs6YjkQiJRV4AAAAaBM9Fss0TZubm0ulUvLP\ndDodCoUciQoAAAC2Ve4VWyISiUxPT1NXBwAA0M4qN8WWjGOXSqUCgUAwGKRLLAAAQNvafxy7\nTCYTDoeNRTTIAgAAtKf9O0+EQiFVVY0/Z2dnmxkPAAAA6rR/YieEGB4eNqZzuVzTggEAAED9\nakrsAAAA0P5qSuzW1taMaXOzLAAAANrH/oldJpMxN7/OzMw0Mx4AAADU6VeJXSaTMc+9fv26\nMZ8usQAAAB1BicfjsVjMeiVVVWdmZkjpAAAA2tmvx7EDAABAR6NXLAAAgEuQ2AEAALgEiR0A\nAIBLkNgBAAC4BIkdAACAS5DYAQAAuASJHQAAgEuQ2AEAALhET6sDeMY3vvGNYrH45S9/2YFj\n7e3tFQoFRVF8Pp8Dh0Mz7Ozs6Lre09Pj9XpbHUu32N7eFkL09vZ6PPwsbF/y+00I0dfX1+pY\nukWn3FN++tOffvLJJ++///7hw4dbHQuaor0SOyHEl770pW9/+9sOHGhzc/Px48eKopw8edKB\nw6EZ7t27p+t6f3//oUOHWh1LV9B1/d69e0KIo0ePkjG0s62trUePHgkhTp061epYuoW8p3g8\nnoGBgVbHYmV6evqTTz5pdRRoIn5zAwAAuASJHQAAgEuQ2AEAALgEiR0AAIBLkNgBAAC4BIkd\nAACAS5DYAQAAuASJHQAAgEuQ2AEAALhE2715AgBwQIqi8J49oDu1V2JXLBZ3d3cfPHjgzLGE\nELquO3M4NIOu60KIzc1N+QJTNJsscCHEkydPtra2WhsMSiiKcrSv8tenbgAAIABJREFUT+nr\nE0L09fWZ3/mmb28/3N42Lh+aoVPuKbu7u60OAc3VXomdoigej8eZNyjv7u7u7e0JIdr8hc2w\nUCgUdF3v6enp6Wmv/8lupeu6fLU8Zd6GFEVR+vo+fvWrxU8/Nc/3nDr1ufd/6NN1Erum6pR7\nisfDI1gu115fzbL54LnnnnPmcDs7O4qiOHY4NNyTJ0+EEL29vYcOHWp1LF1B13VZ5j6fz1wh\nhPahP/ys+GyNkdLnE0LwGXFAR9xTaKN3PTJ3AAAAlyCxAwAAcAkSOwAAAJcgsQMAAHAJEjsA\nAACXILEDAABwCRI7AAAAlyCxAwAAcAkSOwAAAJcgsQMAAHAJEjsAAACXILEDAABwCRI7AAAA\nlyCxAwAAcAkSOwAAAJcgsQMAAHAJEjsAAACXILEDAABwCRI7AAAAlyCxAwAAcAkSOwAAAJcg\nsQMAAHAJEjsAAACXILEDAABwCRI7AAAAlyCxAwAAcAkSOwAAAJcgsQMAAHAJEjsAAACXILED\nAABwCecSu42NjbGxsbGxsY2NDccOCgAA0D16nDnMysrKtWvXksnk4OCgM0cEAADoNk4kdqur\nq9euXVteXnbgWAAAAF3LicTu3XffvXDhwtjYmBDijTfeGBkZMRbdvn37xz/+sfFnsVjc29vb\n3Nx0IKrd3V0hhK7rzhwOzbO7u6vruvU6iqJUW7Tvtt1j31IyympnZ6dYLB5wb6hPtYJVFKWv\nr6/aVltbWxR7U3XKPWVvb6/VIaC5mp7Yra6u3rlz59KlS1euXFlZWXnzzTfNDbL/9m//9vbb\nbxsrnzx5cm9v7/Hjx82Oyszhw6Hhtre3t7e3LVZQFOXo8RO+ngpPlO4Uig8f/IIbnrBZSpR5\nq1gU7G7BKtV+8uTJvrk4Dk7X9Ta/p5DYuV7TE7v19fWhoSFZSzc6Onrt2rX19XUjsfP5fMeO\nHTNWlr9ELX7oN5BxX3HmcGgGeRH3vYIej8fX47n09o/uP94xzx844nv3W1/xeDzc8ETNpVTj\nB4cybxLrgrXYUFEUvuuarcZvJKCpHOo8YRgaGlpfXzdaYycmJiYmJoyl3/jGN3w+38mTJx2I\nZHNz8/Hjx4qiOHM4NMO9e/d0XT9y5MihQ4f2XfnRVuHh5q55js/rEUKcOHGiWfF1IOtS0nX9\n3r17QoijR49atPrVuDfUrVrBWqDMm03eUzwez8DAQKtjseLz+VodApqr6cOdnD59+s6dOyVz\nmn1QAACALtT0xG5kZGRoaGh+fl4Isbq6Kuc0+6AAAABdyImm2LfeemtsbOzGjRtCCAY9AQAA\naBKHnrEjnwMAAGg23hULAADgEiR2AAAALkFiBwAA4BIkdgAAAC5BYgcAAOASJHYAAAAuQWIH\nAADgEiR2AAAALkFiBwAA4BIkdgAAAC5BYgcAAOASJHYAAAAuQWIHAADgEiR2AAAALkFiBwAA\n4BIkdgAAAC5BYgcAAOASJHYAAAAuQWIHAADgEiR2AAAALkFiBwAA4BIkdgAAAC5hL7HTnpJ/\nJhKJYDCYSCSaEBgAAADssZfYXb9+PRAIzM3NCSESiUQsFhNCLC4uRqPRpkQHAACAmvXY3SCf\nz/v9fk3TYrGYqqrZbFYIoShKMplsQngAAAColb0au1gs5vf7hRDXr18XQszMzDQlKAAAANhn\nL7FTVTWTyRjVdaFQSAiRSCTS6XRzwgMAAECt7CV2CwsLs7OzgUBAVdWFhQUhRDAYjMViS0tL\nzQkPAAB0nUwmEwwGFUVRFCWTybQ6nE5iL7Hz+/3ZbFbX9Ww2K9tk5Z88YAcAQHcyMjCzYDBY\nd0KWyWTC4fDCwoKu65FIZHZ2to6ddG23Ttvj2GmaFgwGg8Gg/JPhTgAA6GayikcIEYlEdF3X\ndT2fzw8PD4fD4fqyq6WlJVVVZf1RMpmU3TRt0TQtlUrVcWgXsNcrVibR5jnZbFZRFCHE1NTU\nwaMpFos7OzuffvrpwXdVI13XnTwcaqQoytHjJ3w9FX547BSKDx/8Qn6JSI8ePXr06JHF3jwe\nz8DAQLWl9+/fLxaLdmMQQtQYnvNslZ7BVik9fPjw4cOHFjHUV+b1URRloL9f6esrX6Rvb99/\n9Ki1l6OxrAvWQmPLHNUUi8U2v6fs7Ow0ac+qqhrTfr8/mUyura2lUqnx8XH5RH7t1tbWDhjM\n5OTkAffQuewldrOzs5FIJJlMymTOsLi42JDEzuPx9Pb2Pv/88wff1b62t7c3NzcVRTl+/LgD\nh4NdPT2eS2//6P7jZ76DBo743v3WV4xL9uDBA13XDx8+7PP56j7QsWPH6ohBCLFveC1US+nZ\nIktJ1/UHDx4IIZpX5vVReno+fvWrxWdvqJ5Tpz73/g+Pe72NPVaHaniZo4S8p3g8njYv6t7e\nXseONTExkcvl7t69K0fATaVSuq7LFj9ZCWcMiCsf3Pf7/eb6I5lpyB9m5WvKdTRNm5yczOVy\n5kXBYFDOkXtQVVX+KXclZ8pkRtO0GgNzrNAOzl5il8vlKtaIyiJrCEVRenpsj65Xh93dXTnh\nzOFQh0dbhYebu+Y5Pq9HlF0yj8dzkItovW21GGoPr1UaG57cyqj68nq9zSvz+ugPPys+eGCe\no/T5mnSsTkQ5NFun3FNK6mWa6vbt20KIM2fOGLlXJpOZmZmRqVsikbh9+7au65qmBQKBQCCg\n63ooFCrJsaqtKYSQf6bT6VAoJKcnJyez2Ww2m41GozJdk3swUj0hRD6fDwQCcrr2wBwrtIOz\nPdyJ8T4xST4aaa6ABQAAXU6mVnJktGw2G4lEhBChUEimbkKIWCwme176/f54PC6eZhTlqq05\nOTkZj8dlO6/f749EItWqmYaHh41pv99vJC0HDKw92UvsZmZm5PvEJKPKdGJiosFxAQCAjrK2\ntmb0kE2lUpFIpFq/B5kqGV1oZbvn3bt3a19T07RcLnfmzBljzWQyefCqtdoDa1v2aoxlXiwr\nco3q3Hg83pAH7AAAQOcaHh62NfxZ7XlY+Zol7YeN1VltryVsD3ci6yrNyOoAAIBdtTdxVluz\nSe9H6Ky21xL2EjvtKflnIpFgHDsAAGCL7L4QDoeNFErTtIrpRLU15aNyqVTKvFUmk6kxJ6s2\nokrtgbUte4nd9evXZadlYeoMvLi42LXjOwMAACFELpezGH+uZJHRLyEcDsun2QKBwMWLF4UQ\n8uG5XC4na5Es1pyZmRFCxGIx45G4cDhcMmaezMnOnj0rnrbeyjm5XE72va09sE5huyk2n8/L\noV9isZiqqrJfcdeO7wwAQJeTHSaEELlcTlGU8roe88ByRqPf1NSUTKGEEKqq5vN5OY6dMRZJ\nIBCQu6q4phAiFAql02mji6tcJKenp6fl4WRONjU1paqq3KF8fiwSiSwsLNQeWEMLrLnsdZ6I\nxWKyRK5fvy6eJssAAKBr7fvKr2orTE1NlTymb4w5su+axvoVX2vh9/tL9mOOwZiuPbAOYnsc\nu0wmY1TXydJMJBLpdLo54QEAAKBW9hK7hYWF2dnZQCAgX7IhhAgGg7FYrEndUgAAAFA7e02x\nfr+/pN5y3wpYAAAAOKOeV9qVjwo4Nzdna0xCAAAANJy9xM54h1g5EjsAAIDWspfYzc7Oqqo6\nPDws3wFnzJf9igEAANBC9hK7XC5n9B8eHx+XvWI1Teu4UV4AAADcx/YAxdL09PTs7Kyc9vv9\nxjQAAABaxV5iF4lE5Mth/X7/8PBwMBjMZDLRaFQO3AwAAIAWspfYyR4Si4uLxnQ4HE6lUsbL\nNwAAANAqtoc7qfhSDgAAALSc7WfsMplMIpEw/pStsQ0NCQAAAPWwl9glEolwOCybYqVsNjs7\nO2tO9QAAANAS9ppiY7FYPB6/ePGieabsOTE1NdXIuAAAwP/f3v3FtnHlhx4/I0qU/8j/nezK\nmzpAQXkFN0Af5HoNcp0NFpv6iq4Eb1HI2CcDeyGyXWFhBqiMonCRGhX6YBUJ2Y3aiu4NoKLo\nIn4IBKkm62bbBvFKFVoTiwUM1zD54gAVYSB2Ylu2LOrP3Ieznh0PyRFnNBwOh9/Pg0ANZ86c\nOYfD+fHMOWeax9mf/Pzh05K9bffvDH704287m5+WZbmPXcUAjlGxAAC0sqXna0+WV+1tGwzY\nnHwN5awVZTgcNjwoVnawC4fDTmYKAAAA1lkL7C5evNjT05PNZguFQqFQiMfj8tGxQ0ND9cke\nAAAAamUtsOvv789kMtFotKenp6enJ51OCyGSySQd7AAAQKMUCgVFUcqn6ZBPVWhIlhrF8l3t\n/v5+9WVEdQAAwAXxeFx5IR6Py4WFQqGnp6exGfMOuisCAIAmoCiKEEJrV9KWhEKhfD5fcZO5\nublWa34isAMAAF4XiUTC4bB8nKk0OTkZDocjkYgQIhQKNS5r3kJgBwAAPK1QKMzPz5eP1Bwa\nGpqfnzfM1xGJRBRFiUQiWsc77YV8S7uHm0qltBu7sn+eXEFRFLmJ9jqbzco0K27lKZsHdvJ+\ntiM7u3DhQi6XcyQpAADQIuSd1iNHjhiWyyWG+7BDQ0P5fH5qakp2vNN64EWj0ampqXw+n06n\n5eQeiUQin8+rqhqLxcbGxoQQc3NzQohMJhMKheTd3nw+HwqF+vv7Y7HY3Nxcxa08ZfPALp1O\nJ5PJre9pdnb2zp07W08HAACgIu3OrBaZaS9kuKbdtJXL5b9nzpzRUkgmk9PT0/J1OBweHx+X\nr48ePWqylXfUdCtW63hYrelu0ya9YrEohOjt7bWSNwAAACGb3O7evWtYLpdoQ2Kj0ej8/Hwt\noyX0jXyKoshJeaXTp0/LJr1sNjs1NSVfp1Ipw/NUDVt5x+aPFIvFYtlstr+/v9oKtdxg/vjj\nj0dGRm7cuGFYfuPGjWvXrmn/rq+vr62tPXnyZNMEt259fV0IoaqqO7uDJYqidHV1VXv36dOn\n8kVbW5sQolQqabUpf5ZZSm1pacnGViaqJeiaGkuv3M6dO6u9JQ9KO67l5eVSqaTtruJPu01T\nq/auVfJ4A994Tdm+Xb+8bf8Be/uqdkTVPmBu2vRjWa0cqtW7Fw6qHtyvxGa5pqytrTU6C3aE\nQqFwOHz16lVD0Hb16tVwOKw1wmUymenp6Xg8rh9jYSISiczPz6uqms1mtZuqoVAoFovJhrrJ\nyUn5+ujRo9peKm7lHZsHdqOjo/rpYWz0t5uYmPj93//9im/du3fvZz/7mfbvgQMHNjY2VlZW\nrO5iK1zeHWohI7ZqOjq3B9vbRFnoUFrbePLoy/JvbfPUSqXSxsaG1TzYSNA1NZaeweqaWZ4N\nB7W2tiYvD4qi7NqzrzxBS6ltUVtbm7qy8so/z5S/pa6sWN2Xoij7u7qUzs6KqT1sdNRuXrkm\n5dCxrSMYCJa/VVovPfnqic9iuwZWoqqqHr+mNPbbaStknzl90BaPx2WApV9tcnJSUZSjR49u\n2m6XzWYNmxcKBe0eazQazWQyhtfmW3nE5oGdnB7m2rVrt2/fTqfTsVjMsMKtW7fm5+erbZ7L\n5U6cONHd3V3x3ddff/173/ue9u8vf/nLtra2zkpno+Nk66AQwp3dwRLz3w/B9razP/n5w6cl\n/cL9O4Mf/fjbnZ2d5V/Zm6QWDFZrsas5vzUl6BrbpWe2VTAomzpkQ117e3sgEJD7Kk+wxtRq\nOZZaKIqidHb+ML3w5bOXDmrfjuCHsRPB1VVL+5Kp3X/zrY0vvtAvbzt48GuffdppMTXHmVeu\nWTkI8Uc/iz9a+Ur/1p7OvX/7vcmKZ01Ta0glymuKoijBYIUA2jts/2RtONm5TY5alUtisZhW\nlXKhjMBisVgikUgkEvJB9tFo9NVXX5Uv8vm8NpBC3o3Vn1Pnzp2TgyfkUAl5r1L/Wv5bbSuP\n2DywE0KEQiEZ+abT6YrNmybfNQsLC9evX9f+vXTp0vDw8MDAgPz35MmTJ0+e1N79vd/7vfb2\n9l27dtWY+61YXl6WJ6E7u4Ozlp6vPVle1S8JBtqEEDZuntq73+pmgo6rVnom5EGpqvrgwQMh\nxPbt2/W/iAwJ1pias+4/ev5g6aWWktLqhu19qU8ebzx6pF+idAZtp+amauUghHi29nRpdUn/\nVkegQzTDQdnjciU2yzWlvb2m675nVQuh9MF6f3+/ya1Y/ZomIb5hwrxqKXiQtQrWmiJrXC6E\nGBkZGRkZka8vXLhw9uzZvr4+SzsFAABALaw1yVYbQmEytAIAAADusHOvXc7dHIlE4vG4Ybpn\nAAAANIrle+1ylK98PT8/n06nw+Fwjd0GL1++bHV3AAAAqJG1wE4OLc5kMvp7r/F4PJVK1TIf\nIAAA8KWv7922rcPmkNu9Oz09lLi5WAvs0um0IaoTQkxOTkYiEQI7AABa1v8bPtHoLEAIG33s\nKo6TMJnHDgAAAO6w1mIXDofLZ1iOx+NyDkAAANCaymeErp2cO9rR7LQua4HdxYsXe3p6YrHY\nmTNnhBB3795NJBLCdB47AADge+UzQtdOzh0NR1gL7Pr7+zOZTDQaTafT2sLyXncAAABwn+Xp\nTvr7+z3+MA0AAIDW1KwPAwYAAIABgR0AAGh6kUgklUpVfKtQKCiKks1ma9+keRHYAQCApiGj\ntNqfaFooFHp6euqaJU+x3McOAACgUcbHx4UQ165dMzwZodrTTUOhkKqqiqKUv1XjA1GbCy12\nAACgmcRisatXrzY6Fx5lLbBTFKVizAsAAFBvqVRqdHR0dHR0fn5e32fO0IsuEonIiCUej+s3\nl8vlwmod75qdtcAuHA7n8/ny5f4rFwAA4DW3b98OhUKhUCgcDk9PT8uFhl50kUjk4sWLqqpm\nMpl0Oq31xotGo1NTU/l8Pp1O/8u//ItfO95ZC+zm5uby+byhx2KhUBgbG3M0VwAAAC/JZrPy\nwVdCiKGhIe1ZCbIXnbaOePFceznzrvYc1EwmI4NCIYSqqn6dlNfa4AnuwwIAgIaYnp7WP/hK\nCJHNZg3Pvrp79667mfIca4FdMplMJBKxWEy/8NatW/Pz847mCgAA4CVHjx7VN7PF4/GxsTFD\nYHfkyJEWj0msBXanT5++evXq5OSkYXkkEnEuSwAAAC+Jx+Ojo6P6JaOjoz09PYZGO/k6Ho/L\nWKVQKOTz+ZZ6or21wC4UCk1NTckwTs7+EolEhoaGfDkTDAAA8ALZEyydTufzedlJThswEY1G\nw+GwXC0ajebzeTlrnbxpGw6H5+bmZNwi39W2evXVV7WFWj88H7AW2GWz2Wg0ql8yNzcni9sw\nTyAAAIAjygc66AdMbLq+vvnJr2MmNNZGxY6NjcVisfJCYZ5AAACAhrPWYjc/P1/xrmuLd1QE\nAADwAssTFBsmsZMTxmi3twEAANAo1gK7ixcvyofvSlqXu6GhIYfzBQAAAIus3YqVA4blaAlt\nsuJkMsnICQAAWlngG68p27fb27Zt/wFnM9PKrAV24sUDOuqRFQAA0KRe+eeZRmcBQli9FQsA\nAADPstxiVygUxsfHb926Jf+9ePFiS03oDAAAyv3Rz+KPVr6yt+2ezr1/+z3jQ61gj80JivWz\nPMdisfKHjAEAgNbxbO3p0uqSvW07Ah3OZqaVWQvsxsbGwuHw1NSU9vCNQqFw7ty5VCrl1PgJ\nVVXX1tYcScrcxsaGfOHO7mBVe7vl5mRRvTZNUltbW9NGAumpqupsHmyrlj2TTezl3IQ8KG2n\n6+vr2mHa2JfjRWRev86mZlIdNmrKBtuV+8r2VzsDnfolu4N7xBaqw9njdTY1Zz8StWiWawq9\n5H3P8gTFhkeqhUIh+RQ2RwK7jY2N1dXVR48ebT2pTckPt6qq7uwOlrS1te3bt8/Ghk+ePNG+\nXmtMbUO0BQMVOpuurhnT2Uoe7FEUpWv33orZK61tLD3+quJ3tO3SM2E4qGfPni0vL9vel4NF\ntGkerO7LPLXA+rrS2Vm+XF1ZWQ10WK0pG2xXbmm99Fffea/i8qdPnlqtDkVR9u3cWa0ovnz6\n1NLxKoqyp2tPIBgof2u9tP5o6ZHV0nP2I2HJxsaGx68pq6urjc4C6staYBeLxSo+KNepJ0+0\ntbUFg8EDB9wY9ry8vPz06VNFUdzZHdxh45oXbG87+5OfP3xa0i/cvzP40Y+/7VoezFXL3v79\n+53dkQl5UKqqPnjwQAixa9euzkoXdUupucPZfSmdnffffGvjiy/0C9sOHvzaZ58GvVFT1QQD\nwR+mF7589lL29u0Ifhg7EdwXtJdmtaLYb+uz8dGPZpYfPdcv2b5n29m/GXS89Or08ZPXlLa2\nNi9Ut4lg0GZ1o1lYC+wmJyfj8bihR10qleLJE2hqS8/Xniy/9Cu2YtNLo3g8e61GffJ44+Um\nGaXzV1dKj9fU/UfPHyyt6JeUVrfUcGVSFDaUnq2uLL0UdwY6KrThATC3+ZeO8rJ0Om1Ykkgk\nLl686EJeAQBAC4rH41rUIZ9lGolE5L/xeLzRufOWzVvskslkIpGIxWLVVjh69CgzngAAgDqZ\nnJw8c+ZMNBrVOlwODQ0NDQ3x4Ktymwd2p0+fvnr1KhOaAAAAL0ilUkIIorqKNr8VK8e9upAV\nAAAAc9WiulQqZbhdWygU5Gt531a7aVu+prayJhKJVFxTuwWsX79QKGSzWZOt3GSnY2/hZfJg\nHM8ZAACAngzOyqO6QqGQSCTy+byqqrFYbGxsrFAo9PT0CCGi0ejU1FQ+n0+n0zJuMawpU+jp\n6clkMnJhLBabm5uruKZs6spkMqFQSN4XltPA9ff3m2zlJmuBnQxCe14mn0UBAABQV7du3Uok\nErLRTk+GWXJGtjNnzmhLxIsgTJusrXxNIUShUBBCyEDwzJkz8rmpFdcUQiSTyenpafk6HA6P\nj4/L10ePHjXZyjXWpjtJJBLhcNgwBnZ6ejqdTjuaKwAAAKO5ublUKpVIJESVPnbyFmK1Wdj0\nD1nQrxkKhcLh8LVr186fP3/37t033njDJM3Tp08nEonR0dF8Pj81NdXT0zM6Onrt2rXTp0/X\nnpP6sfxomvL+dgyJBQAA7pDxXHlsF4lE5ufnVVXNZrPmN0ArrilDNJmsNva24pqhUCgWi8mG\nusnJSfn66NGjWshYe07qwdqt2FgsJpsrDRrS2AgAAFrQ+fPnM5lMIpHQxkNks1kZS2nrVAxX\nTNY8d+6c+sKmaZ45cyadTsvgR74+cuSI1ZzUieUnT6RSqfPnz+tzmc/n9VPLAAAAOCgej8tO\nX4qiZDKZ/v5+2cstnU6n0+lwOCxvJ+qHcp47d06+iEaj+XxeG0iRz+fL1yzfXO6l2ppyqIRc\nQf9avLiNWXErd1gL7LLZbCKRkA2VAAAALpicnDTMp1u+xLyBSf9uxTWHhoa08KtQKIyPj/f3\n95ukqd+7pZzUm7XALhqNhsNhQ6fCW7duzc/PO5orAAAAlxieS3bt2rXm7WPmwOAJIYSckQ8A\nAKDpTE5OKoqiTfGRTCabd2CotcAumUwWCgVt3IfGMAEKAABAE/HNUAFrgd358+fl4An9wkKh\nwOAJAABa2SvbX+0MdNrbdndwj7OZaWXWAjs5yoPBEwAAQO+vvvNeo7MAIWzcik0kErFYTL+Q\nwRMAAABeYC2wO3369NWrVw3DegWDJwAAaG0f/Whm+dFze9tu37Pt7N8MOpuflmUtsAuFQhVH\nxbo58x4AAPCa0rPVlaWSvW0DHQFnM9PKrAV2FR+Lce7cuYsXLzbvwGAAAAB/sBbYySdylBsb\nGyOwAwAAaCzLExRXfPKEYQkAAADcZy2w056zq5fNZqu15AEAALisUCj09PRkMpkWvJ3YZmnt\nioMk+vv7z50751B+AAAAXpJKpZRKUqlU+coyqnM/kx5hLbCrKJVKMY8dAACon0wmo6pqPp8X\nQqiqqqpqJpOpuGYoFJKrtSY7T54oZ5iyGAAAwEHlN1X7+/vv3r1bceXyh9q3DgcGT5w5c6YF\n72EDAAB3GB5SX748EonIm4f5fN4Q1cm3wuGwEEKuI59uL9uq5GuTzZuOA4MnAAAAGiUejw8N\nDc3NzaVSqZ6eHhmraYaGhqampmS4piiKdgM3mUyePn16082bjgODJwAAABqiUCik02kZoskG\nPP2ICvnIU60RLplMTk9Py9e3b98OhULmmzejmlrsFEXZSgCby+UuXbokhOjt7b18+bLtdAAA\nAPQM4yTkLVcpGo2Kl9ukzp8/ryjKmTNnhBDyr8nmTarWW7GKopgfrdbOaVAsFhcWFmZmZoQQ\ng4ODExMTIyMjNjIKAABgIGc20feNO3LkiHyRyWSmp6fj8fjk5KS2fjKZHBsbEy8CPpPNm1St\ngV3F7oSpVCqRSFR7V1pcXNQiueHh4Rs3btjNKgAAgCgUClrUEQqFwuGwfLRpoVCYn5/XD+ic\nnJxUFOXo0aPaMIvz588nEolkMlnL5s2opj524XDYXlQnhOjr69NeHzp06PXXX7eVTwAA0NLi\n8bhsYOvp6dH3hJubm5ufn1cUpaenR95alSNeo9FoNpuNxWKJREI/X5s2bKLa5k2tpha78jET\n8Xg8nU4LiwODFxYWTpw4oV9y9erVv/u7v9P+DQaDpVLpwYMHNSa4FbLXoKqq7uyulbW1tVWc\nAVFV1Y2NjWqb7Nu3z8a+vvzyy/I0badmz1dffVVxucnxVmOe84oHu+lW9hj29eTJk6WlJdv7\nsldE1T5IiqLs2bOn2lYmpWQjNXuq5cEGFyp369mwmqBMreuVne2dAf3ybbu3CVufFvPsOXiG\nltvY2PD4NaVUKjU6C/ZNTk7qb6rqGUYC6P/t7+83bHX79m3D/CnNPhJWz/I8duJFVGd16pNi\nsShebsATQpRKpcePH2v/HjhwQLhevn6qTg9SFGXnrj3B9gptw6W1jSePvqxY/rYrRU5H7lRq\n9uzo2m31eKsxX7niwW66lT3l+9J+GtlIzUYRmXyQVtfMLsYVS0lRlL07diidnRXWr8Nlr1pN\n2UvKkXQMaVpN1t4n02T99dL698f/T/lb66V1G58W873v2b6iiVToAAAbJklEQVS9ctWvrDxc\nWtp6CXNN8bhsNiuHTfiV5cDOXlQnhHj//ffLh8R+61vf+tM//VPt37//+78PBAJdXV1Wc2XD\n6urqysqKEMKd3bUsRVGC7W1nf/Lzh09ful7u3xn86Mff7urqqnYVt7e7nTt3VryK20vNHhvH\nW415zise7KZb2SP3parq06dPhRDbtm1rb2+3vS97HwmTrTbNeXlqSmfn/Tff2vjiC/3ytoMH\nv/bZp5aOpRbVasqG+lWug9mwmqCiKIFg4IfphS+fvVS5+3YEP4ydCAjh7BeISdV3bSEsk9cU\nRVF27txpLwV3BAKBzVfyKdmFLBaLVWv28wdrgZ02fbPVqG5iYuKdd94pX97T06N/Uu+HH34Y\nCAS2bdtmKXF7VFWVJ6E7u2txS8/Xniyv6pcEA21CiM5Kv5u3wvEE7XHneN08WLkvLbDr6OjY\n4t7tFVG1rUyYJKg+ebzx6JF+idIZNE/NHo98LKvxyGl4/9HzB0sr+iWl1V+1xTp+QlWr+q0U\nRbNcU1o5sDt//ny1J1j4iYUJimVUF4vFKna5M9lwdnb2xIkT3d3dQohcLpfL5WxkFAAAAOZq\nbbHTorqKDZjpdLpaw+bExMT169f1S+ScdgAAwDfKh7/UTg6UgSNqffKEfHHr1i35dA49+dzc\nakZGRpiRGAAAf6s4/AXuq7XFzqSzYaFQ0PeTAwAAQEPU2sdudHS02lty1maH8gMAAACbamqx\n23T4t9VBsgAAAHCchVGxAAAA8DICOwAAAJ8gsAMAAPAJAjsAAACfILADAADwCQI7AAAAnyCw\nAwAA8AkCOwAAAJ8gsAMAAPAJAjsAAACfILADAADwCQI7AAAAnyCwAwAA8AkCOwAAAJ8gsAMA\nAPAJAjsAAACfILADAADwCQI7AAAAnyCwAwAA8AkCOwAAAJ8gsAMAAPAJAjsAAACfILADAADw\nCQI7AAAAnyCwAwAA8AkCOwAAAJ8gsAMAAPCJ9kZn4CWqqq6vry8vL7uwr9XVVblHd3ZnoChK\nxeWqqrqck3pTFGXbtm3V3n3+/HnFQzbfykTFBG2n5riVlRVLVawoSmdnp9XUzLeyRxastrtS\nqbSxsSHqULbe/0gEvvGasn27fknb/gPmm1itd8nZcjBhkr1qy+2d19XYPijzU8DBmlIUZdMj\nWl9fDwQCiqI8f/5cLrH3fV7t6mA7QYP19fWtJwIv81xgt7GxUSqVXNiXvCwJIdzZnZ6iKNt2\ndAXbjc2lpbWN58+WfBbbmX9ll0olZ69eFRP0TmCnBDo6y+pdCFFa2xBClH8kzAWFUCodl1qH\nj7QsWK1s19bW6hTYefwjoa6svPLPMxWWl0pKMFhtKxv1Xu3boB4fZpPsVftGsndeV82A3YMy\nybm9mqp2TpXWNpyqQXOKouzq7FQq/TBTV1aeWCzYirRrH/zKW4FdW1tbR0fHnj17XNjX8vLy\n06dPFUVxZ3flzv7k5w+f/voCvH9n8KMffzu4e3dDMtMou50+XscTdFawvc1Q7+JF1Yuyj4QQ\n4jdf6Zr8v8erpaZ0dt5/862NL77QL2w7ePBrn33qZKaFEC8KVlXVBw8eCCF27NjheKOgfkee\nTVDp7PxheuHLZy9V074dwQ9jJ0y2slrvLn8bmGTPXh5cOw3NCrbdTk1VPKfajxx5ZfpjN2uw\n2nm924mTrqOjY+uJwMu8Fdi1lKXna0+WV7V/gwH6O7YEQ70LXdWXv/V0Zc08NfXJ441Hj/RL\nlM6qrRFwxP1Hzx8sreiXlFY3bwKxVO/ufxt4IQ/2mOTcXk2Vn1Pq0hPzHTleepzX2IrmOHUB\nAACwKQI7AAAAnyCwAwAA8AkCOwAAAJ8gsAMAAPAJAjsAAACfILADAADwCQI7AAAAnyCwAwAA\n8AkCOwAAAJ8gsAMAAPAJAjsAAACfILADAADwCQI7AAAAnyCwAwAA8AkCOwAAAJ8gsAMAAPAJ\nAjsAAACfILADAADwCQI7AAAAnyCwAwAA8AkCOwAAAJ8gsAMAAPAJAjsAAACfILADAADwCQI7\nAAAAnyCwAwAA8AkCOwAAAJ8gsAMAAPAJlwK7CxcuDA4OXrhwwZ3dAQAAtCA3AruJiYmTJ0/O\nzMycPHlyYmLChT0CAAC0IDcCu+vXrx87dkwIMTAwcP369WKx6MJOAQAAWk17vXeQy+V6e3u7\nu7vlv729vYuLi9q/Dx8+vH//vrayqqqqqq6trdU7V0KIjY0N+cKd3Rm0t1cu+YZkpt6qHaww\nPV6TrUxUS9BeatDIglVVVf67vr6uFbWzZctHQuOFnNurDhvfY96vDhvsfZ87W7DltLMYflX3\nc2lxcbF8SV9fn3ydyWSSyaT21oEDB1ZXV7/66qt650qjqqqbu5Pa2tr279//9b3btnX8usV0\n786gEOLx48daxOkPFQ9WbHa85lsJISwlaDu1hr/16p5O800C33hN2b79pYPdf6Ae2TMU7LNn\nz549eyZMP8yO7OjXx1WHj4RJ6blWsPZy3tg8iM0K0Or3mPtnqKWqD3QfsrcjG9/nzhZsRaur\nq1tMAR6n1Dt4n52dvXHjxuXLl+W/Fy5cOHny5MDAgPz3H//xHw2BXW9v75/92Z/VNUsNpyjK\nrj37gu3G++CltY0nj7702c+pagcrTI/XfCshhKUEbafmkbeqLe9YX1U6O8vfUldWVgMdzubB\nak25tiN7CSqKsr+rq1rpCSFcK1gbOXfzw2xSHSYF+HBpydL3mMsHZXLiiCpVb3IamuzIxve5\nswVb0V/8xV/Mzc199tlnO3bs2GJS8Ka6t9gdOnTIZEk0GtVa74QQf/zHf9zR0bF3795650oI\nsbKysry8rCjKnj17XNhdmY21tbLf4kI0KDP1VuFgxebHW3UrIYR86/Hjx6qq7tixo6OjY7ME\nN0/Ns29VW74eCIiKt2YCgTanj1cWrKqqjx49EkLs2LEjGAy+eL/yh3krO6rCzkFVS3BdiGql\nJ6q/5XjBmry1lQ/z6uqqbFKVidSjOkwK0Nb3mHsFa3LiyM0qbrXpjkql0vLycltb265du8QW\nvs+dLlgj+W0JH3MjsLtz54727507d/SB3f79+/fv36/9qyiKoijudLbQmqN92bejRchOma59\nZqC1FgQCAcrcy9bW1mRlUU2uWV1dld9IHi9zRVEanQXUV91HxXZ3d586dWp2dlYIMTs7e+rU\nKW3kBAAAABzkxnQnIyMjN27cGBwcvHHjxsjIiAt7BAAAaEEutRhrgycAAABQJzwrFgAAwCcI\n7AAAAHyCwA4AAMAnCOwAAAB8gsAOAADAJzw3j+Ivf/nLH/3oRy7saGNjY319XTANdzOTs0wH\nAoG2Nn6iuIQybwp8v7mvWcq8UCg0OguoL88Fdg8fPvyv//qvRucCAACg+XgrsHvzzTcfPnzo\nzr4+//zzu3fvdnR0fOc733Fnj3Dcf/zHf6yvr/f29r722muNzktL2NjY+Pd//3chxBtvvPH1\nr3+90dlBVf/7v//7P//zP21tbd/97ncbnZdWce/evXw+HwwG33zzzUbnZRPBYNDjzz3DVija\nwx9bzT/90z+99957e/bs+bd/+7dG5wU2nTx5cnl5+U/+5E/+4A/+oNF5aQmlUikcDgsh/vIv\n//J3f/d3G50dVDU9PT02NtbR0fGf//mfjc5Lq/iHf/iHv/7rvz5w4MD169cbnRe0NHrJAAAA\n+ASBHQAAgE8E/vzP/7zReWiMQCDw2muvHT9+/I033mh0XmBTZ2fn7/zO7/T19R08eLDReWkJ\niqJs27btW9/6Vl9f3969exudHVQVCAQOHTp0/Pjx3/7t3250XlpFIBD4jd/4jePHj//Wb/1W\no/OClta6fewAAAB8hluxAAAAPkFgBwAA4BMEdgAAAD5BYAcAAOATBHYAAJHL5SYmJhqdi9ZC\nmaMeCOwAoNUVi8WFhYVG56K1UOaok9adx86qXC73h3/4h11dXd/85jcbnRfYQQ26jzJvFrt2\n7Tp+/Pj9+/d37969a9euRmenJVDmqBPmsavJ7OzsoUOH+vr6Gp0R2EQNuo8ybwq5XG5hYWFk\nZET+OzExob1GnVDmqKv2RmegOVy5ckUIMTk52d3d3ei8wA5q0H2UufflcrlLly4JIe7du3f5\n8uVGZ6clUOaoN/rYbS6Xy83MzJw6dSoejzc6L7CDGnQfZd4UFhcXZ2ZmZmZm7ty5Mzg4ODg4\neO/evdnZ2Ubny88oc9QbLXZVTUxMXL9+XQgxPDzc19cnm8oHBwdnZmYanTXUSl+J1KA7KPMm\nMjAwIF/ICioWizIQ15bDcZQ56o0Wu5doP5tyudyJEydmZmYmJyevXLkil4+MjJw6dWpwcLBY\nLDJG3ftyudz169cnJyd7e3uvXLkiO7JQg3VFmTeFiYkJ2VZkaCjq7u6emZk5e/ZsLpdrVN78\nijKHe1S8MDAwoL3+4IMPZmZmVFWdmZlZXFwcGBiQLxYXFz/44AP9mvCmmzdv3rx5c3FxUf6r\nVaKqqtRgnVDmXiYrQn1RTerLFVRtZWwFZY6GoMXuVy5cuCB0LXYnTpyQXb8///zz7u5u2W4n\nG8wPHz7MfSXvu3TpkuyhLHV3d7/77rs3btwQ1GDdUOaeNTg4qN3pW1hYWFxcFELcvHlTuyNR\nLBaLxaK2/ueff96YjPoIZY5GIbD7lbNnz8qbRzK26+vrm5mZKRaLhw8fFkJ0d3cPDw+fOnWq\nu7ubnhDeNzs7OzMz09vb+/7772sL+/r6Xn/9dUFflvqgzD2r9l+tkuzO35Cs+gZljgZiguJf\nOXTo0CeffPL973//ypUr2nyqd+/efe+99956661PP/302LFj3/3udxudTdREVt/bb7/9ySef\nfPLJJ2+//bZc/t///d/Hjx9vaNZ8izL3rP3799+/f/9f//Vf5TfboUOHfvCDHxSLxadPn37z\nm9/ctWtXV1fXK6+8Ir/fisVioVB45513mDJ3KyhzNBATFP/a7OzssWPHbt68eeXKleHhYdnG\nIIf4nTp1igkkPUgbgGlym+/ChQt37tyRr7kbuHWUeTO6cOHCyZMn9d9scja1ycnJmzdvHjt2\njLkGHUeZo1Fosfu13bt337x5c2BgoKurS2u3O378+A9+8AOaHLzp+PHjv/jFL7744ouf/vSn\nP/3pT48cOXLo0CHDOm+//fYvfvGLgwcPfvjhhw3JpM9Q5s3o+fPnMpLQvtkOHTr08OHDZDKp\ntRvBWZQ5GqVFW+yKxWLFX0vao11mZ2f1v7TgWbKdtbu7W2sl6u3tLZ/PXXZ5YZ53R1DmTadY\nLMpfrXyzuYYyR6O0aGA3ODgoXxguSPqnW8qzUXAvyfO0cFyb6lOjr18ZhVQMQWAVZe5Z/Gp1\nH2UOT2nFJ0/IefAvXLjw+uuvX79+XQZ58pQbGBiYmJiQgd2xY8cEo/maR7FYfP/99/WTuZd/\njfLcUmdR5h6kxdmGePrw4cO5XK6vr09W0JUrV65cucKvVkdQ5vCUlmux035ayWuSPAn1fb21\nM3N2dpaorinkcrmFhQXDE7WpvrqizL3J8KtVLtQPBdPaWeVdwkbm1S8oc3hNywV2evrYTuhu\nKr377ruy0Q7NQvv2lKrdGYGDKHOv4Ver+yhzeFBLB3aiLLaTZON5o7IEG7Tu/I3OSAuhzL2M\nX63uo8zhEa3+5Inu7u533nlHDt/TcBI2nYGBgY8//lgIoX9ED7ZoYmLC5F3K3MsM32zySfP0\n7qoryhwe0RKBXcXrU7FYlMMm5NkoX5tfydAQuVzO5F2tHu/du6cNdsbWDQ4Oah2GDCjzpsCv\nVvdR5vAE1e/kWFfDwsXFxYGBgZs3b2pLZLdWd7OGmnzwwQfVqkarx8XFxZmZGZcz5mMDAwOj\no6MV36LMm4KsJv2LDz74oNGZ8olqJUmZwyN8HthVvD7NzMwYojqVM9DDbt68OTo6Wh7bVaxH\nbN3i4mK104Ey9w6TWjD8cOVXq4MqthSolDm8xM+DJ4rF4scff8wzXpuaNpBFDjSjw4o75MAI\n/czDTDLsNfKhveVnhJwLV99h3zB+GbYNDg5WPBEoc3iKnwM7wfXJX4jtXKMN6NOmF5bTdHGt\n8o5cLvfRRx9xRriGlgI0C58HdlyffIbYzjXl027RCOEdtGQ3BC0FaAp+C+zKp6Dj+tR0crnc\npUuX5OvyKxZXsnqoZe7GXC536NAhJq7zGs4I19BSgKbgt+lOFhYWDPMvlE/2feLECWbe8qxi\nsbiwsCDnfzp16tTg4KBhDprLly/39vYODg4y0YaDyk+ccouLi0R1DZTL5QZf0C/XzohGZczH\nDHMtdXd3Dw8Pz8zMaCcCzXXwIL8FdidOnNj0O47rk5ctLi4ePnxYvh4ZGXn33XevX79uiO3e\neecd+fXaiAz606YnzuzsrJv5gYH5Dx5iuzqhpQDNyFeBnbydZP4dx/XJ+27cuKG97uvrk7Gd\nvuI+/vhjnrroIPMTR05H/Pnnn1PmDbTpDx5asuuBlgI0I7/1sdOU9zuR3SNOnTpFfwiPGxwc\nNFSTnE1A69eC+qHDljfJMbD6G3+yK+rw8LAWcBeLRTl9WoPy6De1jFCRPzgpc3iKr1rs9Mqb\nH+ST+4jqvG94eNjQRDcwMHDq1KmbN282MFctgpt63tTX13fnzh19E11fX9/w8PCVK1e0+4C0\nZDtLG05U8aSgJRue5dsWO4nmhyYlJ1+lNaJROHE8SLZb608KIcTExMThw4c5L1zASYFm4fPA\nTrw4G0WliTPgZTK20+7JFovFxcVFHqftGk4cD+IHT2MR26Ep+D+w44uveWmzRgkmAnUdJ443\n8YOnsfjBA+/zf2DHdMSADZw4nsUPngbiBw+8z/+BHQAAjuAHD7yPwA4AAMAnfDvdCQAAQKsh\nsAMAAPAJAjsAAACfILADAADwCQI7AAAAnyCwQwvJZrORSERRFEVRstms/q1UKqUoivnmcp1C\noVDPPPqBvpwPHz68acE6KB6P1293hUJBm0BOTx5vKpWq035dIA+tYtHF43E+80AzUQFHVfyY\nhcPhWCyWz+drTCQWizmesUwmI4SQeYjFYuFw2PCW+ekQi8XkOrUfhW31OHzXGMrZhe8ZfXHJ\nPdZjL5lMJhwOl9d+MpmUx5hMJuux37rSii4cDlerqXw+Hw6HM5mMu1kDYBOBHZwnL+3665wW\nOdUSsuTz+Xpcmw3BXPm7m+5UXsLrHdjV6fBdY17OjnOnuGRUZ56HpgvsDEVnfgoIIYjtgKbQ\n7lzbH/ArPT09hiX9/f2qqkYikXQ6ffTo0fPnz5tsfu7cuXrk6tatW/VI1nF1OnzXuFzO7hRX\nNBrVfpz4hqWiy2Qy0WhUZUJ7wPPoYwf3TE1NCSESiYT8t1AoaD2xIpGIXBiJRObn54UQcrlc\nKDu3ydVMuvsYEtTWzGaziqLMz8/Pz8/rk60xnfIVZG8kRVEM3aqqZUDfgSkSicg0az/82pNV\nXtAnaHLI1VKucafyhbaviuUsF1bMbbWktF3rO7TVWFza7mwfRblUKhUOh/v7+ysWXfmGFbNq\nqWoslYy9w6z4SZMqFkh/f384HG7qfoRAq2h0kyF8yOTOlOzKI+/piBd3ZuX62l1awy2hZDKp\nX83kQ6ulLHsFiZdvm4bD4RpvxVbLmLwVW+1fkwxoHZgymYxs+Kn98C0lK1cwHKaocvtY7ldL\nWQih33DTncr6NWTeUM76zovlua2WlNyvXEe7/VdLcZX3lbR9FHqyh2h50WnbytS0D3zFrFqq\nGkslY/swDZ80+a9+TcMp7PJNdgD2ENjBeSaBnf7ioV9Hf80zXG8MQZ6o0tcnFovpr77mAUe1\njGl7rJix8j52+q3MM1AxXKvl8K0ma7jqJ5PJan2/wuGw/i3bx2KIewzlbEjWkFuTpAyfotqL\ny5GjMGxl+MgZUjZ0Kq2W1dqrxlLJ2D5Mk6KrWCDu9DEFsEXcikXDqKp6/vx5eRdJ3hUqJycl\n0W5jydu4d+/eLV9T9t7T/g2FQrFYLJ1O1ylj0pkzZ7RMWs1AjXuxmqy8ZTY2Nib/vXr16unT\np8tXKxQK8/PzR44c0ZZMTk6qL3pQOViYTqm9UjSOHIXWTqwpFArpdFpWvWToVFotq9WqRt4+\n1hgm4tmUa5UlPy3lBQLAUxg8AVfJnvXyClEoFGT37ampKfN+3OpmXbYrdrzTX+0sqT1jW8lA\nLXuxd1wXL16MRqPatqFQyHx9R3Zab1YrpX5HsWlkY5LVLVZNxX2VL2x4ZQFoIFrs4B7ZSiSE\nkP3Qe3p63njjjbm5uU0vb5u2YcgUbt++7Ug+a8+YbDvs6emxkYFa9mLvuGTxjo+Pj4+PDw0N\nmaw5PT3t1E7rrfZKkep9FBWbjSWTrFasGjlmXGMYpWHOm5UFoIEI7OAe2XohexrJWG10dNR8\nE3mTKxqNarFdoVCoODSv/PbT7du3tclja1djxrRdhMNheXG1lIHa92LvuJLJZDqdTqfT1WaW\nCYVC4XA4nU7rCzObzcqMOVWYTrFUKRpHjkJ+AvVhnAy8rl69ai+rm1aNVa5VlvYzxvGUATjJ\n9V598D+TCYq1hfp1tDGS+Xw+n89rnbjlu+WXKJMxntqzAbTBp/p3q22rvhg/aJ4x+a9hVGyN\nGdDSt3r4lpLVE5tNB11xYjYbxyJ0w2nLy1m/cnluTZLSl3btxaVP0PZRGFQbRmAYhSBeDFyt\nllX9vjadqbvGktnKYVYsOi2f5QXCqFigKRDYwWEVfz9UfKSYvK7IC1L5VAv6a4wW21V8ppNG\nm+tBXva0NQ0RTPk1VUtfvlUtY+qLJxBUS6daBrSF+oOq/fAtJasv3k0fFaA/HEPZ1rJTVVfd\n8qlThnLWF2x5bk2S0vdjM68UfXEZ6tHeUZSXUjKZLF9u+EyKl4epVsxq7VVjqWRsH6a+6Gop\nEMMwagDepKjMJA74USQSmZuba3QufEJRlEwmY6n3m4lmrJpsNsuTJ4CmQB87wIdSqZT5sAlY\nIh+o5UhSTVo1vnyoGuBLTHcC+EcqldKe2EbjioP6+/szmYyiKPl83t4cJc1bNXL2FgcbLAHU\nFS12gH/ICQINPbHgiP7+/nw+Pz4+bm/z5q2a8fHxqakpojqgWdDHDgAAwCdosQMAAPAJAjsA\nAACfILADAADwCQI7AAAAnyCwAwAA8AkCOwAAAJ8gsAMAAPAJAjsAAACfILADAADwCQI7AAAA\nnyCwAwAA8AkCOwAAAJ8gsAMAAPAJAjsAAACfILADAADwCQI7AAAAnyCwAwAA8AkCOwAAAJ8g\nsAMAAPAJAjsAAACfILADAADwCQI7AAAAn/j/7dH0DJk1x3wAAAAASUVORK5CYII=" }, "metadata": {}, "output_type": "display_data" } ], "source": [ "options(repr.plot.width=7,repr.plot.height=7)\n", "\n", "cols <- c(\"Okinawa\" = \"#377eb8\", \"Aichi\" = \"#e41a1c\", \"Kanagawa\" = \"#4daf4a\", \"Tokyo\" = \"#984ea3\")\n", "\n", "df_confirmed %>%\n", " gather(Prefecture,c,-date) %>%\n", " mutate(Prefecture=factor(Prefecture, levels=c(\"Okinawa\", \"Aichi\", \"Kanagawa\", \"Tokyo\") %>% rev)) %>%\n", " filter(c>0) %>%\n", " ggplot(aes(date,c,fill=Prefecture)) +\n", " geom_bar(stat = \"identity\",color=\"white\",size=.25) +\n", " scale_fill_manual(values = cols) +\n", " coord_cartesian(xlim=c(as.Date(\"2018-03-14\"),as.Date(\"2018-05-18\"))) +\n", " scale_x_date(labels = date_format(\"%d-%b\")) +\n", " labs(x=\"Date of laboratory confirmation (day-month)\",y=\"Number of cases\") +\n", " guides(fill = guide_legend(reverse=T)) +\n", " theme(legend.key.size = unit(.5, \"cm\"),\n", " axis.text.x = element_text(angle = 45, hjust = .5, vjust=0.5),\n", " strip.text.x = element_blank(),\n", " panel.grid.minor.x = element_blank(),\n", " plot.title = element_text(size=11, hjust = 0.5, face=\"bold\"),\n", " strip.background = element_rect(colour=\"white\", fill=\"white\"),\n", " plot.margin = unit(c(.5,1,1,.5),\"lines\")) -> p_confirmed\n", "\n", "p_confirmed = arrangeGrob(p_confirmed, top = textGrob(\"B\", x = unit(0, \"npc\"), y = unit(.5, \"npc\"), just=c(\"left\",\"top\"),\n", " gp=gpar(col=\"black\", fontsize=16, fontface=\"bold\", fontfamily=\"Times\")))\n", "\n", "df_onset %>%\n", " gather(Prefecture,i,-date) %>%\n", " mutate(Prefecture=factor(Prefecture, levels=c(\"Okinawa\", \"Aichi\", \"Kanagawa\", \"Tokyo\")%>% rev)) %>%\n", " filter(i>0) %>%\n", " ggplot(aes(date,i,fill=Prefecture)) +\n", " geom_bar(stat = \"identity\",color=\"white\",size=.25) +\n", " scale_fill_manual(values = cols) +\n", " coord_cartesian(xlim=c(as.Date(\"2018-03-14\"),as.Date(\"2018-05-18\"))) +\n", " scale_x_date(labels = date_format(\"%d-%b\")) +\n", " labs(x=\"Date of illness onset (day-month)\",y=\"Number of cases\") +\n", " guides(fill = guide_legend(reverse=T)) +\n", " theme(legend.key.size = unit(.5, \"cm\"),\n", " axis.text.x = element_text(angle = 45, hjust = .5, vjust=0.5),\n", " strip.text.x = element_blank(),\n", " panel.grid.minor.x = element_blank(),\n", " plot.title = element_text(size=11, hjust = 0.5, face=\"bold\"),\n", " strip.background = element_rect(colour=\"white\", fill=\"white\"),\n", " plot.margin = unit(c(1,1,.5,.5),\"lines\")) -> p_onset\n", "\n", "p_onset = arrangeGrob(p_onset, top = textGrob(\"A\", x = unit(0, \"npc\"), y = unit(.25, \"npc\"), just=c(\"left\",\"top\"),\n", " gp=gpar(col=\"black\", fontsize=16, fontface=\"bold\", fontfamily=\"Times\")))\n", "\n", "grid.arrange(p_onset, p_confirmed, widths=c(1), heights=c(1,1), nrow=2, ncol=1)" ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "# Delay function (constant *vs* varied in time)" ] }, { "cell_type": "code", "execution_count": 5, "metadata": {}, "outputs": [ { "data": { "text/html": [ "\n", "\n", "\n", "\t\n", "\t\n", "\t\n", "\t\n", "\t\n", "\t\n", "\n", "
onsetconfirmed
2018-03-142018-03-20
2018-03-272018-03-29
2018-03-272018-03-29
2018-03-262018-03-31
2018-03-252018-03-31
2018-03-272018-03-31
\n" ], "text/latex": [ "\\begin{tabular}{r|ll}\n", " onset & confirmed\\\\\n", "\\hline\n", "\t 2018-03-14 & 2018-03-20\\\\\n", "\t 2018-03-27 & 2018-03-29\\\\\n", "\t 2018-03-27 & 2018-03-29\\\\\n", "\t 2018-03-26 & 2018-03-31\\\\\n", "\t 2018-03-25 & 2018-03-31\\\\\n", "\t 2018-03-27 & 2018-03-31\\\\\n", "\\end{tabular}\n" ], "text/markdown": [ "\n", "onset | confirmed | \n", "|---|---|---|---|---|---|\n", "| 2018-03-14 | 2018-03-20 | \n", "| 2018-03-27 | 2018-03-29 | \n", "| 2018-03-27 | 2018-03-29 | \n", "| 2018-03-26 | 2018-03-31 | \n", "| 2018-03-25 | 2018-03-31 | \n", "| 2018-03-27 | 2018-03-31 | \n", "\n", "\n" ], "text/plain": [ " onset confirmed \n", "1 2018-03-14 2018-03-20\n", "2 2018-03-27 2018-03-29\n", "3 2018-03-27 2018-03-29\n", "4 2018-03-26 2018-03-31\n", "5 2018-03-25 2018-03-31\n", "6 2018-03-27 2018-03-31" ] }, "metadata": {}, "output_type": "display_data" } ], "source": [ "df_epicurve %>% \n", " select(-prefecture) -> df_delay\n", "\n", "df_delay %>% head" ] }, { "cell_type": "code", "execution_count": 6, "metadata": {}, "outputs": [ { "data": { "text/html": [ "\n", "\n", "\n", "\t\n", "\t\n", "\t\n", "\t\n", "\t\n", "\t\n", "\n", "
onsetconfirmeddifference
2018-03-172018-03-203
2018-03-272018-03-292
2018-03-272018-03-292
2018-03-262018-03-315
2018-03-252018-03-316
2018-03-272018-03-314
\n" ], "text/latex": [ "\\begin{tabular}{r|lll}\n", " onset & confirmed & difference\\\\\n", "\\hline\n", "\t 2018-03-17 & 2018-03-20 & 3 \\\\\n", "\t 2018-03-27 & 2018-03-29 & 2 \\\\\n", "\t 2018-03-27 & 2018-03-29 & 2 \\\\\n", "\t 2018-03-26 & 2018-03-31 & 5 \\\\\n", "\t 2018-03-25 & 2018-03-31 & 6 \\\\\n", "\t 2018-03-27 & 2018-03-31 & 4 \\\\\n", "\\end{tabular}\n" ], "text/markdown": [ "\n", "onset | confirmed | difference | \n", "|---|---|---|---|---|---|\n", "| 2018-03-17 | 2018-03-20 | 3 | \n", "| 2018-03-27 | 2018-03-29 | 2 | \n", "| 2018-03-27 | 2018-03-29 | 2 | \n", "| 2018-03-26 | 2018-03-31 | 5 | \n", "| 2018-03-25 | 2018-03-31 | 6 | \n", "| 2018-03-27 | 2018-03-31 | 4 | \n", "\n", "\n" ], "text/plain": [ " onset confirmed difference\n", "1 2018-03-17 2018-03-20 3 \n", "2 2018-03-27 2018-03-29 2 \n", "3 2018-03-27 2018-03-29 2 \n", "4 2018-03-26 2018-03-31 5 \n", "5 2018-03-25 2018-03-31 6 \n", "6 2018-03-27 2018-03-31 4 " ] }, "metadata": {}, "output_type": "display_data" } ], "source": [ "# we shift the onset data of the index case to the date of first exposure \n", "dayZero = as.Date('2018-03-17')\n", "df_delay[which(df_delay$onset=='2018-03-14'),'onset'] = dayZero\n", "\n", "df_delay %<>%\n", " mutate(difference=confirmed-onset,\n", " # if the onset date is unknown, it is assummed to be 5 days prior the confirmation\n", " difference=ifelse(is.na(onset),5,difference), \n", " onset=if_else(is.na(as.numeric(onset)),confirmed-difference,onset)) %>%\n", " mutate(onset = as.Date(onset)) %>%\n", " na.omit\n", "\n", "df_delay %>% head" ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "# Delay distribution function" ] }, { "cell_type": "code", "execution_count": 7, "metadata": {}, "outputs": [], "source": [ "h = function(t,parms) {\n", " pweibull(t,parms[1],parms[2])-pweibull(t-1,parms[1],parms[2]) }\n", "\n", "# Cumulative distribution function for delay distribution\n", "H = function(t,parms) { pweibull(t,parms[1],parms[2]) }" ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "## Constant distribution for the delay" ] }, { "cell_type": "code", "execution_count": 8, "metadata": {}, "outputs": [], "source": [ "calculate_constant_delay = function(prms) { \n", " df_delay %>% \n", " group_by(difference) %>%\n", " count %>%\n", " ungroup %>%\n", " summarize(loglk = sum(n*log(h(difference,prms[1:2])))) %>% \n", " .$loglk \n", "}" ] }, { "cell_type": "code", "execution_count": 9, "metadata": {}, "outputs": [ { "data": { "text/html": [ "-298.47783781515" ], "text/latex": [ "-298.47783781515" ], "text/markdown": [ "-298.47783781515" ], "text/plain": [ "[1] -298.4778" ] }, "metadata": {}, "output_type": "display_data" } ], "source": [ "# test\n", "init = c(2,4)\n", "calculate_constant_delay(init)" ] }, { "cell_type": "code", "execution_count": 10, "metadata": { "scrolled": false }, "outputs": [ { "data": { "text/html": [ "
\n", "\t
$par
\n", "\t\t
    \n", "\t
  1. 1.88393225205278
  2. \n", "\t
  3. 5.05014351109591
  4. \n", "
\n", "
\n", "\t
$value
\n", "\t\t
-280.42513510199
\n", "\t
$counts
\n", "\t\t
\n", "\t
function
\n", "\t\t
7
\n", "\t
gradient
\n", "\t\t
7
\n", "
\n", "
\n", "\t
$convergence
\n", "\t\t
0
\n", "\t
$message
\n", "\t\t
'CONVERGENCE: REL_REDUCTION_OF_F <= FACTR*EPSMCH'
\n", "
\n" ], "text/latex": [ "\\begin{description}\n", "\\item[\\$par] \\begin{enumerate*}\n", "\\item 1.88393225205278\n", "\\item 5.05014351109591\n", "\\end{enumerate*}\n", "\n", "\\item[\\$value] -280.42513510199\n", "\\item[\\$counts] \\begin{description*}\n", "\\item[function] 7\n", "\\item[gradient] 7\n", "\\end{description*}\n", "\n", "\\item[\\$convergence] 0\n", "\\item[\\$message] 'CONVERGENCE: REL\\_REDUCTION\\_OF\\_F <= FACTR*EPSMCH'\n", "\\end{description}\n" ], "text/markdown": [ "$par\n", ": 1. 1.88393225205278\n", "2. 5.05014351109591\n", "\n", "\n", "\n", "$value\n", ": -280.42513510199\n", "$counts\n", ": function\n", ": 7gradient\n", ": 7\n", "\n", "\n", "$convergence\n", ": 0\n", "$message\n", ": 'CONVERGENCE: REL_REDUCTION_OF_F <= FACTR*EPSMCH'\n", "\n", "\n" ], "text/plain": [ "$par\n", "[1] 1.883932 5.050144\n", "\n", "$value\n", "[1] -280.4251\n", "\n", "$counts\n", "function gradient \n", " 7 7 \n", "\n", "$convergence\n", "[1] 0\n", "\n", "$message\n", "[1] \"CONVERGENCE: REL_REDUCTION_OF_F <= FACTR*EPSMCH\"\n" ] }, "metadata": {}, "output_type": "display_data" } ], "source": [ "options(warn=-1)\n", "sol = optim(init,calculate_constant_delay,\n", " method=\"L-BFGS-B\",control=list(fnscale=-1),lower=rep(0,2),\n", " hessian=FALSE)\n", "options(warn=0)\n", "pars = sol$par \n", "\n", "sol" ] }, { "cell_type": "code", "execution_count": 11, "metadata": {}, "outputs": [ { "data": { "text/html": [ "564.850270203979" ], "text/latex": [ "564.850270203979" ], "text/markdown": [ "564.850270203979" ], "text/plain": [ "[1] 564.8503" ] }, "metadata": {}, "output_type": "display_data" } ], "source": [ "# AIC\n", "2*(2-sol$value)" ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "## *h* consists of two distributions" ] }, { "cell_type": "code", "execution_count": 12, "metadata": {}, "outputs": [], "source": [ "calculate_delay_consistent_of_two_distributions = function(prms,tau) { \n", " df_delay %>% \n", " mutate(hNum = ifelse(onset%\n", " group_by(hNum,difference) %>%\n", " count %>%\n", " ungroup %>%\n", " rowwise %>%\n", " mutate(loglk = n*log(h(difference,prms[(2*hNum-1):(2*hNum)]))) %>%\n", " ungroup %>%\n", " summarize(totalloglk = sum(loglk)) %>% \n", " .$totalloglk \n", "}" ] }, { "cell_type": "code", "execution_count": 13, "metadata": {}, "outputs": [ { "data": { "text/html": [ "-291.946913756662" ], "text/latex": [ "-291.946913756662" ], "text/markdown": [ "-291.946913756662" ], "text/plain": [ "[1] -291.9469" ] }, "metadata": {}, "output_type": "display_data" } ], "source": [ "# test\n", "init = c(2,4,1,5)\n", "calculate_delay_consistent_of_two_distributions(init,as.Date(\"2018-04-10\"))" ] }, { "cell_type": "code", "execution_count": 14, "metadata": {}, "outputs": [ { "data": { "text/html": [ "
\n", "\t
$par
\n", "\t\t
    \n", "\t
  1. 2.43885985234863
  2. \n", "\t
  3. 4.59432901810399
  4. \n", "\t
  5. 1.75023784234747
  6. \n", "\t
  7. 5.36600653013233
  8. \n", "
\n", "
\n", "\t
$value
\n", "\t\t
-275.586037868449
\n", "\t
$counts
\n", "\t\t
\n", "\t
function
\n", "\t\t
11
\n", "\t
gradient
\n", "\t\t
11
\n", "
\n", "
\n", "\t
$convergence
\n", "\t\t
0
\n", "\t
$message
\n", "\t\t
'CONVERGENCE: REL_REDUCTION_OF_F <= FACTR*EPSMCH'
\n", "
\n" ], "text/latex": [ "\\begin{description}\n", "\\item[\\$par] \\begin{enumerate*}\n", "\\item 2.43885985234863\n", "\\item 4.59432901810399\n", "\\item 1.75023784234747\n", "\\item 5.36600653013233\n", "\\end{enumerate*}\n", "\n", "\\item[\\$value] -275.586037868449\n", "\\item[\\$counts] \\begin{description*}\n", "\\item[function] 11\n", "\\item[gradient] 11\n", "\\end{description*}\n", "\n", "\\item[\\$convergence] 0\n", "\\item[\\$message] 'CONVERGENCE: REL\\_REDUCTION\\_OF\\_F <= FACTR*EPSMCH'\n", "\\end{description}\n" ], "text/markdown": [ "$par\n", ": 1. 2.43885985234863\n", "2. 4.59432901810399\n", "3. 1.75023784234747\n", "4. 5.36600653013233\n", "\n", "\n", "\n", "$value\n", ": -275.586037868449\n", "$counts\n", ": function\n", ": 11gradient\n", ": 11\n", "\n", "\n", "$convergence\n", ": 0\n", "$message\n", ": 'CONVERGENCE: REL_REDUCTION_OF_F <= FACTR*EPSMCH'\n", "\n", "\n" ], "text/plain": [ "$par\n", "[1] 2.438860 4.594329 1.750238 5.366007\n", "\n", "$value\n", "[1] -275.586\n", "\n", "$counts\n", "function gradient \n", " 11 11 \n", "\n", "$convergence\n", "[1] 0\n", "\n", "$message\n", "[1] \"CONVERGENCE: REL_REDUCTION_OF_F <= FACTR*EPSMCH\"\n" ] }, "metadata": {}, "output_type": "display_data" } ], "source": [ "options(warn=-1)\n", "sol = optim(init,function(x) calculate_delay_consistent_of_two_distributions(x,as.Date(\"2018-04-10\")),\n", " method=\"L-BFGS-B\",control=list(fnscale=-1),lower=rep(0,2),\n", " hessian=FALSE)\n", "options(warn=0)\n", "pars = sol$par \n", "\n", "sol" ] }, { "cell_type": "code", "execution_count": 15, "metadata": {}, "outputs": [ { "name": "stderr", "output_type": "stream", "text": [ "2018-03-14\n", "2018-03-15\n", "2018-03-16\n", "2018-03-17\n", "2018-03-18\n", "2018-03-19\n", "2018-03-20\n", "2018-03-21\n", "2018-03-22\n", "2018-03-23\n", "2018-03-24\n", "2018-03-25\n", "2018-03-26\n", "2018-03-27\n", "2018-03-28\n", "2018-03-29\n", "2018-03-30\n", "2018-03-31\n", "2018-04-01\n", "2018-04-02\n", "2018-04-03\n", "2018-04-04\n", "2018-04-05\n", "2018-04-06\n", "2018-04-07\n", "2018-04-08\n", "2018-04-09\n", "2018-04-10\n", "2018-04-11\n", "2018-04-12\n", "2018-04-13\n", "2018-04-14\n", "2018-04-15\n", "2018-04-16\n", "2018-04-17\n", "2018-04-18\n", "2018-04-19\n", "2018-04-20\n", "2018-04-21\n", "2018-04-22\n", "2018-04-23\n", "2018-04-24\n", "2018-04-25\n", "2018-04-26\n", "2018-04-27\n", "2018-04-28\n", "2018-04-29\n", "2018-04-30\n", "2018-05-01\n", "2018-05-02\n", "2018-05-03\n", "2018-05-04\n", "2018-05-05\n", "2018-05-06\n", "2018-05-07\n", "2018-05-08\n", "2018-05-09\n", "2018-05-10\n", "2018-05-11\n", "2018-05-12\n", "2018-05-13\n", "2018-05-14\n", "2018-05-15\n", "2018-05-16\n", "2018-05-17\n", "2018-05-18\n" ] }, { "data": { "text/html": [ "" ], "text/latex": [ "2018-04-17" ], "text/markdown": [ "2018-04-17" ], "text/plain": [ "[1] \"2018-04-17\"" ] }, "metadata": {}, "output_type": "display_data" }, { "data": { "text/html": [ "
\n", "\t
$par
\n", "\t\t
    \n", "\t
  1. 2.52406986711741
  2. \n", "\t
  3. 4.60895626710039
  4. \n", "\t
  5. 1.654712250303
  6. \n", "\t
  7. 5.60313632355967
  8. \n", "
\n", "
\n", "\t
$value
\n", "\t\t
-272.022793002922
\n", "\t
$counts
\n", "\t\t
\n", "\t
function
\n", "\t\t
11
\n", "\t
gradient
\n", "\t\t
11
\n", "
\n", "
\n", "\t
$convergence
\n", "\t\t
0
\n", "\t
$message
\n", "\t\t
'CONVERGENCE: REL_REDUCTION_OF_F <= FACTR*EPSMCH'
\n", "
\n" ], "text/latex": [ "\\begin{description}\n", "\\item[\\$par] \\begin{enumerate*}\n", "\\item 2.52406986711741\n", "\\item 4.60895626710039\n", "\\item 1.654712250303\n", "\\item 5.60313632355967\n", "\\end{enumerate*}\n", "\n", "\\item[\\$value] -272.022793002922\n", "\\item[\\$counts] \\begin{description*}\n", "\\item[function] 11\n", "\\item[gradient] 11\n", "\\end{description*}\n", "\n", "\\item[\\$convergence] 0\n", "\\item[\\$message] 'CONVERGENCE: REL\\_REDUCTION\\_OF\\_F <= FACTR*EPSMCH'\n", "\\end{description}\n" ], "text/markdown": [ "$par\n", ": 1. 2.52406986711741\n", "2. 4.60895626710039\n", "3. 1.654712250303\n", "4. 5.60313632355967\n", "\n", "\n", "\n", "$value\n", ": -272.022793002922\n", "$counts\n", ": function\n", ": 11gradient\n", ": 11\n", "\n", "\n", "$convergence\n", ": 0\n", "$message\n", ": 'CONVERGENCE: REL_REDUCTION_OF_F <= FACTR*EPSMCH'\n", "\n", "\n" ], "text/plain": [ "$par\n", "[1] 2.524070 4.608956 1.654712 5.603136\n", "\n", "$value\n", "[1] -272.0228\n", "\n", "$counts\n", "function gradient \n", " 11 11 \n", "\n", "$convergence\n", "[1] 0\n", "\n", "$message\n", "[1] \"CONVERGENCE: REL_REDUCTION_OF_F <= FACTR*EPSMCH\"\n" ] }, "metadata": {}, "output_type": "display_data" } ], "source": [ "# for all possible Ï„s\n", "loglk = -1e10\n", "solMLE = NULL\n", "tauMLE = NULL\n", "for (tau in min(df_epicurve$onset):max(df_epicurve$confirmed)) { \n", " tau = as.Date(tau)\n", " message(tau)\n", " options(warn=-1)\n", " sol = optim(init,function(x) calculate_delay_consistent_of_two_distributions(x,tau),\n", " method=\"L-BFGS-B\",control=list(fnscale=-1),lower=rep(0,2),\n", " hessian=FALSE)\n", " options(warn=0)\n", " if (sol$value>loglk) {\n", " loglk = sol$value\n", " solMLE = sol\n", " tauMLE = tau\n", " }\n", "}\n", "(tauMLE)\n", "(solMLE)" ] }, { "cell_type": "code", "execution_count": 16, "metadata": {}, "outputs": [ { "data": { "text/html": [ "554.045586005845" ], "text/latex": [ "554.045586005845" ], "text/markdown": [ "554.045586005845" ], "text/plain": [ "[1] 554.0456" ] }, "metadata": {}, "output_type": "display_data" } ], "source": [ "# AIC\n", "2*(5-solMLE$value)" ] }, { "cell_type": "code", "execution_count": 17, "metadata": {}, "outputs": [ { "data": { "text/html": [ "
    \n", "\t
  1. 2.52406986711741
  2. \n", "\t
  3. 4.60895626710039
  4. \n", "\t
  5. 1.654712250303
  6. \n", "\t
  7. 5.60313632355967
  8. \n", "
\n" ], "text/latex": [ "\\begin{enumerate*}\n", "\\item 2.52406986711741\n", "\\item 4.60895626710039\n", "\\item 1.654712250303\n", "\\item 5.60313632355967\n", "\\end{enumerate*}\n" ], "text/markdown": [ "1. 2.52406986711741\n", "2. 4.60895626710039\n", "3. 1.654712250303\n", "4. 5.60313632355967\n", "\n", "\n" ], "text/plain": [ "[1] 2.524070 4.608956 1.654712 5.603136" ] }, "metadata": {}, "output_type": "display_data" } ], "source": [ "# Fitted parameters\n", "solMLE$par" ] }, { "cell_type": "code", "execution_count": 18, "metadata": {}, "outputs": [ { "data": { "text/html": [ "
    \n", "\t
  1. 4.09034831115467
  2. \n", "\t
  3. 3.01140492976308
  4. \n", "
\n" ], "text/latex": [ "\\begin{enumerate*}\n", "\\item 4.09034831115467\n", "\\item 3.01140492976308\n", "\\end{enumerate*}\n" ], "text/markdown": [ "1. 4.09034831115467\n", "2. 3.01140492976308\n", "\n", "\n" ], "text/plain": [ "[1] 4.090348 3.011405" ] }, "metadata": {}, "output_type": "display_data" } ], "source": [ "# First generation time\n", "## Mean and variance\n", "c(solMLE$par[2]*gamma(1+1/solMLE$par[1]),solMLE$par[2]^2*(gamma(1+2/solMLE$par[1])-gamma(1+1/solMLE$par[1])^2))" ] }, { "cell_type": "code", "execution_count": 19, "metadata": {}, "outputs": [ { "data": { "text/html": [ "
    \n", "\t
  1. 5.00926482971868
  2. \n", "\t
  3. 9.66286331171308
  4. \n", "
\n" ], "text/latex": [ "\\begin{enumerate*}\n", "\\item 5.00926482971868\n", "\\item 9.66286331171308\n", "\\end{enumerate*}\n" ], "text/markdown": [ "1. 5.00926482971868\n", "2. 9.66286331171308\n", "\n", "\n" ], "text/plain": [ "[1] 5.009265 9.662863" ] }, "metadata": {}, "output_type": "display_data" } ], "source": [ "# Second generation time\n", "## Mean and variance\n", "c(solMLE$par[4]*gamma(1+1/solMLE$par[3]),solMLE$par[4]^2*(gamma(1+2/solMLE$par[3])-gamma(1+1/solMLE$par[3])^2))" ] }, { "cell_type": "code", "execution_count": 20, "metadata": {}, "outputs": [ { "data": {}, "metadata": {}, "output_type": "display_data" }, { "data": { "image/png": "iVBORw0KGgoAAAANSUhEUgAAAtAAAAGACAIAAAALU8KhAAAABmJLR0QA/wD/AP+gvaeTAAAg\nAElEQVR4nO3de3Qb2X3g+VsAAUJ86dFttynZbtsCZIaWfSatTkYGIidn44RDqsVoOh115mQS\n7s5sA47pNelMiz7T0a7jCeNNpHhNboZzQvbuxFwfT7aVxJHFiAjPTGLHCpBep+mZtmWZEdAd\nq9Mmu5t68Ik3qvaPa1UweBEsoIgC+f0cne5Coe6tH8Fi1Q/33rqlaJomAAAAzGSrdwAAAGD3\nI+EAAACmI+EAAACmI+EAAACmI+EAAACmI+EAAACmI+EAAACmI+EAAACma6p3AMZ96lOfevnl\nl42VldOdKYpS04hqRtM0K8cm+Oi2T59hz8rhWTk2YeHwrBmYqNGv9cqVKx0dHTWKCHtaAycc\nsVjM5XJ96EMfMlA2mUwKIZqamux2e63jqoFkMul0Oi14FlNVNZ1OCyEsG14mk3E6nfUOpIhs\nNpvJZBRFsWZ4mUxGCNHUZMUTQjqdVlXVbrdbM7xUKtXU1GSzWbG1WJ7oHA6HsfC+/e1vv/XW\nW7UOCnuXFf+AK5TJZDwez7PPPlvvQABgF/rN3/xNEg7UUAMnHHa73eFwHDhwwEDZlZUVIURL\nS4sFv25qmra6utrR0WHB70yZTGZjY0MIYc3w0ul0PB63ZvNvIpFIJBI2m82a4cXjcU3TWlpa\n6h1IEevr69ls1ul0WjO8tbU1l8tl2TOJEKK1tdXhcBiowVgpoJQGTjgURVEUpZpWVpvNZsFG\nWtntarfbLdjdo/emW7MNWVVVYdV+AflxVXnEmsdms2maZs3YZOedNf9ahRCKolizu0f/azUc\nngW7TdHQLHfNAAAAuw8JBwAAMB0JBwAAMB0JBwAAMB0JBwAAMB0JBwAAMB0JBwAAMB0JBwAA\nMJ3lJqvBlt6Mrb301m2tihoef/uj72ix4nyXAIDdioSjwcQyqZ/6yufX08lqKml1OOef/vU2\nR3OtogIAoDy6VBrMG7G1KrMNIcRmOrW4uVKTeAAAqAQtHI3q6hMff+xt795uqW/f/UHf1d8z\nIx4AAMqghQMAAJiOhAMAAJiOhAMAAJiOhAMAAJiOhAMAAJiOhAMAAJiOhAMAAJiOhAMAAJiO\nhAMAAJiOhAMAAJiOhAMAAJiOhAMAAJiOh7ftUeup5Goqvt1S6XR6PZ1od7jMCAkAsIuRcOxR\nP3ftPxgu+/hD7/qTJz5Ww2AAALseXSp7yztbDzjt1WaZL939hzdj6zWJBwCwR5jbwjEyMrKw\nsNDV1XXx4sXCd+fn5z/72c8KIfI2KF8K1Tjkar3+88++unrHWPHvLL/+uW/9uRBC1bSaxgUA\n2OVMTDgmJiZOnTp18eLFmZmZiYmJwcHB3HeXlpZefPHFq1evCiH6+/v1DcqXQvWOtB440nrA\nWFktm61tMACAPcLELpW5ubnHH39cCHHmzJm5ubmlpaXcdxcXF/Vk4plnnrl9+3YlpQAAQCMy\nq4Vjfn6+q6urs7NTvuzq6lpcXNRfCiFOnDihLx8+fPjRRx/dstRrr732ta99TS+VSCRaW1vj\n8W3faqFLpVKa9boGZEiJRMJmK5IOJhIJuZBMJqv52Y1Jp9P/uPemnd77lrLZrKZpO/+xVCKT\nyQghLB6eNWNTVVUIkclkrBmepmmpVEoGaU2pVCprqG3SWCmgFLMSjsXFxcI1uUlGrhdffPHk\nyZNblnrllVd+7/d+T3/r6NGj2Wx2c3PTcJCpVCqVShkubqpS51Z9fTwer+ZnN0b/uOLx+KZV\nb3Ha+Y+lcqqqWjk8PaG0oEwmI7MiC0omk8lkst5RlKR/S9kuEg7UVv2vGbLTpFQuksvhcHR0\ndOgvFUXR/7tdesOGseJm0zStVGD6ekVRdj74+u69EmU+urqTR501w7N+bMLC4VkzMGHtXyv2\nILMSjsOHD2+5RvrCF76g341SvtRP/MRP/OVf/qX+MhAIOJ3Ohx56yEB4d+7cEUK0tbW5XJab\nw0rTtLt37x44cMButxe+u+r44cl3//79xn72arTE7vzj3tsP7vDet5RKpTY2Ng4dOlTvQIqI\nxWKxWMxutx88aLnPTQixubmpaVpbW1u9AyliZWUlk8m4XC5rhnf//v2Wlpbm5uZ6B5JPnkmE\nEO3t7U6n00ANxkoBpZg1aPTw4cMLCwv6y4WFhaIJx8TExKc+9antlgIAAI3FrISjs7Ozp6dn\nZmZGCDEzM9PT05M7YlSamZk5efKkXD8/Pz8/P19JKQAA0HBMHMMxODg4MjLy/PPP507hNTIy\nIoS4ePHixMTE3Nxc7vZyTo6ipQAAQEMzd9BoYcagrxkcHCw1qRd5BgAAuwzPUgEAAKYj4QAA\nAKYj4QAAAKYj4QAAAKYj4QAAAKYj4QAAAKYj4QAAAKYj4QAAAKYj4QAAAKYj4QAAAKYj4QAA\nAKYj4QAAAKYj4QAAAKYj4QAAAKYj4QAAAKYj4QAAAKYj4QAAAKYj4QAAAKYj4QAAAKYj4QAA\nAKYj4QAAAKYj4QAAAKYj4QAAAKYj4QAAAKYj4QAAAKYj4QAAAKYj4QAAAKZrqncAxmWz2XQ6\nvbq6ariGeDyeTCZrGFJNaJomhFhfX1cUpfDd9Y11ubCxsbHqNP6zG5NIJOTC5ubmqmq5bFVV\nVVVVqzkkzKOqqvyvNcPLZrNCCCvHlkqlrBmeqqqxWEz/07CgWCwWj8cNFEyn0zUPBntZAycc\niqLYbDan02mgrPxDstvtDoej1nFVS9O0TCbjcDhstiJXdD1gh8Nh7Gevht1ulwtNTU07v/ct\nZbNZVVUtGJgQIp1OZ7NZRVGsGV4qlRJCWDO2bDaraZrhP3azZbPZpqampiYrnkvlia6pqUn/\ny92WoqcgwDAr/pFUyGaz2e32ffv2GSi7ubkphHA6nS6Xq9ZxVUvTtFgs5nK5ip4jXOkfBtzc\n3GzsZ6+Gnu7UZe9bSqVSqVTKgoEJITRNS6VSiqJYMzxVVTVNs2ZsyWRSVdWmpiZrhpdIJJxO\nZ3Nzc70Dyadpmn6iM5arGUtTgFIaOOFoXB/72pdnb99QNa3egQAAsENIOHba3cTmn33/O1VW\n0mSzHW49UJN4AADYASQcO03VVLnwr7t9xw48UriBbAhtaWkp04F6/KHD72jpMCtEAABqjYSj\nbv6Hd3b95BFP4XpN0+7evXvw4EE6UAEAuwaDkAEAgOlIOAAAgOlIOAAAgOlIOAAAgOlIOAAA\ngOlIOAAAgOlIOAAAgOlIOAAAgOlIOAAAgOlIOAAAgOlIOAAAgOkqSjgURRkfHzc7FAAAsFtV\n2sJx+fJlRVECgUA0GjU1IAAAsPtUlHDMzs6GQiFN07q7uz0ej8/nCwaDZkcGAAB2jYoSjt7e\nXrkwNDSkadr09HRfXx8NHgAAoELbHjQaDAYHBgaEEF6vt7u7e2BgwOfzkXYAAIAyKh00KoQY\nHx9XFKWvr08IEYlEQqHQ0NBQKBQ6d+6cx+OhkwUAAJRSaQuHoijDw8N+v1+mGm63W39raGhI\nCDE6OmpKgAAAoPE1Vbid1+udnp7OzTPyhMPhGoUEAAB2m0pbOPJaNfKMjY1FIpEahQQAAHYb\n4zONBoNBfTawoaGhMukIAADY44wnHB6PZ3h4uIahAACA3apcwhEIBBRFkbeoKAU8Ho/X692p\nOAEAQAMrN2h0cnJycnLS5/OFw2G/35/3bnd39+nTp8vXPjIysrCw0NXVdfHixaIbLC0tBQKB\nycnJzs5OfeXMzMzzzz8vhChTEAAANJCt71IJhUI+n29ycnK7VU9MTJw6derixYszMzMTExOD\ng4N5G8zPz3/2s58tLHj9+vWrV69ud3cAAMCyKhrDEQqFDFQ9Nzf3+OOPCyHOnDkzNze3tLSU\nt8GJEycKE4v5+fmnn37awO4AAIBllWzhCAQCQgjZsCGX89y4cSMcDmuaVrT4/Px8V1eX3lHS\n1dW1uLiY229SygsvvLCwsCCEKMxF1tfXX3/9df1lNpvVNC2TyWxZZymqqlZT3Bh9j9lstuje\n5Ucqf7odjawCqqrKhZt3F5fj6wZqsAnl/QceabIZH61cRjabFTmfsKXIj67KI9Y8qqpaNjb5\nh1CXv9ZKaJpW6m+5vvQTiOHwLHgKQkMrmXDcuHEj9+XU1NS26l1cXCxcc+LEiS0LykEbExMT\n/f39eWM7XnrppfPnz+svjx492traurKysq3AcsVisVgsZri4MWvJTbmwsbFRJvi1tbWdimgb\n4vG4XPhXX/uS4UqOdbzthZ/8FUUoNQoqXzWHhNlUVbVyeKlUqt4hlJRKpSwbXl3OJJXb3Nw0\nVjCdTtc2EuxxJb9ohkIhvSfl7NmzXq9X+++ZOtPX4ODgM88885WvfMW8XcCA97U/7LTZq6zk\n1tryZtqiVw4AgEkqmtq8t7dXf0K9zu12l2lwO3z48JZryjtz5szIyEjumpMnT371q1/VX37m\nM59xOBwHDx7cVrXS/fv3hRAtLS3Nzc0GilcjE//hZ97e3l40eE3TVlZWOjo67PZqL+01155p\nn/uZjy3F19ra2mzb7xZ58Y1XR18KCiEOHDjQ7nTVPLx0Or25uXngwIGa11y9RCIRj8ftdntH\nR0e9YylCfkFvaWmpdyBFrK2tZbPZ5uZma4a3urq6b98+p9NZ70DyyTOJEKKtrc3hcBiowVgp\noJSKEg796fNyOtHx8fHLly+fO3dOPratqMOHD8uhGNLCwsJ2Ew4hxKOPPpr7ct++fUeOHNFf\n2u12RVGquSrbbLadv6jreyy1d5nG2e12CyYcqqoedO476Nx36NAhAwnHmw+GfZj002Wz2SoP\nCfPI+WxEzgFgKTabTdM0a8amTwVk2fDqcibZkv6F0HB4+kEL1ERF14xr1655PJ5Lly4JIcbH\nx+UEo5cvXy46mFTq7Ozs6emZmZkRQszMzPT09FQyYjTXxMTEk08+ua0iAADAmir9khqJRCYn\nJ6PR6PDwsNfrlSM8yo8kHRwcvH79en9///Xr1/VJOEZGRvSOkqWlpf7+fiFEIBCYn5/X10gn\nT57cbo4CAACsqaIuleHhYdl7cu3aNSHEhQsXKqy9cJ7Q3DWdnZ15974WrgEAALtARS0cXq83\nGAzqzRtyAOn4+Pjs7KzJ4QEAgN2gooRjenp6dHRUPq1tenpaCOHz+YaHh69cuWJyeAAAYDeo\nqEvF7XbnzW5ubLJzAACwN5kywzQAAECuilo4JH02DikSifT19THZPgAA2FJFCUcwGOzr6zM7\nFAAAsFtVlHD09fV5vd7jx4/nrd/uE90AAMDeVGmXStFRonlPlAUAACiqokGjY2NjeQM4pMpn\nAAMAAHtZRQnH0NCQnGM0VzQaZWAHAACoREVdKvKZgfKZbQAAANtVUcIxNjY2PDzs9/tzV964\ncSMcDpsTFcpZ+v1/GfvOnBDGb0hu+cBHO3/1DwXPngZgVYFAYGpqqsqZF3IrkY86j0Qibre7\n7oHtTRUlHKdPn758+fLk5GTeep/PZ0JIKCe9/PfrL/5hlZWsf/OPHnry3znfcawmIQFAhZRi\n33PkXZDnz583kAoEAoHCa1PRzaq5rbLCvaC8Sqc2n56elumFvF3F5/OdO3eOCc53npZNy4VD\npz/teNt7t1s8ffe1ezOfE0KIB/UAwI7RNE1O7DQ2NiYfQi4eTPU0NTXl9/v16/rk5OSW1/ho\nNDo1NVVmM72SycnJ7u5uYwMD8vZSSWAoyuDEX6FQSCaq+hGDHdb2WL/r6Mntlkp8f/6HCQcA\n1IPH48lb09vbq2maz+ebmprq7u6u/LIyMDBQ6+jqtpe9oKK7VEZHR/1+f2GX1eXLl00IaU9o\nzSaV+Gp2837Rf2pspeRb8bV6xw4AtScfRa43QgSDwdz+F5/PpyhKIBCIRqOBQECukeMIFUVR\nFEWul0V8Pp9sks+rRJKbKYoyPj6eW7m+pVwuupfCOqPRqF7c5/PpU0jkxiMXGIRQUQtHOBwu\n2nvCoFEjNO3zL7/woyuvib/+P18pvdXKzgUEAPXndru9Xm84HA4Gg0KI3Gb1QCCgd+LLPEAI\nEQqFcsdv6plBMBi8cOFCX19f0YdyXLp0SfaJyDGkN2/enJycDIVCenEhRCQS0Zth8vZSWKfH\n45mdne3t7Y1GowMDAx6PR45LHRgYkBWOj49PTk6eP3/e4/Hs8bEgFbVweL3evIm/5AHh9XpN\nCWpX0zaWf3TltSorUZqcjrcfrUk8AGAR8gEat27d6u3tzb0vcmpq6tixHw5yL3XBDoVCskhv\nb6/so8mrRDp//rxcGBoa8vv9+kjS3Gd3yNSn6F7y6gwEAn6/v7e3VzwY7CiEuHTpUm48soeo\nTJ17R0UtHBcuXJBZoXypp3jnzp0zMbRdSu+ZWuv5N90f6im6wdraWnt7u81WMh10vMNtb3+b\nWSECgJV4vd6+vj6/3y/vZKlVI8HZs2enpqaCwaDMGAyYmpoaGxvTX7rdbpnE7OVmjDIqSjjk\nL0P2Rel9V7ljjGFAprO75QM/Xbhe07T43bv7Dh602+07HxUA1It8PpfemKHT+zWmpqa8Xu/0\n9HSVc2nURNEnfnR3d+98JI2ioi4V8WAUcS6yDQBArUSjUTnooWh7w+TkZCQS8fv94XC48D4X\nY27duiWK3TVTIZn03Lx5sybB7AWVJhyFiiZ3AAAYIO8+nZ2dLXxLDhSVnSlyg5pcgG7evOn1\neks1llTyOPTcUSB6nbmdLMhlPOEYGBiQQ0cBAKhQJBLJWyNvNA2Hw2NjY3rzRu71/saNG/rN\nKVJeliBvcC1MEXLXyJ4aOaJTFpmamtJvwJRdITKPkbWFw+G8G1kL9yKHoOp3wwaDwampKb35\nPy+ecDhcSRKzi5VMOJSthMPhK1eu7GSsqKHk4vcS35/f7r/k7W9lf/BtLZOqd/gAGpKiKPKe\ng+HhYf1qIqd6ikQi+qV6fHxcdq/IPOPcuXPnz5+X012Mjo7qKYu83iuKcvr06dwJM/S8IbeS\n3t7e2dnZGzduyJ3evHkzd3KpoaEhr9cr71yVYfj9fnnXSe5e8up0u90yGI/HoyjKlStX9Nhy\n49H/W5jE7CklB43mPbBNDtXJvXFoj2dqjW5p4mnDZW2HHj30O98TtuYaxgNgL6jwmWdDQ0O5\nwwTlcuF0UG63W6+w8N28SsSDO2ZL7TS3htzl3L0U1ul2u4vOU5W3koe9iTIJR+4D2wKBgJzY\nJHeDaDR67do10wNETTk7u+ztb8uuL1dTiXrvdnb1DfvDj9YqKgDArlcy4cjN2oreVex2u4eH\nh7lXpbHYmlvf9/m/z6wuGSu+eSv81vM8VgAAsG0VzcPh9XoLp0bRZ6GvF1VVs9ns5uam4RqS\nyWQ2m61hSJWIx+NyIZVOFQ1etrzF4/Giz3GujZZHjJXLuA7JhXg8nt7+J59IJORCLBazpWv/\nyWezWU3TqjkkzJPJZIQQqqpaM7x0Oi2EsGZsqqoKIdLptGXDSyaT8vdrTYlEQv5+t2vnT4/Y\n3SqdaVSf5U0IEYlERkdH5Yhik8MrR04HIk9Ghmuoprgx/7hHTRTdu0w4VFU1MeEwSu+GNPbR\n6cVVVTXjk9c/uprXXL3cn72+kRRl/Y+uLn+tFbJybKKK8Bh2gNqqdKbRSCQiH0ujr/T7/fXt\nT7Hb7U1NTe3t7QbKJpNJIYTL5XK5XLWOawuxWOuqEEIIp9NZNHhN0+7evdva2mrBmUa15h8O\nFG1paXFu/5Pft2+fXGhra2t31v6TT6VSGxsbxg4Js8VisUwmY7PZrBne5uampmltbW31DqSI\nlZWVTCbjdDqtGd79+/ddLldzs+XGUGuaJk90+/btczqdBmpoaqroAgFUqNLjqdRAXAAAgC0Z\nn/gLAACgQiQcAADAdCQcAADAdCQcAADAdCQcAADAdCQcAADAdBUlHIqi1H1eUQAA0LgqbeG4\nfPmyoiiBQEA+9hcAAKByFSUcs7OzoVBI07Tu7m6Px+Pz+YLBoNmRAQCAXaOihEN/bNvQ0JCm\nadPT0319fTR4AACACm170GgwGBwYGBBCeL3e7u7ugYEBn89H2gEAAMqodNCoEGJ8fFxRlL6+\nPiFEJBIJhUJDQ0OhUOjcuXMej4dOFgAAUEqlLRyKogwPD/v9fplquN1u/S35zNjR0VFTAgQA\nAI2v0qfFer3e6enp3DwjTzgcrlFIAABgt6m0hSOvVSPP2NhYJBKpUUgAAOxOPp+vVvNa1bCq\nnVFpC0ehYDB469Yt2Z8i/4u9I/btYLL94e2War3z+kfu3Hp5/7vMCAkAypCDEYUQfr///Pnz\nkUhEvwETQohoNOrxeCKRSJnGhSoZTzg8Hk9fX9/eTDXuB3939ev/l6ZmDZTNZtM1j2fnPPiL\nfev/GTRQ+u1C/IYQbzV3iF/5XC2jAoDS5KV0bGxMXrCCwaB8uWMJh7ypQu4uFApZpKq8auUd\nIaYq16USCAQURZFZoVLA4/F4vV6z47MgLZO888e/nnozkl5+1cA/9d4/yHrU1oP1/UEMaH70\nR22H3l1lJW9PrmnJjZrEAwBbGhgY8Pv9+tfj3t7eHR4DUMObKky6P6O3t1fTNDNqzlWuhWNy\ncnJyctLn84XDYb/fn/dud3f36dOnzYzNqtSsls0IIdoe+zln5/u3WzqWSX3xe3/zuuvALx3u\nNiE4c9lc7fs//TdacuPgwYM227YncXnx6//32/7o02YEBqCx/HH0W3/yyreqrOTnjz72lPux\n8tsEg8FwOHzhwoXclW63O7d5Xl7mhBCyFUS2iMzOzo6OjsrL3+TkZPkt+/r6vF5vKBQaHx8f\nHh6WG8/Ozno8Ho/HI4SQG0xPT8vtZROFXpvsyCizX/GgnaawKrmLSCQi35WlZEuB3qhTGLnh\nz7waW3ephEIhn8+X+2NDav/wL7X/2M9vt9RyfH0q8VtCiF8yIaQdoNiblJYD9lYjCYfatM+M\nkAA0nNfW711frHbGyB97+3u23ObWrVtCCHkxLsrn8124cKG3t1de0W022yc/+UkhRF9fn2wI\n8Xg858+fd7vdpbYcHR2VzQPRaHR4eFhmD4FAYHR0VD4VRFGU3ORDCgQC586dkzlKbsZQuF+5\nvdvtLqwqGo3KrhCPx6NpmuwZmZqa0pdlbpEX+bFjx+oyfqWiMRw17CgCAODYwUeeeM8Hq6/E\nQCn9u74cPRoOh3OHL6iqql/Xc4dPRqPRwi1lljA9PS3XyJxALp89e/bGjRu5+9UzBlnb1NSU\nTCyGhoaGh4evXbtWdL9F6VW53W4Zg56jCCFyl+U84HmR37p1y1oJRyAQEELIhg25nOfGjRvh\ncHgHen0AALvME+/5YPUJRyWOHTsmHvRZyDWhUEi/wMnr8ZYXMr35IW/LUo/1kFlFmWGOeYNI\nSm1Zw3tGrHCxLplw5KVmU1NT5gcDAEAtya/yo6Ojud/pu7u7b968qb8MBoMVfuPfckvZfCJ7\nNMoM8NSbIvR8QiZG5qn8ZzRPyW74UCik96ScPXvW6/Vq/z1m+gIAWN/s7Gw4HPb5fIVvud1u\nr9erdzcEg8FSU2lVsqUcoJrbllCqCUTWJjMS2VljXjZQ+c9oOq1h+f3+Z5991ljZ5eXl5eXl\neDxuoKya3Py7AdvfDdjWvvnHBoq/FVs78h8/feQ/fvrrr98qXr+qLi8vZzIZA5WbLZVKyY8u\nm80aKP6NP//38qNbXXmj5rFpmpZMJu/evWtGzdXb3NxcXl6+d+9evQMpbmNjY319vd5RFHf/\n/v3l5WXLhnfv3r1EIlHvKIqQZ5Ll5eVkMmmshmefffbEiROrq6u1Daxe8q59s7Oz+lt6j4bf\n7899mfu9OhKJFG6Z927hXuR3dXmbp9frza25sHiZ/eoKq8rdsuhy0Z8xT+72uZ9MbRmf+AsA\ngEZRmA3o8m6MyH2ZVypvy8I6i+5FzjGxZUhl9rtlVYWlykeeJ3e4q3m2GDRaRiWDRkdGRhYW\nFrq6ui5evFh0g6WlpUAgMDk52dnZWXkpAADQWMq1cFQ5UHRiYuLUqVMXL16cmZmZmJgYHMyf\nDHt+fv6zn/3sdksBAICGU3LQaNGBoqW6fIqam5t7/PHHhRBnzpyZm5tbWlrK2+DEiRNXr17d\nbikAANBwSiYcvb291XT5zM/Pd3V16R0lXV1di4uLW0ZjrBQAALA4swaNFiYKi4uLJ06cqKbU\n1772tfPnz+tvHT161OVy3blzx3CQGxsbGxvbf4pYOi7/v76+ntz+3u8lN+XC6urqneaSxe/f\nv7/twHbQvXv3DJSKxWMPit9Ppe01jegfVXNImC2bzVo5vEQiUe8QSkokEpYNb319fX19vd5R\nlLS2tmasYCqVqm0k2OOYaRQAAJjOrJlGDx8+vOWa7ZZ6//vf/9xzz+kvr169arfb29rathWY\nJBs2mpubHQ7HdstqKZv8du9yuVq2v/fEg4983759RYPXNG1zc7OlpcXA09HMls1m4/G4EKK1\ntVXO3bstTodTLrS0thj7xZWXyWSSyWRra2vNa65eKpVKpVI2m62lpaXesRSRTCaFEM3NzfUO\npIhYLKaqqsPhsGx4TqezqclyUwzIM4kQwuVyGQvPbjerGRJ7U8mjMHcAh3wITd6QDv1RuUUd\nPnx4YWFBf7mwsFBhwlGm1OHDh5988kn95dzcnN1ud7lcW1ZbSCYcDofDQHHNpsoFY8WbtbRc\ncDqdRYvL00Rzc7MF/9rT6bRMOJqbmw3kQ/pZz9XcbOwXV568qJtRc/VUVU2lUoqiWDM8OZOb\nNWNLJBKqqhr+YzdbPB63ZjKkJxxOp9PpdBqowYKnIDS0iq4ZRQeQlh802tnZ2dPTMzMzI4SY\nmZnp6enJnWmjtqUAAIDFmdhoPzg4eP369f7+/uvXr+vTaYyMjIyMjMjlpaWl/v5+IUQgEJif\nny9TCgAANLRKO/ai0eilS5f0gR0XLlyo5EkzhVOF5q7p7OwsnIejaCkAANDQKmrhCAaDHo8n\nd9xoX1/flnOfAwAASBW1cIyOjnq93unpabfbLddEo9GBgYHx8fGhoSEzwycDCiUAAB9OSURB\nVLO02+v31Ls/2G6p+4mYGcEAAGBlFSUc4XA4Eono2YYQwu12h0Ihn8+3lxOOz70U/MbtV+od\nBQAADaCiLhW/35+bbejC4XCt42kA8Uy6+kraHM3dh95RfT0AADSEilo4Jicn5UPkc1eOj497\nvV5zomoM/+LYj/32TxscyPKQq63VYeTOeAAAGlHJhKNwHsnCyUZnZ2drH1Hj6HC63t1+qN5R\nNKT0a99OGProFJu9+Z0fFDbmIwLQkHw+37lz52oyGqGGVe2MkgnH2NjY8PCw3+8vtUF3d3cl\nd8YChe5+/p/dNVrW5f7wuy/8dS2jAbAH6N+i/X7/+fPnI5EIlzBdMBjs6+sTQni93vIPiq9G\nyYTj9OnTly9fzutGAaqROtydsDlcalWDYBLRvxGaKhTLPWgGgDXJB3GMjY3JxgA50cPY2NiO\nJRzBYFAIIXdX5eW8hlXpotHolStX5NThiqIUjqColZIJh7wPJS+mvG0uXbpERoLKZfY/8pT3\n4/vTsf/8c0Otjm0/e2LjW1eX//DfmBEYgF1sYGDA7/frXQ+9vb2RSOTatWs7FsDo6OiFCxes\nVpUuEonol/KxsbHLly/Xtn5dpRN/KYriKbDdR8gCMbtzyXXA/vB7HW9733b/2dvfVu/wATSY\nYDAYDofPnj2bu9LtducOffD5fIqiKIoyPj4uhIhGo4qiBINBuT53lstSWyqK4vP5hBDj4+PK\nA8FgUG4QDof7+vp8Pp++fV5t8vt8mf3q7xZWJRfkf/VSuUEWjTxXbkvPsWPHjh8/Xs0HXsY2\nJv46fvz41NRU7qiO8+fPmxQWAGAXWwt9aS38pSor6fD+cofvl8tvc+vWLSFEmWeb+3w++bAO\n2fNis9k++clPCiH6+voikYgse/78ebfbXWrL0dFR2R8RjUaHh4fltFWBQGB0dDQUCmmapijK\n7Oys/KKu7zcQCJw7dy4UCo2Pj3s8nkgkIt8t3K/cXj4wNa+qaDQqx154PB5N0+RQjKmpKX1Z\n5lV5kR87dqxUd9KVK1fykrMaqnTiL/3BsGfPnpWBRqPRvNnAgAp9995iy/a7VOwb9x1mRANg\nx6WXX4199y+qrGSfx2eglM/nk5NIydGjss1Af1dVVf26nnuBi0ajhVvKLGF6elquyX2I+tmz\nZ/Wnj+W+K8euRqPRqakpmVgMDQ0NDw9fu3at6H6L0qtyu90yBj1HEULkLsu2k7zIb926VTTh\nkBubN7Sl0oe3SefPnx8YGJDRuN1ufRnYlqeCRjrjPvrmzedqHgqAenAe+UD7jz1VfSVbbnPs\n2DEhRO7X41AoJPsdJicn5SVWzxJK0Zsf8rYsHNooyayizFRVMifQldqyht/qt/wZhRADAwPm\n3aIiKkw4/H6/fr/v8ePHZePMlStX9uZMozDsA4c69zU5qp+qVdU0W/40MQAaSfuPPVV9wlEJ\n+a14dHQ09+txd3f3zZs39ZfBYLDCL89bbimbT2SPxujoaKnN9KYIPZ+QiZF5tow8EAjoTTUm\nqXSmUZ/Pd/ny5aGhIbksG2fGxsZMDQ67zDvbDv7XX7xwL7FprPh//fNxsbBzA8sB7A6zs7Ny\noGXh13e32+31evv6+mQDQDAYvHXrVtGptIpuefr06dxt5ADV3LaEaDRatIlC1ibTINlZY153\nQSU/4/j4+NmzZ2WouXfe1pjWsPx+/7PPPmus7PLy8vLycjweN1B2c3Pl7wZsfzdg+/q1/8PY\n3stTVXV5eTmTyZhReZVSqZT86LLZ7M7v/S/+9LfkJ5/NFv9wksnk3bt3dziqCm1ubi4vL9+7\nd6/egRS3sbGxvr5e7yiKu3///vLysmXDu3fvXiKRqHcURcgzyfLycjKZNFbDs88+e+LEidXV\n1doGVi95177Z2Vn9Lb1Hw+/3577M7fiIRCKFW+a9W7gXr9eraZq82cLr9ebWXFi8zH51hVXl\nbll0uejPWFjnDiQG2xvDAQBAIyrMBnR5LR+5L/NK5W1ZWGfRvUxOThads6pM5aWiLVVVYany\nkVdeZw1VOl1jNBoNBAK+B/TbiAEAALZU6cRfedN89fX15c1JAgAAUEpFCYec+CsSiYQeiEQi\nN27cKJywDAAAoFBFCUc4HJ6ens4daiuftGLejOsAAGA3qSjh8Pv9RW/sYR4OAABQiYoSjsnJ\nycIRG+Pj42WmUQMAANCVvC1Wzsyaq/DZsLOzs7WPCAAA7DolE46xsbHh4eHC+UB03d3dPEgF\nAABUomTCcfr06cuXL+/MZCAAAGB3KzmGQ96HspOhAACA3WobU5vrz747fvz4+fPna/XMXMM0\nTVNVNZ02/ujRbDZroHjmQZEq916KnI82k8moqlrzyquUyWT0hcJRPmbTP5B0Om2zFflw5ANo\nzPilVE8Gb+XwLBub/Isw6c+tepqmGTuTmE2f2dpweBY8BaGhVZpwyEfuyuVwODw1NeX1euvb\nBKKqajab3djYMFxDMplMpVLbLZVIxORCKpWqZu/lxWIxk2quhn4K29w0+MTXaugnzY2NDZvN\nXriBfD6Qeb+UauhXTSuHZ83YstmsECKdTssFq1FVNZFIJJPJegdSUjweN/b1wJofOBpXRQlH\nIBAIh8Ozs7O5o0QDgcD4+HjRx/juDLvd7nA4Dh48aKDsnTt3hBAtLS0ul2u7ZWMx27oQQgiX\ny2Vs7+Vpmnb37t2Ojg67vcg1tb7S6fTq6qoQYv/+/TZbpQ/iqZXm5ma5cPDgwaIJh0wBzfil\nVC8Wi8ViMbvdbs3wNjc3NU1ra2urdyBFrKysZDKZ5uZma4Z3//79lpYW/eC0DnkmEUK0tbU5\nnU4DNTgcjloHhT2tomvG1NRUXrYhhJicnGSmUQAAUIlKv6QWvQOWmUYBAEAlKupS8Xq90Wg0\nb5RoIBBgplHUReL780W7VNLpdCYeT6x1lCqo2B3N7zwulJ3uDAIAVJRwXLhwwePx+P3+s2fP\nCiFu3bo1PDwsmGkUdfL6v/twmXdXypZt/VDvkV/7s9rGAwDYUkUJR29v7+zsbF9fX+7s5oWj\nOgBTxR/xZBXF/uBOGYOV3Lpeq3gAAJWr9LbY3t5erboTPVCl5Nvdv3jyYw8lN/7szCdsxW7z\nS6fT8Xi8o6N4l8rG3/7JvWu/Y3KMAIDiKko45D3cJByou7vOtrvONtd7ThRNOGypVHpjw3Xo\nUNGyiVe+aXJ0AICSKho95/V6I5FI4fpgMFjreAAAwC5UUcIRCoUikUg0Gs1dGY1G5UznAAAA\n5W2jSwUAAMCYihKOsbGx4eFhv9+fu/LGjRtM/AUAACpRUcJx+vTpy5cvT05O5q33+XwmhAQA\nAHabisZwuN3uog+Gre/TYgEAQKOodI7naDQaCAR8D3B/CgAAqFxFCUcwGPR4PLnTjPb19dGf\nAgAAKlRRwjE6Oiqn4gg9oGna8ePHA4GA2fEBAIBdoKJBo+FwuHCa0cnJSUVRCkeSAgAA5Kmo\nhSPvhtiiGNUBAABKqSjhmJycHB8fz1sZCAT0x9NHo9G+vr4ahwYAAHaLirpUfD5fOBweHh7O\nW587jBQAAKCUihKOc+fOhcPhMh0rzDoKAADKqGqm0VzcJQsAAEqpKOEoNdNoroabdVRdXcok\nmtLNzdstmI2vmxEPAAC7WEUJx6608QcDK6+/XO8oAADYEyqd2hyF0g+/t94hAADQGPZuC0fL\nk7/tUrJOp3O7BZPZzP/4X774ZnP7//r2o2YEBgDA7rN3E46mdz/mamtzuVzbLahk0vPzXzMj\nJAAAditzE46RkZGFhYWurq6LFy9WvsHMzMzzzz8vhChTEDBGTcb+/rzHWFnF0Xzwn/3a/o/8\nq9qGBAB7gYkJx8TExKlTpy5evDgzMzMxMTE4OFjhBtevX7969ap5gWFvsne8XQghNDW9/Krh\nSu7NfI6EAwAMMDHhmJubk1N3nDlzpr+//8knn+zs7Nxyg/n5+aefftq8qLBntT3W/47/+Q8y\nq28YKx5f+Prmd+a0dLK2UQHAHmFWwjE/P9/V1aVnGF1dXYuLi7kJR6kNXnjhhYWFBSEEjRyo\nLcXu6PiJXzFc/J7QNr8zV8N4AGBPMSvhWFxcLFxz4sSJLTeQgzYmJib6+/snJydzc5SXXnop\n9xly2Wx23759KysrhoOMxWKJRGK7pRLZjFzY3NysZu/lra2tKYpiUuWGaZomF9bW1nZ+77FY\nTC6srKzYin04mqapqmrSL0UeKobrV1VVCJHNZs07Zqohw7NmbNlsVgiRTCYzmUy9YylCVdVY\nLBaPx+sdSEmbm5v63862pNPpmgeDvcyid6kMDg6++93v/spXvpI78mN9ff173/ue/vLo0aOa\nplVzDlJVVZ5ntyXzIOFQVdW8M6A8yVpWXU79+meSyWSKJhz6u2bvvZp6rHnVlAz8OeyYKv/Y\nTWXxv1bD4elfMICaMCvhOHz4cPk1W25w5syZkZGR3DVHjhx58skn9ZcLCws2m83Afa3iwbdV\nh8Nht9u3W1bL/DDrdzgcxva+pUQi0dzcbMEWDlVVU6mUEKIu4TkcDrngcrmKJhyqqqbT6ebt\nT1dfiYzDERdCURRjv/RMJpPJZBRFMSm8KmUyGU3T9E/YUpLJpKZpdrvdsuE1NTUZOJPsAHmi\nczqdNpuROR6NlQJKMTHhkEMxpIWFhcKEo/wGQohHH3009+WxY8eee+45/WUgEGhqamprazMQ\nnvw7bG5uNnDxsD9IOFwul7G9l6dpWiKRaGlpseApLJ1Oy4SjtbV1509G+i+rra2taMKRSqUy\nmYwZvxQhRMrpFEIoimKs/lgslslkbDabSeFVaXNzU9M0a8YmczWHw2HN8NLptMvlsmAeKc8k\nQgiXy2VghkMhRFOTRZvA0aDMumZ0dnb29PTMzMwIIWZmZnp6evJuUdlyg4mJidz2DAAA0LhM\n/JI6ODh4/fr1/v7+69ev60MxRkZG9I6Swg2Wlpb6Hzh58mReCgIAABqUuS1mhfOE5q3Je9nZ\n2cndsAAA7D6MCQIAAKYj4QAAAKYj4QAAAKYj4QAAAKYj4QAAAKYj4QAAAKYj4QAAAKYj4QAA\nAKZjqnw0nmvf/07RR8dlMplEItG2VvKJG002m6/T3e6w3GMvAGDXI+FAw9Af2ParX/9Phiv5\n4ENHgv3/i+Hi2djKm1/8mIGCmUwmqzTt+/Avi4M+w3sHgMZFwoGG8U8fee87WjreiK1VU8mr\na8vGCioOlxBCS8VWv/684b1nf/Cdt/1vIcPFAaBxkXCgYXS27n/p6efKbJBKpTY2Ng4dOlT0\n3emFv/n1v/mq4b23//i5xCv/X3bjjrHiqTeimbu31Y27hgMAgIZGwgFUpOlAZ+evGu/KWfp/\nP73+579bw3gAoLFwlwoAADAdCQcAADAdCQcAADAdCQcAADAdCQcAADAdCQcAADAdCQcAADAd\nCQcAADAdCQcAADAdCQcAADAdCQcAADAdCQcAADAdD28Ddo66urQ08bSxskpz68Gf+UTzo4/V\nNiQA2BkkHMBOsDW3CSG05Mb63/6x4Uoy9/7hnSP/uXZBAcDOafiEQ9O0asoaKK4XMVa8wvpN\nqrxKZv/sVdI/ujLvltnAVC0nfynx5isivup0Og0UT7z239JvRtX4uqnBW/B3msuy4Vn5z0FY\nNTzsQQ2ccGQymVQqdffuXcM1bG5ubm5ubrdUIpuRCxsbG9XsvbyVlRWTaq6J+/fv1zuEkkr9\nUuTvWtM0835r5Tg6Wp/6XcOlU3/6nHgzmslkTA0+kUiYV3mVEomEZcPb2NjY2NiodxQlra+v\nGyuYSqVqGwn2uAZOOOx2u8PhOHjwoIGy8nrZ0tLS3Ny83bLxTFoutLa2Gtt7eZqmraysdHR0\n2O32mldepUwmI09e+/fvt9ksN+I4nU7HYrH9+/cXfbflrRYhhKIoZvzWtpRIJOLxuN1u7+jo\nMFA863IlhbDb7SYFH4/HNU1raWkxo/Iqra2tZbPZ5uZmy4bncrmMNVyZSp5JhBBtbW0Oh8NA\nDcZKAaU0cMKhKIqiKNVclW02m4Hidk2tpviWZOOn3W63YMKhqj/82e12uwUTjmw2K4Qo9bnp\nAdflg1UUpZq9y+JVHvBb1m/BQ06Y/7NXz6RTQZX0bhTD4ekHLVATlrtmAACA3aeBWziqtJFJ\nqelE0rbtsVSJB10qAACgQns34fCHX7i5+ma9owAAYE+gS8W49+1/uN4hAADQGPZuC8dzH/xo\n1mE3PLb8SNuB93WQcAAAUJG9m3AcP9jZ1tbmcrnqHQgAALvf3k04gIaTWrz52m/8uLGytn3t\nD/3z39h37FRtQwKACpFwAA3A3npQCKEmNxPfnzdcidJ86QgJB4A6IeEAGsCBj35CaWpWE2vG\nim++PJt8/YaWitc2KgCoHAkH0ADs7Q8fOvNvDRfPrL6RfP1GDeMBgO3itlgAAGA6Eg4AAGA6\nulSwt8TS6Q98+bPGyjY3Nf3aP/nov3z/P61tSACwF5BwYK94ZF+HEEIT2qrhsZMp8e+//XUS\nDgAwgIQDe8VH39X1hVO/sBzfMFY8vPTK139wK61maxvVTsquvbX+t39c9K1kMqlpmlZ6Hjx7\ny8GWH/kpYbPcQ9gBNAoSDuwVTTb7L7hPGC6uadrXf3CrhvHsvOTrN5YmnjZc/NCZf/vwz4/W\nMB4AewqDRoHdr/X4zyp2R5WVpBa/V5NgAOxNtHAAu1/7yX/R9tjPqelkqQ1isZimaa2trUXf\nfWPqVzZfnjUtOgB7AgkHsCcozha7s6XUuzbh1DTN3tpWvGyTwYcqA4COLhUAAGA6WjgAVCT1\nRuTetYvGytrbH27/8XM2V/EWFAB7AQkHgC0otiYhROoH373zR8af55J+65WHn/qt2gUFoMGQ\ncADYQsdH/nXyBze1dMJY8czqkpaKZ+7/oLZRAWgsJBwAttD6wZ9t/eB3DBd//dLPxr77FzWM\nB0AjIuEAsBPiC98wNu1YOp0WHe9w9n1atDEEBGhgJBzANsTSyf/wnb8yUDCdTtuyas87f+Sg\nOFjzqCxOcewTQqTv3k7fvW24ks2W/R2/+L/XLigAO42EA6iITbEJIdbTyc+9FDRcyfW3Xr18\n+mO1C6oxHOp7Vmiqlik57Vh58Ve+qSXWM29FEt+fN1ZD08EjTfvfYawsgFoxN+EYGRlZWFjo\n6uq6eLH43XRFN9iyFLDzfvpdXf/p1jfvJTaNFU9k08lsZim2VtuoGsK+Y6eOHDtluPjff+bH\n07fn49/609e+9afGalCanEc+NdPygY8ajgFA9UxMOCYmJk6dOnXx4sWZmZmJiYnBwcFKNtiy\nFFAXxw68/frPP2u4+OiLf/b73/vrGsazdzS984Pp2wbbNiQtk3rry8PNRz5gMICH3/NQ/3O2\nffuriQGAiQnH3Nzc5OSkEOLMmTP9/f1PPvlkZ2fnlhtsWQpoXPdTccM9Mi1Nzqfcj72zbc8N\nAWl/6pLz5IDDrrS0lJyavYw3pgZSi9+T/wzHEPvuf7G3P1T0rXQ6vW6322wlZ212PuLp8P2y\nMPrwPMfb3mtvPWSsLGApZiUc8/PzXV1deq7Q1dW1uLiYmzoU3WBxcbFMqVdfffXatWt6DYlE\norW1dXPTYBO3ECKZTGazWcPFTRWPxxVFqXcU+VRVlQuxWMyC4WWzWU3TqjkkzCMvRyupuLEx\np9LlyEvdBwyORWh1NB9qLnnBVlVV0zS73W40NBPJX6uiKPZVI+Ed+eA/P2ZvFppqbO+Hll91\nJjeSr/23Mtuky9YQ++5frPzl7xvbuxAia3fGWwwnHFr7u/+J43/6g/Q+Izf4WPb0iAZlVsKx\nuLhYuObEiRPlNyhaj17q9u3b09PT+ltHjx7NZrPxeNxwkOl0Op0uf66om0TC4CRLO8PK4VVz\nSJinp/P937rzD2spg5/b/VR8Kb722sb91zbu1zawPeF9P2O46I8+9NrppZftmmZwzxvL74rf\nM7x3IYQ9m2pbf8Nw8cyhR5P3F9PiXQbKknCgthrpLpX29vYf+ZEf0V9ms1lFUZqajPwImUxG\nCGGz2co0hNZRJpOx2+0WbELQNE2eg4x97GaT4Vkztve2P/T7J39BGP3oFmOrk38X3ij9fPkt\n3UlsJrIl02tN04QQFjzkxIPYRJ3CSx14x5++58fLbCBbX0q9a1PVI+tLhttXWtKJd638g7Gy\nQgihiSd+6uOOQ+809tFZ83hA4zLr1Hz48OHya7bcoHDl448//qUvfUl/GQgEHA7HgQMHDIR3\n584dIURLS4vL5TJQ3FSapt29e7ejo8OC7dvpdHp1dVUI0dHRYcFcLZVKbWxsGDskzBaLxWKx\nmN1uNxbegQMHxg8/WvOodJubm5qmtVlyZq2VlZVMJuNyuawZ3v3791taWpqbm+sdSD55JhFC\ntLa2Op1OAzU4HAbHnQBFmZhwLCws6C8XFhYKE46iG5QvBQAAGpFZX1I7Ozt7enpmZmaEEDMz\nMz09PXk3mxTdYMtSAACgEZnYKj44OHj9+vX+/v7r16/r02mMjIyMjIyU2aDoSgAA0NDMHV5X\nOFVo3pqic4kywSgAALuM5cb9AQCA3YeEAwAAmI6EAwAAmI6EAwAAmI6EAwAAmI6EAwAAmI6E\nAwAAmM6Kj7mq3Msvv/zxj3/cQEH5kFi73W7BB4IIIdLpdFNTkwWfnKRpmnzunTXDU1U1m81a\n8wEQ2WxWVVVh1edTyGfyWfDxPUKITCajaZrNZrNmeOl02spnElHFiS4ajdY6IuxpjZ1w3Lt3\n75vf/Ga9owAAAFtQ9Ec/N5xvfOMb8qGvBvz2b/+2qqpPPPHEhz70odpGtbvdvn37y1/+shDi\nE5/4REdHR73DaSR/9Vd/FQqFHnrooUAgUO9YGswXv/jFxcXFEydO9PT01DuWRpJMJj//+c8L\nIZ566qljx44ZrueJJ54w9rBZIE8Dt3B85CMfMVz2d37nd4QQjz32WH9/f+0i2v1eeuklmXD0\n9vY+8sgj9Q6nkbzxxhuhUKi9vf3JJ5+sdywN5qtf/eri4uLRo0f56LZlY2NDJhwf/vCHf/In\nf7Le4QAMGgUAAOZr4BaOanR0dFh2dKGVNTU1yZ4UC44YtTin09nR0dHa2lrvQBpPa2trR0eH\ny+WqdyANRlEU+dfKiQ4W0cBjOAAAQKOgSwUAAJiOhAMAAJiOhAMAAJhujyYcIyMj/f39IyMj\n9Q6kwczMzPT39/PRVW5paam/v39paSl3JYfflop+bhx+W5qfny/6EXHIwQr2YsIxMTFx6tSp\nq1evnjp1amJiot7hNJLr169fvXr16tWrFy9erHcsDWB+fr5wmi8Ovy0V/dwEh99WlpaWXnzx\nRfkRLSws6EcXhxwsYi8mHHNzc48//rgQ4syZM3Nzc3nfolDK/Pz8008/Xe8oGsmJEyeuXr2a\nt5LDb0tFPzcOvy0tLi4ODg7K5Weeeeb27dtymUMOFrHn5uGYn5/v6urq7OyUL7u6uhYXF/WX\nKOOFF15YWFgQQhReDFAhDj/DOPy2dOLECX358OHDjz76qOCQg5XsuRaOxcXFLdegqIsXL169\nerWnp6ewcx0V4vAzjMNvW1588cWTJ08KDjlYyZ5LOFClwcHBZ5555itf+Uq9A8FexOFXCZmQ\n5TZ4AFaw5xKOw4cPb7kG5Z05c0bvHsa2cPhVj8NvS1/4whf0wRwccrCOvZhwyJ5gaWFhgT8/\nA2T3MLaLw68mOPzKmJiY+NSnPqW/5JCDdey5hKOzs7Onp2dmZkYIMTMz09PTw/ip7ZqYmOBB\n4cZw+FWPw6+MmZmZkydPyoNqfn5+fn6eQw7WsUcf3jYyMrKwsNDV1cUN/RVaWlrSp0b4zGc+\nQ/dwJUp9aBx+5RV+bhx+lZiYmJibm8tdo9/RwyEHK9ijCQcAANhJe65LBQAA7DwSDgAAYDoS\nDgAAYDoSDgAAYDoSDgAAYDoSDgAAYDoSDqD2gsGgz+cbHx+vdyAAYBUkHECNjY+P9/X1hcPh\negcCABZCwgHU2NDQUCQSqXcUAGAtJBwAAMB0JBxAbUSjUZ/PpyiKz+cr9Vbuu8oD+hp9mx2N\nGwB2BAkHUAPRaNTj8Zw7d07TtOnp6YGBgdx3PR7P8ePHNU2LRCLhcFg+hywSiXi9Xq/XGwqF\n5GZyge4YALsSCQdQA5cuXfL7/UNDQ0IIt9t94cKFvA26u7vlW16v98aNG/pm4XA4GAzKbcbH\nx8fGxtxu987GDgA7gYQDqFY0Gp2amjp79qy+xuPx5G6gadrQ0JDsWMm9e6W3t9fr9Y6OjsqX\nly9fPn369M7EDAA7rKneAQANb8tOkGg0KjtZCntbLly40NfXF41G5UuaNwDsVrRwALVx69at\nUm/JMRyhUKgwn+jt7RVCXLp06dKlS+fOnTM3RACoH1o4gGrJpOHy5ctyDEceOUTj/PnzpYqP\njY0NDw8LITRNMy1GAKgzWjiAGhgbG9NvPxFCXLp0SQgxPDysr7l27ZoQIhgMyjEc0WhU70aR\naYrf79/5sAFgx5BwADUwNDQ0NjY2NTUl59WQ7RljY2OTk5O9vb1+v394eNjn83k8Hr/fHw6H\nr127ltu94vf7c8ecAsDuo9CKC9Sdz+fTZ+MAgF2JFg6gzsbHxxkuCmDXY9AoUB/j4+NyrKhg\nuCiAPYAWDqA+jh07JoTwer3MZQ5gL2AMBwAAMB0tHAAAwHQkHAAAwHQkHAAAwHQkHAAAwHQk\nHAAAwHQkHAAAwHQkHAAAwHT/P7yvFz3n3yaOAAAAAElFTkSuQmCC" }, "metadata": {}, "output_type": "display_data" } ], "source": [ "times = 1:21\n", "cs = c(6,3.2)\n", "options(repr.plot.width=cs[1],repr.plot.height=cs[2])\n", "\n", "clrs = c(\"#1b9e77\",\"#d95f02\",\"#7570b3\")\n", "\n", "data.frame(x=times, `Generation time 1`=h(times,solMLE$par[1:2]), `Generation time 2`=h(times,solMLE$par[3:4])) %>%\n", " gather(Variable,y,-x) %>%\n", " ggplot(aes(x=x-1,y=y)) +\n", " geom_step(aes(color=Variable)) +\n", " scale_color_manual(labels = c(\"Generation time 1\", \"Generation time 2\"), values=clrs) +\n", " labs(x=\"day\",y=\"probability density\",color=\"Distribution\")" ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "# Main analysis \n", "\n", "## Loading the data" ] }, { "cell_type": "code", "execution_count": 21, "metadata": { "scrolled": false }, "outputs": [ { "name": "stderr", "output_type": "stream", "text": [ "Joining, by = c(\"epicurve\", \"number\")\n" ] }, { "data": { "text/html": [ "\n", "\n", "\n", "\t\n", "\t\n", "\t\n", "\t\n", "\t\n", "\t\n", "\n", "
epicurveonsetconfirmed
May27 2018-04-292018-05-12
May27 2018-05-092018-05-12
May27 2018-05-122018-05-13
May27 2018-05-082018-05-14
May27 2018-05-102018-05-15
May27 2018-05-122018-05-18
\n" ], "text/latex": [ "\\begin{tabular}{r|lll}\n", " epicurve & onset & confirmed\\\\\n", "\\hline\n", "\t May27 & 2018-04-29 & 2018-05-12\\\\\n", "\t May27 & 2018-05-09 & 2018-05-12\\\\\n", "\t May27 & 2018-05-12 & 2018-05-13\\\\\n", "\t May27 & 2018-05-08 & 2018-05-14\\\\\n", "\t May27 & 2018-05-10 & 2018-05-15\\\\\n", "\t May27 & 2018-05-12 & 2018-05-18\\\\\n", "\\end{tabular}\n" ], "text/markdown": [ "\n", "epicurve | onset | confirmed | \n", "|---|---|---|---|---|---|\n", "| May27 | 2018-04-29 | 2018-05-12 | \n", "| May27 | 2018-05-09 | 2018-05-12 | \n", "| May27 | 2018-05-12 | 2018-05-13 | \n", "| May27 | 2018-05-08 | 2018-05-14 | \n", "| May27 | 2018-05-10 | 2018-05-15 | \n", "| May27 | 2018-05-12 | 2018-05-18 | \n", "\n", "\n" ], "text/plain": [ " epicurve onset confirmed \n", "1 May27 2018-04-29 2018-05-12\n", "2 May27 2018-05-09 2018-05-12\n", "3 May27 2018-05-12 2018-05-13\n", "4 May27 2018-05-08 2018-05-14\n", "5 May27 2018-05-10 2018-05-15\n", "6 May27 2018-05-12 2018-05-18" ] }, "metadata": {}, "output_type": "display_data" } ], "source": [ "filename = \"data.xlsx\"\n", "\n", "options(warn=-1)\n", "read_excel(filename, sheet = \"raw_onset\") %>% ncol -> nclmns\n", "read_excel(filename, sheet = \"raw_onset\", col_types = rep(\"date\",nclmns)) %>%\n", " gather(epicurve,onset) %>% \n", " mutate(number=1:n()) -> df\n", "if (read_excel(filename, sheet = \"raw_confirm\") %>% ncol!=nclmns)\n", " message(\"Something wrong with number of columns in Excel file!\")\n", "read_excel(filename, sheet = \"raw_confirm\", col_types = rep(\"date\",nclmns)) %>%\n", " gather(epicurve,confirmed) %>%\n", " mutate(number=1:n()) %>%\n", " left_join(df) %>%\n", " select(epicurve,onset,confirmed) %>%\n", " mutate(onset=as.Date(onset), confirmed=as.Date(confirmed)) -> df\n", "options(warn=0)\n", "df %>% tail" ] }, { "cell_type": "code", "execution_count": 22, "metadata": {}, "outputs": [ { "data": { "text/html": [ "\n", "\n", "\n", "\t\n", "\t\n", "\t\n", "\t\n", "\t\n", "\t\n", "\n", "
epicurveonsetconfirmeddifference
Apr01 2018-03-172018-03-206
Apr01 2018-03-272018-03-292
Apr01 2018-03-272018-03-292
Apr01 2018-03-252018-03-316
Apr01 2018-03-252018-03-316
Apr01 2018-03-262018-03-315
\n" ], "text/latex": [ "\\begin{tabular}{r|llll}\n", " epicurve & onset & confirmed & difference\\\\\n", "\\hline\n", "\t Apr01 & 2018-03-17 & 2018-03-20 & 6 \\\\\n", "\t Apr01 & 2018-03-27 & 2018-03-29 & 2 \\\\\n", "\t Apr01 & 2018-03-27 & 2018-03-29 & 2 \\\\\n", "\t Apr01 & 2018-03-25 & 2018-03-31 & 6 \\\\\n", "\t Apr01 & 2018-03-25 & 2018-03-31 & 6 \\\\\n", "\t Apr01 & 2018-03-26 & 2018-03-31 & 5 \\\\\n", "\\end{tabular}\n" ], "text/markdown": [ "\n", "epicurve | onset | confirmed | difference | \n", "|---|---|---|---|---|---|\n", "| Apr01 | 2018-03-17 | 2018-03-20 | 6 | \n", "| Apr01 | 2018-03-27 | 2018-03-29 | 2 | \n", "| Apr01 | 2018-03-27 | 2018-03-29 | 2 | \n", "| Apr01 | 2018-03-25 | 2018-03-31 | 6 | \n", "| Apr01 | 2018-03-25 | 2018-03-31 | 6 | \n", "| Apr01 | 2018-03-26 | 2018-03-31 | 5 | \n", "\n", "\n" ], "text/plain": [ " epicurve onset confirmed difference\n", "1 Apr01 2018-03-17 2018-03-20 6 \n", "2 Apr01 2018-03-27 2018-03-29 2 \n", "3 Apr01 2018-03-27 2018-03-29 2 \n", "4 Apr01 2018-03-25 2018-03-31 6 \n", "5 Apr01 2018-03-25 2018-03-31 6 \n", "6 Apr01 2018-03-26 2018-03-31 5 " ] }, "metadata": {}, "output_type": "display_data" } ], "source": [ "df %<>%\n", " mutate(difference=confirmed-onset,\n", " # if the onset date is unknown, it is assummed to be 5 days prior the confirmation\n", " difference=ifelse(is.na(onset),5,difference), \n", " onset=if_else(is.na(as.numeric(onset)),confirmed-difference,onset)) %>%\n", " na.omit\n", "\n", "# we shift the onset data of the index case to the date of first exposure \n", "df[which(df$onset=='2018-03-14'),'onset'] = as.Date('2018-03-17')\n", "\n", "df %>% head" ] }, { "cell_type": "code", "execution_count": 23, "metadata": {}, "outputs": [ { "data": { "text/html": [ "2066" ], "text/latex": [ "2066" ], "text/markdown": [ "2066" ], "text/plain": [ "[1] 2066" ] }, "metadata": {}, "output_type": "display_data" } ], "source": [ "# total number of records\n", "df %>% nrow" ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "We use Gamma distribution to define generation time distribution $g_t$, Weibull distribution for delay distribution $h_t$ between symptoms onset and lab confirmation" ] }, { "cell_type": "code", "execution_count": 24, "metadata": {}, "outputs": [], "source": [ "# Gamma distribution for incubation period\n", "g = function(time) { \n", " g_mean = 11.7; g_var = 9.0 # from (Klinkenberg and Nishiura 2011)\n", " scl = g_var/g_mean\n", " pgamma(time,shape=g_mean/scl,scale=scl)-pgamma(time-1,shape=g_mean/scl,scale=scl) }" ] }, { "cell_type": "code", "execution_count": 25, "metadata": {}, "outputs": [ { "data": { "text/html": [ "" ], "text/latex": [ "2018-03-17" ], "text/markdown": [ "2018-03-17" ], "text/plain": [ "[1] \"2018-03-17\"" ] }, "metadata": {}, "output_type": "display_data" }, { "data": { "text/html": [ "" ], "text/latex": [ "2018-05-18" ], "text/markdown": [ "2018-05-18" ], "text/plain": [ "[1] \"2018-05-18\"" ] }, "metadata": {}, "output_type": "display_data" }, { "data": { "text/html": [ "\n", "\n", "\n", "\t\n", "\t\n", "\t\n", "\t\n", "\t\n", "\t\n", "\n", "
epicurveonsetconfirmeddifferenceday_onsetday_confirmation
Apr01 2018-03-172018-03-206 0 3
Apr01 2018-03-272018-03-292 10 12
Apr01 2018-03-272018-03-292 10 12
Apr01 2018-03-252018-03-316 8 14
Apr01 2018-03-252018-03-316 8 14
Apr01 2018-03-262018-03-315 9 14
\n" ], "text/latex": [ "\\begin{tabular}{r|llllll}\n", " epicurve & onset & confirmed & difference & day\\_onset & day\\_confirmation\\\\\n", "\\hline\n", "\t Apr01 & 2018-03-17 & 2018-03-20 & 6 & 0 & 3 \\\\\n", "\t Apr01 & 2018-03-27 & 2018-03-29 & 2 & 10 & 12 \\\\\n", "\t Apr01 & 2018-03-27 & 2018-03-29 & 2 & 10 & 12 \\\\\n", "\t Apr01 & 2018-03-25 & 2018-03-31 & 6 & 8 & 14 \\\\\n", "\t Apr01 & 2018-03-25 & 2018-03-31 & 6 & 8 & 14 \\\\\n", "\t Apr01 & 2018-03-26 & 2018-03-31 & 5 & 9 & 14 \\\\\n", "\\end{tabular}\n" ], "text/markdown": [ "\n", "epicurve | onset | confirmed | difference | day_onset | day_confirmation | \n", "|---|---|---|---|---|---|\n", "| Apr01 | 2018-03-17 | 2018-03-20 | 6 | 0 | 3 | \n", "| Apr01 | 2018-03-27 | 2018-03-29 | 2 | 10 | 12 | \n", "| Apr01 | 2018-03-27 | 2018-03-29 | 2 | 10 | 12 | \n", "| Apr01 | 2018-03-25 | 2018-03-31 | 6 | 8 | 14 | \n", "| Apr01 | 2018-03-25 | 2018-03-31 | 6 | 8 | 14 | \n", "| Apr01 | 2018-03-26 | 2018-03-31 | 5 | 9 | 14 | \n", "\n", "\n" ], "text/plain": [ " epicurve onset confirmed difference day_onset day_confirmation\n", "1 Apr01 2018-03-17 2018-03-20 6 0 3 \n", "2 Apr01 2018-03-27 2018-03-29 2 10 12 \n", "3 Apr01 2018-03-27 2018-03-29 2 10 12 \n", "4 Apr01 2018-03-25 2018-03-31 6 8 14 \n", "5 Apr01 2018-03-25 2018-03-31 6 8 14 \n", "6 Apr01 2018-03-26 2018-03-31 5 9 14 " ] }, "metadata": {}, "output_type": "display_data" } ], "source": [ "# using days since index case instead of dates\n", "(mindate = min(df$onset))\n", "(maxdate = max(df$confirmed))\n", "df %<>% \n", " mutate(day_onset = unclass(onset)-unclass(mindate),\n", " day_confirmation = unclass(confirmed)-unclass(mindate))\n", "df %>% head" ] }, { "cell_type": "code", "execution_count": 26, "metadata": {}, "outputs": [ { "data": { "text/html": [ "
    \n", "\t
  1. 'Apr01'
  2. \n", "\t
  3. 'Apr05'
  4. \n", "\t
  5. 'Apr09'
  6. \n", "\t
  7. 'Apr13'
  8. \n", "\t
  9. 'Apr17'
  10. \n", "\t
  11. 'Apr21'
  12. \n", "\t
  13. 'Apr25'
  14. \n", "\t
  15. 'Apr29'
  16. \n", "\t
  17. 'May01'
  18. \n", "\t
  19. 'May03'
  20. \n", "\t
  21. 'May05'
  22. \n", "\t
  23. 'May07'
  24. \n", "\t
  25. 'May09'
  26. \n", "\t
  27. 'May11'
  28. \n", "\t
  29. 'May13'
  30. \n", "\t
  31. 'May15'
  32. \n", "\t
  33. 'May17'
  34. \n", "\t
  35. 'May19'
  36. \n", "\t
  37. 'May21'
  38. \n", "\t
  39. 'May23'
  40. \n", "\t
  41. 'May25'
  42. \n", "\t
  43. 'May27'
  44. \n", "
\n" ], "text/latex": [ "\\begin{enumerate*}\n", "\\item 'Apr01'\n", "\\item 'Apr05'\n", "\\item 'Apr09'\n", "\\item 'Apr13'\n", "\\item 'Apr17'\n", "\\item 'Apr21'\n", "\\item 'Apr25'\n", "\\item 'Apr29'\n", "\\item 'May01'\n", "\\item 'May03'\n", "\\item 'May05'\n", "\\item 'May07'\n", "\\item 'May09'\n", "\\item 'May11'\n", "\\item 'May13'\n", "\\item 'May15'\n", "\\item 'May17'\n", "\\item 'May19'\n", "\\item 'May21'\n", "\\item 'May23'\n", "\\item 'May25'\n", "\\item 'May27'\n", "\\end{enumerate*}\n" ], "text/markdown": [ "1. 'Apr01'\n", "2. 'Apr05'\n", "3. 'Apr09'\n", "4. 'Apr13'\n", "5. 'Apr17'\n", "6. 'Apr21'\n", "7. 'Apr25'\n", "8. 'Apr29'\n", "9. 'May01'\n", "10. 'May03'\n", "11. 'May05'\n", "12. 'May07'\n", "13. 'May09'\n", "14. 'May11'\n", "15. 'May13'\n", "16. 'May15'\n", "17. 'May17'\n", "18. 'May19'\n", "19. 'May21'\n", "20. 'May23'\n", "21. 'May25'\n", "22. 'May27'\n", "\n", "\n" ], "text/plain": [ " [1] \"Apr01\" \"Apr05\" \"Apr09\" \"Apr13\" \"Apr17\" \"Apr21\" \"Apr25\" \"Apr29\" \"May01\"\n", "[10] \"May03\" \"May05\" \"May07\" \"May09\" \"May11\" \"May13\" \"May15\" \"May17\" \"May19\"\n", "[19] \"May21\" \"May23\" \"May25\" \"May27\"" ] }, "metadata": {}, "output_type": "display_data" }, { "data": { "text/html": [ "
    \n", "\t
  1. 'Apr01'
  2. \n", "\t
  3. 'Apr09'
  4. \n", "\t
  5. 'Apr17'
  6. \n", "\t
  7. 'Apr25'
  8. \n", "\t
  9. 'May03'
  10. \n", "\t
  11. 'May11'
  12. \n", "\t
  13. 'May17'
  14. \n", "\t
  15. 'May25'
  16. \n", "
\n" ], "text/latex": [ "\\begin{enumerate*}\n", "\\item 'Apr01'\n", "\\item 'Apr09'\n", "\\item 'Apr17'\n", "\\item 'Apr25'\n", "\\item 'May03'\n", "\\item 'May11'\n", "\\item 'May17'\n", "\\item 'May25'\n", "\\end{enumerate*}\n" ], "text/markdown": [ "1. 'Apr01'\n", "2. 'Apr09'\n", "3. 'Apr17'\n", "4. 'Apr25'\n", "5. 'May03'\n", "6. 'May11'\n", "7. 'May17'\n", "8. 'May25'\n", "\n", "\n" ], "text/plain": [ "[1] \"Apr01\" \"Apr09\" \"Apr17\" \"Apr25\" \"May03\" \"May11\" \"May17\" \"May25\"" ] }, "metadata": {}, "output_type": "display_data" } ], "source": [ "# Available epicurves\n", "(all_epicurves = unique(df$epicurve))\n", "# we restrict ourselves to the following epicurves \n", "# starting from the first one with the time step of eight days\n", "(all_epicurves = c(\"Apr01\",\"Apr09\",\"Apr17\",\"Apr25\",\"May03\",\"May11\",\"May17\",\"May25\"))\n", "df = filter(df,epicurve %in% all_epicurves)" ] }, { "cell_type": "code", "execution_count": 27, "metadata": {}, "outputs": [ { "data": { "text/html": [ "83" ], "text/latex": [ "83" ], "text/markdown": [ "83" ], "text/plain": [ "[1] 83" ] }, "metadata": {}, "output_type": "display_data" } ], "source": [ "(maxDay = max(df$day_confirmation)+21)" ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "# With no switch in delay function" ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "* **Slower version**" ] }, { "cell_type": "code", "execution_count": 48, "metadata": {}, "outputs": [], "source": [ "# if the parameter \"prediction\" is FALSE, the result of the function is log-likelihood,\n", "# otherwise it give the resulting data.frame with all entities\n", "calculate_six_generations = function(prms,prediction=FALSE,ndays=maxDay) {\n", " K = prms[1]; R2 = prms[2]; R3 = prms[3]; R4 = prms[4]; R5 = prms[5]\n", " \n", " data.frame(day = 0:ndays) %>%\n", " mutate(gt=g(day)) -> df_\n", "\n", " #calculating first convolution\n", " conv = c()\n", " for (x in 1:nrow(df_)) {\n", " conv = c(conv,sum(df_$gt[1:x]*df_$gt[x:1])) }\n", " df_ %<>% do(cbind(.,conv1_gt=conv))\n", " \n", " #calculating second convolution\n", " conv = c()\n", " for (x in 1:nrow(df_)) {\n", " conv = c(conv,sum(df_$conv1_gt[1:x]*df_$gt[x:1])) }\n", " df_ %<>% do(cbind(.,conv2_gt=conv))\n", " \n", " #calculating third convolution\n", " conv = c()\n", " for (x in 1:nrow(df_)) {\n", " conv = c(conv,sum(df_$conv2_gt[1:x]*df_$gt[x:1])) }\n", " df_ %<>% do(cbind(.,conv3_gt=conv))\n", " \n", " #calculating fourth convolution\n", " conv = c()\n", " for (x in 1:nrow(df_)) {\n", " conv = c(conv,sum(df_$conv3_gt[1:x]*df_$gt[x:1])) }\n", " df_ %<>% do(cbind(.,conv4_gt=conv))\n", "\n", "\n", " df_ %<>% \n", " mutate(ft = (gt+R2*conv1_gt+R2*R3*conv2_gt+R2*R3*R4*conv3_gt+R2*R3*R4*R5*conv3_gt)/(1+R2+R2*R3+R2*R3*R4+R2*R3*R4*R5)) \n", " \n", " if (prediction) {\n", " df_ %<>% \n", " mutate(ht=h(day,prms[6:7]))\n", " \n", " #calculating convolution with h\n", " conv = c()\n", " for (x in 1:nrow(df_)) {\n", " conv = c(conv,sum(df_$ft[1:x]*df_$ht[x:1])) }\n", " df_ %<>% do(cbind(.,conv_ht=conv)) \n", "\n", " df_ %>% \n", " left_join(Df,by=\"day\") %>%\n", " mutate(lambda_i = K*ft, lambda_c = K*conv_ht) %>%\n", " left_join(select(Df,-i,-c),by=\"day\") %>% return\n", " \n", " } else {\n", " df_ %<>% right_join(Df,by=\"day\") \n", " \n", " maxday = max(df_$day)\n", " \n", " df_ %>%\n", " filter(ft>0 & day% \n", " mutate(lambda = H(maxday-day,prms[6:7])*K*ft) %>%\n", " summarize(loglk = sum(i*log(lambda)-lambda-lfactorial(i))) %>% \n", " .$loglk -> loglk_onset\n", " \n", " df_current %>% \n", " group_by(difference) %>%\n", " count %>% \n", " ungroup %>%\n", " rowwise %>%\n", " mutate(loglk = n*log(h(difference,prms[6:7]))) %>% \n", " ungroup %>%\n", " summarize(loglk = sum(loglk)) %>%\n", " .$loglk -> loglk_delay\n", " \n", " return(loglk_delay+loglk_onset)\n", " }\n", "}\n", "\n", "calculate_five_generations = function(x,prediction=FALSE,ndays=maxDay) { \n", " calculate_six_generations(c(x[1:4],0,x[5:length(x)]),prediction,ndays) }\n", "calculate_four_generations = function(x,prediction=FALSE,ndays=maxDay) { \n", " calculate_six_generations(c(x[1:3],0,0,x[4:length(x)]),prediction,ndays) }\n", "calculate_three_generations = function(x,prediction=FALSE,ndays=maxDay) { \n", " calculate_six_generations(c(x[1:2],0,0,0,x[3:length(x)]),prediction,ndays) }\n", "calculate_two_generations = function(x,prediction=FALSE,ndays=maxDay) { \n", " calculate_six_generations(c(x[1],0,0,0,0,x[2:length(x)]),prediction,ndays) }\n", "\n", "getDelay = function(prms) {\n", " df_current %>% \n", " mutate(delta = day_confirmation-day_onset) %>%\n", " group_by(delta) %>%\n", " count %>%\n", " ungroup -> df_\n", "\n", " df_ %>% \n", " right_join(data.frame(delta=1:max(df_$delta)+1),by=\"delta\") %>%\n", " mutate(n = ifelse(is.na(n),0,n), ht = h(delta,prms)) %>%\n", " mutate(freq = n/sum(n)) %>%\n", " return\n", "}" ] }, { "cell_type": "code", "execution_count": 49, "metadata": {}, "outputs": [ { "data": { "text/html": [ "-38.3821900262908" ], "text/latex": [ "-38.3821900262908" ], "text/markdown": [ "-38.3821900262908" ], "text/plain": [ "[1] -38.38219" ] }, "metadata": {}, "output_type": "display_data" } ], "source": [ "# test\n", "pars = c(123.00059,1.25,1,2,4)\n", "calculate_four_generations(pars)" ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "* **Faster (optimized) version** (it gives the same result as the one above)" ] }, { "cell_type": "code", "execution_count": 50, "metadata": {}, "outputs": [], "source": [ "# if the parameter \"prediction\" is FALSE, the result of the function is log-likelihood,\n", "# otherwise it give the resulting data.frame with all entities\n", "calculate_six_generations = function(prms,prediction=FALSE) {\n", " R2 = prms[1]; R3 = prms[2]; R4 = prms[3]; R5 = prms[4]\n", " \n", " Df = data.frame(day=0:(unclass(as.Date('2018'%&%current_epicurve,\"%Y%b%d\"))-unclass(dayZero)))\n", "\n", " df_current %>% \n", " filter(day_onset>0) %>% #removing index case\n", " group_by(day_onset) %>%\n", " count %>%\n", " rename(day=day_onset) %>%\n", " right_join(Df,by=\"day\") %>%\n", " mutate(n=ifelse(is.na(n),0,n)) %>%\n", " rename(i=n) -> Df\n", "\n", " df_current %>%\n", " filter(day_onset>0) %>% #removing index case\n", " group_by(day_confirmation) %>%\n", " count %>%\n", " rename(day=day_confirmation) %>%\n", " right_join(Df,by=\"day\") %>%\n", " mutate(n=ifelse(is.na(n),0,n)) %>%\n", " rename(c=n) %>%\n", " select(day,i,c) %>%\n", " arrange(day) -> Df\n", "\n", " Df %>% mutate(date=day+dayZero) %>%\n", " select(date,day) %>% rename(onset=date) %>% right_join(df_current,by=\"onset\") -> df_current\n", " \n", " maxday = ifelse(prediction,maxDay,max(Df$day))\n", " \n", " gt = g(0:maxday)\n", "\n", " #calculating first convolution\n", " conv1_gt = c()\n", " for (x in 1:length(gt)) {\n", " conv1_gt = c(conv1_gt,sum(gt[1:x]*gt[x:1])) }\n", " \n", " #calculating second convolution\n", " conv2_gt = c()\n", " for (x in 1:length(gt)) {\n", " conv2_gt = c(conv2_gt,sum(conv1_gt[1:x]*gt[x:1])) }\n", " \n", " #calculating third convolution\n", " conv3_gt = c()\n", " for (x in 1:length(gt)) {\n", " conv3_gt = c(conv3_gt,sum(conv2_gt[1:x]*gt[x:1])) }\n", " \n", " #calculating fourth convolution\n", " conv4_gt = c()\n", " for (x in 1:length(gt)) {\n", " conv4_gt = c(conv4_gt,sum(conv3_gt[1:x]*gt[x:1])) }\n", " \n", " ft = (gt+R2*conv1_gt+R2*R3*conv2_gt+R2*R3*R4*conv3_gt+R2*R3*R4*R5*conv3_gt)/(1+R2+R2*R3+R2*R3*R4+R2*R3*R4*R5)\n", " \n", " if (prediction) {\n", " K = sum(Df$i[-max(Df$day)])/sum(H(maxday:0,prms[5:6])*ft)\n", " \n", " ht=h(0:maxday,prms[5:6])\n", " \n", " #calculating convolution with h\n", " conv_ht = c()\n", " for (x in 1:length(ht)) {\n", " conv_ht = c(conv_ht,sum(ft[1:x]*ht[x:1])) }\n", " \n", " data.frame(\n", " day = 0:maxday,\n", " lambda_i = K*ft, \n", " lambda_c = K*conv_ht) %>%\n", " left_join(Df,by=\"day\") %>% return\n", " \n", " } else {\n", " K = sum(Df$i[-maxday])/sum(H(maxday:0,prms[5:6])*ft)\n", " Klast <<- K\n", " lambda = (H(maxday:0,prms[5:6])*ft*K)[-c(1,maxday+1)]\n", " \n", " loglk_onset = sum(Df$i[-c(1,maxday+1)]*log(lambda)-lambda-lfactorial(Df$i[-c(1,maxday+1)]))\n", " \n", " dt = table(df_current$difference) %>% { apply(as.matrix.noquote(data.frame(.)),2,as.numeric) }\n", " loglk_delay = sum(dt[,2]*log(h(dt[,1],prms[5:6])))\n", " \n", " return(loglk_delay+loglk_onset)\n", " }\n", "}\n", "\n", "calculate_five_generations = function(x,prediction=FALSE) { calculate_six_generations(c(x[1:3],0,x[4:length(x)]),prediction) }\n", "calculate_four_generations = function(x,prediction=FALSE) { calculate_six_generations(c(x[1:2],0,0,x[3:length(x)]),prediction) }\n", "calculate_three_generations = function(x,prediction=FALSE) { calculate_six_generations(c(x[1],0,0,0,x[2:length(x)]),prediction) }\n", "calculate_two_generations = function(x,prediction=FALSE) { calculate_six_generations(c(0,0,0,0,x),prediction) }\n", " \n", "calculate_generations = function(ngenerations,x,prediction=FALSE) {\n", " switch(ngenerations,\n", " NULL,\n", " calculate_two_generations(x,prediction),\n", " calculate_three_generations(x,prediction),\n", " calculate_four_generations(x,prediction),\n", " calculate_five_generations(x,prediction),\n", " calculate_six_generations(x,prediction)\n", " )\n", "}" ] }, { "cell_type": "code", "execution_count": 51, "metadata": {}, "outputs": [ { "data": { "text/html": [ "-37.6853604583798" ], "text/latex": [ "-37.6853604583798" ], "text/markdown": [ "-37.6853604583798" ], "text/plain": [ "[1] -37.68536" ] }, "metadata": {}, "output_type": "display_data" }, { "data": { "text/html": [ "79.0469298896036" ], "text/latex": [ "79.0469298896036" ], "text/markdown": [ "79.0469298896036" ], "text/plain": [ "[1] 79.04693" ] }, "metadata": {}, "output_type": "display_data" } ], "source": [ "# test\n", "pars = c(1.25,1,2,4)\n", "(calculate_four_generations(pars))\n", "Klast" ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "## Generating a table with varied number of generations\n", "\n", "## Two generations" ] }, { "cell_type": "code", "execution_count": 52, "metadata": {}, "outputs": [], "source": [ "# File names to save the output\n", "\n", "final_pars_output = \"final_pars_constant_delay.csv\"\n", "\n", "recalc = TRUE" ] }, { "cell_type": "code", "execution_count": 53, "metadata": { "scrolled": false }, "outputs": [ { "name": "stderr", "output_type": "stream", "text": [ "Apr01\n" ] }, { "name": "stdout", "output_type": "stream", "text": [ " mean_h1 var_h1 par1_h1 par2_h1 K loglk AIC rmse_i\n", "1 4.044729 3.93481 2.147092 4.567165 25.83603 -37.24594 80.49188 1.047905\n", " rmse_c\n", "1 1.323245\n" ] }, { "name": "stderr", "output_type": "stream", "text": [ "Apr09\n" ] }, { "name": "stdout", "output_type": "stream", "text": [ " mean_h1 var_h1 par1_h1 par2_h1 K loglk AIC rmse_i\n", "1 3.912038 3.872445 2.087287 4.416724 35.3243 -100.4916 206.9832 1.065747\n", " rmse_c\n", "1 1.378465\n" ] }, { "name": "stderr", "output_type": "stream", "text": [ "Apr17\n" ] }, { "name": "stdout", "output_type": "stream", "text": [ " mean_h1 var_h1 par1_h1 par2_h1 K loglk AIC rmse_i\n", "1 3.924118 2.913656 2.454589 4.424604 63.01257 -273.625 553.25 2.807909\n", " rmse_c\n", "1 2.718949\n" ] }, { "name": "stderr", "output_type": "stream", "text": [ "Apr25\n" ] }, { "name": "stdout", "output_type": "stream", "text": [ " mean_h1 var_h1 par1_h1 par2_h1 K loglk AIC rmse_i\n", "1 3.955826 2.918283 2.474559 4.459543 80.00003 -483.1434 972.2869 3.307684\n", " rmse_c\n", "1 3.146875\n" ] }, { "name": "stderr", "output_type": "stream", "text": [ "Done\n" ] } ], "source": [ "if (recalc) {\n", " final_pars = NULL\n", "\n", " # initial parameter values used in optim function\n", " pars = c(2,5)\n", " options(warn=-1)\n", " for (current_epicurve in unique(df$epicurve)[1:4]) { \n", " message(current_epicurve)\n", "\n", " df %>% \n", " filter(epicurve==current_epicurve) %>% \n", " select(-epicurve) -> df_current\n", "\n", " Df = data.frame(day=0:(unclass(as.Date('2018'%&%current_epicurve,\"%Y%b%d\"))-unclass(dayZero)))\n", "\n", " df_current %>% \n", " filter(day_onset>0) %>% #removing index case\n", " group_by(day_onset) %>%\n", " count %>%\n", " rename(day=day_onset) %>%\n", " right_join(Df,by=\"day\") %>%\n", " mutate(n=ifelse(is.na(n),0,n)) %>%\n", " rename(i=n) -> Df\n", "\n", " df_current %>%\n", " filter(day_onset>0) %>% #removing index case\n", " group_by(day_confirmation) %>%\n", " count %>%\n", " rename(day=day_confirmation) %>%\n", " right_join(Df,by=\"day\") %>%\n", " mutate(n=ifelse(is.na(n),0,n)) %>%\n", " rename(c=n) %>%\n", " select(day,i,c) %>%\n", " arrange(day) -> Df\n", "\n", " Df %>% mutate(date=day+dayZero) %>%\n", " select(date,day) %>% rename(onset=date) %>% right_join(df_current,by=\"onset\") -> df_current\n", "\n", " solMLE = optim(pars,\n", " function(x) calculate_generations(length(pars),x,FALSE),\n", " method=\"L-BFGS-B\",\n", " control=list(fnscale=-1),lower=rep(0,length(pars))) \n", "\n", " # Weibull distribution mean and variance\n", " parsH = solMLE$par[(length(pars)-1):length(pars)]\n", " pars_h = c(parsH[2]*gamma(1+1/parsH[1]),parsH[2]^2*(gamma(1+2/parsH[1])-(gamma(1+1/parsH[1]))^2))\n", "\n", " # Maximum likelihood estimates (MLE)\n", " calculate_generations(length(pars),solMLE$par,prediction=TRUE) %>% \n", " rename(`MLE_i`=`lambda_i`,`MLE_c`=`lambda_c`) -> dfMLE\n", "\n", " # RMSE\n", " calculate_generations(length(pars),solMLE$par,prediction=TRUE) %>%\n", " na.omit %>%\n", " mutate(epsilon_i = (lambda_i-i), epsilon_c = (lambda_c-c)) %>%\n", " summarize(rmse_i = sqrt(sum(epsilon_i^2)/n()),rmse_c = sqrt(sum(epsilon_c^2)/n())) %>% as.numeric -> rmse\n", "\n", " npars = length(pars)\n", " output = data.frame(t(c(pars_h,solMLE$par[(length(pars)-1):length(pars)],\n", " Klast,solMLE$value,2*(npars+1-solMLE$value),rmse))) #npars+2, additional two is due to tau and K\n", " colnames(output) = c(\"mean_h1\",\"var_h1\",\"par1_h1\",\"par2_h1\",\n", " \"K\",\"loglk\",\"AIC\",\"rmse_i\",\"rmse_c\")\n", "\n", " print(output) \n", " \n", " final_pars %<>% rbind(output %>% gather(parameter,estimate) %>% \n", " mutate(epicurve=current_epicurve,generations=length(pars)))\n", " } \n", "}\n", "\n", "message(\"Done\")" ] }, { "cell_type": "code", "execution_count": 54, "metadata": {}, "outputs": [ { "data": { "text/html": [ "\n", "\n", "\n", "\t\n", "\t\n", "\t\n", "\t\n", "\n", "
epicurvegenerationsAICKloglkmean_h1par1_h1par2_h1rmse_crmse_ivar_h1
Apr01 2 80.49188 25.83603 -37.245944.044729 2.147092 4.567165 1.323245 1.047905 3.934810
Apr09 2 206.98325 35.32430 -100.491623.912038 2.087287 4.416724 1.378465 1.065747 3.872445
Apr17 2 553.24995 63.01257 -273.624983.924118 2.454589 4.424604 2.718949 2.807909 2.913656
Apr25 2 972.28686 80.00003 -483.143433.955826 2.474559 4.459543 3.146875 3.307684 2.918283
\n" ], "text/latex": [ "\\begin{tabular}{r|lllllllllll}\n", " epicurve & generations & AIC & K & loglk & mean\\_h1 & par1\\_h1 & par2\\_h1 & rmse\\_c & rmse\\_i & var\\_h1\\\\\n", "\\hline\n", "\t Apr01 & 2 & 80.49188 & 25.83603 & -37.24594 & 4.044729 & 2.147092 & 4.567165 & 1.323245 & 1.047905 & 3.934810 \\\\\n", "\t Apr09 & 2 & 206.98325 & 35.32430 & -100.49162 & 3.912038 & 2.087287 & 4.416724 & 1.378465 & 1.065747 & 3.872445 \\\\\n", "\t Apr17 & 2 & 553.24995 & 63.01257 & -273.62498 & 3.924118 & 2.454589 & 4.424604 & 2.718949 & 2.807909 & 2.913656 \\\\\n", "\t Apr25 & 2 & 972.28686 & 80.00003 & -483.14343 & 3.955826 & 2.474559 & 4.459543 & 3.146875 & 3.307684 & 2.918283 \\\\\n", "\\end{tabular}\n" ], "text/markdown": [ "\n", "epicurve | generations | AIC | K | loglk | mean_h1 | par1_h1 | par2_h1 | rmse_c | rmse_i | var_h1 | \n", "|---|---|---|---|\n", "| Apr01 | 2 | 80.49188 | 25.83603 | -37.24594 | 4.044729 | 2.147092 | 4.567165 | 1.323245 | 1.047905 | 3.934810 | \n", "| Apr09 | 2 | 206.98325 | 35.32430 | -100.49162 | 3.912038 | 2.087287 | 4.416724 | 1.378465 | 1.065747 | 3.872445 | \n", "| Apr17 | 2 | 553.24995 | 63.01257 | -273.62498 | 3.924118 | 2.454589 | 4.424604 | 2.718949 | 2.807909 | 2.913656 | \n", "| Apr25 | 2 | 972.28686 | 80.00003 | -483.14343 | 3.955826 | 2.474559 | 4.459543 | 3.146875 | 3.307684 | 2.918283 | \n", "\n", "\n" ], "text/plain": [ " epicurve generations AIC K loglk mean_h1 par1_h1 par2_h1 \n", "1 Apr01 2 80.49188 25.83603 -37.24594 4.044729 2.147092 4.567165\n", "2 Apr09 2 206.98325 35.32430 -100.49162 3.912038 2.087287 4.416724\n", "3 Apr17 2 553.24995 63.01257 -273.62498 3.924118 2.454589 4.424604\n", "4 Apr25 2 972.28686 80.00003 -483.14343 3.955826 2.474559 4.459543\n", " rmse_c rmse_i var_h1 \n", "1 1.323245 1.047905 3.934810\n", "2 1.378465 1.065747 3.872445\n", "3 2.718949 2.807909 2.913656\n", "4 3.146875 3.307684 2.918283" ] }, "metadata": {}, "output_type": "display_data" } ], "source": [ "final_pars %>% spread(parameter,estimate)" ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "## Three and more generations" ] }, { "cell_type": "code", "execution_count": 55, "metadata": { "scrolled": false }, "outputs": [ { "name": "stderr", "output_type": "stream", "text": [ "Number of generations 3\n", "Apr01\n", "Apr09\n", "Apr17\n", "Apr25\n", "May03\n", "May11\n", "May17\n", "May25\n", "Number of generations 4\n", "Apr09\n", "Apr17\n", "Apr25\n", "May03\n", "May11\n", "May17\n", "May25\n", "Number of generations 5\n", "Apr09\n", "Apr17\n", "Apr25\n", "May03\n", "May11\n", "May17\n", "May25\n", "Number of generations 6\n", "Apr09\n", "Apr17\n", "Apr25\n", "May03\n", "May11\n", "May17\n", "May25\n", "Done\n" ] } ], "source": [ "if (recalc) {\n", " for (J in 1:4) {\n", " pars = c(rep(1.,J),2,5)\n", "\n", " message(\"Number of generations \",J+2)\n", "\n", " # initial parameter values used in optim function\n", " options(warn=-1)\n", " for (current_epicurve in unique(df$epicurve)[ifelse(J==1,1,2):length(unique(df$epicurve))]) { \n", " message(current_epicurve)\n", "\n", " df %>% \n", " filter(epicurve==current_epicurve) %>% \n", " select(-epicurve) -> df_current\n", "\n", " Df = data.frame(day=0:(unclass(as.Date('2018'%&%current_epicurve,\"%Y%b%d\"))-unclass(dayZero)))\n", "\n", " df_current %>% \n", " filter(day_onset>0) %>% #removing index case\n", " group_by(day_onset) %>%\n", " count %>%\n", " rename(day=day_onset) %>%\n", " right_join(Df,by=\"day\") %>%\n", " mutate(n=ifelse(is.na(n),0,n)) %>%\n", " rename(i=n) -> Df\n", "\n", " df_current %>%\n", " filter(day_onset>0) %>% #removing index case\n", " group_by(day_confirmation) %>%\n", " count %>%\n", " rename(day=day_confirmation) %>%\n", " right_join(Df,by=\"day\") %>%\n", " mutate(n=ifelse(is.na(n),0,n)) %>%\n", " rename(c=n) %>%\n", " select(day,i,c) %>%\n", " arrange(day) -> Df\n", "\n", " Df %>% mutate(date=day+dayZero) %>%\n", " select(date,day) %>% rename(onset=date) %>% right_join(df_current,by=\"onset\") -> df_current\n", "\n", " solMLE = optim(pars,\n", " function(x) calculate_generations(length(pars),x,FALSE),\n", " method=\"L-BFGS-B\",\n", " control=list(fnscale=-1),lower=rep(0,length(pars))) \n", "\n", " # Weibull distribution mean and variance\n", " parsH = solMLE$par[(length(pars)-1):length(pars)]\n", " pars_h = c(parsH[2]*gamma(1+1/parsH[1]),parsH[2]^2*(gamma(1+2/parsH[1])-(gamma(1+1/parsH[1]))^2))\n", "\n", " # Maximum likelihood estimates (MLE)\n", " calculate_generations(length(pars),solMLE$par,prediction=TRUE) %>% \n", " rename(`MLE_i`=`lambda_i`,`MLE_c`=`lambda_c`) -> dfMLE\n", "\n", " # RMSE\n", " calculate_generations(length(pars),solMLE$par,prediction=TRUE) %>%\n", " na.omit %>%\n", " mutate(epsilon_i = (lambda_i-i), epsilon_c = (lambda_c-c)) %>%\n", " summarize(rmse_i = sqrt(sum(epsilon_i^2)/n()),rmse_c = sqrt(sum(epsilon_c^2)/n())) %>% as.numeric -> rmse\n", "\n", " npars = length(pars)\n", " output = data.frame(t(c(pars_h,solMLE$par[(length(pars)-1):length(pars)],\n", " Klast,solMLE$value,2*(npars+1-solMLE$value),rmse))) #npars+2, additional two is due to tau and K\n", " colnames(output) = c(\"mean_h1\",\"var_h1\",\"par1_h1\",\"par2_h1\",\n", " \"K\",\"loglk\",\"AIC\",\"rmse_i\",\"rmse_c\")\n", "\n", " final_pars %<>% rbind(output %>% gather(parameter,estimate) %>% \n", " mutate(epicurve=current_epicurve,generations=length(pars)))\n", " }\n", "\n", "# final_pars %>%\n", "# write.table(file=final_pars_output, sep=\",\", col.names=T, append = T, quote = F, row.names = F)\n", " }\n", "}\n", "\n", "message(\"Done\")" ] }, { "cell_type": "code", "execution_count": 56, "metadata": {}, "outputs": [ { "data": { "text/html": [ "\n", "\n", "\n", "\t\n", "\t\n", "\t\n", "\t\n", "\t\n", "\t\n", "\t\n", "\t\n", "\n", "
epicurvegenerationsswitchesAICloglkKmean_h1par1_h1par2_h1rmse_crmse_ivar_h1
Apr01 2 0 80.49188 -37.24594 25.83603 4.044729 2.147092 4.567165 1.323245 1.047905 3.934810
Apr09 3 0 204.12866 -98.06433 68.10538 4.061816 2.198336 4.586395 1.739619 1.472954 3.803674
Apr17 3 0 344.41905 -168.20953 75.92714 4.068596 2.497009 4.585688 1.641221 1.396995 3.037520
Apr25 4 0 448.09032 -219.04516 97.71981 4.038389 2.510051 4.551056 1.686684 1.430253 2.964801
May03 5 0 598.70950 -293.35475142.08896 4.293683 2.176907 4.848302 1.909321 1.587827 4.325689
May11 5 0 703.15713 -345.57857125.57604 4.480782 1.959805 5.053882 1.786760 1.375710 5.690231
May17 5 0 740.86426 -364.43213124.34020 4.500895 1.889103 5.071254 1.703754 1.266656 6.134795
May25 5 0 749.90946 -368.95473123.21179 4.509955 1.896179 5.082092 1.608431 1.204498 6.118089
\n" ], "text/latex": [ "\\begin{tabular}{r|llllllllllll}\n", " epicurve & generations & switches & AIC & loglk & K & mean\\_h1 & par1\\_h1 & par2\\_h1 & rmse\\_c & rmse\\_i & var\\_h1\\\\\n", "\\hline\n", "\t Apr01 & 2 & 0 & 80.49188 & -37.24594 & 25.83603 & 4.044729 & 2.147092 & 4.567165 & 1.323245 & 1.047905 & 3.934810 \\\\\n", "\t Apr09 & 3 & 0 & 204.12866 & -98.06433 & 68.10538 & 4.061816 & 2.198336 & 4.586395 & 1.739619 & 1.472954 & 3.803674 \\\\\n", "\t Apr17 & 3 & 0 & 344.41905 & -168.20953 & 75.92714 & 4.068596 & 2.497009 & 4.585688 & 1.641221 & 1.396995 & 3.037520 \\\\\n", "\t Apr25 & 4 & 0 & 448.09032 & -219.04516 & 97.71981 & 4.038389 & 2.510051 & 4.551056 & 1.686684 & 1.430253 & 2.964801 \\\\\n", "\t May03 & 5 & 0 & 598.70950 & -293.35475 & 142.08896 & 4.293683 & 2.176907 & 4.848302 & 1.909321 & 1.587827 & 4.325689 \\\\\n", "\t May11 & 5 & 0 & 703.15713 & -345.57857 & 125.57604 & 4.480782 & 1.959805 & 5.053882 & 1.786760 & 1.375710 & 5.690231 \\\\\n", "\t May17 & 5 & 0 & 740.86426 & -364.43213 & 124.34020 & 4.500895 & 1.889103 & 5.071254 & 1.703754 & 1.266656 & 6.134795 \\\\\n", "\t May25 & 5 & 0 & 749.90946 & -368.95473 & 123.21179 & 4.509955 & 1.896179 & 5.082092 & 1.608431 & 1.204498 & 6.118089 \\\\\n", "\\end{tabular}\n" ], "text/markdown": [ "\n", "epicurve | generations | switches | AIC | loglk | K | mean_h1 | par1_h1 | par2_h1 | rmse_c | rmse_i | var_h1 | \n", "|---|---|---|---|---|---|---|---|\n", "| Apr01 | 2 | 0 | 80.49188 | -37.24594 | 25.83603 | 4.044729 | 2.147092 | 4.567165 | 1.323245 | 1.047905 | 3.934810 | \n", "| Apr09 | 3 | 0 | 204.12866 | -98.06433 | 68.10538 | 4.061816 | 2.198336 | 4.586395 | 1.739619 | 1.472954 | 3.803674 | \n", "| Apr17 | 3 | 0 | 344.41905 | -168.20953 | 75.92714 | 4.068596 | 2.497009 | 4.585688 | 1.641221 | 1.396995 | 3.037520 | \n", "| Apr25 | 4 | 0 | 448.09032 | -219.04516 | 97.71981 | 4.038389 | 2.510051 | 4.551056 | 1.686684 | 1.430253 | 2.964801 | \n", "| May03 | 5 | 0 | 598.70950 | -293.35475 | 142.08896 | 4.293683 | 2.176907 | 4.848302 | 1.909321 | 1.587827 | 4.325689 | \n", "| May11 | 5 | 0 | 703.15713 | -345.57857 | 125.57604 | 4.480782 | 1.959805 | 5.053882 | 1.786760 | 1.375710 | 5.690231 | \n", "| May17 | 5 | 0 | 740.86426 | -364.43213 | 124.34020 | 4.500895 | 1.889103 | 5.071254 | 1.703754 | 1.266656 | 6.134795 | \n", "| May25 | 5 | 0 | 749.90946 | -368.95473 | 123.21179 | 4.509955 | 1.896179 | 5.082092 | 1.608431 | 1.204498 | 6.118089 | \n", "\n", "\n" ], "text/plain": [ " epicurve generations switches AIC loglk K mean_h1 \n", "1 Apr01 2 0 80.49188 -37.24594 25.83603 4.044729\n", "2 Apr09 3 0 204.12866 -98.06433 68.10538 4.061816\n", "3 Apr17 3 0 344.41905 -168.20953 75.92714 4.068596\n", "4 Apr25 4 0 448.09032 -219.04516 97.71981 4.038389\n", "5 May03 5 0 598.70950 -293.35475 142.08896 4.293683\n", "6 May11 5 0 703.15713 -345.57857 125.57604 4.480782\n", "7 May17 5 0 740.86426 -364.43213 124.34020 4.500895\n", "8 May25 5 0 749.90946 -368.95473 123.21179 4.509955\n", " par1_h1 par2_h1 rmse_c rmse_i var_h1 \n", "1 2.147092 4.567165 1.323245 1.047905 3.934810\n", "2 2.198336 4.586395 1.739619 1.472954 3.803674\n", "3 2.497009 4.585688 1.641221 1.396995 3.037520\n", "4 2.510051 4.551056 1.686684 1.430253 2.964801\n", "5 2.176907 4.848302 1.909321 1.587827 4.325689\n", "6 1.959805 5.053882 1.786760 1.375710 5.690231\n", "7 1.889103 5.071254 1.703754 1.266656 6.134795\n", "8 1.896179 5.082092 1.608431 1.204498 6.118089" ] }, "metadata": {}, "output_type": "display_data" } ], "source": [ "final_pars %>% spread(parameter,estimate) %>% mutate(switches=0,AIC=as.numeric(AIC)) %>% \n", " group_by(epicurve) %>%\n", " filter(AIC==min(AIC)) %>%\n", " select(epicurve,generations,switches,AIC,loglk,everything()) -> final_pars_0\n", "\n", "final_pars_0" ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "# With a switch in delay function" ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "## As an example, we analyse first only one particular epicurve" ] }, { "cell_type": "code", "execution_count": 106, "metadata": {}, "outputs": [ { "data": { "text/html": [ "'Apr09'" ], "text/latex": [ "'Apr09'" ], "text/markdown": [ "'Apr09'" ], "text/plain": [ "[1] \"Apr09\"" ] }, "metadata": {}, "output_type": "display_data" } ], "source": [ "(current_epicurve = all_epicurves %>% .[2])#rev %>%" ] }, { "cell_type": "code", "execution_count": 107, "metadata": {}, "outputs": [ { "data": { "text/html": [ "\n", "\n", "\n", "\t\n", "\t\n", "\t\n", "\t\n", "\t\n", "\t\n", "\n", "
dayic
183 3
190 5
201 5
210 2
220 1
230 1
\n" ], "text/latex": [ "\\begin{tabular}{r|lll}\n", " day & i & c\\\\\n", "\\hline\n", "\t 18 & 3 & 3 \\\\\n", "\t 19 & 0 & 5 \\\\\n", "\t 20 & 1 & 5 \\\\\n", "\t 21 & 0 & 2 \\\\\n", "\t 22 & 0 & 1 \\\\\n", "\t 23 & 0 & 1 \\\\\n", "\\end{tabular}\n" ], "text/markdown": [ "\n", "day | i | c | \n", "|---|---|---|---|---|---|\n", "| 18 | 3 | 3 | \n", "| 19 | 0 | 5 | \n", "| 20 | 1 | 5 | \n", "| 21 | 0 | 2 | \n", "| 22 | 0 | 1 | \n", "| 23 | 0 | 1 | \n", "\n", "\n" ], "text/plain": [ " day i c\n", "1 18 3 3\n", "2 19 0 5\n", "3 20 1 5\n", "4 21 0 2\n", "5 22 0 1\n", "6 23 0 1" ] }, "metadata": {}, "output_type": "display_data" } ], "source": [ "df %>% \n", " filter(epicurve==current_epicurve) %>% \n", " select(-epicurve) -> df_current\n", "\n", "Df = data.frame(day=0:(unclass(as.Date('2018'%&%current_epicurve,\"%Y%b%d\"))-unclass(as.Date('2018-03-17'))))\n", "\n", "df_current %>% \n", " filter(day_onset>0) %>% #removing index case from fitting\n", " group_by(day_onset) %>%\n", " count %>%\n", " rename(day=day_onset) %>%\n", " right_join(Df,by=\"day\") %>%\n", " mutate(n=ifelse(is.na(n),0,n)) %>%\n", " rename(i=n) -> Df\n", "\n", "df_current %>%\n", " filter(day_onset>0) %>% #removing index case from fitting\n", " group_by(day_confirmation) %>%\n", " count %>%\n", " rename(day=day_confirmation) %>%\n", " right_join(Df,by=\"day\") %>%\n", " mutate(n=ifelse(is.na(n),0,n)) %>%\n", " rename(c=n) %>%\n", " select(day,i,c) %>%\n", " arrange(day) -> Df\n", "\n", "# Df %<>% mutate(date=day+as.Date('2018-03-17'))\n", "\n", "Df %>% tail" ] }, { "cell_type": "code", "execution_count": 108, "metadata": {}, "outputs": [ { "name": "stderr", "output_type": "stream", "text": [ "Joining, by = \"onset\"\n" ] }, { "data": { "text/html": [ "\n", "\n", "\n", "\t\n", "\t\n", "\t\n", "\t\n", "\t\n", "\t\n", "\n", "
onsetdayconfirmeddifferenceday_onsetday_confirmation
2018-03-17 0 2018-03-206 0 3
2018-03-2710 2018-03-292 10 12
2018-03-2710 2018-03-292 10 12
2018-03-25 8 2018-03-316 8 14
2018-03-25 8 2018-03-316 8 14
2018-03-26 9 2018-03-315 9 14
\n" ], "text/latex": [ "\\begin{tabular}{r|llllll}\n", " onset & day & confirmed & difference & day\\_onset & day\\_confirmation\\\\\n", "\\hline\n", "\t 2018-03-17 & 0 & 2018-03-20 & 6 & 0 & 3 \\\\\n", "\t 2018-03-27 & 10 & 2018-03-29 & 2 & 10 & 12 \\\\\n", "\t 2018-03-27 & 10 & 2018-03-29 & 2 & 10 & 12 \\\\\n", "\t 2018-03-25 & 8 & 2018-03-31 & 6 & 8 & 14 \\\\\n", "\t 2018-03-25 & 8 & 2018-03-31 & 6 & 8 & 14 \\\\\n", "\t 2018-03-26 & 9 & 2018-03-31 & 5 & 9 & 14 \\\\\n", "\\end{tabular}\n" ], "text/markdown": [ "\n", "onset | day | confirmed | difference | day_onset | day_confirmation | \n", "|---|---|---|---|---|---|\n", "| 2018-03-17 | 0 | 2018-03-20 | 6 | 0 | 3 | \n", "| 2018-03-27 | 10 | 2018-03-29 | 2 | 10 | 12 | \n", "| 2018-03-27 | 10 | 2018-03-29 | 2 | 10 | 12 | \n", "| 2018-03-25 | 8 | 2018-03-31 | 6 | 8 | 14 | \n", "| 2018-03-25 | 8 | 2018-03-31 | 6 | 8 | 14 | \n", "| 2018-03-26 | 9 | 2018-03-31 | 5 | 9 | 14 | \n", "\n", "\n" ], "text/plain": [ " onset day confirmed difference day_onset day_confirmation\n", "1 2018-03-17 0 2018-03-20 6 0 3 \n", "2 2018-03-27 10 2018-03-29 2 10 12 \n", "3 2018-03-27 10 2018-03-29 2 10 12 \n", "4 2018-03-25 8 2018-03-31 6 8 14 \n", "5 2018-03-25 8 2018-03-31 6 8 14 \n", "6 2018-03-26 9 2018-03-31 5 9 14 " ] }, "metadata": {}, "output_type": "display_data" } ], "source": [ "Df %>% mutate(date=day+as.Date('2018-03-17')) %>%\n", " select(date,day) %>% rename(onset=date) %>% right_join(df_current) -> df_current\n", "\n", "df_current %>% head" ] }, { "cell_type": "code", "execution_count": 109, "metadata": {}, "outputs": [], "source": [ "# if the parameter \"prediction\" is FALSE, the result of the function is log-likelihood,\n", "# otherwise it give the resulting data.frame with all entities\n", "calculate_six_generations = function(prms,tau,prediction=FALSE) {\n", " K = prms[1]; R2 = prms[2]; R3 = prms[3]; R4 = prms[4]; R5 = prms[5]\n", " \n", " maxday = max(Df$day)\n", " \n", " data.frame(day = 0:maxday) %>%\n", " mutate(gt=g(day)) -> df_\n", "\n", " #calculating first convolution\n", " conv = c()\n", " for (x in 1:nrow(df_)) {\n", " conv = c(conv,sum(df_$gt[1:x]*df_$gt[x:1])) }\n", " df_ %<>% do(cbind(.,conv1_gt=conv))\n", " \n", " #calculating second convolution\n", " conv = c()\n", " for (x in 1:nrow(df_)) {\n", " conv = c(conv,sum(df_$conv1_gt[1:x]*df_$gt[x:1])) }\n", " df_ %<>% do(cbind(.,conv2_gt=conv))\n", " \n", " #calculating third convolution\n", " conv = c()\n", " for (x in 1:nrow(df_)) {\n", " conv = c(conv,sum(df_$conv2_gt[1:x]*df_$gt[x:1])) }\n", " df_ %<>% do(cbind(.,conv3_gt=conv))\n", " \n", " #calculating fourth convolution\n", " conv = c()\n", " for (x in 1:nrow(df_)) {\n", " conv = c(conv,sum(df_$conv3_gt[1:x]*df_$gt[x:1])) }\n", " df_ %<>% do(cbind(.,conv4_gt=conv))\n", "\n", "\n", " df_ %<>% \n", " mutate(ft = (gt+R2*conv1_gt+R2*R3*conv2_gt+R2*R3*R4*conv3_gt+R2*R3*R4*R5*conv3_gt)/(1+R2+R2*R3+R2*R3*R4+R2*R3*R4*R5)) \n", " \n", " if (prediction) {\n", " df_ %<>% \n", " mutate(hNum = ifelse(day% do(cbind(.,conv_ht=conv)) \n", "\n", " df_ %>% \n", " left_join(Df,by=\"day\") %>%\n", " mutate(lambda_i = K*ft, lambda_c = K*conv_ht) %>%\n", " left_join(select(Df,-i,-c),by=\"day\") %>% return\n", " \n", " } else {\n", " df_ %<>% right_join(Df,by=\"day\") \n", " \n", " df_ %>%\n", " mutate(hNum = ifelse(day%\n", " filter(ft>0 & day%\n", " rowwise %>%\n", " mutate(lambda = H(maxday-day,prms[6:7+2*hNum])*K*ft) %>%\n", " ungroup %>%\n", " summarize(loglk = sum(i*log(lambda)-lambda-lfactorial(i))) %>% \n", " .$loglk -> loglk_onset\n", " \n", " df_current %>% \n", " mutate(hNum = ifelse(day%\n", " group_by(hNum,difference) %>%\n", " count %>% \n", " ungroup %>%\n", " rowwise %>%\n", " mutate(loglk = n*log(h(difference,prms[6:7+2*hNum]))) %>% \n", " ungroup %>%\n", " summarize(loglk = sum(loglk)) %>%\n", " .$loglk -> loglk_delay\n", " \n", " return(loglk_delay+loglk_onset)\n", " }\n", "}\n", "\n", "calculate_five_generations = function(x,tau,prediction=FALSE) { calculate_six_generations(c(x[1:4],0,x[5:length(x)]),tau,prediction) }\n", "calculate_four_generations = function(x,tau,prediction=FALSE) { calculate_six_generations(c(x[1:3],0,0,x[4:length(x)]),tau,prediction) }\n", "calculate_three_generations = function(x,tau,prediction=FALSE) { calculate_six_generations(c(x[1:2],0,0,0,x[3:length(x)]),tau,prediction) }\n", "calculate_two_generations = function(x,tau,prediction=FALSE) { calculate_six_generations(c(x[1],0,0,0,0,x[2:length(x)]),tau,prediction) }" ] }, { "cell_type": "code", "execution_count": 110, "metadata": {}, "outputs": [ { "data": { "text/html": [ "-99.7947484165783" ], "text/latex": [ "-99.7947484165783" ], "text/markdown": [ "-99.7947484165783" ], "text/plain": [ "[1] -99.79475" ] }, "metadata": {}, "output_type": "display_data" } ], "source": [ "# test\n", "pars = c(118.10832,1.25,1,2,4,1,4)\n", "tau0 = 30\n", "calculate_four_generations(pars,tau=tau0)" ] }, { "cell_type": "code", "execution_count": 111, "metadata": {}, "outputs": [], "source": [ "# if the parameter \"prediction\" is FALSE, the result of the function is log-likelihood,\n", "# otherwise it give the resulting data.frame with all entities\n", "calculate_six_generations = function(prms,tau,prediction=FALSE) {\n", " R2 = prms[1]; R3 = prms[2]; R4 = prms[3]; R5 = prms[4]\n", " \n", " maxday = ifelse(prediction,maxDay,max(Df$day))\n", "\n", " gt = g(0:maxday)\n", " hNum = ifelse(0:maxday%\n", " left_join(Df,by=\"day\") %>% return\n", " \n", " } else {\n", " K = sum(Df$i[-maxday])/sum(mapply(function(x,y) H(x,prms[5:6+2*y]),maxday:0,hNum)*ft)\n", " Klast <<- K\n", " lambda = (mapply(function(x,y) H(x,prms[5:6+2*y]),maxday:0,hNum)*ft*K)[-c(1,maxday+1)] \n", " #the first and the last elements are zeros -> so we remove them due to non-zeros loglk\n", " \n", " loglk_onset = sum(Df$i[-c(1,maxday+1)]*log(lambda)-lambda-lfactorial(Df$i[-c(1,maxday+1)]))\n", " \n", " dt = table(df_current[df_current$day% { apply(as.matrix.noquote(data.frame(.)),2,as.numeric) }\n", " loglk_delay = sum(dt[,2]*log(h(dt[,1],prms[5:6]))) \n", " dt = table(df_current[df_current$day>=tau,]$difference) %>% { apply(as.matrix.noquote(data.frame(.)),2,as.numeric) }\n", " loglk_delay = loglk_delay + sum(dt[,2]*log(h(dt[,1],prms[7:8])))\n", " \n", " return(loglk_delay+loglk_onset)\n", " }\n", "}\n", "\n", "calculate_five_generations = function(x,tau,prediction=FALSE) { calculate_six_generations(c(x[1:3],0,x[4:length(x)]),tau,prediction) }\n", "calculate_four_generations = function(x,tau,prediction=FALSE) { calculate_six_generations(c(x[1:2],0,0,x[3:length(x)]),tau,prediction) }\n", "calculate_three_generations = function(x,tau,prediction=FALSE) { calculate_six_generations(c(x[1],0,0,0,x[2:length(x)]),tau,prediction) }\n", "calculate_two_generations = function(x,tau,prediction=FALSE) { calculate_six_generations(c(0,0,0,0,x),tau,prediction) }\n", " \n", "calculate_generations = function(ngenerations,x,tau,prediction=FALSE) {\n", " switch(ngenerations,\n", " NULL,\n", " calculate_two_generations(x,tau,prediction),\n", " calculate_three_generations(x,tau,prediction),\n", " calculate_four_generations(x,tau,prediction),\n", " calculate_five_generations(x,tau,prediction),\n", " calculate_six_generations(x,tau,prediction)\n", " )\n", "}" ] }, { "cell_type": "code", "execution_count": 118, "metadata": {}, "outputs": [ { "data": { "text/html": [ "-138.767263846683" ], "text/latex": [ "-138.767263846683" ], "text/markdown": [ "-138.767263846683" ], "text/plain": [ "[1] -138.7673" ] }, "metadata": {}, "output_type": "display_data" }, { "data": { "text/html": [ "35.0360109272234" ], "text/latex": [ "35.0360109272234" ], "text/markdown": [ "35.0360109272234" ], "text/plain": [ "[1] 35.03601" ] }, "metadata": {}, "output_type": "display_data" } ], "source": [ "# test\n", "pars = c(1.25,1,2,4)\n", "tau0 = 10\n", "calculate_generations(length(pars)-2,pars,tau=tau0,F)\n", "Klast " ] }, { "cell_type": "code", "execution_count": 119, "metadata": { "scrolled": false }, "outputs": [ { "name": "stdout", "output_type": "stream", "text": [ "[1] 35.15829\n" ] }, { "data": { "text/html": [ "
\n", "\t
$par
\n", "\t\t
    \n", "\t
  1. 14.2652034957704
  2. \n", "\t
  3. 5.72318819578778
  4. \n", "\t
  5. 1.81141722252888
  6. \n", "\t
  7. 3.98788513991266
  8. \n", "
\n", "
\n", "\t
$value
\n", "\t\t
-90.6018650014102
\n", "\t
$counts
\n", "\t\t
\n", "\t
function
\n", "\t\t
27
\n", "\t
gradient
\n", "\t\t
27
\n", "
\n", "
\n", "\t
$convergence
\n", "\t\t
0
\n", "\t
$message
\n", "\t\t
'CONVERGENCE: REL_REDUCTION_OF_F <= FACTR*EPSMCH'
\n", "\t
$hessian
\n", "\t\t
\n", "\n", "\t\n", "\t\n", "\t\n", "\t\n", "\n", "
-0.03453957 2.775074e-01 0.000000e+00 0.000000
0.27750741 -2.996994e+01-3.552714e-09 0.000000
0.00000000 -3.552714e-09-1.411752e+01 3.532815
0.00000000 0.000000e+00 3.532815e+00-6.438431
\n", "
\n", "
\n" ], "text/latex": [ "\\begin{description}\n", "\\item[\\$par] \\begin{enumerate*}\n", "\\item 14.2652034957704\n", "\\item 5.72318819578778\n", "\\item 1.81141722252888\n", "\\item 3.98788513991266\n", "\\end{enumerate*}\n", "\n", "\\item[\\$value] -90.6018650014102\n", "\\item[\\$counts] \\begin{description*}\n", "\\item[function] 27\n", "\\item[gradient] 27\n", "\\end{description*}\n", "\n", "\\item[\\$convergence] 0\n", "\\item[\\$message] 'CONVERGENCE: REL\\_REDUCTION\\_OF\\_F <= FACTR*EPSMCH'\n", "\\item[\\$hessian] \\begin{tabular}{llll}\n", "\t -0.03453957 & 2.775074e-01 & 0.000000e+00 & 0.000000 \\\\\n", "\t 0.27750741 & -2.996994e+01 & -3.552714e-09 & 0.000000 \\\\\n", "\t 0.00000000 & -3.552714e-09 & -1.411752e+01 & 3.532815 \\\\\n", "\t 0.00000000 & 0.000000e+00 & 3.532815e+00 & -6.438431 \\\\\n", "\\end{tabular}\n", "\n", "\\end{description}\n" ], "text/markdown": [ "$par\n", ": 1. 14.2652034957704\n", "2. 5.72318819578778\n", "3. 1.81141722252888\n", "4. 3.98788513991266\n", "\n", "\n", "\n", "$value\n", ": -90.6018650014102\n", "$counts\n", ": function\n", ": 27gradient\n", ": 27\n", "\n", "\n", "$convergence\n", ": 0\n", "$message\n", ": 'CONVERGENCE: REL_REDUCTION_OF_F <= FACTR*EPSMCH'\n", "$hessian\n", ": \n", "| -0.03453957 | 2.775074e-01 | 0.000000e+00 | 0.000000 | \n", "| 0.27750741 | -2.996994e+01 | -3.552714e-09 | 0.000000 | \n", "| 0.00000000 | -3.552714e-09 | -1.411752e+01 | 3.532815 | \n", "| 0.00000000 | 0.000000e+00 | 3.532815e+00 | -6.438431 | \n", "\n", "\n", "\n", "\n", "\n" ], "text/plain": [ "$par\n", "[1] 14.265203 5.723188 1.811417 3.987885\n", "\n", "$value\n", "[1] -90.60187\n", "\n", "$counts\n", "function gradient \n", " 27 27 \n", "\n", "$convergence\n", "[1] 0\n", "\n", "$message\n", "[1] \"CONVERGENCE: REL_REDUCTION_OF_F <= FACTR*EPSMCH\"\n", "\n", "$hessian\n", " [,1] [,2] [,3] [,4]\n", "[1,] -0.03453957 2.775074e-01 0.000000e+00 0.000000\n", "[2,] 0.27750741 -2.996994e+01 -3.552714e-09 0.000000\n", "[3,] 0.00000000 -3.552714e-09 -1.411752e+01 3.532815\n", "[4,] 0.00000000 0.000000e+00 3.532815e+00 -6.438431\n" ] }, "metadata": {}, "output_type": "display_data" } ], "source": [ "options(warn=-1)\n", "sol = optim(pars,function(x) calculate_generations(length(pars)-2,x,tau0,FALSE),\n", " method=\"L-BFGS-B\",control=list(fnscale=-1),lower=rep(0,length(pars)),\n", " hessian=TRUE)\n", "options(warn=0)\n", "pars = sol$par \n", "\n", "print(Klast)\n", "sol" ] }, { "cell_type": "code", "execution_count": 120, "metadata": {}, "outputs": [ { "name": "stdout", "output_type": "stream", "text": [ "[1] 5.5177639 0.2242096\n", "[1] 3.545310 4.106577\n" ] } ], "source": [ "# Obtained Weibull distribution mean and variance\n", "for (j in c(1,0)) {\n", " parsH = pars[(length(pars)-1):length(pars)-2*j]\n", " c(parsH[2]*gamma(1+1/parsH[1]),parsH[2]^2*(gamma(1+2/parsH[1])-(gamma(1+1/parsH[1]))^2)) %>% print\n", "}" ] }, { "cell_type": "code", "execution_count": 122, "metadata": {}, "outputs": [ { "data": { "text/html": [ "\n", "\n", "\n", "\t\n", "\t\n", "\t\n", "\t\n", "\t\n", "\t\n", "\t\n", "\t\n", "\t\n", "\t\n", "\t\n", "\t\n", "\t\n", "\t\n", "\t\n", "\t\n", "\t\n", "\t\n", "\t\n", "\t\n", "\n", "
daylambda_ilambda_cic
0 0.000000e+000.000000e+000 0
1 2.338793e-100.000000e+000 0
2 2.642188e-063.640250e-210 0
3 3.757145e-041.127990e-160 0
4 8.730200e-038.387958e-130 0
5 7.386053e-023.790673e-100 0
6 3.278238e-015.565394e-080 0
7 9.317029e-013.454924e-060 0
8 1.912672e+001.096431e-043 0
9 3.066350e+001.872416e-033 0
10 4.049056e+001.796733e-024 0
11 4.573939e+001.028387e-014 0
12 4.544981e+003.799385e-011 2
13 4.057204e+009.867195e-015 0
14 3.307145e+001.936984e+003 5
15 2.493431e+003.040403e+002 4
16 1.756884e+003.981750e+004 0
17 1.166656e+004.493195e+001 6
18 7.352085e-014.478377e+003 3
19 4.422439e-014.019213e+000 5
\n" ], "text/latex": [ "\\begin{tabular}{r|lllll}\n", " day & lambda\\_i & lambda\\_c & i & c\\\\\n", "\\hline\n", "\t 0 & 0.000000e+00 & 0.000000e+00 & 0 & 0 \\\\\n", "\t 1 & 2.338793e-10 & 0.000000e+00 & 0 & 0 \\\\\n", "\t 2 & 2.642188e-06 & 3.640250e-21 & 0 & 0 \\\\\n", "\t 3 & 3.757145e-04 & 1.127990e-16 & 0 & 0 \\\\\n", "\t 4 & 8.730200e-03 & 8.387958e-13 & 0 & 0 \\\\\n", "\t 5 & 7.386053e-02 & 3.790673e-10 & 0 & 0 \\\\\n", "\t 6 & 3.278238e-01 & 5.565394e-08 & 0 & 0 \\\\\n", "\t 7 & 9.317029e-01 & 3.454924e-06 & 0 & 0 \\\\\n", "\t 8 & 1.912672e+00 & 1.096431e-04 & 3 & 0 \\\\\n", "\t 9 & 3.066350e+00 & 1.872416e-03 & 3 & 0 \\\\\n", "\t 10 & 4.049056e+00 & 1.796733e-02 & 4 & 0 \\\\\n", "\t 11 & 4.573939e+00 & 1.028387e-01 & 4 & 0 \\\\\n", "\t 12 & 4.544981e+00 & 3.799385e-01 & 1 & 2 \\\\\n", "\t 13 & 4.057204e+00 & 9.867195e-01 & 5 & 0 \\\\\n", "\t 14 & 3.307145e+00 & 1.936984e+00 & 3 & 5 \\\\\n", "\t 15 & 2.493431e+00 & 3.040403e+00 & 2 & 4 \\\\\n", "\t 16 & 1.756884e+00 & 3.981750e+00 & 4 & 0 \\\\\n", "\t 17 & 1.166656e+00 & 4.493195e+00 & 1 & 6 \\\\\n", "\t 18 & 7.352085e-01 & 4.478377e+00 & 3 & 3 \\\\\n", "\t 19 & 4.422439e-01 & 4.019213e+00 & 0 & 5 \\\\\n", "\\end{tabular}\n" ], "text/markdown": [ "\n", "day | lambda_i | lambda_c | i | c | \n", "|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|\n", "| 0 | 0.000000e+00 | 0.000000e+00 | 0 | 0 | \n", "| 1 | 2.338793e-10 | 0.000000e+00 | 0 | 0 | \n", "| 2 | 2.642188e-06 | 3.640250e-21 | 0 | 0 | \n", "| 3 | 3.757145e-04 | 1.127990e-16 | 0 | 0 | \n", "| 4 | 8.730200e-03 | 8.387958e-13 | 0 | 0 | \n", "| 5 | 7.386053e-02 | 3.790673e-10 | 0 | 0 | \n", "| 6 | 3.278238e-01 | 5.565394e-08 | 0 | 0 | \n", "| 7 | 9.317029e-01 | 3.454924e-06 | 0 | 0 | \n", "| 8 | 1.912672e+00 | 1.096431e-04 | 3 | 0 | \n", "| 9 | 3.066350e+00 | 1.872416e-03 | 3 | 0 | \n", "| 10 | 4.049056e+00 | 1.796733e-02 | 4 | 0 | \n", "| 11 | 4.573939e+00 | 1.028387e-01 | 4 | 0 | \n", "| 12 | 4.544981e+00 | 3.799385e-01 | 1 | 2 | \n", "| 13 | 4.057204e+00 | 9.867195e-01 | 5 | 0 | \n", "| 14 | 3.307145e+00 | 1.936984e+00 | 3 | 5 | \n", "| 15 | 2.493431e+00 | 3.040403e+00 | 2 | 4 | \n", "| 16 | 1.756884e+00 | 3.981750e+00 | 4 | 0 | \n", "| 17 | 1.166656e+00 | 4.493195e+00 | 1 | 6 | \n", "| 18 | 7.352085e-01 | 4.478377e+00 | 3 | 3 | \n", "| 19 | 4.422439e-01 | 4.019213e+00 | 0 | 5 | \n", "\n", "\n" ], "text/plain": [ " day lambda_i lambda_c i c\n", "1 0 0.000000e+00 0.000000e+00 0 0\n", "2 1 2.338793e-10 0.000000e+00 0 0\n", "3 2 2.642188e-06 3.640250e-21 0 0\n", "4 3 3.757145e-04 1.127990e-16 0 0\n", "5 4 8.730200e-03 8.387958e-13 0 0\n", "6 5 7.386053e-02 3.790673e-10 0 0\n", "7 6 3.278238e-01 5.565394e-08 0 0\n", "8 7 9.317029e-01 3.454924e-06 0 0\n", "9 8 1.912672e+00 1.096431e-04 3 0\n", "10 9 3.066350e+00 1.872416e-03 3 0\n", "11 10 4.049056e+00 1.796733e-02 4 0\n", "12 11 4.573939e+00 1.028387e-01 4 0\n", "13 12 4.544981e+00 3.799385e-01 1 2\n", "14 13 4.057204e+00 9.867195e-01 5 0\n", "15 14 3.307145e+00 1.936984e+00 3 5\n", "16 15 2.493431e+00 3.040403e+00 2 4\n", "17 16 1.756884e+00 3.981750e+00 4 0\n", "18 17 1.166656e+00 4.493195e+00 1 6\n", "19 18 7.352085e-01 4.478377e+00 3 3\n", "20 19 4.422439e-01 4.019213e+00 0 5" ] }, "metadata": {}, "output_type": "display_data" } ], "source": [ "calculate_generations(length(pars)-2,pars,tau=tau0,prediction=TRUE) -> dfMLE \n", "dfMLE %>% head(20)" ] }, { "cell_type": "code", "execution_count": 123, "metadata": {}, "outputs": [ { "name": "stderr", "output_type": "stream", "text": [ "Warning message:\n", "\"Removed 60 rows containing missing values (geom_bar).\"Warning message:\n", "\"Removed 60 rows containing missing values (geom_bar).\"" ] }, { "data": { "image/png": "iVBORw0KGgoAAAANSUhEUgAABDgAAAOECAIAAADL3RZYAAAABmJLR0QA/wD/AP+gvaeTAAAg\nAElEQVR4nOzdX2wb2X3w/TOSKFm2VG/WeYrYQdc3ZOK6Qt4LBYExgy0WaAOD1K5i7IWMRQII\nKLBkW6EvGTTyixcVst1UBQoL6JIodEEuWlRFi8AqsHFliKyRBljEJR+nXSFPUnXriuzFpq3V\nzcbeeCXL/D/vxYnnHZMUxRmRnCH5/WCx4AxnOD8ekzz6nTPnHEXXdQEAAAAAbjLkdAAAAAAA\nUItEBQAAAIDrkKgAAAAAcB0SFQAAAACuQ6ICAAAAwHVIVAAAAAC4DokKAAAAANchUQEAAADg\nOiQqAAAAAFyHRAUAAACA65CoAAAAAHCdEacDeMbLL7/8P//zP05HAQCD6L333nM6hDajTgEA\np7SlTnFXoiKE+OVf/uUvfOELNk4slUrVanV4eHhkxHVvyrUKhYIQwuPxDA3Rt9aSarVaKpWE\nEGNjY07H0jPK5XKlUhkaGvJ4PE7H0jOKxaKu6yMjI8PDw1243I9//OOf/vSnXbhQ91GndBN1\nilXUKTZQp9jQu3WK635/f+3Xfu1P/uRPbJz46NGjUql04sSJiYmJtkfVl3Rdf/DggRBicnKS\nn8gWFQqFvb09IcSZM2cURXE6nN6wv7+fz+c9Hs/p06edjqVnPHz4sFqtnjp1anx8vAuXW1xc\n7NdEhTqla6hTbKBOsYE6xYberVNo8wAAAADgOiQqAAAAAFyHRAUAAACA65CoAAAAAHAdEhUA\nAAAArkOiAgAAAMB1SFQAAAAAuA6JCgAAAADXIVEBAAAA4DpdSlRu3bo1Ozs7Ozt77dq17lwR\nANDHdnd3ZbWyu7vrdCwAgI4Y6c5l7ty5s7Gx0Z1rAQD6261bt95+++14PH727FmnYwEAdEo3\nEpWtra2rV6924UIAgL63tbX19ttv0/gFAH2vG4nKjRs37t27J4SgXgEAHNONGzcuX748Ozsr\nhHjjjTemp6edjggA0BHdSFSuX78uhFhdXZ2dna3pqf/rv/7raDRqbJ45c6ZYLP7sZz+zfa18\nPp/P548T7QDa29vb29tzOooe8+DBA6dD6DGlUuk4X+3B9Pjx48ePH3fhQsVisQtXaYutra17\n9+5dvXp1YWHh1q1bb775prlaoU5xA+oUG6hTrKJOsaEX65QujVERQiwsLLzwwgvvvPPOwsJC\n1y7aWyZXvmU83lv8poORAIA73b9//8KFC7IX5ZVXXnn77bfv37/PSJVOMKok6iMATuleoiKE\neOWVV2pm/fr1X//1z3zmM8bmn/7pn46MjExOTtp48YODg0ql4vF4Tpw4cdxAXcBeIVii6/r+\n/r4Q4sSJEx6Pp9OX6w+lUkk2r05MTCiK4nQ4vSGfz5dKpeHh4ZMnTzodS8/Y39/XdX1sbGx0\ndLQLlxsZ6Wpd0EYXLly4f/++cfcXdUontFiA1Ck2UKfYQJ1iQ+/WKd2unM6fP2/efOGFF154\n4QVjMxqNDg0NjY2N2XjlfD5fqVSGh4ftne4GBdPjLrwLo1LxeDy9W2jdJyuVsbExKpUWlUql\nUqlk+6s9mB4/fqzr+sjISHcKbWioZ9bUOnfunBz0aN5jPKZOaSOjSmqxBKhT7KFOsYo6xYbe\nrVO6Wjmtrq6++uqr3bwiAKCfTE9PX7hwYXV1VQixtbUl9zgdFACgIzreo7K7uxsKheTjN954\ngzuJAQDHcf369dnZ2du3bwsmkwSAvtbxROXs2bNUJACANqJaAYBB0DP3JQMAAAAYHCQqAAAA\nAFyHRAUAAACA65CoAAAAAHAdEhUAAAAArkOiAgAAAMB1SFQAAAAAuA6JCgAAAADXIVEBAAAA\n4DokKgAAAABch0QFAAAAgOuQqAAAAABwHRIVAAAAAK5DogIAAADAdUhUAAAAALgOiQoAAAAA\n1yFRAQAAAOA6JCoAAAAAXIdEBQAAAIDrkKgAAAAAcB0SFQAAAACuQ6ICAAAAwHVIVAAAAAC4\nzojTAQwo5d20fKC/pDkbCQAAAOBC9KgAAAAAcB16VFxBdrDknQ4DAAAAcAl6VAAAAAC4DokK\nAAAAANdx161f1Wq1WCz+7Gc/s/0K+Xw+n++lW6gOe7PHKQSr9vb29vb2una5/vDgwQOnQ+gx\npVKpm5/q/vD48ePHjx934ULFYrELVwEAwBJ3JSpDQ0Mej+e5556zce7+/n65XB4dHT158mTb\nA+ucw96svUKwRNf1R48eCSFOnjw5Ojra6cv1h2KxeHBwIIQ4ffq0oihOh9MbDg4OisXiyMjI\nxMSE07H0jE8++aRarY6Pj4+NjXXhch6PpwtXAQDAEnclKkIIRVFGRuxEJf9qHBoasne6Uw6L\ntgvvQtd1+WB4eLi3Cs1BlUpFPhgZGSFRadHQ0JA4xld7kHXtB40PMwDAhRijAgAAAMB1SFQA\nAAAAuA6JCgAAAADXIVEBAAAA4DokKgAAAABch0l4AABOyuVy5s1sNhsIBIxpCQEAA4tEBQDg\njFQqFQgEnI4CAOBSJCoAAGcEAgFVVaempmr2JxIJR+IBALgKiQoAwDHpdLp+5/b2dvcjAQC4\nDYPpAQDOiEajNQNUpKWlpe4HAwBwG2uJSu4puRmLxTRNi8ViHQgMANDnwuHw5uZmzc5cLsfA\nFQCAsJqobG5u+ny+lZUVIUQsFotEIkKI9fX1UCjUkegAAP1LUZRIJKI8y+fzOR0XAMAVLI9R\nyWazXq83l8tFIhFVVeXtxYqixOPxDoQHAOhb0Wg0EokEg0Hzzu3t7Uwm41RIAAD3sJaoRCKR\ncDgshJCd9dxGDACwbWZmZn19vb6dS9M0R+IBALiKtVu/VFVNpVJGd4rf7xdCxGKxZDLZmfAA\nAH3L6/U2nPWr4U4AwKCxlqisra0tLy/7fD5VVdfW1oQQmqZFIpGbN292JjwAQJ9LpVKapmma\nFgqFGk4CBgAYTNZu/apv/aLdCwBgm6ZpxoiUTCaTSCSM0Y8AgAHHOioAAGeEQqFMJpNMJnWT\nqakpZr0HAAh7K9PXdM1ns9lAIKDreptCAgAMhEQikUwm5XBHQzwe1zRNTtwCABhk1hIVY+0U\nAACOryZLkdo7PfEx29FohmuxBIzDZM9YJyPqH+ZCczaSXkShWdWL303L0xOrqlozK/HNmzcT\niURbowIA9D9VVXO5nNfrNe8MhUKqqrbl9avVarFYfPDgge1XyOfz+Xy+LcE4bnLlW8bjvcVv\nHn380wcNC9B4NflScnPy6Z79/f1jxTp4Hj586HQIPaZUKh3nqz2YDg4ODg4OunChYrHYrpey\nfOtX/RjHhu1hAAA0t7S05PP5gsHglStXhBA7Ozuy075dU94PDQ15PJ5PfepTNs7d29srl8tj\nY2MnT55sSzCOK5set1ImxvEND6551vzip06dGh0dtRPi4CkWi48fPxZCPPfcc4qiOB1Obzg4\nOCgUCiMjI5OTk0cfDSGEEI8ePapWq+Pj4ydOnOjC5TweT7teylqiEgwG61u/hBCyjgEAoHV+\nvz+ZTAYCAXO3fP2oleNQFGV4eNjeicc53YXMuUQrb8o4vuHBNc+aX3xoaKhvCq3ThoZ+MafR\n8PAwiUqL+u+72TVd+2628cNsLVGJx+OxWCwcDpvH0zOYHgBgj9/vp/oAADRkLVFJpVKRSITx\n9AAAAAA6ylqiEggEVFWdmpoy79ze3m7vDC0AgH4VCoWEEPF43HhcQ9YpdLMAANowmF4IoWla\nO4IBAPS57e1t8yaTRgIADmNtZfpoNFqz2qNUM2HxYa5du7a1tWXpigCAfpJOp40GrytXrqiq\nqj8rm806GyEAwCWsJSrhcHhzc7NmZy6XCwQCR55769ate/fuWbpc31DeTRv/WTqlo1EBgLP8\nfn99L73X6+W+LwCAsHrrl5xuzMZg+t3dXSHEhQsXrJ4IAOhXiqLU5ySpVGpnZyccDjsSEgDA\nPawlKtFoNBKJBINB885WBtO/8847CwsLd+7cqdn/8OHDDz/80NiU/f7lcllYJ2u7arVq7/Su\nqQmvebQdfS/G3weVSsXlheYelUpFPiiXy8x536JqtSqEsP3VHmRd+0FzVQ+Gz+cLBAIkKgAA\na4nKzMzM+vq6nK3FrPlg+tXV1VdffbXhU8lkMhqNGptnzpwplUo///nPLUVlViwWi8Wi7dO7\noObdNX+zxymK1h0cHBwcHHThQv3k0aNHTofQY8rlcnc+z/3kyZMnT5486cKFSqVSF65iCIVC\nxhj6hgm/qqrdjAcA4E7WEhWv19tw1q+GO6Wtra1Lly6dPXvWcmh9YXLlW0KIvBAn/FeFEPnU\nDZESQgjhv9quFxdC7C1+8/ivBgDdEY/H4/G4pmmZTKami14IcfHixZmZGUcCAwC4iuXpiYUQ\nqVRqeXlZCDE1NbW4uOj1epscfPfu3du3bxubb7755uuvv/7KK6/IzUAgMD09bTz7jW98w+Px\nPPfcczai2t/fL5fLo6OjJ0+etHF6h1SOOqD5m23+bKW1ww6j67rsFjh58uTo6KiNVxhAxWJR\n9j6dPn2aW79adHBwUCwWR0ZGJiYmnI6lZ3zyySfVanV8fHxsbKwLl/N4PF24So10Oq1pWn0X\nPQAAkuVERbaByceZTCaRSKiq2qRHZWFhYWFhQT6+du3a1atXzZnJ888///zzzxubiqIoijIy\nYid9kn81Dg0N2Tu9Q45MVJpH2/zZSmuHHca4K314eNhVheZmxhiVkZEREpUWDQ0NCSFsf7UH\nWdd+0Jz6MMu6o37W+5WVFRIYAIC16YlDoVAmk0kmk+Y576empmKxWIfiAwD0q1QqpSiKrw6r\nQAIAhNUelUQikUwm/X6/eae81ZgZWgAAliwvL6uqOjU1lUgkzINVFhcXHYwKAOASlm8qqMlS\npCOnJ5auX79u9XIAgH6VyWSMe1CvXLki65dcLpfNZpuPfgQADAJrt36pqlp/M3EoFGIqSQCA\nbYuLi3KOFiGE1+s1HgMABpm1HpWlpSWfzxcMBq9cuSKE2NnZkavUJ5PJjkQHAOhfwWBQ07S5\nublwODw1NaVp2tLS0s2bN1vspQcA9DdriYrf708mk4FAwDzSsX7UCgAAR5JDHNfX18PhsHwc\nCASEEOaFgAEAA8vOGBXjlmIAAI7DPLt9k5nuAQADyNoYlYZz7adSKaYnBgAAANBGbVhKzOfz\nBQIBpicGANhQM0dLNpsNBAJ03QMAWkpUQqGQMSilYacKs34BAKyKxWJyRhYAAOq1lKjE43E5\nzDGTyZjX5JIuXrw4MzPTgdgAAP0sEomoqrq0tGTeefPmTVamBwAIS7d+pdNpTdPi8XjnogEA\nDJT6AfRMIwkAkKwNpmdKFgBAuwSDwfpFhIUQcqkuAMCAs5aoCCFyuVwoFNKeSqVSnQgLAND3\n4vH45uamECJnkkql5GoqAIABZ23WL6P+MEbPBwIBVVXpaQEAWJVKpSKRCOPpXU559xdVvP6S\n5mwkAAaNtURleXlZVdW1tTWv12vsDIVCoVCIsSsAAEtkU9fU1JR55/b2diaTcSokHEnmLXmn\nwwAwCKwlKplMpn5u+3g8rigKiQoAwKqGHfKaRss9AMDiGJX6uYnrMWoFANCKaDTacDB9zYTF\nAIDBZC1RicfjsVisZmcoFEomk/JxLpdjECQAoBXhcFgOpjejHgEASNZu/ZJrPtYPfGRxLgCA\nVYqiCCEYTA8AaMhaojI3N9dwcXoDgyABAC2KRqORSKSmTqEeAQBI1hKVmZmZ9fX15uPmGQQJ\nAGjFYXUK9QgAQFhNVLxe75FLprCmCgCgFT6fr+F+6hEAgLCxMr14dglhuYqwvM8YAIDWqaqa\nzWbr9zN7JABAWO1RicVijHoEALRFOp2WOYl5EeFcLre8vOz3+52LCwDgCtYSlUgkoqpqzQz3\nN2/eZNYvAIBV9MYDAJqwlqiIRrcO0+4FALCBWb8AAE1YS1SCwWAulzP30UtXrlxpX0gAgIHA\nrF8AgCYsr0wvVxGuGUzPKsIAAKsOm0mSWb8AAMJqj0oqlYpEIoynBwDYEwqFhBCyF0U+riFv\n/dJ1vduRAQBcxlqiEggEVFWdmpoy72zv/cS6rpfLZXsnCiGq1aq9053SPNoW38txSkwIUalU\neqvQHFSpVOSDcrnMOOAWVatVcYyv9iDr2g9aN7OC7e1t8yZzsQAADtOGwfSiffcTV6vVUqn0\n85//3PYrFIvFYrHYlmDaYvKoA5q/2ebPTrZ22JEODg4ODg6O8woD6NGjR06H0GPK5fIxP6gD\n6MmTJ0+ePOnChUqlUheuIk1NTRnJyZUrV7a3t2uqlVwud9hCkACAgWItUYlGow0H09dMWGzb\n0NDQ6Ojopz/9aRvnPnr0qFQqnThxYmJioi3BtEXhqAOevtl/b/rsES9ur8R0XX/w4IEQYnJy\ncmxszMYrDKBCobC3tyeEOHPmDD0qLdrf38/n8x6P5/Tp007H0jMePnxYrVZPnTo1Pj7ehcuN\njo524SpSIpGIRqPysd/vr5830uv1ct8XAEBYHUwfDoflYHqzXC7HYHoAQIvC4bB8cFi2TysA\nAEBYTVQURYlEIsqz6KMHALQoGAzK1egP0/xZAMDgsHzrF4tzAQBsW1xcNDdv0XkCADiMtUSF\nxbkAAMfh9Xqz2ezm5ub777+fSCRqWr4EjV8AgKesJSoszgUAOCav1yuHqSQSifqWL0E3CwBA\nCGFjjEosFutQKACAgZJMJi3tr3Ht2rWtra22RgQAcBFriYoQYn19XVGUUCiUy+U6ERAAYEDU\nz03cfL/ZrVu37t271+6IAAAuYi1RSSaT6XRa1/WLFy/6fD5N05ieBQBwHLlnpVKpI2/92t3d\nFUJcuHChKwECAJxhbYyK0coVDofD4bCxfnAwGFxcXKxfCBIAgMOkUil7y3C98847CwsLd+7c\nqdm/u7v7n//5n8amruvVarVUKtm4hFx00vbpLmfvTTU8S3k3LYTIm/ZUKpW+LLROqFQq8kGp\nVGJoVouq1aoQQtd1PmZWde27Kf+N2sJaomKWSqWWl5eFEKqqXrx4cX5+XgixtrZGugIAaEUg\nEFBVdWpqqmZ/IpFoctbq6uqrr77a8Knvfe97xrL3QogzZ86Uy+VHjx7ZjrBYLBaLRdunu8qk\n6bEsk8mVb8nNvcVvNj/efNaRDg4ObIQ34D755BOnQ+gxx/xqD6Z8Pp/P548+7tjK5XK7Xspa\noqIoiq7rsVgsEokIIVRVzWazMjMJh8OxWMzn8yWTyVZuLwYAoOGkkdvb24cdv7W1denSpbNn\nz3YyqIH2v7b/XT7oxp8zANCU5R4V2TXZ8F6vcDgciUSWl5dJVNpLdqwLIfSXWK8GQP+IRqO5\nXK6+H35paemwU+7evXv79m1j880333z99ddfeeUVuTk3Nzc7O2s8+9prr42Ojp45c8ZGbJ98\n8kmpVDpx4sSpU6dsnO5C5o4hWSbFZzeP1OJhExMTY2Nj1oIbVIVCYX9/Xwjx/PPPc+tXix4/\nfpzP5z0ezy/90i85HUvP+Pjjj6vV6smTJ8fHx7twudHR0Xa9lOVERVXV5vd3sVAXAKAVsite\nrqliyOVygUBADhGpt7CwsLCwIB9fu3bt6tWr09PTxrOjo6PmClL+5XfMv//68s/HmjfV4nts\n/bC+LLROMAqKQrOBErOqFz9mlhOV5ms7RqPRmZmZY8QDABgUssqU9xIDAFDDWqKSzWbl8imy\nRyUWi62vr8/NzRntYTUNYwAAHCYajUYikWAwaN65vb1NzzwAQFhNVDY3N2WlEo/H5ZB6VVXX\n19fff//9eDzeoRABAH1pZmZmfX29vvrQtJbG412/fr0DQQEA3MLyrV9ymq9cLiezFHknmKIo\nJCoAAEu8Xm/D24mb32MMABgQ1lamj0Qi8qavzc1N0XRiFgAAWpFKpTRN0zQtFArJu4sBABBW\ne1RUVU2lUj6fT3anyGmIY7FYMpnsTHgAgH6maZoxIiWTySQSCaOvHgAw4Kz1qKytrS0vL/t8\nPjlJsRBC07RIJHLz5s3OhAcA6FuhUCiTySSTSd1kamoqFos5HRoAwHnWelTq7yem3QsAYE8i\nkUgmkzVrBMfjcU3TmEMSAGCtRwUAgDaqyVIkpicGAAgSFQCAU1RVrR89HwqFVFV1JB4AgKtY\nnp4YAIC2WFpa8vl8wWDwypUrQoidnR25Sj0TtAAARCuJSigUSiQSuq53IRoAwODw+/3JZDIQ\nCCQSCWNn/agVAMBgOjpRSSQS0Wi0C6EAAAaN3++nIQwA0FBLY1SM2VcURWl4wGH7AQBoIpVK\nmScj1jQtlUo5GA8AwD2OTlSCwWDzaoNKBQBgQywWCwQC6+vrxp50Or28vMw6KgAA0cqtX4uL\niz6fz9i00Xmyu7sbCoWEEJcvX15YWLB6ei9S3v3F8jJ5Z+MAABeLRCLRaHRmZsa8U85NzDoq\nAICjExWv15vNZjc3N99///1EIhEMBmsO2N7ebj7n/VtvvbWxsSGEmJ2dvXTp0vT09HEiBgD0\njYYJCeuoAABEi9MTe71eWZckEol4PF5/QJNult3d3evXr8vHly9fthUkAKAPyXVUvF6vsUfe\nS8w6KgAAYXUdlcPmtm8y5/3Zs2flg62tLSFETXfKT37yk52dHWOzWq1Wq9VCoWApKuNcIUSl\nUrF3ulOaR1vz7GEH23vLxkw7pVLJxumDySirQqHAHBItqlQqQgjbX+3BJL+e5XK5O4Umfz+7\nT66jkkwm5Q3GKysrcp7iubk5R+IBALiKtUTlsLntj5zzfnV19fbt2/U9Kt///vfNcx+fOXOm\nXC7v7e1ZisqsVCp1+c/uyZVvyQd7i980NvNCnPBfbeX0Jm82n7ohUjfMr1Zz8GTTF6kJrIl8\nPp/PM5rGmv39fadD6DGVSuU4X+3BVCgUupOolMvlLlylnrGOinlnNBplgAoAQNhbmT6VSi0v\nLwshpqamFhcXzb32h1lYWHj11VdDodALL7zwyiuv2LgoAKD/sI4KAOAwlhMVTdOMYY6ZTCaR\nSKiqmk6njzzx7Nmzr7/++p07d8yJyte+9rWvfe1rxubLL788Ojr66U9/2mpUQohHjx6VSqUT\nJ05MTEzYON02o7VThm218fPpm/13Kwc3vnTzwOrpuv7gwQMhxOTk5NjYWCsBoFAoyG6BM2fO\ncOtXi/b39/P5vMfjOX36tNOx9IyHDx9Wq9VTp06Nj4934XKjo6NduAoAAJa0tOCjIRQKZTKZ\nZDKpm0xNTbU45/25c+fOnz9vK04AAAAAA8RaopJIJJLJZM2IlHg8bl6uq4kbN25cunTJ0hUB\nAAAADCBriYo4ZNx8kznvt7a2Zp+6evUqi6gAwCALhULcNgkAaIW1MSr1c94LIUKhUJM576en\np+VqjwAAJBIJ82SPAAAcxlqiIue8DwaDV65cEULs7OxEIhHRdB0VAADMjNmHFUVpOOXXYfsB\nAAPF8joqcs57uSaXVD9qBQCAhoLBYCqValJryMXpAQCwPD0xc94DAGxbXFyU69BLjFcBABzG\nzoKPAADY4/V6s9ns5ubm+++/n0gkgsFgzQHb29tNJmgBAAwOEhUAQFd5vV45TCWRSMTj8foD\n6GYBAAgb0xMDANAWh03EwgQtAABBogIAcMphQ+qZoAUAIEhUAADOSqVSmqZpmhYKhXK5nNPh\nAADcwtoYlYZz26dSqZ2dHWNefAAAWqRpmjF0PpPJJBIJVVXT6bSzUQEA3KANPSo+n08u+wgA\nQOtCoVAmk0kmk7rJ1NRULBZzOjQAgPNaSlRCoZCiKHIaFqWOz+dTVbXDcQIA+k0ikahfMjge\nj6+vrzsVEgDAPVq69Ssej8fjcdlBXz/n/cWLF2dmZjoQGwCgzzUcN886Kj3txP9+Twihv6Q5\nHQiAnmdhjEo6ndY0reGc9wAAWKWqai6X83q95p2hUIheegCAsDqYPp1O53K5+fl5+VgIoWna\n3NwcI+kBAFYtLS35fL5gMHjlyhUhxM7OjhzxyDoqAABhNVFJpVKBQMC8J51Oy7Er5CoAAEv8\nfn8ymQwEAolEwthZP2oFADCYrM36tby8HAwG62coZuAjAMAGv9+vP4ssBQAgWetRyWQyDae3\nZ+AjAAAAgDay1qMiBz6a96RSKbm/nUEBAAAAGGzWEpWlpaWVlRVj0xiyMjc31+a4AAAAAAww\na7d+yVuHjZUf5c5oNMpIegAAAABtZC1REU8HPnYiFAAAAACQrN36lXtKbsZiMU3TYrFYBwID\nAAAAMLisJSqbm5s+n08OU4nFYnJlrvX19VAo1JHoAAD9S1EUmroAAIexlqgIIbLZbDwez+Vy\nkUhEVdV0Op1Op81rdQEA0KL19XVFUUKhUM2UkgAAWEtUIpGI1+sVQmxubgohlpaWOhIUAGAA\nJJPJdDqt6/rFixd9Pp+maXLKewAAhI11VFKplNGdIicBi8ViyWSyM+EBAPqWsQh9OBzWdX1t\nbS0QCNDB0n3Ku2nl3QarOQOAs6wlKmtra8vLyz6fT1XVtbU1IYSmaZFI5ObNm50JDwAwEFKp\n1Pz8vBBCVdWLFy/Oz89rmka6AgCDzNr0xF6vN51+ptGlZvOYdF2vVquFQsHGudVqVQhRqVTs\nnX589q5r6azDDm7+Ioc9a0wzXSqVWo9hwBllVSgUjKWE0FylUhFC2P5qDyb59SyXy90pNPn7\n2X2Koui6bkzNoqpqNpuVNxiHw+FYLObz+ZLJpNHxYlVP1ykd1fBNHflO21JhwYw6xQbqFBt6\nt06xvI5KR+m6XqlUDg4ObJwrC6VcLts73baTTx/I655scmgjlqKVBz//o/flZr7pi5xs+qxZ\nsVgkV2mRkd09efLE2Uh6iPxuVqvVLn83e5r8pJVKpXK53IXLyYrfEfKPs2AwuLi4KFMUQzgc\njkQiy8vLx0lUeq5O6Rxz9dSwwmr+TvOpGyJ1Qwgh/FdbuVzflFtHUafYQJ1iQ+/WKXYSlZq+\n+Gw2GwgE2rIK5NDQkMfj+dSnPmXj3EePHpVKpbGxsYmJieNH0jojM5VhWz5fmmQAACAASURB\nVE1ULb3Zww5uuL/Q9FkhhK7rDx48EEKcOnVqbGys9TAGWaFQ2NvbE0I899xztH61aH9/P5/P\nj4yMnD592ulYesbDhw+r1er4+Pj4+HgXLufxeLpwlYbkjcQ1KYpZJpOx/eK9WKd0jrl6alhh\n2Suow7T31foVdYoN1Ck29G6dYi1RSaVSgUCgXdcGAAy45vcPR6PRmZmZrgUDAHAVa4lKIBBQ\nVXVqaqpmP+uoAACskl3x9SPmV1ZW4vG4ECIcDjsQFgDAHSzf+tWw9Wt7e7sdwQAABkiTXnqZ\nqAAABpm1RCUajeZyufqbiVn5EQBg1fLysuylTyQSwWDQ2L+4uOhgVAAAl7CWqMj5Imv64nO5\nXLsG0wMABkcmkzHqjitXrsjZvXK5nDFJMQBgkFlb8FFRlEgkojzL5/N1KDgAwCBYXFxcXl6W\nj71er/EYADDILN/6FYlEzB30Qojt7e3jTB8JABhMwWBQ07S5ublwODw1NaVp2tLS0s2bN6lT\nAADCaqIyMzOzvr5eP8ZR07T2hQQAGAjxeFzTtPX19XA4LB/LsfXRaNTp0AAAzrOWqHi93oaz\nfjWfCB8AgIbM1QdVCQDAzNoYFSmVSmmapmlaKBSqn/8eAADbqFYAAJLlREV2zWcymUwmk0gk\nfD4f930BANplfn4+lUo5HQUAwHnWEpVQKJTJZJLJpG4yNTUVi8U6FB8AoJ8oR8lkMjdv3nQ6\nTACA86yNUUkkEslkUk51b5AjIGsWVwEAoF7N7JGJREKu+WgcsL297VBoAAB3sZaoCCFqshSJ\nqSQBAK0wzx4ZCoXqG79yudzm5qZD0QEAXMTarV+qqtYPcwyFQqqqti8kAEDfMs8emUgk6hu/\nvF5vJBLpelwAANex1qOytLTk8/mCweCVK1eEEDs7O7I6SSaTHYkOANC/VFVNpVI1uQqDHgEA\nkrVExe/3J5PJQCCQSCSMnfUd9wAAHGlpaSkQCASDwcXFRSFENptdXl7OZDIs+AgAEPbGqOi6\n3olQAAADxe/3Z7PZ+fl5n89n7AwGg8zOAgAQNhIVAADaxTxkBQAAMzsr0wMAAABAR5GoAAAA\nAHAdEhUAAAAArkOiAgAAAMB1SFQAAAAAuI61REVRFJbiAgAAANBplntU1tfXFUUJhUK5XK4T\nAQEABgSNXwCAJqwlKslkMp1O67p+8eJFn8+naVoqlepQZACAvkfjV39T3k3L/5wOBEBPspao\n+P1++SAcDuu6vra2FggEqGMAADbQ+AUAaML+YPpUKjU/Py+EUFX14sWL8/PzmqY1TFe2trZm\nZ2dnZ2evXbtmP1IAQH+h8QsA0ITlwfRCiFgspihKIBAQQmSz2XQ6HQ6H0+n03Nycz+eraQ/b\n3d29e/fuxsbGxsbGvXv3VldX2xg9AKA/tN74BQAYEJZ7VBRFiUQiwWBQpiher9d4KhwOCyGW\nl5fNx9+/f39hYUE+fv311z/44IPjBQwA6BM2Gr8AAINjxOoJqqqura2Z85MamUzGvDk9PW08\nPnfu3Pnz583P/vCHP/zHf/xHY7NSqVQqlcePH1uNSp4rhCiXy/ZOt80oQXldqwVqKdrDDm64\nf6Tps0IIXdflg0KhUC6XWw9jkMmPmRDi8ePH8m8sHEl+umx/tQeT/HoWi8VqtdqFyxkf7O6T\n36NgMLi4uFhTs4TD4Ugksry8bNwhBgAYKJYTlXS62dwd0Wh0ZmbmsGfv3r176dIl855//dd/\nXVtbMzbPnDlTqVSePHliNSpDuVzu8t/ck08fyLAnmxzaiKU3O/Kt/1cIkRfihP/qkS8y2fRZ\ns2Kx2HoMkPL5vNMh9JhqtXqcr/ZgKpVKpVKpCxdyMFGx2vgFABgc1hIVow3+MPLur4Z2d3fF\nsx0sQojJycnPfvazxmahUFAUZXh42FJUUrVa1XVdUZShIfszBByHvbDtnWXpRZo8K/86GRoa\nonOgRbquyxbutvzDDQjHv5u9qMvfTQd/AY7T+AUA6G+We1RyudzKysr29rbcXFpaarFT/q23\n3rp+/XrNzq985Stf+cpXjM2XX37Z4/F86lOfshqVEOLRo0elUmlsbGxiYsLG6bYVnj6QYRea\nHNqIvTfbyosUmj4rhNB1/cGDB0KIU6dOjY2NHT+MQVAoFPb29oQQzz33HNldi/b39/P5/MjI\nyOnTp52OpWc8fPiwWq2Oj4+Pj4934XIej6cLV6l3nMYvAEDfs9bAmUqlfD5fIpEw9gQCgVAo\ndOSJq6urX//61y1HBwDoa7lcLhQKaU8xdB4AYLCWqCwvL6uqKmdlkbLZ7Pb2diwWa3LWrVu3\nLl26dPbsWSHE1tbW1tbWsUIGAPQF241fAIBBYO3Wr0wmk81mzaMevV5vOp3WNO2wDvrV1dXb\nt2+b92xsbNgIFADQZ2Tjl3kwfS6Xm5+fj8Vi3PQFALCWqASDwYZzszSZlWVhYcFYR6W/Ke+m\nhRBMBQUALbLR+AUAGBzWbv2Kx+P1nfKxWExV1faFBAAYCDYavwAAg+PoHpX6qY3M9xNLyWSy\nbREBAAaDbPyKx+PmnTR+AQCkoxOVaDQaiUSCweBhB1y8eJFlgwEAraDxCwDQoqMTlZmZmfX1\n9ZoWLwAAbKDxCwDQoqMTFTm0sQuhAAD6Ho1fAIAWWRtMDwDAcdD4BQBoEYkKAAAAANchUQEA\nAADgOiQqAAAAAFzHcqKSy+U0TdM0TW5qmhaLxdodFQAAAICBdvSsX2apVCoQCJj3pNNpOSl+\nOBxuZ1ywQnn3FyNT9Zc0ZyMBAEtyudz8/LwQQo6w1zRtbm6OCgUAIKz2qCwvLweDQV3Xa/av\nr6+3LyQAwEBIpVI+ny+TyWQyGbknnU5HIhE66gEAwmqikslkGk5+b9QxAAC0yF7j19bW1uzs\n7Ozs7LVr1zoZHQDAYdYSFVVVc7mceU8qlZL72xkUAGAA2Gj82t3dvXv37sbGxsbGxr1791ZX\nVzsZIADASdYSlaWlpZWVFWPTGLIyNzfX5rgAAP3ORuPX/fv3FxYW5OPXX3/9gw8+6GiEAAAH\nWRtM7/f7hRBy9Lz8vxAiGo0y8BEAYJVs/DI6VVpp/JqenjYenzt37vz58+Znf/CDH3zve98z\nNqvVarlc3t/ftxFbpVIRQpRKJXunu5DH9Fi+Kc+zB7T3nda8Wt8UY3vJj5kQYn9/3/izCs2V\nSiUhRKVS4UPVOnmHbbFYND5yHVUul9v1UtYSFSGE3++vv58YAACrjtn4dffu3UuXLpn3ZLPZ\nd955x9g8c+ZMtVrN5/O2I6xUKt2p19ticuVb8sHe4jfrnzWnJbJMahKV4xRUjXzqhkjdEELk\nhTjhv9reF+9LhULB6RB6zDG/2oOpVCrJNK/TqtVqu17KcqKSSqV2dnaMWkTTtKWlJVnZAABg\nie3Gr93dXfFsB4sQ4vnnn//VX/1VY/Ojjz5SFGVkxHJNJ4SoVCq6rg8NDQ0N9d7KyEe+5YYH\n2CuoFnX0xXtXtVqVf9JRPq2ThaYoyvDwsNOx9AzZxdG1H7Q2dg9a+2LEYrFIJKKqqpGopNNp\nTdPMqQsAAC2y3fj11ltvXb9+vWZnIBAwL/b18ssvezye5557zkZgjx49KpVKo6OjExMTNk53\nhNEm3/Atm1vs5QE1bfj2CqpFHX3x3lUoFPb29oQQp0+f5tavFu3v7+fz+ZGRkdOnTzsdS894\n+PBhtVodHx8fHx/vwuU8Hs/RB7XGWl4ViUSi0eja2pp5ZyaTYR0VAIBVsVgsEAiYa5B0Or28\nvHzkOiqrq6tf//rXOxwdAMBhlrsaG/acsI4KAMAq2fg1MzNj3ikrlCa99Ldu3bp06dLZs2eF\nEFtbW6LuBjAcSXk3LYTgBn8ALmctUZFTSXq9XmMP66gAAGyz2vi1urp6+/Zt856NjY32hwUA\ncAFricrS0pLP50smkz6fTwixsrKSSCQE66gAAKyz0fi1sLBgrKMCAOhvltdRSSaT5qGKgnVU\nAAC20PgFAGiCdVQAAM6g8QsA0ATzdgMAHEPjFwDgMHYSlVwuZ97MZrOBQICaBgAAAEC7WEtU\nUqlUTR99e+m6XqlUHj9+bOPcSqUihCiXy/ZOt+2YfVLtjdb8aiONdpoZuWWhUJBLluJI8mMm\nhHj8+DGLc7VIfrpsf7UHk/x6FotFuWp1pxkfbEfQ+AUAaMjan9mBQEBV1ampqZr9cvhjW+i6\nfpyK+Zind197o234akdeolqt8jd3i4zC1HWdP6RaZBRUb3033aBrP2hOfZg73fgFAOhplvsD\n0ul0/c7t7e12BCMURRkZGZmcnLRx7qNHj6rVqsfjmZiYaEswLSoc73R7b7aVVys02mmm63qh\nUBBCjI+Pj42NtTGMPlYoFPb29oQQExMTZHct2t/fr1Qqw8PD7f2097eHDx/quj42NjY+Pt6F\ny42MODNesQuNX3AVudCkEEJ/SXM2EgA9wVrlFI1Ga+a8l5aWltoXEgBgUHS08QsA0NOGLB0d\nDoc3NzdrduZyOfruAQBWycav+v00fgEAhNVERVGUSCSiPEsu1AUAgCU0fgEAmrB861ckEgkG\ng+ad29vbmUymrVEBAPqfHOgViUScDgQA4EbWEpWZmZn19fV4PF6zX9MYFQcAsIbGLwBAE9YS\nFa/Xu7a2JtMSOQJS07S5ubmGoyEBAGiCxi8AQBPHXfAxnU7LvvtwONzOuAAA/Y7GLwBAE9YG\n0y8vLweDwfqlwdbX19sXEgBgIKRSKZ/Pl8lkjHu90ul0JBKJxWLOBgYAcANriUomk6nvo5f7\n2xQPAGBQ0PgFAGjC2q1fqqrWLPiYSqXk/jbHBQDod5lMpuFdXjR+AQCE1R6VpaWllZUVY9MY\nsjI3N9fmuAAA/U42fpn30PgFADBY61Hx+/3i6cz38v9CiGg0ykh6AIBVsvHLuKOYxi8AgJm1\nREUI4ff76+8nBgDAKhq/AABNWE5U6tWMWgEAoEU0fgEADmNtjEpD8/Pz8q5iAACOqWbUCgBg\nYB2dqChHyWQyN2/e7EKsAIC+R+MXAEA6+tavaDQaiUSCwaDcTCQSqqpOTU0ZB2xvb3cqOgBA\nfzHGojRx8+ZNOXwFADDIjk5UZmZm1tfX5awsoVAomUzW1B+5XG5zc7NTAQIA+giNXwCAFh2d\nqHi9XmNBrkQiUb8yvdfrjUQiTNICADgSjV8AgBZZG0yvqmr9rcOxWKx98QAA+llN41f9LV6y\n8avrcQEAXMfyyvSBQCAUCuVyuVwul0qlNE2LRCLRaLRD8QEA+hWNXwCAJiyvTJ/NZufn530+\nn7EzGAxy35d7KO/+oqky72wcAHAU2fgVDAYXFxeFENlsdnl5OZPJ0PgFABA2Fnw099oDAGAb\njV8AgCbasDI9AAD20PgFADjM0YlKKBQSQhgztNQfsL29nclkdF1ve3AAAAAABtPRiUrNlPaJ\nRKJjwQAA+hyNXwCAFh2dqJg75a9cubK9vV3TTZ/L5cy3FwMAcBgavwAALbI2PbHf76+/mdjr\n9dL0BQBoRTqdNuqRK1euqKqqPyubzTobIQDAJawlKkKIVCplnuRe07T6WfDr7e7uzs7O7u7u\nWr0cAKBf0fgFAGjCWqISi8UCgcD6+rqxJ51OLy8vN1+fa2trq+GNyACAAWev8QsAMAisJSpy\nEfq1tTXzzkwmY05d6k1PT29sbNiJDgDQv+w1fgEABoTldVQarsOVyWTsXf7OnTubm5vGZqVS\nKZfLe3t7Nl6qUqkIIUqlkr3TbRs93untjbbhqx15iSdPnhSLxTaG0cfkx0wIsb+/72wkPaRc\nLgshKpVKl7+bPU3e+1QoFGTpdVp3rlJPNn7NzMyYd8oKhTUfAQDWEhVVVXO5nNfrNfbIPnpV\nVe1d/oMPPviHf/gHY/PMmTPVarVQKNh7NSFEpVIx/pTsjuMkKvnUDZG6IYQQ/qvHj0S+Wl6I\nE8++WsPynFz5lnga/N7iN536M6V3HedTOpiO+dUeTOVyuTvfzWq12oWrNNTexi8AQD+xlqgs\nLS35fL5kMinnI15ZWZEzS87Nzdm7/Pnz53/zN3/T2PzRj340NDQ0NjZm46VKpVK1Wh0eHh4Z\nsdxN1N+OLM+RkZHh4eHuBNPrZKefaKFUYSiXy5VKZWhoyOPxOB1LzygWi7qud+27OTRkeWKV\ntmh74xd6i/LuL6ZS0F/SnI0EgDtZ+5ve7/cnk8lAIGDeGY1GbffRv/jiiy+++KKx+fLLL4+M\njExOTtp4qUePHlWrVY/HMzExYS8Ye9zfRNywPM1hj4+P82d3iwqFgrx/aWJiQlEUp8PpDfv7\n+5VKZXh42N5XezA9fPhQ1/WxsbHx8fEuXM6p9p22N34BAPqJ5crJ7/czcSQA4Pja3vgFAOgn\n3CUFAHAMjV8AgMPYSVRyuZx5M5vNBgKBJjXN7u6uXEclFAq98cYb09PTNi7qNsadtXln4wAA\nAAD6kbVEJZVK1fTRt+Ls2bOsowIAaMhq4xcAYEBYS1QCgYCqqlNTUzX75fBHAABaZ6/xCwAw\nICzf+pVOp+t3bm9vtyMYAMAAofELANCEtUQlGo3WzHkvLS0ttS8kAMCgoPELAHAYa4t8hcPh\nzc3Nmp25XI6+ewCAVbLxq34/jV8AAGG1R0WucBeJRDoTDABggITD4VgsVrNqimz8astgel3X\ny+WyXKTVqkqlIoQolUr2TnfE6NMHDWMerd/1rM6903zqRiF1QwiRF+KE/6oQovD//N/mzR4q\n5PaSHzMhxP7+vrOR9JByuSyEqFQqA/uxsUH+ohYKBVl6ndbGq1i+9SsSiQSDQfPO7e3tTCbT\nroAAAAOiC41fiqIMDVm7d6CNpzulJuaJf/4/ooXJ9B18p71YyG1hJOSKosivA45kFNTAfmxs\n69oPWhs/zNYSlZmZmfX19Xg8XrNf07R2BQQAGBCdbvxSFGV4ePjUqVM2zi2Xy9VqdWRkxN7p\njig8fWAvZgffaQ8VcnsVCoVisSiEOHXqFIlKi/b398vlsu2v9mAqFAq6ro+Ojo6Pj3fhcsPD\nw+16KWuJitfrbTjwseFOAACaoPELANDE0YmKXFReViTycQ3Z+sXiXAAAS2j8AgA0cXSiUjNN\nJNPbAwBso/ELANCioxMVc8vWlStXtre3a9q6crmcz+drf2gAgL5D4xcAoEXWxqj4/X6/31+z\n0+v10vTlZsq7v0gs9Ze47RuAw2j8AgC0iJndAADO8Pv99cNRaPwCAEgkKgAAAABch0QFAAAA\ngOuQqAAAAABwHRIVAAAAAK5DogIAAADAdUhUAAAAALiOtXVUAAAAOsFY9Uuw8BcAIQQ9KgAA\nAABciEQFAAAAgOuQqAAAAABwHRIVAAAAAK5DogIAAADAdUhUAAAAALgOiQoAAAAA13HXOiq6\nrpfL5b29PRvnVioVIUSpVLJ3+iAwl8yoaf+TJ0+KxWL34+lF8mMmhNjf33c2kh5SLpeFEJVK\nhe9m63RdF0IUCgVZep3WnasAAGCJuxIVIYSiKCMjdqKSFe3Q0JC90wfBYSUzPDxMobVOftKG\nh4cVRXE6lt5QrVYrlYrtr/Zgkm0HXftB48MMAHAhd/3doCjK8PDw+Pi4jXOLxWKlUrF9+iAw\nl0zBtH90dHRsbKz78fSiQqFQKBSEEOPj4/xt16JKpVIqlYaGhvhutu7Jkye6rns8nu4U2vDw\ncBeuAgCAJYxRAQAAAOA67upRQRco76aFEHmnwwAAAACaoEcFAAAAgOuQqAAAAABwHRIVAAAA\nAK5DogIAAADAdRhMDwAAXEdO/SLpL2kORgLAKfSoAAAAAHAdEhUAAAAArsOtX60y+qDpgAYA\nAAA6jUQFAIC+QssagP7ArV8AAAAAXIdEBQAAAIDrkKgAAAAAcB0SFYgT//s983T1AAAAgONI\nVAAAAAC4DokKAAAAANdhemIAANADmHYZGDT0qAAAAABwHRIVAAAAAK5DogIAAADAdUhUAAAA\nALgOg+nxDIYqAgAAwA1IVAAAQO+hZQ3oe9z6BQAAAMB1SFQAAAAAuA63fgEA0NvkTVB5p8MA\ngPbqUqJy7dq1e/fuXbhw4fr169254vFx86ugEAC4Ui/WKeg0Kiyg/3Tj1q/V1dUXX3xxY2Pj\nxRdfXF1d7cIVAQD9ijoFAAZENxKV27dvf/GLXxRCvPLKK7dv397d3e3CRdEJyrtp+Z/TgQAY\nXNQpaAUVFtAHOn7r19bW1oULF86ePSs3L1y4cP/+fWMTPc1cAdDVDqALqFMAYHB0PFG5f/9+\n/Z7p6Wn5+O/+7u/+4i/+wniqXC6XSqWPP/7YxoWq1aoQolAolEole6E+/6P35YOH/9dF8/6a\neOyF5wbNI2/+No8shI8//tgoQFFXhn1D13X54Oc//7mzkfQQ+d0sl8u9+93pPlloT548yee7\nMUDa9s9m9/VQndI5rf/YWnrvDn5DG9Yp7d2sqeJdUmFRp9hAnWJD79YpDs/6tbe399///d/G\n5pkzZ3Rdr1Qqll5kcuVbxuMT/qtCiHzqho1NYWymGmzmhTjhv1qzaSlOZ9W8r8OePextnvyT\nN8yb9f9GNXvk5v/a/ne5+dHU59u1KffUbHbzWg5eul+vNSBvs0PXanhpYZHx11Kvc1WdckSN\nY/zYWr9W3rzZ8g/7kW+85ne+m1qsUzqxKffwA9hP1xqQt9mha7mtTlE6XT9tbW3duHHDmJjl\n2rVrV69eNVq/3n///X/+5382Dr5x48aFCxf++I//2MaF8vl8pVLxeDyjo6PHD3sQ6Lp+cHAg\nhBgbGxsZYaLqlpTL5UKhIIQ4efKkoihOh9MbisViqVQaHh4+ceKE07H0jIODA13XR0dHPR5P\nFy73B3/wB9///vffe++9LlzrmKhTXIs6xQbqFBuoU2zo3Tql4z8l586du3fvnrF57969c+fO\nGZsXL168ePH/73L927/92+Hh4fHxcRsXKhaLlUrF9ukDyKhURkdHx8bGnA6nNxQKBVmpjI+P\nU6m0qFKplEqloaEhvpute/Lkia7rHo+nO4U2PDzchau0BXWKa1Gn2ECdYgN1ig29W6d0fNav\ns2fPXr58+datW0KIW7duXb58mVGPAAB7qFMAYHB0Y3rihYWFO3fuzM7O3rlzZ2FhoQtXBAD0\nK+oUABgQXbqLlMWDAQDtQp0CAIOgGz0qAAAAAGAJiQoAAAAA1yFRAQAAAOA6JCoAAAAAXIdE\nBQAAAIDrkKgAAAAAcB0SFQAAAACuQ6ICAAAAwHVIVAAAAAC4DokKAAAAANcZcTqAWj/60Y9+\n93d/18aJ5XJZ1/WhoaHh4eG2R9WvSqWSEGJ4eHhoiJS1JdVqtVKpCCE8Ho/TsfSMSqVSrVYV\nRRkZcd0Pjmt1+buZy+W6cBVHUKd0E3WKVdQpNlCn2NC7dYrr/o0fPnz4T//0T05HAQDoB9Qp\nANC73JWovPrqq48fP7Z37t///d9/+OGHPp9PVdX2RtWvyuXy3/zN3wghXnrppfPnzzsdTm/4\n4IMP3n33XSHEV7/6VdpyWpROp3O53Gc+85nLly87HUvPWF9ff/LkyfT09NTUlNOx9DDqlG6i\nTrGBOsUG6hQberdOcde34rd+67dsn/sv//IvH3744cWLF3/v936vjSH1sXw+LysVv9//G7/x\nG06H0xu+973vyUrld37nd06cOOF0OL3h448/zuVyn/3sZ/lutm5zc/PJkyeqqs7PzzsdSw+j\nTukm6hQbqFNsoE6xoXfrFO4iBQAAAOA6JCoAAAAAXEfRdd3pGNrj4OCgXC6Pjo7SedoiXdf3\n9vaEEOPj48w30qJSqfTkyRMhxOTkpKIoTofTG/L5fLFYHBkZOXnypNOx9Iz9/f1qtXrixInR\n0VGnYxlQ1ClWUafYQJ1iA3WKDb1bp/RPogIAAACgb3DrFwAAAADXIVEBAAAA4DokKgAAAABc\nh0QFAAAAgOu4a8FHdN/W1tabb74pH29sbDgbTK+g0Gyg0KyixNCL+NzaQKHZQKFZ1aMlRo/K\nQNvd3b179+7GxsbGxsbly5dnZ2dXV1edDsrtKDQbKDSrKDH0Ij63NlBoNlBoVvVuiQ3/4R/+\nodMxHNfW1tZv//Zvf/vb3/72t7/92muvOR1OL9nZ2RkaGvr85z8vhPjSl770uc997s///M8f\nPnz4pS99yenQ3ItCs4FCs4oScxB1im18bm2g0Gyg0Kzq3RLr+R6V3s0RXeLOnTvG4+np6Tfe\neOP27du3bt1yMCT3o9BsoNCsosQcQZ1yTHxubaDQbKDQrOrREuv5HpXezRHd4Ny5c3/2Z39m\nLq5z585NTEy8/fbbL7300uTkpLPhucTu7q65KCi0Fm1tbX3nO9+RpUShWUWJOYU65Tj43LaC\nOsUe6pTj6N0S6/lEZXd3N5lMfvnLX5ab586dk/XKxMSErGlgtru7+9WvfvXb3/628WGdmJhY\nX183F9fnP//5hw8fPn78mAKU/uiP/ui73/2u8RkTFFprvvOd7ywsLBibFFpzxu1GP/zhD+WH\njRJzBHWKJdQpNlCn2EOdYknf1Ck9n6j0bo7YfVtbW9/4xjfk4//4j/+QH1b5Ma357P7Kr/zK\n/fv33fzB7aadnZ0f/OAHxlddPP1uU2hN7O7u/tu//Zu5EZpCa2J3d/e73/3uW2+99dprr+3s\n7AwPD587d44ScwR1SuuoU+yhTrGBOsWSfqpTej5RET2bI3bfd77zna997Wu///u//9prr730\n0ktvvvmmHCf6pS99SX52jbp5f39fCHHu3DmHI3aHDz/8MBQK/eVf/qW5XqHQmtvZ2fmv//ov\no1K5du3al7/8ZQrtMH/1V39ltBQODw8b1QYl5gjqlBZRp9hDnWIDdYol/VSnKLquOx1DG6yu\nrt6+ffv1119/5ZVX5J7d3d333nvP2IQQ4tq1a9evXzc2b926de7cuenpabm5u7sbCoXk4wsX\nLpiPHHBbW1tCiOnp6dnZWVkyq6ur8ieAQjvM1tbWjRs3ZFndvn1bhuiB6AAAIABJREFU7rx8\n+fLCwgKFVk8OZ5S/V1tbW+fOnTt79qzxLCXWfdQpraBOsYc6xQbqFEv6qU7pk0RFPK1X5KdW\nCLG7u3v//n3jFxNCiK2tLXOBUEQtMv+BMjs7K4S4cOHC17/+dfPXHjXk7+Abb7whhJCfMbnU\n1BtvvMFHriH50aoXj8f5pDmCOuVI1Cn2UKfYQJ1iVd/UKf2TqIheyxEdUVOv3Lp1S/5W3rp1\n64tf/GJvfXa7ySioa9eu3bt3j09XK2RZmZe/3draunv3rnk0JOoZHzZhakR0NqSBRZ1yJOoU\ne6hTbKBOsafX65SeX0fF7OzZsxtP9dY/Q9c0bHjY3d19++2333vvve7H01uuXbt2/vz5jY2N\ne/fuXbt2zelw3O7q1aviaQe0RLtXK37yk58Yj6enp1988UUHgxlw1ClHok45DuoUS6hT7On1\nOqWvEhVYde7cOdlkaL4VGw3JGkW23GxsbJw/f353d9fpoFxtenr69ddff/vtt83r5b3wwgsO\nhtQr3L8CF9AQdUrrqFOsok6xrafrlL669QtW3bp16+2336ZGOdLu7u4777xD/7IN8jZiY9Pc\na4+GzLcbCUoMPYU6pUXUKbZRp1jV63UKicpAm52dpUYBALQFdQqA9uqHdVRg28TEBDUKAKAt\nqFMAtBc9KgAAAABch8H0AAAAAFyHRAUAAACA65CoAAAAAHAdEhUAAAAArkOigu5JpVKapsVi\nMacCCIVCiqK49kKOlw8A9BDHfzOpU4BOI1FBl8RisUAgkMlknA7EpSgfAGgdv5nNUT7oDyQq\n6JJwOJzNZp2NIR6Pd2c+bhsXckP5AECvcMNvJnUK0GkkKgAAAABch0QFnZXL5TRNUxRF07TD\nnjI/qzxl7DGOMW+GQqFcLhcKhQ67bsPDUqmUfB25Uz6WD2rCq4ktl8sZT8VisYb7zWxcqL58\nGl5LMTEXTiqVahjJYW+kYeE3L+FW3jgAdBR1CnUKBosOdIzsd45Go/KxqqrGpq7rQohgMGgc\nZjxWVVVVVfPrCCGy2ayu68Fg0Dg9GAzKU+o1PCyZTBqfeRmJOTYjAGMzmUwaj414otGoOeaG\n3yCrFzqsfA67lvkw+ZQsnMPKv+EbaVj4TUq4lTcOAB1FnUKdgkHDJwMdVPO7L39tzZWK8dhc\nkcjD5E+hruvRaNR8irFfvn7D6x52WDAYNH4NzY9lAMZhqqoaV6w50nxKNBqtuVDDU5pc6Mjy\nOexa8mdd1kOH1ShHvpGGhX9Y0bX4xgGgc6hTml+IOgX9h0QFnWJuejHvMf/M6aZWH3OLl/ln\nzvy7KY8MBoNNfkmbHNbKb3192AajWcus5u0c50Lm8ml+LaMJqskve5M3Yj6mpvAbFl3rbxwA\nOoQ6xeqFqFPQBxijgk45cr4ReUvr/Pz82tqa0Z0tLS0tZTKZXC4n71v1er1yfzqdDgaDiUTC\n5/M1uau1xcPsqfkKhcNhe6/Tynwsh13L6/XKJqidnR17Vz+s8JsUXbveOADYQJ3SHHUK+hKJ\nCjqrya+ez+ebmppKp9NGnWHw+/1CiJWVlZWVlbm5OfNT8Xg8m80Gg8FMJuPz+Q578RYPO8zN\nmzcPe+qwIYb2NK8VmgxnXF9fj0ajkUikeTyHvZEmhX9Y0bX3jQOADdQpzVGnoN/Y6YYBWiOe\n7Xyv74Y297/XDHaUrTs1H9H6u28b9tcfdljr9xOLZ7uhk8lkMpms7xzPZrO2u+mbl0/za9X0\nqtcH0PyNNCn8hkXX+hsHgM6hTml+IeoU9B8SFXSQrBhqxh3KPeZBfvKxvG/YXEmYz5XMv8jy\nrIbXPeww809wzc+x+fe94e2z5ndk1rBWa/FCTcqnybVUVTX/uBtFVx/GYW+kSeEfVnQtvnEA\n6BzqlOYXok5B/yFRQWcZP0byZ0uYGmPkb6jcLx/XNKjIuqfm1cxj9Q77XWt4mBFJMBg030Gr\nm5b7NdcrxjE1F6p5R03ecisXalI+Da9lVDzygCN/5Q97I4cVfpMSPvKNA0CnUadQp2CgKPqz\nn0vAPTRNS6fTTkcBAOgH1ClAz2EwPVwqFovVDHkEAMAe6hSgF404HQDwjFgsFolE5GO6+wAA\nx0GdAvQ0elTgLp/73OeE6eZaAABso04BehpjVAAAAAC4Dj0qAAAAAFyHRAUAAACA65CoAAAA\nAHAdEhUAAAAArkOiAgAAAMB1SFQAAAAAuA6JCgAAAADXIVEBAAAA4DokKgAAAABch0QFAAAA\ngOuQqAAAAABwHRIVAAAAAK5DogIAAADAdUhUAAAAALgOiQoAAAAA1yFRAQAAAOA6JCoAAAAA\nXIdEBQAAAIDrkKgAAAAAcB0SFQAAAACuQ6ICAIMlFotpmqYoiqIomqalUikhRCgUOvLEVo4B\nAKBdSFQAYFDkcjlFUdbX15eWlnRd13U9nU7v7OwoitLKuYlEogtBAgAgjTgdQBu8/PLL1Wr1\nC1/4gtOBNFatVkulkhBibGzM6VjcSNf1YrEohPB4PENDZM4NFItFXddHRkaGh4edjsWNSqVS\ntVodGhryeDydvtaPf/zjn/70p++9916nL9QJuVzO5/OpqppOp837w+Hw5z73ueXl5eanz8/P\ndzI6AADq6L1vZmbmG9/4htNRHKpQKHz00UcfffRRtVp1OhY3qlQqsnzkn+Oo9+DBg48++ujg\n4P9r725i27oSu+Ef2pITT75mYrxTyIukCyqjMYwu6jQTkHCRdlAYlMeCkUUGXbmbUEBdjFRg\nrAHeCk8nz+vN2IuKUwiFZHTh5QhoEEiwWAOddlBXRDCNHmDmFQI1JArMFJDQBHBi58Ox9cF3\ncd9csJIsiRRJXYm/3yIgL++559wrhuaf55x7vtjvhiTUvXv3Pvroo3v37rWhrh/+8Idnzpxp\nQ0WtkM/nQwizs7OPezV6UC6XM5lM9A9EJpOJNsZbav/hGBsbi3crl8vxoeLt8TFjGw4elyqX\ny1Hzorpqq9vchuZcDgASzw/YAB0hGriVy+W2fHViYiJ60Nvbe/r06Wq1Wi6XS6VSNC9lbm4u\nDhLVajWEUCgU3n///Xi33t7eqHihUBgeHo4SSAghmgkTT27p7e2NRp2Vy+XoaaVSCSFcunQp\nal6xWBwdHS2VSlGkqe3/iR5EBQHoBIIKwOEX5YENHSOPc+rUqRBCOp3OZDILCwtb7jM8PBxl\nm3Q6HXWhRJPyp6am8vl8Op0OIVy5ciWEMDs7G+05ODiYz+ejpJROp2/evBlCuH79eqgJQrlc\nLpfLVavVdDodJZbosCGEQqEwNjYWHRmATiCoABx+u++IqFarQ0NDlUolm82WSqUt94nCQ+or\nw8PDIYQPPvggenVDtom3T05ORhEokk6n8/n8NhP0c7lcJpOJJ89MTU2dP39+l2cBwCFwGCbT\nA7C9aGjW44JHrUqlEs2bv3nz5vYT6KPBXRuMjo729/cXi8VcLnfr1q0QwksvvRS+6tLZoDa3\nbCk6WlxWdwpAR9GjAnD4ReO4wledIduI5qjMzc3tmAq2PFQul8vn81evXo16WmZnZ+OxXiGE\n999/v65mR2WvX79+/fr1N954o66yABx0ggpARxgdHQ0hPO42xNF89yh7RHNLthH1z0Q9J9GW\nSqVSKBRCCIVC4dSpU3Nzc9G0+9q5+5sHer3//vvxLcIeZ2xsbHJycnJycmhoaPs9AThkBBWA\njpDL5WZnZ0ulUrwafSSajlIbTqIhW8ViMRoqVqlUagduFQqFeAJ9f39/NE2lt7c3mkAyNTU1\nPDycqpHNZqOCURXZbDY6WrFYrI0fj5u1H+0QTbUHoKMIKgCdIpfLlcvl06dPxwEjm83eunUr\nHugVDdwaHh7OZrO9vb35fL5UKt26dSudTkcxI5VKRYFkaGhowzoq0RGifptapVIp6mxJp9Px\nXYlTqdQ777wTT/GPJ+6nUqnNs1ny+fzFixdbdlUASKjUlrMhD5bvfe973/72t6N7XCbQo0eP\n7t+/H0I4ceJEKpXa7+Ykzvr6+t27d0MIzz33XBtWFj+I7t69u76+/tRTTx0/fny/25JE9+/f\nf/To0bFjx5599tlW13XlypV/+Zd/OaAr07dHoVA4f/587fyWSqVy/fr1eJ2WBmSz2Xg1FQA6\nhx4VAJqjWCy+//77m2fh76U/pFAomEYP0JkEFQCa44MPPpicnNwwAebWrVu1U+p3qVAoxIu0\nmEYP0JkEFQCaY2hoaHZ2Nro3cTQBplwuNxYzotVXotkvzW4mAAeDBR8BaJpcLtdA/8mWxzkE\nUygB2As9KgAAQOLoUeHAe/ijHzRQ6omf/LTpLQEAoFn0qAAAAIkjqAAAAIkjqAAAAIkjqAAA\nAIkjqAAAAIkjqAAAAInj9sQAB1JjN+bentt2A5AcelQAAIDEEVQAAIDEEVQAAIDEEVQAAIDE\nEVQAAIDEEVQAAIDEEVQA2JNUKlUsFver9kqlkkqlKpXKfjUAgBZpU1AZGRkZGBgYGRnZ8tX5\n+fmBgYHNO2xfCoB9l0ql9rH2SqXS29u7jw0AoHXaEVTGx8fPnj07PT199uzZ8fHxDa8uLy+/\n++6709PT09PTi4uL8Q7blwIgCarV6j7Wnk6ny+XyPjYAgNZpR1C5ffv2yy+/HEK4cOHC7du3\nl5eXa19dWlq6fPly9PjNN9/8zW9+s5tSAADAIdbV6grm5+f7+vp6enqip319fUtLS/HTEMKZ\nM2fixydPnnzxxRd3LPXZZ5/du3evtpZqtbq2ttbSE2nY+vp69GBtbW1/x0gkU3x91tfX2/lH\nTOwb5nHafH0OkOgX/fZ8COxv70FCZLPZUqkUQiiXy+l0Ot4efb6NjY0NDQ2FEAYHBycnJ6OX\n4usWl412iwZuzc7O9vf3f/Ob3/zwww/j/eMxXVEtGwrW1gjAYdXyoLK0tLR5S204qfXuu+++\n+uqrO5Z65513xsbG4pdOnDixsrLy8ccfN63RrfHJJ580VvD/WviPBkp9dPpbjVW3Xz799NPG\nCj7TUKnkv2E2ePDgwYMHD/a7FcnVng+BlZWVVleRcIODg2+88cbc3FyhUOjt7Y0TSH9/f7Va\nLRaL/f3958+fjzZGrxYKhehpNpsdHR3N5XJRCDly5MgPfvCDEMLVq1ejPaPt0VCudDo9Ozsb\nPdhQ8KWXXsrlctlsNgothUJheHi47VcCgJZL0F2/osFdj8swAOyvSqUyOTkZ5ZCoWyMOIVGo\nyOVymUzm1q1bIYTJycnBwcF4z0qlUiqV+vv7U6lU1FWyvr4eZZKbN29GB0mn0/l8/vr169HT\nd955JwonGwp+8MEHxWKxVCpFR45zEQCHTMt7VE6ePLnjlsjf/M3fXLt2bTelvvvd77700kvx\n07feequrq+u5555rQnNbYHV19fPPPw8hPPvss+0cqJDYC7JBtVq9f/9+COGpp57q6mrkDbne\nUL0H5fqEEO7fv1+tVp988sknnnhiv9uSRJ9//vnq6mpXV9dTTz3V6roae4seGhumrWcymc37\nnD59Onw1x723t3dycjKfz09MTESvbhg7t/mewhcvXuzv779y5Uq5XL548WK8fUPBQqGwZe0A\nHCbtCCqLi4vx08XFxS2Dyvj4+F/+5V/uslRPT0/tLJdUKnXkyJHu7u4mN71J4n9fu7u72xlU\nEntBNojnqHR1dTXW5ocN1XtQrk8IIZVKVavVo0ePHqA2t9ORI0ei/7bh+kR1dazaSSPRltrf\njCILCwtRwEin0/FUk1OnTkX9HsViMZfLbVNF1CcTdarE8WbLgtGUFQAOsZb/o9vT03Pu3LmZ\nmZkQwszMzLlz52ozRmRmZubVV1+Nts/Pz8/Pz++mFADtlE6nM5nM1atXw1dDuTaEh2hEVjRe\nK1oCMp1OR1MKo7L9/f3xnvGwsQ1GR0cnJyfj7pQtC0axJxpaBsBh1Y5hDJcvXx4ZGblx40Zf\nX188uCtaxvHatWvj4+O3b9+u3X96evpxpQDYR3Nzc6lUKuocjkeCjY2NxUGidnp99CAe+jU3\nN5fNZqOy0cbocTSBPu6liTpVaiPQ5oIhhOheYZOTk9EYsA0HAeAQSB2Cu21+73vf+/a3vx3P\nv0yaR48eRXMwTpw40djQr9Qv5hooVX0t20Cp9ltfX797924I4bnnnmtw6NePftBAqSd+8tMG\nSu2Lu3fvrq+vP/XUU8ePH9/vtiTR/fv3Hz16dOzYsWeffbbVdV25cuVf/uVf3nvvvVZXtBuN\nvfO3d4D+vwDg0Ovo8dYAAEAyCSoAAEDiCCoAAEDiCCoAAEDiCCoAAEDiCCoAAEDiCCoAAEDi\nCCoAAEDitGNlegCazuKMABxuggrAgZT6xVzTj1l9Ldv0YwJAYwz9AgAAEkdQAQAAEkdQAQAA\nEkdQAQAAEkdQAQAAEkdQAQAAEkdQAQAAEkdQAaB9KpVKKpWqVCohhGw2WygUmntMAA4NCz6y\nhcYWkrNUHLC9SqXS29ub/GMCkASCCgBtkk6ny+VynCvm5rb7TaRYLIYQcrlcXccE4NAw9AuA\nJLp69ep+NwGA/SSoALBbqVSqWCymUqlUKhVNL4nmh0Qbs9n/f/xnNput3Scum0ql4q6PuOCG\nIoODg9FLpVKpv7+/rmMCcJgIKgDsSiqVCiH09/dXq9XZ2dnh4eF//Md/jELC1atXq9VqNJQr\nm82Ojo5Wq9VyuTw8PBxFkWw2OzY2Vq1Wx8bGwqaJJXGR2dnZycnJEEK1Wg0hzM7O7v6YABwy\nHTpH5eGPftBAqSd+8tOmtwTgoKhWq6lUanZ2NoSQy+Uymcx//Md/RPNDbt68Ge1TqVSinpC4\n1AcffBBCKJVKUeQ4f/788PBwOp2Ojhb+51yUXC4XRZRauzxmC88cgP3QoUEFgNbZEDYKhUIm\nk3nczlHqaO4xATgEDP0CoEEvvfTSltvjmSexUqm0zUG2ebWxYwJwCAgqANQh6gApFoulUmnz\nvYPT6XQmk4mHaRWLxUKhcP78+RDC4ODglgeMDhK/WqlUNmSSBo4JwCEgqABQh+Hh4VQq1d/f\nXy6XQwjRnPje3t54Yfi5ublMJhPdj+udd94ZGhpKp9PRLPlUKnXp0qVo/9/5nd8JIfT391cq\nlWq1Gr0a7RBFl3w+H9/1a5fHtDg9wGFijgoAdZidna3tSNk89z1stZLjlrPka21+dWJiYmJi\nYi/HBOBA06MCAAAkjqACwK7E66hsntcOAE1n6BcAu2KcFQDtpEcFAABInMPQo7K+vr6ysvLJ\nJ5/svsjxhiqqq4pY/BvkvXv3Gqq2QY21dh9r/Oyzz6KBJfVq519zX6yvr4cQvvzyy4cPH+53\nW5JobW0thFDvh0BjVlZWWl0FABA5DEEllUodOXLkySefbHVFjVWxtrb24MGDEMITTzzR2Bfx\nxrThgjSlxmq1urq6GkI4duzY0aNHm92ox2r/9WnY559/Xq1Wu7q6uru797stSfTgwYO1tbX2\nfAgcOaIXGgDa5JAElaNHj9b1HaWx36Ub+xr06NGjKKg8+eSTgspm6+vrn3/+eQjh2LFjjX0R\nb+dfc1988cUXUVA5QG1up0ePHq2trdX7IdCYdmZpAOhwfh0EAAAS5zD0qAB0oOpr2f1uAgC0\nkB4VAAAgcQQVAAAgcQz9qk/qF3MNlPro9Lea3hIAADjE9KgAAACJI6gAAACJI6gAAACJI6gA\nAACJI6gAAACJI6gAAACJI6gAAACJI6gAAACJI6gAAACJI6gAAACJI6gAAACJI6gAAACJI6gA\nAACJI6gAAACJI6gAAACJI6gAAACJI6gAAACJI6gAAACJI6gAAACJI6gAAACJI6gAAACJI6gA\nAACJI6gAAACJI6gAAACJI6gAAACJI6gAAACJI6gAAACJI6gAAACJ06agMjIyMjAwMDIy8rgd\nlpeXBwYGlpeXazfOzMwMDAxsXxAAADh8utpQx/j4+NmzZ69duzYzMzM+Pn758uUNO8zPz7/1\n1lubC965c2d6eroNLQQAABKlHUHl9u3bExMTIYQLFy4MDAy8/vrrPT09tTucOXNmenp6YGCg\nduP8/Pz3v//9NjSvPZ65/r8fNVTwiZ/8tMlNaaWHP/pBA6WeCeHTK/+r6Y1pncZOMxy0vyYA\nwD5qeVCZn5/v6+uLk0lfX9/S0tKGoLKln/3sZ4uLiyGEzZ0qd+7cuXXrVvx0bW1tdXX1008/\n3X2rju1+1xp1VdEsDVfa/tZ++umnjV3YyBdffHHkSCNjEdv/12z4NBurtFqthhAePny4urra\naM2HWXRZ6v0Q2EtdAEAbtDyoLC0tbd5y5syZHQteu3YthDA+Pj4wMDAxMVGbbX7zm9/80z/9\nU/z0xIkT6+vrDx8+3H2rGvuiWVcVzdJwpe1v7cOHD/cSVFZWVhor2P6/ZsOnuZdKV1dXfUve\nRr0fAg3X0uoqAIBII0GlUqnUPi2Xy/39/dGPvk13+fLlF1544e23366d2dLT0/PKK6/ET//z\nP/8zlUp1d3e3ogG12lBFEyttf2v3WGNXV1cqlWpWY3Z0gP6aUYQ7evRoYz1Oh97q6mq1Wk2l\nUl1dLf/lpZ1vUQDocPX9u14sFvv7++sqcvLkyR23bO/ChQsb7vr13e9+97vf/W789Hvf+153\nd/dzzz23+2M29rtrXVU0S8OVtr+1zz333F5+0H7qqaca+x7f/r9mw6fZWKV3795dX19/8skn\njx8/3mjNh9n9+/cfPXrU3d397LPPtrqufcm3ANCZ6gsq/f39mUzm9OnTG7ZPTk4+rsjJkyej\nqSaRxcXFeoNKCOHFF1+stwgAAHBw1T1SYm5ubvPGhYWFx+3f09Nz7ty5mZmZCxcuzMzMnDt3\nbjcz6WuNj4+//vrr9bYTAAA4uOob8j42NrZhgkpkdHR0m1KXL1++c+fOwMDAnTt34qkmIyMj\n8YCuaLXHEMLg4OD8/Hy8JfLqq6/Wm20AAIADrb4elaGhoUKhMDQ0VLuxUqnsOJk+uoXX47b0\n9PRsuAfx5i0AAEDnqC+oRHe8GR4ebk1jAAAAQqg3qIyNjQ0PD+fz+dqNCwsLpVKpqa0CAAA6\nWn1B5fz581NTUxMTExu2Z7PZ5jWJDnVs7pcNlKq+5r0HAHAI1TeZPp1Ob3nXry03AgAANKaR\nha6LxWI2m81ms4ODg1veBAwAAGAv6l5HJZvNxjNSSqXS5ORkJpPRowIAADRRfT0qg4ODpVJp\ndna2WuP06dOFQqFF7QMAADpQfUFlcnJydnY2l8vVbpyYmJiammpqqwAAgI5W9xyVDSkl4vbE\nAABAE9UXVDKZzObZ84ODg5lMpnlNAgAAOl19k+lHR0d7e3vz+fzFixdDCB988EG0Sv3s7GxL\nWgcAAHSk+oJKLpebnZ3t7++fnJyMN26etQIAALAXdd+eOJfLVavVVjQFAAAg0siCjwAAAC21\nc4/K4OBgCGFiYiJ+vMHCwkKpVNLNAgAANMvOQWVhYaH2ae3sFAAAgFbYeejX3Nzc3Nxc9Pji\nxYuZTKb6P5XL5RY3EgAA6Cz1zVHJ5XJxaIml02njvgAAgCaqL6ikUqnNG4vFYqFQaFJ7AAAA\nmnHXr97e3mjZRwAAgKbYVVAZHBxMpVJRd0pqk97e3kwm0+J2AgAAHWRXCz5OTExMTExks9lS\nqZTP5ze8eurUqfPnz7egbQAAQIeqY2X6ubm5bDYbLagCAADQOvXNUdl8yy8AAICmq6NHJYRQ\nqVQ2b7x06dLo6Ggul2tSkwAAgE5XX1Dp7e3dcvvVq1cFFQAAoFnqCyohhEwmc/r06dotCwsL\nG7YAAADsRX1BJZPJbJ6mUiwWH9fTAgAA0IAmTKbP5XKXLl1qUnsAAACasTJ9oVAolUp7Pw4A\nAECkvqFf0eL0m21eBRIAAKBhTZhMf/HiRbf8AgAAmqgJk+n3XbVaXV9ff/jwYasrakMVTay0\n/a11fVpUabVaDSGsrq7uS5uTb319PfpvG65PVBcA0Ab1BZUEppQQQrVaXVtb++KLL3Zf5GsN\nVVRXFc3ScKXtb+0XX3zR2IXdl0r3cn0aPs3GKo2CysrKyurqaqM1H2ZReKj3Q6Axa2trra4C\nAIjUPfSrUqlcv359YWEhepqENemPHDnS3d39jW98Y/dFGvvdta4qmqXhStvf2m984xvt/8G/\n4Ur3cn0aPs3GKr179+76+vrx48ePHz/eaM2H2f379x89etTd3f3ss8+2uq7u7u5WVwEAROq7\n61e0ZMrk5GS8pb+/f3BwsNmtAgAAOlp9QeXq1auZTKZcLs99pVwuLywsFAqFFrUPAADoQPUF\nlVKpdPPmzXQ6HW9Jp9Nzc3NTU1PNbhgAANC56gsq+Xy+NqXELPgIAAA0UX2T6ScmJgYHBycm\nJmo3FgqFTCbT1FbRHA9/9IMGSj3xk582vSUAAFCXnYPK5tXoayfTR2ZnZ5vWIgAAoOPtHFTG\nxsaGh4fz+fzjdjh16tS+36EYAAA4THYOKufPn5+amtow3AsAAKB1dp5MH93Xqw1NAQAAiOzc\noxKt5xj1qGy5tuPCwkKpVKpWq01vHAAA0Jl2DioLCwu1TzfPpAcAAGiunYd+RSvQR48vXryY\nyWSq/1O5XG5xIwEAgM5S34KPuVxu83yVdDpt3BcAANBE9QWVVCq1eVkVAACA5qovqGQymS0H\nehWLxSa1BwAAoM6gMjc3Vy6XK5VK7cZKpXL16tWmtgoAAOhoO9/1q5ZxXwAAQBvUF1TGxsaG\nh4fz+Xztxmgdlaa2CgAA6Gj1BZXz589PTU1Fiz/WymazzWsSAADQ6eoLKr29vZvvRFwsFt94\n443mNQkAAOh09U2m31Jvb+/w8PDejwMAABDZVVAZHByMV1BJbdLb25vJZFrcTgAAoIPsaujX\nxMTExMRENpstlUobZtKHEE6dOnX+/PkWtA0AAOhQdcxRmZuby2azm2fSAwAANFd9c1Ru3rxZ\nqVTiBR8LhUI2my0UCi1oGAAA0LnqCyq3bt3q7e29fv16CKGOWlTCAAAbFklEQVRQKERz6Kem\npgYHB1vSOgAAoCPVd3viEEK5XE6n05VKZXh4OJPJzM3NhRBSqZQhYQAAQLPU16MyPDycTqdD\nCLdu3QohjI6OtqRRAABAZ6svqGQymWKxGHen5HK5EEKhUJidnW1N8wAAgE5U92T6q1evRgun\n3Lx5M4SQzWaHh4ffeeed1jQPAADoRPXNUUmn09GklNiGpwAAAHtXX48KAABAG+zcoxLdeji6\nqdeWtyFeWFgolUrVarXpjQMAADrTzkFlYWGh9unk5GQD1YyMjCwuLvb19V27dm3LHZaXlwcH\nBycmJnp6enZfCgAAOJR2Hvo1NzcXT0S5ePFiJpOp/k/lcnn7I4yPj589e3Z6evrs2bPj4+Ob\nd5ifn9/cV7NjKQAA4LCqb45KLpfbPHs+nU5vP+7r9u3bL7/8cgjhwoULt2/fXl5e3rDDmTNn\npqen6y0FAAAcVnWvTL9ZpVKJVoHc0vz8fF9fXzygq6+vb2lpqXZ8VwOl7t69+9///d/xzlHH\nzurq6p5OYxfaUEUTKz1ABfeiQ1obQlhfX9+XNidf9ENJez4ETMYDgLZpQlC5dOnS6OhotPjj\nZktLS5u3nDlzZvtjbl9qdnZ2bGwsfunEiRMrKyuffPLJ7tv8zO53rVFXFc3ScKWffPJJm0+z\n4Rr3ov2nGRp9/+yx0gcPHjx48KDh4odevR8CDdfS6ioAgMjOQ79SOymVShZ8BAAAmmjnHpWx\nsbHh4eF8Ph89nZyczGQyp0+fjnfYcFuwDU6ePLnjlnpL9ff31/bJ/PCHP+zu7v7617++42Fj\na7vftUZdVTRLw5V+/etfb/NpNlzjXrT/NEOj75+GK71///76+vrx48efeOKJRms+zD7//POV\nlZXu7u6nnnqq1XV1d3e3ugoAILJzUDl//vzU1FS8jsrs7OyGUV6VSuXWrVuPK37y5MnFxcX4\n6eLi4i6Dyjalnn/++eeffz5+GnXsdHXVMYytsS+adVXRLA1X2tXV1ebTbLjGvdjLaaZ+sfHO\nELtRfS3b8Gnu5S105MiRfXkHJl8qlYr+24brE9UFALTBzkO/0ul0fKevycnJzXNR0un08PDw\n44r39PScO3duZmYmhDAzM3Pu3LkdZ9I3XAoAADgc6rs9cSaTKRaLGzYWCoXtS12+fPnOnTsD\nAwN37ty5fPlytHFkZGRkZCR6vLy8PDAwEEIYHBycn5/fphQAANAJ6hspMTo62t/fn8/nr1y5\nEkIol8tXr14tlUq19+Da0ual5Wu39PT0bF5HZctSAABAJ6gvqORyuXK5fOnSpd7e3nhjPp8f\nGhpqdsMAAIDOVffc09opKwAAAK1Q3xwVAACANhBUAACAxBFUAACAxBFUAACAxBFUAACAxBFU\nAACAxKkvqKRSqR3XoQcAANijuntUpqamUqnU4OBgpVJpRYMAAADqCyqzs7Nzc3PVavXUqVO9\nvb3ZbLZYLLaoZQAAQMeqL6jkcrnowdDQULVavXnzZn9/vw4WAACguRqfTF8sFi9duhRCyGQy\np06dunTpUjabFVcAAIC9q3syfQihUCikUqn+/v4QQrlcnpubGxoampube+ONN3p7ew0GAwAA\n9qjuHpVUKjU8PJzP56OIkk6n45eGhoZCCFevXm1mAwEAgM7TVW+BTCZz8+bN2nyyQalU2luT\nAACATld3j8qGXpQNxsbGyuXy3poEAAB0uvp6VKrVaghh84z569evT0xMhK9GfwEAAOxFfUGl\nWCxGc+g3i4IKAADA3tUXVK5evZrJZE6fPj05OZnP5+PtV65caXbDAACAzlVfUCmVStHorxDC\nxYsXo/UfK5VKuVzeZuIKAABAXRpc8PHKlSvxbYjT6bRbEgMAAE1UX1DJ5/PZbLZQKKTT6dOn\nT2ez2WKxODg46JbEAABAE9UXVKIZ81NTU/Hj/v7+ycnJsbGxVjQOAADoTHUv+Dg3N7flYwAA\ngGZpcI4KAABA6+zcozI4OLj9DgsLC7V3AwMAANijXQ39mpycbHU7AAAAYjsP/bp48WImk6k+\nXrlcbkNDAQCAzrFzUMnlcttPmk+n08Z9AQAATVT3ZPpKpZLNZrPZbPQ0Wlal2a0CAAA6Wn23\nJy4Wi/39/bVb5ubmUqlUCGFoaKiZ7QIAADpYfT0qV69ezefzmwd6RUtAAgAANEV9PSqlUmnL\n+SqlUqlJ7WnE+vr6ysrKxx9/vPsiX2uoorqqaJaGK/3444/bfJoN17gXB+s0G6t0fX09hPDg\nwYMvv/yy0ZoPs+j61Psh0JiVlZVWVwEAROoLKplMplKppNPpeEuxWIy2N7ld9UilUkePHv3a\n11r+JbkNVTSx0gNUcC8O1mk2Vvazzz6rVqvd3d3Hjh1ruOpD7MGDB6urq0ePHj1+/Hir6zp6\n9GirqwAAIvUFldHR0evXr09MTERP4ykrb7zxRvObtmupVOrIkSNPPPHE7os8bKiiuqpoloYr\nfeKJJ9p8mg3XuBcH6zQbq/Tzzz+vVqtdXV378g5MvocPH4YQ6v0QaMyRI3XfgAQAaEx9QSWX\ny4UQotnz0X9DCGNjY2bSAwAATVRfUAkh5HI5q6YAAAAt1YRhDJVKZe8HAQAAiDUhqFy6dCma\nUg8AANAUOweV1E5KpdI777zThrYCAAAdYuc5KmNjY8PDw/l8Pno6OTmZyWROnz4d77CwsNCq\n1gEAAB1p56By/vz5qamp6JbEg4ODs7Oz0b2/YpVK5datW61qIAAA0Hl2HvqVTqfj1egnJyc3\npJRoh+Hh4eY3DQAA6FT1TabPZDKb580XCoXmtQcAAKDOoDI6Otrf3z84OFipVCqVSrFYzGaz\nw8PDY2NjLWofAADQgepemb5cLl+6dKm3tzfemM/nrUwPAAA0Ud0r09dOWQEAAGiFJiz4CAAA\n0FyCCgAAkDiCCgAAkDiCCgAAkDiCCgAAkDiCCgAAkDiCCgAAkDiCCgAAkDiCCgAAkDh1r0wP\n7EXqF3MNlPro9Lea3hIAgCTTowIAACSOoAIAACSOoAIAACSOoAIAACSOoAIAACSOoAIAACSO\noAIAACSOoAIAACSOoAIAACSOoAIAACROV3uqGRkZWVxc7Ovru3bt2u53mJmZuXHjRghhm4IA\nAMDh044elfHx8bNnz05PT589e3Z8fHz3O9y5c2d6enp6elpKAQCAjtKOoHL79u2XX345hHDh\nwoXbt28vLy/vZof5+fnvf//7bWgeAACQNC0f+jU/P9/X19fT0xM97evrW1paip9us8PPfvaz\nxcXFEML09HSrGwkAACRKy4PK0tLS5i1nzpzZcYdouNf4+PjAwMDExERttvn5z3/+D//wD/HT\n1dXVlZWVe/fu7b5VT+5+1xp1VdEsDVd67969Np9mwzXuxcE6zb28hb788stHjx41XPwQW11d\nDSHU+yHQmJWVlVZXAQBE2jSZvmGXL19+4YUX3n777cuXL8cbl5eXf/nLX8ZPT5w4Ua1W6/oC\n0dgXzX35jtJwpSsrK20+zYZr3IuDdZp7eQutra2tra01XPzQq/dDoOFaWl0FABBpeVA5efLk\n9lt23OHChQsjIyO1W3p7e19//fX46b/9278dOXLkySdb/iW5DVU0sdIDVHAvDtZp7qVsd3f3\n0aNHGy5+iD169Gh9ff3IkSPHjh1rdV1HjrilOwC0STuCSjTVJLK4uLg5qGy/QwjhxRdfrH36\nne985zvf+U789Hvf+15XV9fTTz+9+1Y93P2uNeqqolkarvTpp59u82k2XONeHKzT3Mtb6Nix\nY8ePH2+4+CF2//79R48e1fsh0JiurqT3QgPAodHyXwd7enrOnTs3MzMTQpiZmTl37lztbJPd\n7DA+Pl7bfwIAABx67RjGcPny5Tt37gwMDNy5cyeeajIyMhIP6Nq8w/Ly8sBXXn311Q3RBQAA\nONzaNIxh84qNG7ZseNrT0+OuxAAA0LFMDAUAABJHUAEAABJHUAEAABJHUAEAABJHUAEAABJH\nUAEAABJHUAEAABJHUAEAABJHUAEAABJHUAEAABJHUAEAABJHUAEAABJHUAEAABJHUAEAABJH\nUAEAABJHUAEAABJHUAEAABJHUAEAABJHUAEAABJHUAEAABJHUAEAABKna78bALRW6hdzDZSq\nvpZteksAAHZPjwoAAJA4ggoAAJA4ggoAAJA45qgAW3v4ox80VvCJn/y0uS0BADqQHhUAACBx\nBBUAACBxBBUAACBxBBUAACBxBBUAACBxBBUAACBxBBUAACBxDsM6KtVqdW1t7csvv9x9kVRD\nFdVVRbM0XOmXX37Z5tNsuMa9OFinuZe30Orqajvfgft1mg1YW1uL/tuGeqO6AIA2OCRBZX19\n/eHDh7sv8mRDFdVVRbM0XOnDhw/bfJoN17gXB+s09/IWWl1dXV9fb7h4vfbrNBsQXZZ6PwT2\nUhcA0AaHIagcOXKku7v7ueee232Rxr7O1FVFszRc6XPPPdfm02y4xr04WKe5l7fQk08+efz4\n8YaL12u/TrMB9+/ff/ToUXd397PPPtvqurq7u1tdBQAQMUcFAABIHEEFAABIHEEFAABIHEEF\nAABIHEEFAABIHEEFAABIHEEFAABIHEEFAABIHEEFAABIHEEFAABIHEEFAABInK79bgBw2KR+\nMddYwepr2ea2BAA4uPSoAAAAiSOoAAAAiSOoAAAAiSOoAAAAiSOoAAAAiSOoAAAAiSOoAAAA\niSOoAAAAiSOoAAAAiSOoAAAAiSOoAAAAiSOoAAAAiSOoAAAAidO13w0AaILn/s//20Cp6mvZ\nprcEAGgKPSoAAEDiCCoAAEDiCCoAAEDiCCoAAEDiCCoAAEDiCCoAAEDiCCoAAEDitCmojIyM\nDAwMjIyM1LXDjqUAAIBDqR1BZXx8/OzZs9PT02fPnh0fH9/lDjuWAgAADqt2BJXbt2+//PLL\nIYQLFy7cvn17eXl5NzvsWAoAADisulpdwfz8fF9fX09PT/S0r69vaWkpfvq4HZaWlrYptby8\n/F//9V/xEarV6vr6+srKSqvPpQ1VNLHSA1RwLw7Wae6l7NraWjuv8AH6a66vr7etxr3UBQDU\npeVBZWlpafOWM2fObL/DlseJS/385z8fGxuLXzpx4sTq6uq9e/d236pndr9rjbqqaJaGK713\n716bT7PhGvfiYJ3mXt5C3f/P/93Ad+RPr/yvxqrbt7/m9f9db6njezvNuvZfXV1trCIAoF4t\nDyrJ1PDXmo9Of6vNNe5LpU6zRTXuS6X7UGNjxfZYaaOnCQAkU8uDysmTJ7ffsuMOmze+8cYb\nAwMD8dM//dM/PXbs2IkTJ/ba1tZ49OjRp59+GkJ4/vnnU6nUfjcncdbX1z/++OMQwrPPPtvd\n3b3fzUmijz/+eH19/Wtf+9rx48f3uy1J9Omnnz569OjYsWPPPNPyTqBjx461ugoAINKOoLK4\nuBg/XVxc3BxUttxhm1LHjh2r/boQfftPbAaIG5ZKpRLbyH3k+uyS67Mj1wcADpOW3/Wrp6fn\n3LlzMzMzIYSZmZlz587VzqR/3A47lgIAAA6xdtye+PLly3fu3BkYGLhz587ly5ejjSMjI/FK\njlvusOVGAACgE7RpMv21a9e237J5h8dtBAAADr129KgAAADURVABAAASR1ABAAASR1ABAAAS\nR1ABAAASR1ABAAASR1ABAAASR1ABAAASR1ABAAASp00r07far371qz//8z/f71ZsbX19fW1t\nLYTQ3d29321Jomq1urq6GkLo6upKpVL73ZwkWllZCSEcPXr0yBG/LGxhdXW1Wq2mUqmurpZ/\noFUqlVZXAQBEDklQuXv37i9/+cv9bgUAANAchyGo/OEf/uHdu3f3uxWP9eGHH/76178OIbz2\n2mtt+MX3wHn48OGdO3dCCL//+7///PPP73dzkujOnTsPHz5Mp9O/+7u/u99tSaJf/epXH330\n0Te/+c3f+73fa0N1x44da0MtAECqWq3udxsOuX/+538eGRkJIfzrv/7r1772tf1uTuJ8+OGH\n/f39IYS/+7u/+4M/+IP9bk4S5XK5jz766C/+4i/+7M/+bL/bkkQ//OEPf/GLX/zxH//xtWvX\n9rstAEDTGPIOAAAkjqACAAAkjqFfLRfPUfmjP/qjo0eP7ndzEscclR2Zo7K9X//61x9++GHb\n5qgAAO0hqAAAAIlj6BcAAJA4ggoAAJA4ggoAAJA4ggoAAJA4FkoHDpv5+fm33norejw9Pb2/\njQEAGqNHpd3Gx8f3uwkcbN5C21teXn733Xenp6enp6fPnTs3MDDgigHAQSSotNXAwMDt27f3\nuxUJNT8/P/CV/W5LcnkL7WhpaemFF16IHl++fPmv//qvb9++LasAwIEjqLTPwMBAX1+fgShb\n8iv4bngL7VK0hGjkzJkzUVaZmZnZxyYBAPU6+uMf/3i/29ARlpeXV1ZW/uqv/mq/G5JQH3zw\nwZEjR771rW+FEF555ZWXXnrp7//+7+/evfvKK6/sd9OSwltol06ePPm3f/u3tW+ekydPPv30\n0zdu3HjttdeeeeaZ/W0eALBLJtO3SU9PzwsvvLC8vDw4OBhv7Ovru3bt2j62KlHu3Llz4cKF\n6HH0K/hbb731wgsvxBs7nLfQ7r355ps3btyoffNcuHDht7/97XvvveftBAAHhaFf7fPyyy9H\nXzEnJiaiMU7BxOivnDlzZnFxsfZqnDlzJvq6uby8vI8NSxRvoV26cOHCuXPnbty4UTvc6/XX\nX9/HJgEA9TL0q32eeeaZp59++sc//nE8+ORP/uRP/v3f/93opsjTTz89NTX19NNPRwPAQgjf\n+ta37t69+/nnn8dbOpy30O698sord+/enZqaiseAffbZZyGEkydP7nfTAIBdSVWr1f1uQ0eb\nn58/efJkT0/PfjckEcbHx2/fvv3mm2/G43OWl5cN19leJ7+FdlwvpXaknGFyAHCwmKOyz5aW\nls6cObPfrdgH4+Pjly9f3rAx2nLjxo3f/va38aud+RP4wMDAxMTEbuJHx76F4jvFhRDGx8cH\nBgbOnTu34U3V09PjJmkAcEDpUWmy+Bfczd+ZNosG0Hdgd0G0UsrjvkH6FTy6DfGLL77oLbSN\n+fn5paWl+Nyj3pX4/7tOvjIAcDiYTN9M8/Pz8Tfs7ddtWF5eHhgY+O1vf9uBX6R2XAwk+hU8\n0pkp5dy5c9GJb3MjgU5+C8W2WS/lxo0bta8CAAeOHpVmGh8ff/XVV6NxOFG3gGEnGywvL7/9\n9ts7dhR0rNrxS67VjjYP95qZmblx48YuR80BAEmmR6WZfvOb38SzBXp6et588835+fnaHWZm\nZjp8eex4MZCBGiMjI/EOnXyJlpeX+/r64q/d0VftDZ0qnXx9NvzfFEJ48803N3RdRjcmfu+9\n99rbNACg+QSVZvr+979f+/Tll1/esIPhKGGnxUA6+RL19PRseAu9/vrrb7/9du2WTr4+7777\nbjS7KWa9FAA4xAz9arL5+fnaWzDNzMxEUwhmZmZefvllw1Ei8WWJbXkTMEII4+Pjr7/+undO\nCGF+fv5nP/vZ4uLihhGV0V2ta4fMdeyd0ADgMBFUWiv6Rh7NV6ldHoQNOnkxkO2ZqRKJfwIY\nGRnZnFXcKQ4ADh9BpbWi799Syo4297EQ06mywZZZBQA4ZMxRaa2lpSUpZUcdOzt8lzbPVOlw\n165d6+vr2zBfBQA4ZPSotNbAwICUso1oxM5uFseEDfSrAMDhJqi0lhFN0DpRVgkhiCsAcPgI\nKsBBtby8/N577/ktAAAOJXNUgIPq7bffllIA4LDSowIAACSOHhUAACBxBBUAACBxBBUAACBx\nBBUAACBxBBUAACBxBBWao1gsZrPZQqEQPR0cHEylUpt3SKVSqVSqWCxuuSWxNp9OAzZcIgAA\ntiGo0ASFQqG/v79UKj1uh2Kx2N/ff/PmzWq1ms/nr169unlLOxvcfjteIgAAallHheaoVCq9\nvb1jY2NDQ0ObXx0cHFxYWJibm9tmy6G3/SUCAKCWHhXaYWFhYcctAAAQE1RoXKVSiSaZZLPZ\nDS8Vi8VoUkf0oFQqlUqleDrKhi1RkUKhED3NZrOVSiU6fjw5JJvNxrVsv2f0YEOT4qbWlnrc\n0TaLT2fHinZ/iTY0KdqY+kq8Jd6n9ung4GDUkm2qBgA42KrQkHK5HEIYGxuLHmcymfjp7Ozs\nhndXJpPJZDK1xTdsGRsby+fz8WGjstExQwizs7PRMXfcM25PCCHaLX46OzsbP46r3vJoG9Se\nzvYV7f4SVavVuGDtQaLdNlyrEEK5XK5Wq/l8Pi6ez+cfVy8AwCEgqNCgDV+Uo2/ztV+j6woq\ntTuPjY3FuWLDcXa/ZyaTiZuXyWTihm3Y83FH23yy8Z7bVLS51DaXqPZx7dWIdoubMTY2Vluk\ntnmCCgBwiBn6RSMqlcrk5OTFixfjLb29vQ0fLbo3cTzqaXh4OITwwQcf7GXP2qaWSqWXXnop\n3jIxMVGtVhs72u7teImq1erQ0FA0AKz2bmC5XC6TycS3QZuamjp//nz0OJPJ9Pf3R+O+ohNp\nSlMBABKoa78bwIEUD5Rqouqub0C3+z3bf7TYjpeoUqlcunQphHDz5s3oQWx0dLS/vz+eMJNO\np6MHc3Nzg4ODk5OTk5OTmUzm5s2b8UsAAIeMHhUa16zOh8ju13xsYHXId955p4lH271tLlFv\nb+/p06fn5uY2h41cLhdCuH79+vXr1994443alyYmJsrlcj6fL5VKe+nFAgBIOEGFRkTfpKem\npppytOgLd39/f5wZKpXKliu4737PWDqdzmQyk5OTtbsVi8VisdjA0XZv+0sU1XjlypXHFR8b\nG4t6TmoXXYlu85VOpycmJqKpLI+7TRkAwIG3rzNkOMCiqefxfO5oinm8JbrDVfRSPAgqunXV\nlluio9WKXqo9Tl17hppbe8W37dr8zn/c0TaoPfg2Fe3+EtVOrI8eZzKZcrlcW3vYdD+x2on7\n8W3QAAAOJV90aFz8LT/6kh1/8463x9/IY1tu2fJo1Zp7AW/ID9vvWa2Zc1KbVeJ94lKPO9rj\nTjOfz+9Y0S4vUfWr3BJtjx7X3pos2mHDLcjGxsbi2xw/rrUAAIdDqtqamcTAHmWz2bm5uf1u\nBQDA/jBHBZKoUChsmEYPANBR3J4YEqRQKETLuYSW3TcZAOBA0KMCCRItTBlPaAEA6FjmqAAA\nAImjRwUAAEgcQQUAAEgcQQUAAEgcQQUAAEgcQQUAAEgcQQUAAEgcQQUAAEgcQQUAAEgcQQUA\nAEgcQQUAAEic/w+unQmtJW2HngAAAABJRU5ErkJggg==" }, "metadata": {}, "output_type": "display_data" } ], "source": [ "options(repr.plot.width=9,repr.plot.height=7.5)\n", "xmax = max(dfMLE$day)\n", "\n", "dfMLE %>%\n", " select(one_of(\"day\",\"lambda_i\",\"i\")) %>%\n", " rename(pred=lambda_i,obs=i) %>%\n", " gather(Category,Count,-day) %>%\n", " mutate(Category=factor(Category,levels=c(\"pred\",\"obs\") %>% rev)) %>%\n", " ggplot(aes(x=day)) +\n", " geom_bar(aes(y=Count,fill=Category),stat=\"identity\",position=position_dodge(1)) +\n", " coord_cartesian(xlim=c(0,xmax)) +\n", " guides(fill=F) +\n", " labs(y=\"incidence by onset of symptoms\",x=\"days since index case\") +\n", " theme(axis.text.x = element_text(angle = 45, hjust = .5, vjust=0.5),\n", " strip.text.x = element_blank(),\n", " panel.grid.minor.x = element_blank(),\n", " strip.background = element_rect(colour=\"white\", fill=\"white\"),\n", " legend.position=c(.2,.87),\n", " plot.margin = unit(c(.5,1,.5,.5),\"lines\"),\n", " legend.direction=\"horizontal\") -> plt_onset\n", "\n", "dfMLE %>%\n", " select(one_of(\"day\",\"lambda_c\",\"c\")) %>%\n", " rename(pred=lambda_c,obs=c) %>%\n", " gather(Category,Count,-day) %>%\n", " mutate(Category=factor(Category,levels=c(\"pred\",\"obs\") %>% rev)) %>%\n", " ggplot(aes(x=day)) +\n", " geom_bar(aes(y=Count,fill=Category),stat=\"identity\",position=position_dodge(1)) +\n", " coord_cartesian(xlim=c(0,xmax)) +\n", " guides(fill=F) +\n", " labs(y=\"incidence by day of confirmation\",x=\"days since index case\") +\n", " theme(axis.text.x = element_text(angle = 45, hjust = .5, vjust=0.5),\n", " strip.text.x = element_blank(),\n", " panel.grid.minor.x = element_blank(),\n", " strip.background = element_rect(colour=\"white\", fill=\"white\"),\n", " legend.position=c(.2,.87),\n", " plot.margin = unit(c(.5,1,.5,.5),\"lines\"),\n", " legend.direction=\"horizontal\") -> plt_confirmation\n", "\n", "getDelay(parsH[1:2]) %>%\n", " select(delta,ht,freq) %>%\n", " rename(predicted=ht,observed=freq) %>%\n", " gather(Category,Count,-delta) %>%\n", " mutate(Category=factor(Category,levels=c(\"predicted\",\"observed\") %>% rev)) %>%\n", " ggplot(aes(x=delta)) +\n", " geom_bar(aes(y=Count,fill=Category),stat=\"identity\",position=position_dodge(1)) +\n", " guides(fill=guide_legend(title.hjust = 0.5)) +\n", " labs(y=\"delay distribution\",x=\"difference in days\") +\n", " theme(axis.text.x = element_text(angle = 45, hjust = .5, vjust=0.5),\n", " strip.text.x = element_blank(),\n", " panel.grid.minor.x = element_blank(),\n", " strip.background = element_rect(colour=\"white\", fill=\"white\"),\n", " legend.position=c(1.25,.9),\n", " plot.margin = unit(c(.5,4,.5,.5),\"lines\")\n", " ) -> plt_delay\n", "\n", "grid.arrange(ggplotGrob(plt_onset), ggplotGrob(plt_confirmation), ggplotGrob(plt_delay),\n", " widths=c(1,1), heights=c(1,1), nrow=2, ncol=2)" ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "## Creating cluster to fasten the calculations" ] }, { "cell_type": "code", "execution_count": 154, "metadata": {}, "outputs": [], "source": [ "number_of_cores = parallel::detectCores()-2\n", "clusters = parallel::makeCluster(number_of_cores)\n", "registerDoParallel(clusters)" ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "## Generating a table with varied number of generations\n", "\n", "## Two generations" ] }, { "cell_type": "code", "execution_count": 124, "metadata": {}, "outputs": [], "source": [ "# File names to save the output\n", "\n", "final_pars_output = \"final_pars_varied_delay.csv\"\n", "\n", "recalc = TRUE" ] }, { "cell_type": "code", "execution_count": 163, "metadata": { "scrolled": false }, "outputs": [ { "name": "stderr", "output_type": "stream", "text": [ "Apr01\n" ] }, { "name": "stdout", "output_type": "stream", "text": [ " tau tauDate mean_h1 var_h1 mean_h2\n", "1 11 Mar28 4.39259735948419 2.1573918436451 15.8623046549225\n", " var_h2 par1_h1 par2_h1 par1_h2\n", "1 576.186086227435 3.29199326912327 4.89750001774415 0.679603523936439\n", " par2_h2 K loglk AIC\n", "1 12.1720171735286 25.72152052601 -34.6842372465291 81.3684744930581\n", " rmse_i rmse_c\n", "1 1.04623354350151 1.32605473134763\n" ] }, { "name": "stderr", "output_type": "stream", "text": [ "Apr09\n" ] }, { "name": "stdout", "output_type": "stream", "text": [ " tau tauDate mean_h1 var_h1 mean_h2\n", "1 11 Mar28 4.85766878835482 3.61421647857598 3.52585377719005\n", " var_h2 par1_h1 par2_h1 par1_h2\n", "1 3.48953241101394 2.76215359454369 5.45805833210042 1.97031284962405\n", " par2_h2 K loglk AIC\n", "1 3.97730112858787 35.0355894909167 -98.6048729840624 209.209745968125\n", " rmse_i rmse_c\n", "1 1.06574704315339 1.26202022031967\n" ] }, { "name": "stderr", "output_type": "stream", "text": [ "Apr17\n" ] }, { "name": "stdout", "output_type": "stream", "text": [ " tau tauDate mean_h1 var_h1 mean_h2\n", "1 25 Apr11 4.0645351783915 3.13907417912528 3.54203644187095\n", " var_h2 par1_h1 par2_h1 par1_h2\n", "1 2.02089257041855 2.44883301886211 4.58316416628174 2.68552768972435\n", " par2_h2 K loglk AIC\n", "1 3.98374943081259 63.0113376190142 -272.559218476185 557.11843695237\n", " rmse_i rmse_c\n", "1 2.80790871197967 2.68773705631973\n" ] }, { "name": "stderr", "output_type": "stream", "text": [ "Apr25\n" ] }, { "name": "stdout", "output_type": "stream", "text": [ " tau tauDate mean_h1 var_h1 mean_h2\n", "1 25 Apr11 4.08190758477988 3.22332772738053 3.78401093089457\n", " var_h2 par1_h1 par2_h1 par1_h2\n", "1 2.39989419027517 2.42440073070502 4.60371482839008 2.62660606798618\n", " par2_h2 K loglk AIC\n", "1 4.25894786937791 80.00001759699 -482.529254218088 977.058508436175\n", " rmse_i rmse_c\n", "1 3.30768368190519 3.11273607132457\n" ] }, { "name": "stderr", "output_type": "stream", "text": [ "Done\n" ] } ], "source": [ "if (recalc) {\n", " final_pars = NULL\n", "\n", " # initial parameter values used in optim function\n", " pars = c(5,4,5,4)\n", " options(warn=-1)\n", " for (current_epicurve in unique(df$epicurve)[1:4]) { \n", " message(current_epicurve)\n", "\n", " df %>% \n", " filter(epicurve==current_epicurve) %>% \n", " select(-epicurve) -> df_current\n", "\n", " Df = data.frame(day=0:(unclass(as.Date('2018'%&%current_epicurve,\"%Y%b%d\"))-unclass(dayZero)))\n", "\n", " df_current %>% \n", " filter(day_onset>0) %>% #removing index case\n", " group_by(day_onset) %>%\n", " count %>%\n", " rename(day=day_onset) %>%\n", " right_join(Df,by=\"day\") %>%\n", " mutate(n=ifelse(is.na(n),0,n)) %>%\n", " rename(i=n) -> Df\n", "\n", " df_current %>%\n", " filter(day_onset>0) %>% #removing index case\n", " group_by(day_confirmation) %>%\n", " count %>%\n", " rename(day=day_confirmation) %>%\n", " right_join(Df,by=\"day\") %>%\n", " mutate(n=ifelse(is.na(n),0,n)) %>%\n", " rename(c=n) %>%\n", " select(day,i,c) %>%\n", " arrange(day) -> Df\n", "\n", " Df %>% mutate(date=day+dayZero) %>%\n", " select(date,day) %>% rename(onset=date) %>% right_join(df_current,by=\"onset\") -> df_current\n", "\n", " foreach(\n", " tau0=1:max(Df$day), \n", " .packages=c(\"dplyr\",\"tidyr\",\"magrittr\"),\n", " .inorder=FALSE,\n", " .combine=rbind\n", " ) %dopar% {\n", " # we require that there would be at least two cases present in each subgroup day=tau0\n", " # to estimate the delay function\n", " if (nrow(df_current[df_current$day1 & nrow(df_current[df_current$day>=tau0,])>1) {\n", " tryCatch({\n", " sol = optim(pars,\n", " function(x) calculate_generations(length(pars)-2,x,tau0,FALSE),\n", " method=\"L-BFGS-B\",\n", " control=list(fnscale=-1),lower=rep(0,length(pars)))\n", "\n", " }, error=function(cond){print(cond)})\n", " data.frame(tau=tau0,loglk=sol$value) \n", " }\n", " } -> output\n", " \n", " tauOptim = output[output$loglk==min(output$loglk),]$tau\n", " solMLE = optim(pars,\n", " function(x) calculate_generations(length(pars)-2,x,tauOptim,FALSE),\n", " method=\"L-BFGS-B\",\n", " control=list(fnscale=-1),lower=rep(0,length(pars))) \n", "\n", " # Weibull distribution mean and variance\n", " pars_h = NULL\n", " for (j in c(1,0)) {\n", " parsH = solMLE$par[(length(pars)-1):length(pars)-2*j]\n", " pars_h = c(pars_h,parsH[2]*gamma(1+1/parsH[1]),parsH[2]^2*(gamma(1+2/parsH[1])-(gamma(1+1/parsH[1]))^2))\n", " }\n", "\n", " # Maximum likelihood estimates (MLE)\n", " calculate_generations(length(pars)-2,solMLE$par,tauOptim,prediction=TRUE) %>% \n", " rename(`MLE_i`=`lambda_i`,`MLE_c`=`lambda_c`) -> dfMLE\n", "\n", " # RMSE\n", " calculate_generations(length(pars)-2,solMLE$par,tauOptim,prediction=TRUE) %>%\n", " na.omit %>%\n", " mutate(epsilon_i = (lambda_i-i), epsilon_c = (lambda_c-c)) %>%\n", " summarize(rmse_i = sqrt(sum(epsilon_i^2)/n()),rmse_c = sqrt(sum(epsilon_c^2)/n())) %>% as.numeric -> rmse\n", "\n", " npars = length(pars)\n", " output = data.frame(t(c(tauOptim,format(tauOptim+dayZero,\"%b%d\"),pars_h,solMLE$par[(length(pars)-3):length(pars)],\n", " Klast,solMLE$value,2*(npars+2-solMLE$value),rmse))) #npars+2, additional two is due to tau and K\n", " colnames(output) = c(\"tau\",\"tauDate\",\"mean_h1\",\"var_h1\",\"mean_h2\",\"var_h2\",\"par1_h1\",\"par2_h1\",\"par1_h2\",\"par2_h2\",\n", " \"K\",\"loglk\",\"AIC\",\"rmse_i\",\"rmse_c\")\n", "\n", " print(output) \n", " \n", " final_pars %<>% rbind(output %>% gather(parameter,estimate) %>% mutate(epicurve=current_epicurve,generations=length(pars)-2))\n", " } \n", "}\n", "\n", "message(\"Done\")" ] }, { "cell_type": "code", "execution_count": 164, "metadata": {}, "outputs": [ { "data": { "text/html": [ "\n", "\n", "\n", "\t\n", "\t\n", "\t\n", "\t\n", "\n", "
epicurvegenerationsAICKloglkmean_h1mean_h2par1_h1par1_h2par2_h1par2_h2rmse_crmse_itautauDatevar_h1var_h2
Apr01 2 81.3684744930581 25.72152052601 -34.68423724652914.39259735948419 15.8623046549225 3.29199326912327 0.6796035239364394.89750001774415 12.1720171735286 1.32605473134763 1.04623354350151 11 Mar28 2.1573918436451 576.186086227435
Apr09 2 209.209745968125 35.0355894909167 -98.60487298406244.85766878835482 3.52585377719005 2.76215359454369 1.97031284962405 5.45805833210042 3.97730112858787 1.26202022031967 1.06574704315339 11 Mar28 3.61421647857598 3.48953241101394
Apr17 2 557.11843695237 63.0113376190142 -272.5592184761854.0645351783915 3.54203644187095 2.44883301886211 2.68552768972435 4.58316416628174 3.98374943081259 2.68773705631973 2.80790871197967 25 Apr11 3.13907417912528 2.02089257041855
Apr25 2 977.058508436175 80.00001759699 -482.5292542180884.08190758477988 3.78401093089457 2.42440073070502 2.62660606798618 4.60371482839008 4.25894786937791 3.11273607132457 3.30768368190519 25 Apr11 3.22332772738053 2.39989419027517
\n" ], "text/latex": [ "\\begin{tabular}{r|lllllllllllllllll}\n", " epicurve & generations & AIC & K & loglk & mean\\_h1 & mean\\_h2 & par1\\_h1 & par1\\_h2 & par2\\_h1 & par2\\_h2 & rmse\\_c & rmse\\_i & tau & tauDate & var\\_h1 & var\\_h2\\\\\n", "\\hline\n", "\t Apr01 & 2 & 81.3684744930581 & 25.72152052601 & -34.6842372465291 & 4.39259735948419 & 15.8623046549225 & 3.29199326912327 & 0.679603523936439 & 4.89750001774415 & 12.1720171735286 & 1.32605473134763 & 1.04623354350151 & 11 & Mar28 & 2.1573918436451 & 576.186086227435 \\\\\n", "\t Apr09 & 2 & 209.209745968125 & 35.0355894909167 & -98.6048729840624 & 4.85766878835482 & 3.52585377719005 & 2.76215359454369 & 1.97031284962405 & 5.45805833210042 & 3.97730112858787 & 1.26202022031967 & 1.06574704315339 & 11 & Mar28 & 3.61421647857598 & 3.48953241101394 \\\\\n", "\t Apr17 & 2 & 557.11843695237 & 63.0113376190142 & -272.559218476185 & 4.0645351783915 & 3.54203644187095 & 2.44883301886211 & 2.68552768972435 & 4.58316416628174 & 3.98374943081259 & 2.68773705631973 & 2.80790871197967 & 25 & Apr11 & 3.13907417912528 & 2.02089257041855 \\\\\n", "\t Apr25 & 2 & 977.058508436175 & 80.00001759699 & -482.529254218088 & 4.08190758477988 & 3.78401093089457 & 2.42440073070502 & 2.62660606798618 & 4.60371482839008 & 4.25894786937791 & 3.11273607132457 & 3.30768368190519 & 25 & Apr11 & 3.22332772738053 & 2.39989419027517 \\\\\n", "\\end{tabular}\n" ], "text/markdown": [ "\n", "epicurve | generations | AIC | K | loglk | mean_h1 | mean_h2 | par1_h1 | par1_h2 | par2_h1 | par2_h2 | rmse_c | rmse_i | tau | tauDate | var_h1 | var_h2 | \n", "|---|---|---|---|\n", "| Apr01 | 2 | 81.3684744930581 | 25.72152052601 | -34.6842372465291 | 4.39259735948419 | 15.8623046549225 | 3.29199326912327 | 0.679603523936439 | 4.89750001774415 | 12.1720171735286 | 1.32605473134763 | 1.04623354350151 | 11 | Mar28 | 2.1573918436451 | 576.186086227435 | \n", "| Apr09 | 2 | 209.209745968125 | 35.0355894909167 | -98.6048729840624 | 4.85766878835482 | 3.52585377719005 | 2.76215359454369 | 1.97031284962405 | 5.45805833210042 | 3.97730112858787 | 1.26202022031967 | 1.06574704315339 | 11 | Mar28 | 3.61421647857598 | 3.48953241101394 | \n", "| Apr17 | 2 | 557.11843695237 | 63.0113376190142 | -272.559218476185 | 4.0645351783915 | 3.54203644187095 | 2.44883301886211 | 2.68552768972435 | 4.58316416628174 | 3.98374943081259 | 2.68773705631973 | 2.80790871197967 | 25 | Apr11 | 3.13907417912528 | 2.02089257041855 | \n", "| Apr25 | 2 | 977.058508436175 | 80.00001759699 | -482.529254218088 | 4.08190758477988 | 3.78401093089457 | 2.42440073070502 | 2.62660606798618 | 4.60371482839008 | 4.25894786937791 | 3.11273607132457 | 3.30768368190519 | 25 | Apr11 | 3.22332772738053 | 2.39989419027517 | \n", "\n", "\n" ], "text/plain": [ " epicurve generations AIC K loglk \n", "1 Apr01 2 81.3684744930581 25.72152052601 -34.6842372465291\n", "2 Apr09 2 209.209745968125 35.0355894909167 -98.6048729840624\n", "3 Apr17 2 557.11843695237 63.0113376190142 -272.559218476185\n", "4 Apr25 2 977.058508436175 80.00001759699 -482.529254218088\n", " mean_h1 mean_h2 par1_h1 par1_h2 \n", "1 4.39259735948419 15.8623046549225 3.29199326912327 0.679603523936439\n", "2 4.85766878835482 3.52585377719005 2.76215359454369 1.97031284962405 \n", "3 4.0645351783915 3.54203644187095 2.44883301886211 2.68552768972435 \n", "4 4.08190758477988 3.78401093089457 2.42440073070502 2.62660606798618 \n", " par2_h1 par2_h2 rmse_c rmse_i tau\n", "1 4.89750001774415 12.1720171735286 1.32605473134763 1.04623354350151 11 \n", "2 5.45805833210042 3.97730112858787 1.26202022031967 1.06574704315339 11 \n", "3 4.58316416628174 3.98374943081259 2.68773705631973 2.80790871197967 25 \n", "4 4.60371482839008 4.25894786937791 3.11273607132457 3.30768368190519 25 \n", " tauDate var_h1 var_h2 \n", "1 Mar28 2.1573918436451 576.186086227435\n", "2 Mar28 3.61421647857598 3.48953241101394\n", "3 Apr11 3.13907417912528 2.02089257041855\n", "4 Apr11 3.22332772738053 2.39989419027517" ] }, "metadata": {}, "output_type": "display_data" } ], "source": [ "final_pars %>% spread(parameter,estimate)" ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "## Three and more generations" ] }, { "cell_type": "code", "execution_count": 165, "metadata": { "scrolled": false }, "outputs": [ { "name": "stderr", "output_type": "stream", "text": [ "Number of generations 3\n", "Apr01\n", "Apr09\n", "Apr17\n", "Apr25\n", "May03\n", "May11\n", "May17\n", "May25\n", "Number of generations 4\n", "Apr09\n", "Apr17\n", "Apr25\n", "May03\n", "May11\n", "May17\n", "May25\n", "Number of generations 5\n", "Apr09\n", "Apr17\n", "Apr25\n", "May03\n", "May11\n", "May17\n", "May25\n", "Number of generations 6\n", "Apr09\n", "Apr17\n", "Apr25\n", "May03\n", "May11\n", "May17\n", "May25\n", "Done\n" ] } ], "source": [ "if (recalc) {\n", " for (J in 1:4) {\n", " pars = c(rep(1.,J),2,5,3,4)\n", "\n", " message(\"Number of generations \",J+2)\n", "\n", " # initial parameter values used in optim function\n", " options(warn=-1)\n", " for (current_epicurve in unique(df$epicurve)[ifelse(J==1,1,2):length(unique(df$epicurve))]) { \n", " message(current_epicurve)\n", "\n", " df %>% \n", " filter(epicurve==current_epicurve) %>% \n", " select(-epicurve) -> df_current\n", "\n", " Df = data.frame(day=0:(unclass(as.Date('2018'%&%current_epicurve,\"%Y%b%d\"))-unclass(dayZero)))\n", "\n", " df_current %>% \n", " filter(day_onset>0) %>% #removing index case\n", " group_by(day_onset) %>%\n", " count %>%\n", " rename(day=day_onset) %>%\n", " right_join(Df,by=\"day\") %>%\n", " mutate(n=ifelse(is.na(n),0,n)) %>%\n", " rename(i=n) -> Df\n", "\n", " df_current %>%\n", " filter(day_onset>0) %>% #removing index case\n", " group_by(day_confirmation) %>%\n", " count %>%\n", " rename(day=day_confirmation) %>%\n", " right_join(Df,by=\"day\") %>%\n", " mutate(n=ifelse(is.na(n),0,n)) %>%\n", " rename(c=n) %>%\n", " select(day,i,c) %>%\n", " arrange(day) -> Df\n", "\n", " Df %>% mutate(date=day+dayZero) %>%\n", " select(date,day) %>% rename(onset=date) %>% right_join(df_current,by=\"onset\") -> df_current\n", "\n", " foreach(\n", " tau0=1:max(Df$day),\n", " .packages=c(\"dplyr\",\"tidyr\",\"magrittr\"),\n", " .inorder=FALSE,\n", " .combine=rbind\n", " ) %dopar% {\n", " # we require that there would be at least two cases present in each subgroup day=tau0\n", " # to estimate the delay function\n", " if (nrow(df_current[df_current$day1 & nrow(df_current[df_current$day>=tau0,])>1) {\n", " tryCatch({\n", " sol = optim(pars,\n", " function(x) calculate_generations(length(pars)-2,x,tau0,FALSE),\n", " method=\"L-BFGS-B\",\n", " control=list(fnscale=-1),lower=rep(0,length(pars)))\n", "\n", " }, error=function(cond){print(cond)})\n", " data.frame(tau=tau0,loglk=sol$value) \n", " }\n", " } -> output\n", "\n", " tauOptim = output[output$loglk==min(output$loglk),]$tau\n", " solMLE = optim(pars,\n", " function(x) calculate_generations(length(pars)-2,x,tauOptim,FALSE),\n", " method=\"L-BFGS-B\",\n", " control=list(fnscale=-1),lower=rep(0,length(pars))) \n", "\n", " # Weibull distribution mean and variance\n", " pars_h = NULL\n", " for (j in c(1,0)) {\n", " parsH = solMLE$par[(length(pars)-1):length(pars)-2*j]\n", " pars_h = c(pars_h,parsH[2]*gamma(1+1/parsH[1]),parsH[2]^2*(gamma(1+2/parsH[1])-(gamma(1+1/parsH[1]))^2))\n", " }\n", "\n", " # Maximum likelihood estimates (MLE)\n", " calculate_generations(length(pars)-2,solMLE$par,tauOptim,prediction=TRUE) %>% \n", " rename(`MLE_i`=`lambda_i`,`MLE_c`=`lambda_c`) -> dfMLE\n", "\n", " # RMSE\n", " calculate_generations(length(pars)-2,solMLE$par,tauOptim,prediction=TRUE) %>%\n", " na.omit %>%\n", " mutate(epsilon_i = (lambda_i-i), epsilon_c = (lambda_c-c)) %>%\n", " summarize(rmse_i = sqrt(sum(epsilon_i^2)/n()),rmse_c = sqrt(sum(epsilon_c^2)/n())) %>% as.numeric -> rmse\n", "\n", " npars = length(pars)\n", " output = data.frame(t(c(tauOptim,format(tauOptim+dayZero,\"%b%d\"),pars_h,solMLE$par[(length(pars)-3):length(pars)],\n", " Klast,solMLE$par[1:(length(pars)-4)],solMLE$value,2*(npars+2-solMLE$value),rmse))) #npars+2, additional two is due to tau and K\n", " colnames(output) = c(\"tau\",\"tauDate\",\"mean_h1\",\"var_h1\",\"mean_h2\",\"var_h2\",\"par1_h1\",\"par2_h1\",\"par1_h2\",\"par2_h2\",\n", " \"K\",c(\"R\"%&%(2:(J+1))),\"loglk\",\"AIC\",\"rmse_i\",\"rmse_c\")\n", "\n", " final_pars %<>% rbind(output %>% gather(parameter,estimate) %>% mutate(epicurve=current_epicurve,generations=length(pars)-2))\n", " }\n", "\n", "# final_pars %>%\n", "# write.table(file=final_pars_output, sep=\",\", col.names=T, append = T, quote = F, row.names = F)\n", " }\n", "}\n", "\n", "message(\"Done\")" ] }, { "cell_type": "code", "execution_count": 166, "metadata": {}, "outputs": [ { "data": { "text/html": [ "\n", "\n", "\n", "\t\n", "\t\n", "\t\n", "\t\n", "\t\n", "\t\n", "\t\n", "\t\n", "\n", "
epicurvegenerationsswitchestautauDateAICloglkKmean_h1mean_h2...par2_h1par2_h2R2R3R4R5rmse_crmse_ivar_h1var_h2
Apr01 2 1 11 Mar28 81.36847 -34.684237246529125.72152052601 4.39259735948419 15.8623046549225 ... 4.89750001774415 12.1720171735286 NA NA NA NA 1.32605473134763 1.04623354350151 2.1573918436451 576.186086227435
Apr09 3 1 11 Mar28 207.33255 -96.666274838624260.2895795115133 4.85770704954315 3.69625810355023 ... 5.4581019060818 4.17313909916217 0.938204013051551NA NA NA 1.65257582384134 1.37108865315585 3.61429234113614 3.45079785938741
Apr17 3 1 24 Apr10 349.97873 -167.98936269530974.8567474055843 4.12754035190244 3.83864567289599 ... 4.65235547933119 4.3195417490074 1.52056513218659 NA NA NA 1.63698491106479 1.39295753538546 3.13768164668523 2.44055852699075
Apr25 4 1 24 Apr10 453.49034 -218.74517091351996.7004494667949 4.13061282591983 3.88698188292093 ... 4.65601824147909 4.37606300877576 1.34497323550229 0.682766793768383NA NA 1.68248531252453 1.41902009832491 3.15243377995469 2.57420036679001
May03 5 1 18 Apr04 604.58221 -293.291105873806142.581939326984 4.22840976749677 4.32212576081768 ... 4.77400308064525 4.88042735002151 1.35127312525943 0.7621842642003781.33299932794081 NA 1.90872521903326 1.59169160603472 3.97017104258895 4.44497592289921
May11 5 1 46 May02 708.88241 -345.441204439372125.096302856632 4.49644882837161 4.30953027747521 ... 5.07285007468998 4.83674846683189 1.33156063772568 0.8593950201316060.60289781187 NA 1.78607827145336 1.3734194595674 5.61110745257598 6.54440633897593
May17 5 1 45 May01 746.59086 -364.295429755597124.330347135654 4.51689766306534 4.39175076020785 ... 5.09139084603557 4.92223999795685 1.32487775308412 0.8922775724858830.534189719713544NA 1.70295529989776 1.26665701540388 6.03510496188127 7.06699281597785
May25 5 1 45 May01 755.77219 -368.886094207812123.221153324229 4.51692824693498 4.46519189800703 ... 5.09142086778493 5.01534276540328 1.32099997732123 0.9121242230882480.477008301006462NA 1.6078340007658 1.20447585744293 6.03550451292114 6.85730326305217
\n" ], "text/latex": [ "\\begin{tabular}{r|llllllllllllllllllllll}\n", " epicurve & generations & switches & tau & tauDate & AIC & loglk & K & mean\\_h1 & mean\\_h2 & ... & par2\\_h1 & par2\\_h2 & R2 & R3 & R4 & R5 & rmse\\_c & rmse\\_i & var\\_h1 & var\\_h2\\\\\n", "\\hline\n", "\t Apr01 & 2 & 1 & 11 & Mar28 & 81.36847 & -34.6842372465291 & 25.72152052601 & 4.39259735948419 & 15.8623046549225 & ... & 4.89750001774415 & 12.1720171735286 & NA & NA & NA & NA & 1.32605473134763 & 1.04623354350151 & 2.1573918436451 & 576.186086227435 \\\\\n", "\t Apr09 & 3 & 1 & 11 & Mar28 & 207.33255 & -96.6662748386242 & 60.2895795115133 & 4.85770704954315 & 3.69625810355023 & ... & 5.4581019060818 & 4.17313909916217 & 0.938204013051551 & NA & NA & NA & 1.65257582384134 & 1.37108865315585 & 3.61429234113614 & 3.45079785938741 \\\\\n", "\t Apr17 & 3 & 1 & 24 & Apr10 & 349.97873 & -167.989362695309 & 74.8567474055843 & 4.12754035190244 & 3.83864567289599 & ... & 4.65235547933119 & 4.3195417490074 & 1.52056513218659 & NA & NA & NA & 1.63698491106479 & 1.39295753538546 & 3.13768164668523 & 2.44055852699075 \\\\\n", "\t Apr25 & 4 & 1 & 24 & Apr10 & 453.49034 & -218.745170913519 & 96.7004494667949 & 4.13061282591983 & 3.88698188292093 & ... & 4.65601824147909 & 4.37606300877576 & 1.34497323550229 & 0.682766793768383 & NA & NA & 1.68248531252453 & 1.41902009832491 & 3.15243377995469 & 2.57420036679001 \\\\\n", "\t May03 & 5 & 1 & 18 & Apr04 & 604.58221 & -293.291105873806 & 142.581939326984 & 4.22840976749677 & 4.32212576081768 & ... & 4.77400308064525 & 4.88042735002151 & 1.35127312525943 & 0.762184264200378 & 1.33299932794081 & NA & 1.90872521903326 & 1.59169160603472 & 3.97017104258895 & 4.44497592289921 \\\\\n", "\t May11 & 5 & 1 & 46 & May02 & 708.88241 & -345.441204439372 & 125.096302856632 & 4.49644882837161 & 4.30953027747521 & ... & 5.07285007468998 & 4.83674846683189 & 1.33156063772568 & 0.859395020131606 & 0.60289781187 & NA & 1.78607827145336 & 1.3734194595674 & 5.61110745257598 & 6.54440633897593 \\\\\n", "\t May17 & 5 & 1 & 45 & May01 & 746.59086 & -364.295429755597 & 124.330347135654 & 4.51689766306534 & 4.39175076020785 & ... & 5.09139084603557 & 4.92223999795685 & 1.32487775308412 & 0.892277572485883 & 0.534189719713544 & NA & 1.70295529989776 & 1.26665701540388 & 6.03510496188127 & 7.06699281597785 \\\\\n", "\t May25 & 5 & 1 & 45 & May01 & 755.77219 & -368.886094207812 & 123.221153324229 & 4.51692824693498 & 4.46519189800703 & ... & 5.09142086778493 & 5.01534276540328 & 1.32099997732123 & 0.912124223088248 & 0.477008301006462 & NA & 1.6078340007658 & 1.20447585744293 & 6.03550451292114 & 6.85730326305217 \\\\\n", "\\end{tabular}\n" ], "text/markdown": [ "\n", "epicurve | generations | switches | tau | tauDate | AIC | loglk | K | mean_h1 | mean_h2 | ... | par2_h1 | par2_h2 | R2 | R3 | R4 | R5 | rmse_c | rmse_i | var_h1 | var_h2 | \n", "|---|---|---|---|---|---|---|---|\n", "| Apr01 | 2 | 1 | 11 | Mar28 | 81.36847 | -34.6842372465291 | 25.72152052601 | 4.39259735948419 | 15.8623046549225 | ... | 4.89750001774415 | 12.1720171735286 | NA | NA | NA | NA | 1.32605473134763 | 1.04623354350151 | 2.1573918436451 | 576.186086227435 | \n", "| Apr09 | 3 | 1 | 11 | Mar28 | 207.33255 | -96.6662748386242 | 60.2895795115133 | 4.85770704954315 | 3.69625810355023 | ... | 5.4581019060818 | 4.17313909916217 | 0.938204013051551 | NA | NA | NA | 1.65257582384134 | 1.37108865315585 | 3.61429234113614 | 3.45079785938741 | \n", "| Apr17 | 3 | 1 | 24 | Apr10 | 349.97873 | -167.989362695309 | 74.8567474055843 | 4.12754035190244 | 3.83864567289599 | ... | 4.65235547933119 | 4.3195417490074 | 1.52056513218659 | NA | NA | NA | 1.63698491106479 | 1.39295753538546 | 3.13768164668523 | 2.44055852699075 | \n", "| Apr25 | 4 | 1 | 24 | Apr10 | 453.49034 | -218.745170913519 | 96.7004494667949 | 4.13061282591983 | 3.88698188292093 | ... | 4.65601824147909 | 4.37606300877576 | 1.34497323550229 | 0.682766793768383 | NA | NA | 1.68248531252453 | 1.41902009832491 | 3.15243377995469 | 2.57420036679001 | \n", "| May03 | 5 | 1 | 18 | Apr04 | 604.58221 | -293.291105873806 | 142.581939326984 | 4.22840976749677 | 4.32212576081768 | ... | 4.77400308064525 | 4.88042735002151 | 1.35127312525943 | 0.762184264200378 | 1.33299932794081 | NA | 1.90872521903326 | 1.59169160603472 | 3.97017104258895 | 4.44497592289921 | \n", "| May11 | 5 | 1 | 46 | May02 | 708.88241 | -345.441204439372 | 125.096302856632 | 4.49644882837161 | 4.30953027747521 | ... | 5.07285007468998 | 4.83674846683189 | 1.33156063772568 | 0.859395020131606 | 0.60289781187 | NA | 1.78607827145336 | 1.3734194595674 | 5.61110745257598 | 6.54440633897593 | \n", "| May17 | 5 | 1 | 45 | May01 | 746.59086 | -364.295429755597 | 124.330347135654 | 4.51689766306534 | 4.39175076020785 | ... | 5.09139084603557 | 4.92223999795685 | 1.32487775308412 | 0.892277572485883 | 0.534189719713544 | NA | 1.70295529989776 | 1.26665701540388 | 6.03510496188127 | 7.06699281597785 | \n", "| May25 | 5 | 1 | 45 | May01 | 755.77219 | -368.886094207812 | 123.221153324229 | 4.51692824693498 | 4.46519189800703 | ... | 5.09142086778493 | 5.01534276540328 | 1.32099997732123 | 0.912124223088248 | 0.477008301006462 | NA | 1.6078340007658 | 1.20447585744293 | 6.03550451292114 | 6.85730326305217 | \n", "\n", "\n" ], "text/plain": [ " epicurve generations switches tau tauDate AIC loglk \n", "1 Apr01 2 1 11 Mar28 81.36847 -34.6842372465291\n", "2 Apr09 3 1 11 Mar28 207.33255 -96.6662748386242\n", "3 Apr17 3 1 24 Apr10 349.97873 -167.989362695309\n", "4 Apr25 4 1 24 Apr10 453.49034 -218.745170913519\n", "5 May03 5 1 18 Apr04 604.58221 -293.291105873806\n", "6 May11 5 1 46 May02 708.88241 -345.441204439372\n", "7 May17 5 1 45 May01 746.59086 -364.295429755597\n", "8 May25 5 1 45 May01 755.77219 -368.886094207812\n", " K mean_h1 mean_h2 ... par2_h1 \n", "1 25.72152052601 4.39259735948419 15.8623046549225 ... 4.89750001774415\n", "2 60.2895795115133 4.85770704954315 3.69625810355023 ... 5.4581019060818 \n", "3 74.8567474055843 4.12754035190244 3.83864567289599 ... 4.65235547933119\n", "4 96.7004494667949 4.13061282591983 3.88698188292093 ... 4.65601824147909\n", "5 142.581939326984 4.22840976749677 4.32212576081768 ... 4.77400308064525\n", "6 125.096302856632 4.49644882837161 4.30953027747521 ... 5.07285007468998\n", "7 124.330347135654 4.51689766306534 4.39175076020785 ... 5.09139084603557\n", "8 123.221153324229 4.51692824693498 4.46519189800703 ... 5.09142086778493\n", " par2_h2 R2 R3 R4 R5\n", "1 12.1720171735286 NA NA NA NA\n", "2 4.17313909916217 0.938204013051551 NA NA NA\n", "3 4.3195417490074 1.52056513218659 NA NA NA\n", "4 4.37606300877576 1.34497323550229 0.682766793768383 NA NA\n", "5 4.88042735002151 1.35127312525943 0.762184264200378 1.33299932794081 NA\n", "6 4.83674846683189 1.33156063772568 0.859395020131606 0.60289781187 NA\n", "7 4.92223999795685 1.32487775308412 0.892277572485883 0.534189719713544 NA\n", "8 5.01534276540328 1.32099997732123 0.912124223088248 0.477008301006462 NA\n", " rmse_c rmse_i var_h1 var_h2 \n", "1 1.32605473134763 1.04623354350151 2.1573918436451 576.186086227435\n", "2 1.65257582384134 1.37108865315585 3.61429234113614 3.45079785938741\n", "3 1.63698491106479 1.39295753538546 3.13768164668523 2.44055852699075\n", "4 1.68248531252453 1.41902009832491 3.15243377995469 2.57420036679001\n", "5 1.90872521903326 1.59169160603472 3.97017104258895 4.44497592289921\n", "6 1.78607827145336 1.3734194595674 5.61110745257598 6.54440633897593\n", "7 1.70295529989776 1.26665701540388 6.03510496188127 7.06699281597785\n", "8 1.6078340007658 1.20447585744293 6.03550451292114 6.85730326305217" ] }, "metadata": {}, "output_type": "display_data" } ], "source": [ "final_pars %>% spread(parameter,estimate) %>% mutate(switches=1,AIC=as.numeric(AIC)) %>% \n", " group_by(epicurve) %>%\n", " filter(AIC==min(AIC)) %>%\n", " select(epicurve,generations,switches,tau,tauDate,AIC,loglk,everything()) -> final_pars_1\n", "\n", "final_pars_1" ] }, { "cell_type": "code", "execution_count": 167, "metadata": {}, "outputs": [ { "data": { "text/html": [ "\n", "\n", "\n", "\t\n", "\t\n", "\t\n", "\t\n", "\t\n", "\t\n", "\t\n", "\t\n", "\n", "
epicurvegenerationsswitchesAICloglkKmean_h1par1_h1par2_h1rmse_c...tautauDatemean_h2par1_h2par2_h2R2R3R4R5var_h2
Apr01 2 0 80.49188 -37.24594 25.83603 4.044729 2.147092 4.567165 1.323245 ... NA NA NA NA NA NA NA NA NA NA
Apr09 3 0 204.12866 -98.06433 68.10538 4.061816 2.198336 4.586395 1.739619 ... NA NA NA NA NA NA NA NA NA NA
Apr17 3 0 344.41905 -168.20953 75.92714 4.068596 2.497009 4.585688 1.641221 ... NA NA NA NA NA NA NA NA NA NA
Apr25 4 0 448.09032 -219.04516 97.71981 4.038389 2.510051 4.551056 1.686684 ... NA NA NA NA NA NA NA NA NA NA
May03 5 0 598.70950 -293.35475142.08896 4.293683 2.176907 4.848302 1.909321 ... NA NA NA NA NA NA NA NA NA NA
May11 5 0 703.15713 -345.57857125.57604 4.480782 1.959805 5.053882 1.786760 ... NA NA NA NA NA NA NA NA NA NA
May17 5 0 740.86426 -364.43213124.34020 4.500895 1.889103 5.071254 1.703754 ... NA NA NA NA NA NA NA NA NA NA
May25 5 0 749.90946 -368.95473123.21179 4.509955 1.896179 5.082092 1.608431 ... NA NA NA NA NA NA NA NA NA NA
\n" ], "text/latex": [ "\\begin{tabular}{r|llllllllllllllllllllll}\n", " epicurve & generations & switches & AIC & loglk & K & mean\\_h1 & par1\\_h1 & par2\\_h1 & rmse\\_c & ... & tau & tauDate & mean\\_h2 & par1\\_h2 & par2\\_h2 & R2 & R3 & R4 & R5 & var\\_h2\\\\\n", "\\hline\n", "\t Apr01 & 2 & 0 & 80.49188 & -37.24594 & 25.83603 & 4.044729 & 2.147092 & 4.567165 & 1.323245 & ... & NA & NA & NA & NA & NA & NA & NA & NA & NA & NA \\\\\n", "\t Apr09 & 3 & 0 & 204.12866 & -98.06433 & 68.10538 & 4.061816 & 2.198336 & 4.586395 & 1.739619 & ... & NA & NA & NA & NA & NA & NA & NA & NA & NA & NA \\\\\n", "\t Apr17 & 3 & 0 & 344.41905 & -168.20953 & 75.92714 & 4.068596 & 2.497009 & 4.585688 & 1.641221 & ... & NA & NA & NA & NA & NA & NA & NA & NA & NA & NA \\\\\n", "\t Apr25 & 4 & 0 & 448.09032 & -219.04516 & 97.71981 & 4.038389 & 2.510051 & 4.551056 & 1.686684 & ... & NA & NA & NA & NA & NA & NA & NA & NA & NA & NA \\\\\n", "\t May03 & 5 & 0 & 598.70950 & -293.35475 & 142.08896 & 4.293683 & 2.176907 & 4.848302 & 1.909321 & ... & NA & NA & NA & NA & NA & NA & NA & NA & NA & NA \\\\\n", "\t May11 & 5 & 0 & 703.15713 & -345.57857 & 125.57604 & 4.480782 & 1.959805 & 5.053882 & 1.786760 & ... & NA & NA & NA & NA & NA & NA & NA & NA & NA & NA \\\\\n", "\t May17 & 5 & 0 & 740.86426 & -364.43213 & 124.34020 & 4.500895 & 1.889103 & 5.071254 & 1.703754 & ... & NA & NA & NA & NA & NA & NA & NA & NA & NA & NA \\\\\n", "\t May25 & 5 & 0 & 749.90946 & -368.95473 & 123.21179 & 4.509955 & 1.896179 & 5.082092 & 1.608431 & ... & NA & NA & NA & NA & NA & NA & NA & NA & NA & NA \\\\\n", "\\end{tabular}\n" ], "text/markdown": [ "\n", "epicurve | generations | switches | AIC | loglk | K | mean_h1 | par1_h1 | par2_h1 | rmse_c | ... | tau | tauDate | mean_h2 | par1_h2 | par2_h2 | R2 | R3 | R4 | R5 | var_h2 | \n", "|---|---|---|---|---|---|---|---|\n", "| Apr01 | 2 | 0 | 80.49188 | -37.24594 | 25.83603 | 4.044729 | 2.147092 | 4.567165 | 1.323245 | ... | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | \n", "| Apr09 | 3 | 0 | 204.12866 | -98.06433 | 68.10538 | 4.061816 | 2.198336 | 4.586395 | 1.739619 | ... | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | \n", "| Apr17 | 3 | 0 | 344.41905 | -168.20953 | 75.92714 | 4.068596 | 2.497009 | 4.585688 | 1.641221 | ... | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | \n", "| Apr25 | 4 | 0 | 448.09032 | -219.04516 | 97.71981 | 4.038389 | 2.510051 | 4.551056 | 1.686684 | ... | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | \n", "| May03 | 5 | 0 | 598.70950 | -293.35475 | 142.08896 | 4.293683 | 2.176907 | 4.848302 | 1.909321 | ... | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | \n", "| May11 | 5 | 0 | 703.15713 | -345.57857 | 125.57604 | 4.480782 | 1.959805 | 5.053882 | 1.786760 | ... | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | \n", "| May17 | 5 | 0 | 740.86426 | -364.43213 | 124.34020 | 4.500895 | 1.889103 | 5.071254 | 1.703754 | ... | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | \n", "| May25 | 5 | 0 | 749.90946 | -368.95473 | 123.21179 | 4.509955 | 1.896179 | 5.082092 | 1.608431 | ... | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | \n", "\n", "\n" ], "text/plain": [ " epicurve generations switches AIC loglk K mean_h1 \n", "1 Apr01 2 0 80.49188 -37.24594 25.83603 4.044729\n", "2 Apr09 3 0 204.12866 -98.06433 68.10538 4.061816\n", "3 Apr17 3 0 344.41905 -168.20953 75.92714 4.068596\n", "4 Apr25 4 0 448.09032 -219.04516 97.71981 4.038389\n", "5 May03 5 0 598.70950 -293.35475 142.08896 4.293683\n", "6 May11 5 0 703.15713 -345.57857 125.57604 4.480782\n", "7 May17 5 0 740.86426 -364.43213 124.34020 4.500895\n", "8 May25 5 0 749.90946 -368.95473 123.21179 4.509955\n", " par1_h1 par2_h1 rmse_c ... tau tauDate mean_h2 par1_h2 par2_h2 R2 R3 R4\n", "1 2.147092 4.567165 1.323245 ... NA NA NA NA NA NA NA NA\n", "2 2.198336 4.586395 1.739619 ... NA NA NA NA NA NA NA NA\n", "3 2.497009 4.585688 1.641221 ... NA NA NA NA NA NA NA NA\n", "4 2.510051 4.551056 1.686684 ... NA NA NA NA NA NA NA NA\n", "5 2.176907 4.848302 1.909321 ... NA NA NA NA NA NA NA NA\n", "6 1.959805 5.053882 1.786760 ... NA NA NA NA NA NA NA NA\n", "7 1.889103 5.071254 1.703754 ... NA NA NA NA NA NA NA NA\n", "8 1.896179 5.082092 1.608431 ... NA NA NA NA NA NA NA NA\n", " R5 var_h2\n", "1 NA NA \n", "2 NA NA \n", "3 NA NA \n", "4 NA NA \n", "5 NA NA \n", "6 NA NA \n", "7 NA NA \n", "8 NA NA " ] }, "metadata": {}, "output_type": "display_data" } ], "source": [ "rbind(\n", " final_pars_0 %>% mutate_all(funs(as.numeric(.))),\n", " final_pars_1 %>% mutate_all(funs(as.numeric(.)))) %>%\n", " group_by(epicurve) %>%\n", " filter(AIC==min(AIC)) %>%\n", " arrange(epicurve)" ] }, { "cell_type": "code", "execution_count": 168, "metadata": {}, "outputs": [ { "data": { "text/html": [ "\n", "\n", "\n", "\t\n", "\t\n", "\t\n", "\t\n", "\t\n", "\t\n", "\t\n", "\t\n", "\n", "
epicurvegenerationsswitchestautauDateAICloglkKmean_h1mean_h2...par2_h1par2_h2R2R3R4R5rmse_crmse_ivar_h1var_h2
Apr01 2 1 11 Mar28 81.36847 -34.684237246529125.72152052601 4.39259735948419 15.8623046549225 ... 4.89750001774415 12.1720171735286 NA NA NA NA 1.32605473134763 1.04623354350151 2.1573918436451 576.186086227435
Apr09 3 1 11 Mar28 207.33255 -96.666274838624260.2895795115133 4.85770704954315 3.69625810355023 ... 5.4581019060818 4.17313909916217 0.938204013051551NA NA NA 1.65257582384134 1.37108865315585 3.61429234113614 3.45079785938741
Apr17 3 1 24 Apr10 349.97873 -167.98936269530974.8567474055843 4.12754035190244 3.83864567289599 ... 4.65235547933119 4.3195417490074 1.52056513218659 NA NA NA 1.63698491106479 1.39295753538546 3.13768164668523 2.44055852699075
Apr25 4 1 24 Apr10 453.49034 -218.74517091351996.7004494667949 4.13061282591983 3.88698188292093 ... 4.65601824147909 4.37606300877576 1.34497323550229 0.682766793768383NA NA 1.68248531252453 1.41902009832491 3.15243377995469 2.57420036679001
May03 5 1 18 Apr04 604.58221 -293.291105873806142.581939326984 4.22840976749677 4.32212576081768 ... 4.77400308064525 4.88042735002151 1.35127312525943 0.7621842642003781.33299932794081 NA 1.90872521903326 1.59169160603472 3.97017104258895 4.44497592289921
May11 5 1 46 May02 708.88241 -345.441204439372125.096302856632 4.49644882837161 4.30953027747521 ... 5.07285007468998 4.83674846683189 1.33156063772568 0.8593950201316060.60289781187 NA 1.78607827145336 1.3734194595674 5.61110745257598 6.54440633897593
May17 5 1 45 May01 746.59086 -364.295429755597124.330347135654 4.51689766306534 4.39175076020785 ... 5.09139084603557 4.92223999795685 1.32487775308412 0.8922775724858830.534189719713544NA 1.70295529989776 1.26665701540388 6.03510496188127 7.06699281597785
May25 5 1 45 May01 755.77219 -368.886094207812123.221153324229 4.51692824693498 4.46519189800703 ... 5.09142086778493 5.01534276540328 1.32099997732123 0.9121242230882480.477008301006462NA 1.6078340007658 1.20447585744293 6.03550451292114 6.85730326305217
\n" ], "text/latex": [ "\\begin{tabular}{r|llllllllllllllllllllll}\n", " epicurve & generations & switches & tau & tauDate & AIC & loglk & K & mean\\_h1 & mean\\_h2 & ... & par2\\_h1 & par2\\_h2 & R2 & R3 & R4 & R5 & rmse\\_c & rmse\\_i & var\\_h1 & var\\_h2\\\\\n", "\\hline\n", "\t Apr01 & 2 & 1 & 11 & Mar28 & 81.36847 & -34.6842372465291 & 25.72152052601 & 4.39259735948419 & 15.8623046549225 & ... & 4.89750001774415 & 12.1720171735286 & NA & NA & NA & NA & 1.32605473134763 & 1.04623354350151 & 2.1573918436451 & 576.186086227435 \\\\\n", "\t Apr09 & 3 & 1 & 11 & Mar28 & 207.33255 & -96.6662748386242 & 60.2895795115133 & 4.85770704954315 & 3.69625810355023 & ... & 5.4581019060818 & 4.17313909916217 & 0.938204013051551 & NA & NA & NA & 1.65257582384134 & 1.37108865315585 & 3.61429234113614 & 3.45079785938741 \\\\\n", "\t Apr17 & 3 & 1 & 24 & Apr10 & 349.97873 & -167.989362695309 & 74.8567474055843 & 4.12754035190244 & 3.83864567289599 & ... & 4.65235547933119 & 4.3195417490074 & 1.52056513218659 & NA & NA & NA & 1.63698491106479 & 1.39295753538546 & 3.13768164668523 & 2.44055852699075 \\\\\n", "\t Apr25 & 4 & 1 & 24 & Apr10 & 453.49034 & -218.745170913519 & 96.7004494667949 & 4.13061282591983 & 3.88698188292093 & ... & 4.65601824147909 & 4.37606300877576 & 1.34497323550229 & 0.682766793768383 & NA & NA & 1.68248531252453 & 1.41902009832491 & 3.15243377995469 & 2.57420036679001 \\\\\n", "\t May03 & 5 & 1 & 18 & Apr04 & 604.58221 & -293.291105873806 & 142.581939326984 & 4.22840976749677 & 4.32212576081768 & ... & 4.77400308064525 & 4.88042735002151 & 1.35127312525943 & 0.762184264200378 & 1.33299932794081 & NA & 1.90872521903326 & 1.59169160603472 & 3.97017104258895 & 4.44497592289921 \\\\\n", "\t May11 & 5 & 1 & 46 & May02 & 708.88241 & -345.441204439372 & 125.096302856632 & 4.49644882837161 & 4.30953027747521 & ... & 5.07285007468998 & 4.83674846683189 & 1.33156063772568 & 0.859395020131606 & 0.60289781187 & NA & 1.78607827145336 & 1.3734194595674 & 5.61110745257598 & 6.54440633897593 \\\\\n", "\t May17 & 5 & 1 & 45 & May01 & 746.59086 & -364.295429755597 & 124.330347135654 & 4.51689766306534 & 4.39175076020785 & ... & 5.09139084603557 & 4.92223999795685 & 1.32487775308412 & 0.892277572485883 & 0.534189719713544 & NA & 1.70295529989776 & 1.26665701540388 & 6.03510496188127 & 7.06699281597785 \\\\\n", "\t May25 & 5 & 1 & 45 & May01 & 755.77219 & -368.886094207812 & 123.221153324229 & 4.51692824693498 & 4.46519189800703 & ... & 5.09142086778493 & 5.01534276540328 & 1.32099997732123 & 0.912124223088248 & 0.477008301006462 & NA & 1.6078340007658 & 1.20447585744293 & 6.03550451292114 & 6.85730326305217 \\\\\n", "\\end{tabular}\n" ], "text/markdown": [ "\n", "epicurve | generations | switches | tau | tauDate | AIC | loglk | K | mean_h1 | mean_h2 | ... | par2_h1 | par2_h2 | R2 | R3 | R4 | R5 | rmse_c | rmse_i | var_h1 | var_h2 | \n", "|---|---|---|---|---|---|---|---|\n", "| Apr01 | 2 | 1 | 11 | Mar28 | 81.36847 | -34.6842372465291 | 25.72152052601 | 4.39259735948419 | 15.8623046549225 | ... | 4.89750001774415 | 12.1720171735286 | NA | NA | NA | NA | 1.32605473134763 | 1.04623354350151 | 2.1573918436451 | 576.186086227435 | \n", "| Apr09 | 3 | 1 | 11 | Mar28 | 207.33255 | -96.6662748386242 | 60.2895795115133 | 4.85770704954315 | 3.69625810355023 | ... | 5.4581019060818 | 4.17313909916217 | 0.938204013051551 | NA | NA | NA | 1.65257582384134 | 1.37108865315585 | 3.61429234113614 | 3.45079785938741 | \n", "| Apr17 | 3 | 1 | 24 | Apr10 | 349.97873 | -167.989362695309 | 74.8567474055843 | 4.12754035190244 | 3.83864567289599 | ... | 4.65235547933119 | 4.3195417490074 | 1.52056513218659 | NA | NA | NA | 1.63698491106479 | 1.39295753538546 | 3.13768164668523 | 2.44055852699075 | \n", "| Apr25 | 4 | 1 | 24 | Apr10 | 453.49034 | -218.745170913519 | 96.7004494667949 | 4.13061282591983 | 3.88698188292093 | ... | 4.65601824147909 | 4.37606300877576 | 1.34497323550229 | 0.682766793768383 | NA | NA | 1.68248531252453 | 1.41902009832491 | 3.15243377995469 | 2.57420036679001 | \n", "| May03 | 5 | 1 | 18 | Apr04 | 604.58221 | -293.291105873806 | 142.581939326984 | 4.22840976749677 | 4.32212576081768 | ... | 4.77400308064525 | 4.88042735002151 | 1.35127312525943 | 0.762184264200378 | 1.33299932794081 | NA | 1.90872521903326 | 1.59169160603472 | 3.97017104258895 | 4.44497592289921 | \n", "| May11 | 5 | 1 | 46 | May02 | 708.88241 | -345.441204439372 | 125.096302856632 | 4.49644882837161 | 4.30953027747521 | ... | 5.07285007468998 | 4.83674846683189 | 1.33156063772568 | 0.859395020131606 | 0.60289781187 | NA | 1.78607827145336 | 1.3734194595674 | 5.61110745257598 | 6.54440633897593 | \n", "| May17 | 5 | 1 | 45 | May01 | 746.59086 | -364.295429755597 | 124.330347135654 | 4.51689766306534 | 4.39175076020785 | ... | 5.09139084603557 | 4.92223999795685 | 1.32487775308412 | 0.892277572485883 | 0.534189719713544 | NA | 1.70295529989776 | 1.26665701540388 | 6.03510496188127 | 7.06699281597785 | \n", "| May25 | 5 | 1 | 45 | May01 | 755.77219 | -368.886094207812 | 123.221153324229 | 4.51692824693498 | 4.46519189800703 | ... | 5.09142086778493 | 5.01534276540328 | 1.32099997732123 | 0.912124223088248 | 0.477008301006462 | NA | 1.6078340007658 | 1.20447585744293 | 6.03550451292114 | 6.85730326305217 | \n", "\n", "\n" ], "text/plain": [ " epicurve generations switches tau tauDate AIC loglk \n", "1 Apr01 2 1 11 Mar28 81.36847 -34.6842372465291\n", "2 Apr09 3 1 11 Mar28 207.33255 -96.6662748386242\n", "3 Apr17 3 1 24 Apr10 349.97873 -167.989362695309\n", "4 Apr25 4 1 24 Apr10 453.49034 -218.745170913519\n", "5 May03 5 1 18 Apr04 604.58221 -293.291105873806\n", "6 May11 5 1 46 May02 708.88241 -345.441204439372\n", "7 May17 5 1 45 May01 746.59086 -364.295429755597\n", "8 May25 5 1 45 May01 755.77219 -368.886094207812\n", " K mean_h1 mean_h2 ... par2_h1 \n", "1 25.72152052601 4.39259735948419 15.8623046549225 ... 4.89750001774415\n", "2 60.2895795115133 4.85770704954315 3.69625810355023 ... 5.4581019060818 \n", "3 74.8567474055843 4.12754035190244 3.83864567289599 ... 4.65235547933119\n", "4 96.7004494667949 4.13061282591983 3.88698188292093 ... 4.65601824147909\n", "5 142.581939326984 4.22840976749677 4.32212576081768 ... 4.77400308064525\n", "6 125.096302856632 4.49644882837161 4.30953027747521 ... 5.07285007468998\n", "7 124.330347135654 4.51689766306534 4.39175076020785 ... 5.09139084603557\n", "8 123.221153324229 4.51692824693498 4.46519189800703 ... 5.09142086778493\n", " par2_h2 R2 R3 R4 R5\n", "1 12.1720171735286 NA NA NA NA\n", "2 4.17313909916217 0.938204013051551 NA NA NA\n", "3 4.3195417490074 1.52056513218659 NA NA NA\n", "4 4.37606300877576 1.34497323550229 0.682766793768383 NA NA\n", "5 4.88042735002151 1.35127312525943 0.762184264200378 1.33299932794081 NA\n", "6 4.83674846683189 1.33156063772568 0.859395020131606 0.60289781187 NA\n", "7 4.92223999795685 1.32487775308412 0.892277572485883 0.534189719713544 NA\n", "8 5.01534276540328 1.32099997732123 0.912124223088248 0.477008301006462 NA\n", " rmse_c rmse_i var_h1 var_h2 \n", "1 1.32605473134763 1.04623354350151 2.1573918436451 576.186086227435\n", "2 1.65257582384134 1.37108865315585 3.61429234113614 3.45079785938741\n", "3 1.63698491106479 1.39295753538546 3.13768164668523 2.44055852699075\n", "4 1.68248531252453 1.41902009832491 3.15243377995469 2.57420036679001\n", "5 1.90872521903326 1.59169160603472 3.97017104258895 4.44497592289921\n", "6 1.78607827145336 1.3734194595674 5.61110745257598 6.54440633897593\n", "7 1.70295529989776 1.26665701540388 6.03510496188127 7.06699281597785\n", "8 1.6078340007658 1.20447585744293 6.03550451292114 6.85730326305217" ] }, "metadata": {}, "output_type": "display_data" } ], "source": [ "final_pars_1" ] }, { "cell_type": "code", "execution_count": 169, "metadata": {}, "outputs": [ { "data": { "text/html": [ "\n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", "\n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", " \n", "\n", "
epicurve generations tauDate mean h1t var h1t mean h2t var h2t K R2 R3 R4 R5 negloglk AIC
Apr01 2 Mar28 4.39 2.16 15.86 576.19 25.7 34.7 81.4
Apr09 3 Mar28 4.86 3.61 3.70 3.45 60.3 0.94 96.7 207.3
Apr17 3 Apr10 4.13 3.14 3.84 2.44 74.9 1.52 168.0 350.0
Apr25 4 Apr10 4.13 3.15 3.89 2.57 96.7 1.34 0.68 218.7 453.5
May03 5 Apr04 4.23 3.97 4.32 4.44 142.6 1.35 0.76 1.33 293.3 604.6
May11 5 May02 4.50 5.61 4.31 6.54 125.1 1.33 0.86 0.60 345.4 708.9
May17 5 May01 4.52 6.04 4.39 7.07 124.3 1.32 0.89 0.53 364.3 746.6
May25 5 May01 4.52 6.04 4.47 6.86 123.2 1.32 0.91 0.48 368.9 755.8
" ] }, "metadata": {}, "output_type": "display_data" } ], "source": [ "# a bit nicer form\n", "options(warn=-1)\n", "final_pars_1 %>% \n", " arrange(epicurve,generations) %>%\n", " group_by(epicurve) %>%\n", " mutate(\n", " `mean h1t`= sprintf(\"%0.2f\",mean_h1%>%as.numeric),\n", " `var h1t`=sprintf(\"%0.2f\",var_h1%>%as.numeric),\n", " `mean h2t`= sprintf(\"%0.2f\",mean_h2%>%as.numeric),\n", " `var h2t`=sprintf(\"%0.2f\",var_h2%>%as.numeric),\n", " K=sprintf(\"%0.1f\",K%>%as.numeric),\n", " R2=ifelse(!is.na(R2),\n", " sprintf(\"%0.2f\",R2%>%as.numeric),\n", " ''),\n", " R3=ifelse(!is.na(R3),\n", " sprintf(\"%0.2f\",R3%>%as.numeric),\n", " ''),\n", " R4=ifelse(!is.na(R4),\n", " sprintf(\"%0.2f\",R4%>%as.numeric),\n", " ''),\n", " R5=ifelse(!is.na(R5),\n", " sprintf(\"%0.2f\",R5%>%as.numeric),\n", " ''),\n", " negloglk=sprintf(\"%.1f\",-as.numeric(loglk)),\n", " AIC=sprintf(\"%.1f\",AIC)\n", " ) %>%\n", " select(epicurve,generations,tauDate,`mean h1t`,`var h1t`,`mean h2t`,`var h2t`,K,R2,R3,R4,R5,negloglk,AIC) -> pars_final_kabble#\n", "\n", "\n", "pars_final_kabble %>%\n", " kable(\"html\", escape = F) %>%\n", " kable_styling(\"hover\", full_width = F) %>%\n", " as.character() %>%\n", " display_html()\n", "options(warn=0)" ] }, { "cell_type": "code", "execution_count": null, "metadata": {}, "outputs": [], "source": [] } ], "metadata": { "kernelspec": { "display_name": "R", "language": "R", "name": "ir" }, "language_info": { "codemirror_mode": "r", "file_extension": ".r", "mimetype": "text/x-r-source", "name": "R", "pygments_lexer": "r", "version": "3.5.1" } }, "nbformat": 4, "nbformat_minor": 2 }