html.json (24394B)
1 { 2 "hash": "8a50c3c76dab30e00dbe505419cd5af9", 3 "result": { 4 "engine": "knitr", 5 "markdown": "---\nengine: knitr\ntitle: Functions\n---\n\n\n\n## Learning objectives:\n\n- How to make functions in R\n- What are the parts of a function\n- Nested functions\n\n## How to make a simple function in R\n\n**Function components**\n\nFunctions have three parts, `formals()`, `body()`, and `environment()`.\n\n\n\n::: {.cell layout-align=\"center\"}\n::: {.cell-output-display}\n\n```{=html}\n<div id=\"htmlwidget-b0f018098d1077574e94\" style=\"width:100%;height:100%;\" class=\"DiagrammeR html-widget\"></div>\n<script type=\"application/json\" data-for=\"htmlwidget-b0f018098d1077574e94\">{\"x\":{\"diagram\":\"\\n graph LR\\n A{formals}-->B(body)\\n B-->C(environment)\\nstyle A fill:#bbf,stroke:#f66,stroke-width:2px,color:#fff,stroke-dasharray: 5 5\\n\"},\"evals\":[],\"jsHooks\":[]}</script>\n```\n\n:::\n:::\n\n\n\n--------------------------------------------------------------------------------\n\n**Example: [coffee rations](https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-07-07/coffee_ratings.csv)**\n\n\n\n::: {.cell}\n\n:::\n\n::: {.cell}\n\n```{.r .cell-code}\navg_points <- function(species){\n # this function is for calculating the mean\n avg <- coffee_ratings |>\n filter(species == species) |>\n summarise(mean = mean(total_cup_points))\n return(avg)\n}\n```\n:::\n\n::: {.cell}\n\n```{.r .cell-code}\navg_points(\"Arabica\")\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> # A tibble: 1 × 1\n#> mean\n#> <dbl>\n#> 1 82.1\n```\n\n\n:::\n:::\n\n\n\n---------------------------------------------------------------------------------\n\n\n\n::: {.cell}\n\n```{.r .cell-code}\nformals(avg_points)\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> $species\n```\n\n\n:::\n:::\n\n::: {.cell}\n\n```{.r .cell-code}\nbody(avg_points)\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> {\n#> avg <- summarise(filter(coffee_ratings, species == species), \n#> mean = mean(total_cup_points))\n#> return(avg)\n#> }\n```\n\n\n:::\n:::\n\n::: {.cell}\n\n```{.r .cell-code}\nenvironment(avg_points)\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> <environment: R_GlobalEnv>\n```\n\n\n:::\n:::\n\n\n\n\n-----------------------------------------------------------------------------------\n\nFunctions uses attributes, one attribute used by base R is `srcref`, short for **source reference**. \nIt points to the source code used to create the function. \nIt contains code comments and other formatting.\n\n\n\n::: {.cell}\n\n```{.r .cell-code}\n#| eval=FALSE\nmy_f <- function(){\n #test\n return(1)\n}\n\nattr(my_f, \"srcref\")\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> NULL\n```\n\n\n:::\n:::\n\n\n\n## Primitive functions\n\nAre the core function in base R, such as `sum()`\n\n\n::: {.cell}\n\n```{.r .cell-code}\nsum\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> function (..., na.rm = FALSE) .Primitive(\"sum\")\n```\n\n\n:::\n:::\n\n\n\nType of primitives:\n\n- builtin \n- special\n\n\n\n::: {.cell}\n\n```{.r .cell-code}\ntypeof(sum)\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> [1] \"builtin\"\n```\n\n\n:::\n:::\n\n\n\n\nThese core functions have components to NULL.\n\n## Anonymous functions\n\nIf you don't provide a name to a function\n\n\n\n::: {.cell}\n\n```{.r .cell-code}\nlapply(mtcars |> select(mpg, cyl), function(x) length(unique(x)))\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> $mpg\n#> [1] 25\n#> \n#> $cyl\n#> [1] 3\n```\n\n\n:::\n:::\n\n::: {.cell}\n\n```{.r .cell-code}\nvector_len <- function(x) {\n length(unique(x))\n}\n```\n:::\n\n::: {.cell}\n\n```{.r .cell-code}\nlapply(mtcars |> select(mpg, cyl), vector_len)\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> $mpg\n#> [1] 25\n#> \n#> $cyl\n#> [1] 3\n```\n\n\n:::\n:::\n\n\n\n-------------------------------------------------------------------------------------------\n\n**Invoking a function**\n\n\n\n::: {.cell}\n\n```{.r .cell-code}\nargs <- unique(coffee_ratings$species)[[1]] |> as.list()\n\ndo.call(avg_points, args)\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> # A tibble: 1 × 1\n#> mean\n#> <dbl>\n#> 1 82.1\n```\n\n\n:::\n:::\n\n\n\n`do.call` is used a lot with apply's family \n\n## Function composition\n\n\n\n::: {.cell}\n\n```{.r .cell-code}\nx <- runif(100)\n# Nested function calls\nsquare <- function(x) x^2\ndeviation <- function(x) x - mean(x)\nsqrt(mean(square(deviation(x))))\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> [1] 0.2549537\n```\n\n\n:::\n:::\n\n::: {.cell}\n\n```{.r .cell-code}\n# intermediate result\nout <- deviation(x)\nout <- square(out)\nout <- mean(out)\nout <- sqrt(out)\nout\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> [1] 0.2549537\n```\n\n\n:::\n:::\n\n::: {.cell}\n\n```{.r .cell-code}\n# Pipe workflow\nx |> \n deviation() |>\n square() |>\n mean() |>\n sqrt()\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> [1] 0.2549537\n```\n\n\n:::\n:::\n\n\n\n## More about functions insights\n\n### Lexical scoping\n\n**Rules**\n\n- Name masking\n- Functions versus variables\n- A fresh start\n- Dynamic lookup\n\n--------------------------------------------------------------------------------\n\n#### Name masking\n\nSave us from our polluted global environment! \n\n\n\n::: {.cell}\n\n```{.r .cell-code}\nbob <- 1; alice <- 2\n\ng02 <- function() {bob <- \"test\"; alice <- \"bacon\"; c(bob, alice)}\n\ng03 <- function() {bob <- \"test\"; c(bob, alice)}\n\ng02()\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> [1] \"test\" \"bacon\"\n```\n\n\n:::\n\n```{.r .cell-code}\ng03()\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> [1] \"test\" \"2\"\n```\n\n\n:::\n:::\n\n\n\nNote: also applied for functions names\n\n------------------------------------------------------------------------------------\n\n#### Functions versus variables\n\n::: {.callout-caution}\nDo not be too smart!\n:::\n\n\n\n::: {.cell}\n\n```{.r .cell-code}\ng09 <- function(x) x + 100\ng10 <- function() {\n g09 <- 10\n g09(g09)\n}\ng10()\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> [1] 110\n```\n\n\n:::\n:::\n\n\n\n------------------------------------------------------------------------------------\n\n#### Fresh start:\n\n\n\n::: {.cell}\n\n```{.r .cell-code}\ng11 <- function() {\n if (!exists(\"a\")) {\n print(\"I am here\")\n a <- 1\n } else {\n print(\"Dead branch!\")\n a <- a + 1\n }\n a\n}\n\ng11()\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> [1] \"I am here\"\n```\n\n\n:::\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> [1] 1\n```\n\n\n:::\n\n```{.r .cell-code}\ng11()\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> [1] \"I am here\"\n```\n\n\n:::\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> [1] 1\n```\n\n\n:::\n:::\n\n\n\n-------------------------------------------------------------------------------------\n\n#### Dynamic scoping:\n\n**\"When\"**: R looks for the value **when** the function is run \n\nThis function \n\n\n::: {.cell}\n\n```{.r .cell-code}\ng12 <- function() x + 1\nx <- 15\ng12()\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> [1] 16\n```\n\n\n:::\n\n```{.r .cell-code}\nx <- 20\ng12()\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> [1] 21\n```\n\n\n:::\n:::\n\n\n\n------------------------------------------------------------------------------------\n\n#### Debugging\n\n\n\n::: {.cell}\n\n```{.r .cell-code}\ncodetools::findGlobals(g12)\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> [1] \"+\" \"x\"\n```\n\n\n:::\n:::\n\n\n\nYou can change the function’s environment to an environment which contains nothing:\n\n\n::: {.cell}\n\n```{.r .cell-code}\n# environment(g12) <- emptyenv()\n# g12()\n# Error in x + 1 : could not find function \"+\"\n```\n:::\n\n\n\n------------------------------------------------------------------------------------\n\n## Lazy Evaluation:\n\n\n::: {.callout-important}\nfunction arguments are only evaluated when accessed\n:::\n\n------------------------------------------------------------------------------------\n\n#### Promises \n\nSee you at chapter 20! \n\nPromises: multiple definitions? \n\n- [Futurverse](https://journal.r-project.org/archive/2021/RJ-2021-048/RJ-2021-048.pdf)\n\n- [Promises](https://rstudio.github.io/promises/) in Shiny \n\n----------------------------------------------------------------------------------\n\n#### Default arguments\n\nArguments defined by other arguments or variables in Functions\n\n::: {.callout-caution}\nNot recommended by Hadley!\n:::\n\n----------------------------------------------------------------------------------\n\n#### Missing arguments \n\n`missing()` checks if an argument is missing (TRUE/FALSE) then you can \"branch\" according to it\n\n::: {.callout-caution}\nDo not be like `sample()` ! \n:::\n\n------------------------------------------------------------------------------------\n\n### ... (dot-dot-dot)\n\n**Example**\n\n\n\n::: {.cell}\n\n```{.r .cell-code}\ni01 <- function(y, z) {\n list(y = y, z = z)\n}\ni02 <- function(x, ...) {\n i01(...)\n}\nstr(i02(x = 1, y = 2, z = 3))\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> List of 2\n#> $ y: num 2\n#> $ z: num 3\n```\n\n\n:::\n:::\n\n\n\nUsed a lot with higher ordered functions! \n\n-----------------------------------------------------------------------------------\n\n### Exiting a function\n\n1. Implicit or explicit returns\n\n2. Invisibility (`<-` most famous function that returns an invisible value)\n\n3. `stop()` to stop a function with an error.\n\n4. Exit handlers (`on.exit()`)\n\n------------------------------------------------------------------------------------\n\n### Function forms\n\n>Everything that exists is an object.\nEverything that happens is a function call.\n— John Chambers\n\n\n\n\n::: {.cell}\n::: {.cell-output-display}\n{width=584}\n:::\n:::\n\n\n\n---\n\n\n## Case Study: SIR model function\n\nThis is an interesting example taken from a course on Coursera: [Infectious disease modelling-ICL](https://www.coursera.org/specializations/infectious-disease-modelling)\n\nThe purpose of this example is to show how to make a model passing through making a function.\n\nFirst we need to load some useful libraries:\n\n\n\n::: {.cell}\n\n```{.r .cell-code}\nlibrary(deSolve)\nlibrary(reshape2)\n```\n:::\n\n\n\n\nThen set the model inputs:\n\n- population size (N)\n- number of susceptable (S)\n- infected (I)\n- recovered (R)\n\nAnd add the model parameters:\n\n- infection rate ($\\beta$)\n- recovery rate ($\\gamma$)\n\n\n\n\n::: {.cell}\n\n```{.r .cell-code}\nN<- 100000 # population\n\nstate_values<- c(S = N -1, # susceptible\n I = 1, # infected\n R = 0) # recovered\n\nparameters<- c(beta = 1/2, # infection rate days^-1\n gamma = 1/4) # recovery rate days^-1\n```\n:::\n\n\n\n\nThen we set the **time** as an important factor, which defines the length of time we are looking at this model run. It is intended as the time range in which the infections spread out, let’s say that we are aiming to investigate an infection period of 100 days.\n\n\n\n::: {.cell}\n\n```{.r .cell-code}\ntimes<- seq(0, 100, by = 1)\n```\n:::\n\n\n\nFinally, we set up the **SIR model**, the susceptable, infected and recovered model. How do we do that is passing the paramenters through a function of the time, and state.\n\nWithin the model function we calculate one more paramenter, the **force of infection**: $\\lambda$ \n\n\n\n::: {.cell}\n\n```{.r .cell-code}\nsir_model<- function(time, state, parameters){\n with(as.list(c(state, parameters)),{\n N<- S + I + R\n lambda = beta * I/N # force of infection\n dS<- - lambda * S \n dI<- lambda * S - gamma * I\n dR<- gamma * I\n return(list(c(dS,dI,dR)))\n })\n}\n```\n:::\n\n\n\n\nOnce we have our **SIR model** function ready, we can calculate the **output** of the model, with the help of the function `ode()` from {deSolve} package.\n\n\n\n::: {.cell}\n\n```{.r .cell-code}\noutput<- as.data.frame(ode(y = state_values,\n times = times,\n func = sir_model,\n parms = parameters))\noutput %>% head\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> time S I R\n#> 1 0 99999.00 1.000000 0.0000000\n#> 2 1 99998.43 1.284018 0.2840252\n#> 3 2 99997.70 1.648696 0.6487171\n#> 4 3 99996.77 2.116939 1.1169863\n#> 5 4 99995.56 2.718152 1.7182450\n#> 6 5 99994.02 3.490086 2.4902600\n```\n\n\n:::\n:::\n\n\n\nIn addition to our builtin SIR model function we can have a look at:\n\n\n\n::: {.cell}\n\n```{.r .cell-code}\n?deSolve::ode()\n```\n:::\n\n\n\nIt solves **Ordinary Differential Equations**. \n\n\n\n::: {.cell}\n\n```{.r .cell-code}\ndeSolve:::ode\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> function (y, times, func, parms, method = c(\"lsoda\", \"lsode\", \n#> \"lsodes\", \"lsodar\", \"vode\", \"daspk\", \"euler\", \"rk4\", \"ode23\", \n#> \"ode45\", \"radau\", \"bdf\", \"bdf_d\", \"adams\", \"impAdams\", \"impAdams_d\", \n#> \"iteration\"), ...) \n#> {\n#> if (is.null(method)) \n#> method <- \"lsoda\"\n#> if (is.list(method)) {\n#> if (!inherits(method, \"rkMethod\")) \n#> stop(\"'method' should be given as string or as a list of class 'rkMethod'\")\n#> out <- rk(y, times, func, parms, method = method, ...)\n#> }\n#> else if (is.function(method)) \n#> out <- method(y, times, func, parms, ...)\n#> else if (is.complex(y)) \n#> out <- switch(match.arg(method), vode = zvode(y, times, \n#> func, parms, ...), bdf = zvode(y, times, func, parms, \n#> mf = 22, ...), bdf_d = zvode(y, times, func, parms, \n#> mf = 23, ...), adams = zvode(y, times, func, parms, \n#> mf = 10, ...), impAdams = zvode(y, times, func, parms, \n#> mf = 12, ...), impAdams_d = zvode(y, times, func, \n#> parms, mf = 13, ...))\n#> else out <- switch(match.arg(method), lsoda = lsoda(y, times, \n#> func, parms, ...), vode = vode(y, times, func, parms, \n#> ...), lsode = lsode(y, times, func, parms, ...), lsodes = lsodes(y, \n#> times, func, parms, ...), lsodar = lsodar(y, times, func, \n#> parms, ...), daspk = daspk(y, times, func, parms, ...), \n#> euler = rk(y, times, func, parms, method = \"euler\", ...), \n#> rk4 = rk(y, times, func, parms, method = \"rk4\", ...), \n#> ode23 = rk(y, times, func, parms, method = \"ode23\", ...), \n#> ode45 = rk(y, times, func, parms, method = \"ode45\", ...), \n#> radau = radau(y, times, func, parms, ...), bdf = lsode(y, \n#> times, func, parms, mf = 22, ...), bdf_d = lsode(y, \n#> times, func, parms, mf = 23, ...), adams = lsode(y, \n#> times, func, parms, mf = 10, ...), impAdams = lsode(y, \n#> times, func, parms, mf = 12, ...), impAdams_d = lsode(y, \n#> times, func, parms, mf = 13, ...), iteration = iteration(y, \n#> times, func, parms, ...))\n#> return(out)\n#> }\n#> <bytecode: 0x5e4ff4997c50>\n#> <environment: namespace:deSolve>\n```\n\n\n:::\n:::\n\n::: {.cell}\n\n```{.r .cell-code}\nmethods(\"ode\")\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> [1] ode.1D ode.2D ode.3D ode.band\n#> see '?methods' for accessing help and source code\n```\n\n\n:::\n:::\n\n\n\n\n---\n\nWith the help of the {reshape2} package we use the function `melt()` to reshape the output:\n\n\n\n::: {.cell}\n\n```{.r .cell-code}\nmelt(output,id=\"time\") %>% head\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> time variable value\n#> 1 0 S 99999.00\n#> 2 1 S 99998.43\n#> 3 2 S 99997.70\n#> 4 3 S 99996.77\n#> 5 4 S 99995.56\n#> 6 5 S 99994.02\n```\n\n\n:::\n:::\n\n\n\n\nThe same as usign `pivot_longer()` function.\n\n\n::: {.cell}\n\n```{.r .cell-code}\noutput%>%\n pivot_longer(cols = c(\"S\",\"I\",\"R\"),\n names_to=\"variable\",\n values_to=\"values\") %>%\n arrange(desc(variable)) %>%\n head\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> # A tibble: 6 × 3\n#> time variable values\n#> <dbl> <chr> <dbl>\n#> 1 0 S 99999 \n#> 2 1 S 99998.\n#> 3 2 S 99998.\n#> 4 3 S 99997.\n#> 5 4 S 99996.\n#> 6 5 S 99994.\n```\n\n\n:::\n:::\n\n\n\n---\n\n\nBefore to proceed with the visualization of the SIR model output we do a bit of investigations.\n\n**What if we want to see how `melt()` function works?**\n\n**What instruments we can use to see inside the function and understand how it works?**\n\n\nUsing just the function name **melt** or `structure()` function with *melt* as an argument, we obtain the same output. To select just the argument of the function we can do `args(melt)`\n\n\n\n::: {.cell}\n\n```{.r .cell-code}\nreshape2:::melt\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> function (data, ..., na.rm = FALSE, value.name = \"value\") \n#> {\n#> UseMethod(\"melt\", data)\n#> }\n#> <bytecode: 0x5e4ff455aee8>\n#> <environment: namespace:reshape2>\n```\n\n\n:::\n:::\n\n::: {.cell}\n\n```{.r .cell-code}\nbody(melt)\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> {\n#> UseMethod(\"melt\", data)\n#> }\n```\n\n\n:::\n:::\n\n::: {.cell}\n\n```{.r .cell-code}\nformals(melt)\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> $data\n#> \n#> \n#> $...\n#> \n#> \n#> $na.rm\n#> [1] FALSE\n#> \n#> $value.name\n#> [1] \"value\"\n```\n\n\n:::\n:::\n\n::: {.cell}\n\n```{.r .cell-code}\nenvironment(melt)\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> <environment: namespace:reshape2>\n```\n\n\n:::\n:::\n\n::: {.cell}\n\n```{.r .cell-code}\ntypeof(melt)\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> [1] \"closure\"\n```\n\n\n:::\n:::\n\n\n\n> \"R functions simulate a closure by keeping an explicit reference to the environment that was active when the function was defined.\"\n\n\nref: [closures](https://www.r-bloggers.com/2015/03/using-closures-as-objects-in-r/)\n\n\n\nTry with `methods()`, or `print(methods(melt))`: Non-visible functions are asterisked!\n\n> The S3 method name is followed by an asterisk * if the method definition is not exported from the package namespace in which the method is defined.\n\n\n\n::: {.cell}\n\n```{.r .cell-code}\nmethods(\"melt\", data)\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> [1] melt.array* melt.data.frame* melt.default* melt.list* \n#> [5] melt.matrix* melt.table* \n#> see '?methods' for accessing help and source code\n```\n\n\n:::\n:::\n\n::: {.cell}\n\n```{.r .cell-code}\nmethods(class=\"table\")\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> [1] [ aperm as_tibble as.data.frame Axis \n#> [6] coerce initialize lines melt plot \n#> [11] points print show slotsFromS3 summary \n#> [16] tail \n#> see '?methods' for accessing help and source code\n```\n\n\n:::\n:::\n\n::: {.cell}\n\n```{.r .cell-code}\nhelp(UseMethod)\n```\n:::\n\n\n\n\nWe can access to some of the above calls with `getAnywhere()`, for example here is done for \"melt.data.frame\":\n\n\n::: {.cell}\n\n```{.r .cell-code}\ngetAnywhere(\"melt.data.frame\")\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> A single object matching 'melt.data.frame' was found\n#> It was found in the following places\n#> registered S3 method for melt from namespace reshape2\n#> namespace:reshape2\n#> with value\n#> \n#> function (data, id.vars, measure.vars, variable.name = \"variable\", \n#> ..., na.rm = FALSE, value.name = \"value\", factorsAsStrings = TRUE) \n#> {\n#> vars <- melt_check(data, id.vars, measure.vars, variable.name, \n#> value.name)\n#> id.ind <- match(vars$id, names(data))\n#> measure.ind <- match(vars$measure, names(data))\n#> if (!length(measure.ind)) {\n#> return(data[id.vars])\n#> }\n#> args <- normalize_melt_arguments(data, measure.ind, factorsAsStrings)\n#> measure.attributes <- args$measure.attributes\n#> factorsAsStrings <- args$factorsAsStrings\n#> valueAsFactor <- \"factor\" %in% measure.attributes$class\n#> df <- melt_dataframe(data, as.integer(id.ind - 1), as.integer(measure.ind - \n#> 1), as.character(variable.name), as.character(value.name), \n#> as.pairlist(measure.attributes), as.logical(factorsAsStrings), \n#> as.logical(valueAsFactor))\n#> if (na.rm) {\n#> return(df[!is.na(df[[value.name]]), ])\n#> }\n#> else {\n#> return(df)\n#> }\n#> }\n#> <bytecode: 0x5e4feee017f0>\n#> <environment: namespace:reshape2>\n```\n\n\n:::\n:::\n\n\n\n\nReferences:\n\n- [stackoverflow article](https://stackoverflow.com/questions/11173683/how-can-i-read-the-source-code-for-an-r-function)\n- [Rnews bulletin: R Help Desk](https://www.r-project.org/doc/Rnews/Rnews_2006-4.pdf)\n\n\n\n---\n\nGoing back to out model output visualization.\n\n\n\n::: {.cell}\n\n```{.r .cell-code}\noutput_full<- melt(output,id=\"time\")\n```\n:::\n\n::: {.cell}\n\n```{.r .cell-code}\noutput_full$proportion<- output_full$value/sum(state_values)\n```\n:::\n\n::: {.cell}\n\n```{.r .cell-code}\nggplot(data = output, aes(x = time, y = I)) + \n geom_line() + \n xlab(\"Time(days)\") +\n ylab(\"Number of Infected\") + \n labs(\"SIR Model: prevalence of infection\")\n```\n\n::: {.cell-output-display}\n{width=960}\n:::\n:::\n\n::: {.cell}\n\n```{.r .cell-code}\nggplot(output_full, aes(time, proportion, color = variable, group = variable)) + \n geom_line() + \n xlab(\"Time(days)\") +\n ylab(\"Prevalence\") + \n labs(color = \"Compartment\", title = \"SIR Model\")\n```\n\n::: {.cell-output-display}\n{width=960}\n:::\n:::\n", 6 "supporting": [ 7 "06_files/figure-revealjs" 8 ], 9 "filters": [ 10 "rmarkdown/pagebreak.lua" 11 ], 12 "includes": { 13 "include-in-header": [ 14 "<script src=\"../site_libs/htmlwidgets-1.6.4/htmlwidgets.js\"></script>\n<script src=\"../site_libs/d3-3.3.8/d3.min.js\"></script>\n<script src=\"../site_libs/dagre-0.4.0/dagre-d3.min.js\"></script>\n<link href=\"../site_libs/mermaid-0.3.0/dist/mermaid.css\" rel=\"stylesheet\" />\n<script src=\"../site_libs/mermaid-0.3.0/dist/mermaid.slim.min.js\"></script>\n<link href=\"../site_libs/DiagrammeR-styles-0.2/styles.css\" rel=\"stylesheet\" />\n<script src=\"../site_libs/chromatography-0.1/chromatography.js\"></script>\n<script src=\"../site_libs/DiagrammeR-binding-1.0.11/DiagrammeR.js\"></script>\n" 15 ], 16 "include-after-body": [ 17 "\n<script>\n // htmlwidgets need to know to resize themselves when slides are shown/hidden.\n // Fire the \"slideenter\" event (handled by htmlwidgets.js) when the current\n // slide changes (different for each slide format).\n (function () {\n // dispatch for htmlwidgets\n function fireSlideEnter() {\n const event = window.document.createEvent(\"Event\");\n event.initEvent(\"slideenter\", true, true);\n window.document.dispatchEvent(event);\n }\n\n function fireSlideChanged(previousSlide, currentSlide) {\n fireSlideEnter();\n\n // dispatch for shiny\n if (window.jQuery) {\n if (previousSlide) {\n window.jQuery(previousSlide).trigger(\"hidden\");\n }\n if (currentSlide) {\n window.jQuery(currentSlide).trigger(\"shown\");\n }\n }\n }\n\n // hookup for slidy\n if (window.w3c_slidy) {\n window.w3c_slidy.add_observer(function (slide_num) {\n // slide_num starts at position 1\n fireSlideChanged(null, w3c_slidy.slides[slide_num - 1]);\n });\n }\n\n })();\n</script>\n\n" 18 ] 19 }, 20 "engineDependencies": {}, 21 "preserve": {}, 22 "postProcess": true 23 } 24 }