# Installing the package To install the current stable, CRAN version of the package, type: ```{r install, eval=FALSE} install.packages("incidence") ``` To benefit from the latest features and bug fixes, install the development, *github* version of the package using: ```{r install2, eval=FALSE} devtools::install_github("reconhub/incidence") ``` Note that this requires the package *devtools* installed.
# What does it do? The main functions of the package include: - **`incidence`**: compute incidence from dates in various formats; any fixed time interval can be used; the returned object is an instance of the (S3) class *incidence*. - **`plot`**: this method (see `?plot.incidence` for details) plots *incidence* objects, and can also add predictions of the model(s) contained in an *incidence_fit* object (or a list of such objects). - **`fit`**: fit one or two exponential models (i.e. linear regression on log-incidence) to an *incidence* object; two models are calibrated only if a date is provided to split the time series in two (argument `split`); this is typically useful to model the two phases of exponential growth, and decrease of an outbreak; each model returned is an instance of the (S3) class *incidence_fit*, each of which contains various useful information (e.g. growth rate *r*, doubling/halving time, predictions and confidence intervals); results can be plotted using `plot`, or added to an existing `uncudence` plot using the piping-friendly function `add_incidence_fit`. - **`fit_optim_split`**: finds the optimal date to split the time series in two, typically around the peak of the epidemic. - **`[`**: lower-level subsetting of *incidence* objects, permitting to specify which dates and groups to retain; uses a syntax similar to matrices, i.e. `x[i, j]`, where `x` is the *incidence* object, `i` a subset of dates, and `j` a subset of groups. - **`subset`**: subset an *incidence* object by specifying a time window. - **`pool`**: pool incidence from different groups into one global incidence time series. - **`cumulate`**: computes cumulative incidence over time from and `incidence` object. - **`as.data.frame`**: converts an *incidence* object into a `data.frame` containing dates and incidence values. - **`bootstrap`**: generates a bootstrapped *incidence* object by re-sampling, with replacement, the original dates of events. - **`find_peak`**: locates the peak time of the epicurve. - **`estimate_peak`**: uses bootstrap to estimate the peak time (and related confidence interval) of a partially observed outbreak. # Worked example: simulated Ebola outbreak ## Loading the data This example uses the simulated Ebola Virus Disease (EVD) outbreak from the package [*outbreaks*](https://cran.r-project.org/package=outbreaks). We will compute incidence for various time steps, calibrate two exponential models around the peak of the epidemic, and analyse the results. First, we load the data: ```{r, data} library(outbreaks) library(ggplot2) library(incidence) dat <- ebola_sim$linelist$date_of_onset class(dat) head(dat) ``` ## Computing and plotting incidence We compute the daily incidence: ```{r, incid1} i <- incidence(dat) i plot(i) ``` The daily incidence is quite noisy, but we can easily compute other incidence using larger time intervals: ```{r, interv} # weekly, starting on Monday (ISO week, default) i.7 <- incidence(dat, interval = "1 week") plot(i.7) # semi-weekly, starting on Saturday i.14 <- incidence(dat, interval = "2 saturday weeks") plot(i.14, border = "white") ## monthly i.month <- incidence(dat, interval = "1 month") plot(i.month, border = "white") ``` `incidence` can also compute incidence by specified groups using the `groups` argument. For instance, we can compute incidence by gender: ```{r, gender} i.7.sex <- incidence(dat, interval = "1 week", groups = ebola_sim$linelist$gender) i.7.sex plot(i.7.sex, stack = TRUE, border = "grey") ``` We can do the same for hospitals, using the 'clean' version of the dataset, with some customization of the legend: ```{r, hosp} i.7.hosp <- with(ebola_sim_clean$linelist, incidence(date_of_onset, interval = "week", groups = hospital)) i.7.hosp head(get_counts(i.7.hosp)) plot(i.7.hosp, stack=TRUE) + theme(legend.position= "top") + labs(fill="") ``` ## Handling `incidence` objects `incidence` objects can be manipulated easily. The `[` operator implements subsetting of dates (first argument) and groups (second argument). For instance, to keep only the peak of the distribution: ```{r, middle} i[100:250] plot(i[100:250]) ``` Or to keep every other week: ```{r, stripes} i.7[c(TRUE,FALSE)] plot(i.7[c(TRUE,FALSE)]) ``` Some temporal subsetting can be even simpler using `subset`, which permits to retain data within a specified time window: ```{r, tail} i.tail <- subset(i, from=as.Date("2015-01-01")) i.tail plot(i.tail, border="white") ``` Subsetting groups can also matter. For instance, let's try and visualise the incidence based on onset of symptoms by outcome: ```{r, i7outcome} i.7.outcome <- incidence(dat, 7, groups=ebola_sim$linelist$outcome) i.7.outcome plot(i.7.outcome, stack = TRUE, border = "grey") ``` By default, `incidence` treats missing data (NA) as a separate group (see argument `na_as_group`). We could disable this to retain only known outcomes, but alternatively we can simply subset the object to exclude the last (3rd) group: ```{r, groupsub} i.7.outcome[,1:2] plot(i.7.outcome[,1:2], stack = TRUE, border = "grey") ``` Groups can also be collapsed into a single time series using `pool`: ```{r, pool} i.pooled <- pool(i.7.outcome) i.pooled identical(i.7$counts, i.pooled$counts) ``` ## Modelling incidence Incidence data, excluding zeros, can be modelled using log-linear regression of the form: log(*y*) = *r* x *t* + *b* where *y* is the incidence, *r* is the growth rate, *t* is the number of days since a specific point in time (typically the start of the outbreak), and *b* is the intercept. Such model can be fitted to any incidence object using `fit`. Of course, a single log-linear model is not sufficient for modelling our epidemic curve, as there is clearly an growing and a decreasing phase. As a start, we can calibrate a model on the first 20 weeks of the epidemic: ```{r, fit1} plot(i.7[1:20]) early.fit <- fit(i.7[1:20]) early.fit ``` The resulting objects (known as `incidence_fit` objects) can be plotted, in which case the prediction and its confidence interval is displayed: ```{r} plot(early.fit) ``` However, a better way to display these predictions is adding them to the incidence plot using the argument `fit`: ```{r} plot(i.7[1:20], fit = early.fit) ``` In this case, we would ideally like to fit two models, before and after the peak of the epidemic. This is possible using the following approach, if you know what date to use to split the data in two phases: ```{r, fit.both} fit.both <- fit(i.7, split=as.Date("2014-10-15")) fit.both plot(i.7, fit=fit.both) ``` This is much better, but the splitting date is not completely optimal. To look for the best possible splitting date (i.e. the one maximizing the average fit of both models), we use: ```{r, optim} best.fit <- fit_optim_split(i.7) best.fit plot(i.7, fit=best.fit$fit) ``` These models are very good approximation of these data, showing a doubling time of `r round(get_info(best.fit$fit, "doubling"), 1)` days during the first phase, and a halving time of `r round(get_info(best.fit$fit, "halving"), 1)` days during the second. To access these parameters, you can use the `get_info()` function. The possible parameters are: - "r", the daily growth rate - "doubling" the rate of doubling in days (if "r" is positive) - "halving" the rate of halving in days (if "r" is negative) - "pred" a data frame of incidence predictions For "r", "doubling", and "halving", you can also add ".conf" to get the confidence intervals. Here's how you can get the doubling and halving times of the above epi curve: ```{r, get_info} get_info(best.fit$fit, "doubling") # doubling time get_info(best.fit$fit, "doubling.conf") # confidence interval get_info(best.fit$fit, "halving") get_info(best.fit$fit, "halving.conf") ``` Note that `fit` will also take groups into account if incidence has been computed for several groups: ```{r, optim2} best.fit2 <- fit_optim_split(i.7.sex) best.fit2 plot(i.7.sex, fit=best.fit2$fit) ``` Using `get_info()` on this fit object will return all groups together: ```{r, get_info_groups} get_info(best.fit2$fit, "doubling") # doubling time get_info(best.fit2$fit, "doubling.conf") # confidence interval get_info(best.fit2$fit, "halving") get_info(best.fit2$fit, "halving.conf") ``` incidence/vignettes/conversions.Rmd 0000644 0001762 0000144 00000010613 14621104516 017220 0 ustar ligges users --- title: "Conversions to and from the incidence class" author: "Thibaut Jombart, Zhian N. Kamvar" date: "`r Sys.Date()`" output: rmarkdown::html_vignette: toc: true toc_depth: 2 vignette: > %\VignetteIndexEntry{Conversions} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r, echo = FALSE} knitr::opts_chunk$set( collapse = TRUE, comment = "#>", fig.width=7, fig.height=5 ) ``` This vignette documents to types of conversion which can be made using the *incidence* class: - *'exports'*: conversion from an *incidence* object to another type of object; this can be useful for processing incidence data in another software, or for reporting results. - *'imports'*conversion from already computed incidence into an *incidence* object; this can be useful for using features of the *incidence* package for data handling and plotting with incidence data computed elsewhere.
# Exporting results To export results, we first compute semi-weekly incidence (with weeks starting on Sunday, the beginning of the CDC epiweek) by gender from the simulated Ebola data used in the [overview vignette](https://www.repidemicsconsortium.org/incidence/articles/overview.html): ```{r example} library(outbreaks) library(incidence) dat <- ebola_sim$linelist$date_of_onset i_14 <- incidence(dat, interval = "2 epiweeks", groups = ebola_sim$linelist$gender) i_14 plot(i_14, border = "white") ``` To export the data to a `data.frame`, one simply needs: ```{r} as.data.frame(i_14) ``` The first column contains the dates marking the (inclusive) left side of the time intervals used for computing incidence, and the other columns give counts for the different groups. This function also has an option for exporting data as a 'long' format, i.e. with a column for 'groups' and a column for counts. This format can be useful especially when working with *ggplot2*, which expect data in this shape: ```{r, long} df <- as.data.frame(i_14, long = TRUE) head(df) tail(df) ## example of custom plot using steps: library(ggplot2) ggplot(df, aes(x = dates, y = counts)) + geom_step(aes(color = groups)) ``` Finally, note that when ISO weeks are used, these are also reported in the output: ```{r, iso} i_7 <- incidence(dat, interval = "week") i_7 plot(i_7, border = "white") head(as.data.frame(i_7)) tail(as.data.frame(i_7)) ```
# Importing pre-computed incidence The function `as.incidence` facilitates the conversion of pre-computed incidences to an *incidence* object. Typically, the input will be imported into R from a *.csv* file or other spreadsheet formats. `as.incidence` is a generic with methods for several types of objects (see `?as.incidence`). The main method is `matrix`, as other types are coerced to `matrix` first and then passed to `as.incidence.matrix`: ```{r, conversions} args(incidence:::as.incidence.matrix) ``` The only mandatory argument `x` is a table of counts, with time intervals in rows and groups in columns; if there are no groups, then the column doesn't need a name; but if there are several groups, then columns should be named to indicate group labels. Optionally, `dates` can be provided to indicate the (inclusive) lower bounds of the time intervals, corresponding to the rows of `x`; most sensible date formats will do; if indicated as a character string, make sure the format is `YYYY-mm-dd`, e.g. `2017-04-01` for the 1st April 2017. Let us illustrate the conversion using a simple vector of incidence: ```{r} vec <- c(1,2,3,0,3,2,4,1,2,1) i <- as.incidence(vec) i plot(vec, type = "s") plot(i, border = "white") ``` Assuming the above incidences are computed weekly, we would then use: ```{r} i <- as.incidence(vec, interval = 7) i plot(i, border = "white") ``` Note that in this case, incidences have been treated as per week, and corresponding dates in days have been computed during the conversion (the first day is always '1'), so that the first days of weeks 1, 2, 3... are: ```{r} i$dates ``` In practice, it is best to provide the actual dates marking the lower bounds of the time intervals. We can illustrate this by a round trip using the example of the previous section: ```{r, round_trip} ## convertion: incidence --> data.frame: i_14 df <- as.data.frame(i_14) head(df) tail(df) ## conversion: data.frame --> incidence new_i <- as.incidence(df[group_names(i_14)], df$dates, interval = "2 epiweeks") new_i ## check round trip identical(new_i, i_14) ``` incidence/vignettes/customize_plot.Rmd 0000644 0001762 0000144 00000020120 14621106437 017726 0 ustar ligges users --- title: "Customize plots of incidence" author: "Thibaut Jombart, Zhian N. Kamvar" date: "`r Sys.Date()`" output: rmarkdown::html_vignette: toc: true toc_depth: 4 vignette: > %\VignetteIndexEntry{Customise graphics} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r, echo = FALSE} knitr::opts_chunk$set( collapse = TRUE, comment = "#>", fig.width=7, fig.height=5 ) ``` This vignette provides some tips for the most common customisations of graphics produced by `plot.incidence`. Our graphics use *ggplot2*, which is a distinct graphical system from base graphics. If you want advanced customisation of your incidence plots, we recommend following an introduction to *ggplot2*.
# Example data: simulated Ebola outbreak This example uses the simulated Ebola Virus Disease (EVD) outbreak from the package [*outbreaks*](https://cran.r-project.org/package=outbreaks): `ebola_sim_clean`. First, we load the data: ```{r, data} library(outbreaks) library(ggplot2) library(incidence) onset <- ebola_sim_clean$linelist$date_of_onset class(onset) head(onset) ``` We compute the weekly incidence: ```{r, incid1} i <- incidence(onset, interval = 7) i i.sex <- incidence(onset, interval = 7, group = ebola_sim_clean$linelist$gender) i.sex i.hosp <- incidence(onset, interval = 7, group = ebola_sim_clean$linelist$hospital) i.hosp ```
# The `plot.incidence` function When calling `plot` on an *incidence* object, the function `plot.incidence` is implicitly used. To access its documentation, use `?plot.incidence`. In this section, we illustrate existing customisations. ## Default behaviour By default, the function uses grey for single time series, and colors from the color palette `incidence_pal1` when incidence is computed by groups: ```{r, default} plot(i) plot(i.sex) plot(i.hosp) ``` However, some of these defaults can be altered through the various arguments of the function: ```{r, args} args(incidence:::plot.incidence) ``` ## Changing colors ### The default palette A color palette is a function which outputs a specified number of colors. By default, the color used in *incidence* is called `incidence_pal1`. Its behaviour is different from usual palettes, in the sense that the first 4 colours are not interpolated: ```{r, incidence_pal1, fig.height = 8} par(mfrow = c(3, 1), mar = c(4,2,1,1)) barplot(1:2, col = incidence_pal1(2)) barplot(1:4, col = incidence_pal1(4)) barplot(1:20, col = incidence_pal1(20)) ``` This palette also has a light and a dark version: ```{r, pal2, fig.height = 8} par(mfrow = c(3,1)) barplot(1:20, col = incidence_pal1_dark(20), main = "palette: incidence_pal1_dark") barplot(1:20, col = incidence_pal1(20), main = "palette: incidence_pal1") barplot(1:20, col = incidence_pal1_light(20), main = "palette: incidence_pal1_light") ``` ### Using different palettes Other color palettes can be provided via `col_pal`. Various palettes are part of the base R distribution, and many more are provided in additional packages. We provide a couple of examples: ```{r, palettes} plot(i.hosp, col_pal = rainbow) plot(i.sex, col_pal = cm.colors) ``` ### Specifying colors manually Colors can be specified manually using the argument `color`; note that whenever incidence is computed by groups, the number of colors must match the number of groups, otherwise `color` is ignored. #### Example 1: changing a single color ```{r, colors1} plot(i, color = "darkred") ``` #### Example 2: changing several colors (note that naming colors is optional) ```{r, colors2} plot(i.sex, color = c(m = "orange2", f = "purple3")) ``` #### Example 3: using color to highlight specific groups ```{r, colors3} plot(i.hosp, color = c("#ac3973", "#6666ff", "white", "white", "white", "white")) ```
# Useful *ggplot2* tweaks Numerous tweaks for *ggplot2* are documented online. In the following, we merely provide a few useful tips in the context of *incidence*. ## Changing dates on the *x*-axis ### Changing date format By default, the dates indicated on the *x*-axis of an incidence plot may not have the suitable format. The package *scales* can be used to change the way dates are labeled (see `?strptime` for possible formats): ```{r, scales1} library(scales) plot(i, labels_week = FALSE) + scale_x_date(labels = date_format("%d %b %Y")) ``` Notice how the labels are all situated at the first of the month? If you want to make sure the labels are situated in a different orientation, you can use the `make_breaks()` function to calculate breaks for the plot: ```{r scales_breaks} b <- make_breaks(i, labels_week = FALSE) b plot(i) + scale_x_date(breaks = b$breaks, labels = date_format("%d %b %Y")) ``` And for another example, with a subset of the data (first 50 weeks), using more detailed dates and rotating the annotations: ```{r, scales2} plot(i[1:50]) + scale_x_date(breaks = b$breaks, labels = date_format("%a %d %B %Y")) + theme(axis.text.x = element_text(angle = 45, hjust = 1, size = 12)) ``` Note that you can save customisations for later use: ```{r, scales3} rotate.big <- theme(axis.text.x = element_text(angle = 45, hjust = 1, size = 12)) ``` ### Changing the grid The last example above illustrates that it can be useful to have denser annotations of the *x*-axis, especially over short time periods. Here, we provide an example where we try to zoom on the peak of the epidemic, using the data by hospital: ```{r, grid1} plot(i.hosp) ``` Let us look at the data 40 days before and after the 1st of October: ```{r, grid2} period <- as.Date("2014-10-01") + c(-40, 40) i.zoom <- subset(i.hosp, from = period[1], to = period[2]) detailed.x <- scale_x_date(labels = date_format("%a %d %B %Y"), date_breaks = "2 weeks", date_minor_breaks = "week") plot(i.zoom, border = "black") + detailed.x + rotate.big ``` ### Handling non-ISO weeks If you have weekly incidence that starts on a day other than monday, then the above solution may produce breaks that fall inside of the bins: ```{r, saturday-epiweek} i.sat <- incidence(onset, interval = "1 week: saturday", groups = ebola_sim_clean$linelist$hospital) i.szoom <- subset(i.sat, from = period[1], to = period[2]) plot(i.szoom, border = "black") + detailed.x + rotate.big ``` In this case, you may want to either calculate breaks using `make_breaks()` or use the `scale_x_incidence()` function to automatically calculate these for you: ```{r, saturday-epiweek2} plot(i.szoom, border = "black") + scale_x_incidence(i.szoom, n_breaks = nrow(i.szoom)/2, labels_week = FALSE) + rotate.big ``` ```{r, saturday-epiweek3} sat_breaks <- make_breaks(i.szoom, n_breaks = nrow(i.szoom)/2) plot(i.szoom, border = "black") + scale_x_date(breaks = sat_breaks$breaks, labels = date_format("%a %d %B %Y")) + rotate.big ``` ### Labelling every bin Sometimes you may want to label every bin of the incidence object. To do this, you can simply set `n_breaks` to the number of rows in your incidence object: ```{r label-bins} plot(i.szoom, n_breaks = nrow(i.szoom), border = "black") + rotate.big ``` ## Changing the legend The previous plot has a fairly large legend which we may want to move around. Let us save the plot as a new object `p` and customize the legend: ```{r, legend1} p <- plot(i.zoom, border = "black") + detailed.x + rotate.big p + theme(axis.text.x = element_text(angle = 45, hjust = 1, size = 12), legend.position = "top", legend.direction = "horizontal", legend.title = element_blank()) ``` ## Applying the style of European Programme for Intervention Epidemiology Training (EPIET) ### Display individual cases For small datasets it is convention of EPIET to display individual cases as rectangles. It can be done by doing two things: first, adding using the option `show_cases = TRUE` with a white border and second, setting the background to white. We also add `coord_equal()` which forces each case to be a square. ```{r, EPIET1} i.small <- incidence(onset[160:180]) plot(i.small, border = "white", show_cases = TRUE) + theme(panel.background = element_rect(fill = "white")) + rotate.big + coord_equal() ``` incidence/vignettes/incidence_fit_class.Rmd 0000644 0001762 0000144 00000022662 14621104516 020627 0 ustar ligges users --- title: "Details of the incidence_fit class" author: "Zhian N. Kamvar" date: "`r Sys.Date()`" output: rmarkdown::html_vignette: toc: true toc_depth: 3 vignette: > %\VignetteIndexEntry{Incidence fit class} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r setup, include = FALSE} knitr::opts_chunk$set( collapse = TRUE, comment = "#>", fig.width=7, fig.height=5 ) ``` This vignette details the structure and construction of the `incidence_fit` and `incidence_fit_list` classes, which are produced by the `fit()` and `fit_optim_split()` functions, respectively. By the end of this tutorial, you should be able to construct `incidence_fit` and `incidence_fit_list` objects for use with your own models. # Structure of an `incidence_fit` object An `incidence_fit` object contains three elements: - `$model`: The model fit to an `incidence` object. Currently, this represents a log-linear model, but it can be any model. - `$info`: Information derived from the model - `r` The growth rate - `r.conf` the confidence interval of `r` - `pred` a data frame containing the predictions of the model using the true dates (`dates`), their numeric version used in the model (`dates.x`), the predicted value (`fit`), and the lower (`lwr`) and upper (`upr`) bounds of the associated confidence interval. - `doubling` the predicted doubling time in days (only if `r` is positive) - `doubling.conf` the confidence interval of the doubling time - `halving` the predicted halving time in days (only if `r` is negative) - `halving.conf` the confidence interval of the halving time - `$origin`: the date corresponding to day '0' Internally, when `fit()` is run, these elements are constructed by function `incidence:::extract_info()`. First we need to setup data. We will use simulated Ebola outbreak data from the *outbreaks* package over weekly intervals and calculate the fit for the first 20 weeks: ```{r fit_dates} library(outbreaks) library(incidence) dat <- ebola_sim$linelist$date_of_onset i <- incidence(dat, interval = "week") i f <- fit(i[1:20]) f plot(i, fit = f) ``` As you can see, the `incidence_fit` object has a print method and a plot method. If you want to access individual elements in the `$info` element, you can use the `get_info()` function: ```{r get_info} get_info(f, "r") get_info(f, "r.conf") get_info(f, "doubling.conf") ``` This will be important later when we combine several `incidence_fit` objects into a single `incidence_fit_list`. # Building an `incidence_fit` object from scratch The `incidence_fit` object can be constructed from any model from which you can derive the daily growth rate, doubling/halving times, predictions, and confidence intervals. The following three steps show roughly how it is done from model fitting to construction. ### Step 1: create the model The default model for `fit()` is a log-linear model on the intervals between dates. To fit this model, we will need to create a data frame with the counts and the midpoints of the intervals: ```{r create_model} # ensure all dates have at least one incidence i2 <- i[1:20] i2 <- i2[apply(get_counts(i2), 1, min) > 0] df <- as.data.frame(i2, long = TRUE) df$dates.x <- get_dates(i2, position = "center", count_days = TRUE) head(df) lm1 <- stats::lm(log(counts) ~ dates.x, data = df) lm1 ``` If we compare that to the `$model` element produced from `fit()`, we can see that it is identical: ```{r fit_model} all.equal(f$model, lm1) ``` ### Step 2: creation of the `$info` list: The `$info` list is created directly from the model itself: ```{r make_info} r <- stats::coef(lm1)["dates.x"] r.conf <- stats::confint(lm1, "dates.x", 0.95) new.data <- data.frame(dates.x = sort(unique(lm1$model$dates.x))) pred <- exp(stats::predict(lm1, newdata = new.data, interval = "confidence", level = 0.95)) pred <- cbind.data.frame(new.data, pred) info_list <- list( r = r, r.conf = r.conf, doubling = log(2) / r, doubling.conf = log(2) / r.conf, pred = pred ) info_list ``` ### Step 3: combine lists and create object the last step is to combine everything into a list and create the object. ```{r combine} origin <- min(get_dates(i2)) info_list$pred$dates <- origin + info_list$pred$dates.x the_fit <- list( lm = lm1, info = info_list, origin = min(get_dates(i2)) ) class(the_fit) <- "incidence_fit" the_fit plot(i, fit = the_fit) ``` # Structure of an `incidence_fit_list` object There are several reasons for having multiple fits to a single `incidence` object. One may want to have a separate fit for different groups represented in the object, or one may want to split the fits at the peak of the epidemic. To aid in plotting and summarizing the different fits, we've created the `incidence_fit_list` class. This class has two defining features: - It consists of a named list containing one or more `incidence_fit` objects or lists containing `incidence_fit` objects. - An attribute called "locations" contains a list whose length is equal to the number of `incidence_fit` objects in the object. Each list element contains a vector that defines where an `incidence_fit` object is within the `incidence_fit_list`. The reason for this structure is because it is sometimes necessary to nest lists of `incidence_fit` objects within lists. When this happens, accessing individual elements of the objects cumbersome. To alleviate this, each object has a distinct path within the named list in the "locations" attribute that allows one to access the object directly since R allows you to traverse the elements of a nested list by subsetting with a vector: ```{r nest} l <- list(a = list(b = 1, c = 2),d = list(e = list(f = 3, g = 4), h = 5)) str(l) l[[c("a", "b")]] l[[c("d", "e", "f")]] ``` ## Example: A tale of two fits The function `fit_optim_split()` attempts to find the optimal split point in an epicurve, producing an `incidence_fit_list` object in the `$fit` element of the returned list: ```{r incidence_fit_list} fl <- fit_optim_split(i) fl$fit plot(i, fit = fl$fit) ``` Here you can see that the object looks very similar to the `incidence_fit` object, but it has extra information. The first thing you may notice is the fact that both "doubling" and "halving" are shown. This is because the two fits have different signs for the daily growth rate. The second thing you may notice is the fact that there is something called `attr(x, 'locations')`. This attribute gives the location of the `incidence_fit` objects within the list. We can illustrate how this works if we look at the structure of the object: ```{r incidence_fit_list_str} str(fl$fit, max.level = 2) ``` Internally, all of the methods for `incidence_fit_list` use the 'locations' attribute to navigate: ```{r incidence_fit_methods} methods(class = "incidence_fit_list") ``` For example, it's often useful to extract the growth rate for all models at once. The `get_info()` method allows us to do this easily: ```{r get_info_incidence_fit_list} get_info(fl$fit, "r") get_info(fl$fit, "r.conf") ``` Because doubling or halving is determined by whether or not `r` is negative, we automatically filter out the results that don't make sense, but you can include them with `na.rm = FALSE`: ```{r get_doubling} get_info(fl$fit, "doubling.conf") get_info(fl$fit, "doubling.conf", na.rm = FALSE) ``` ## Example: Nested incidence_fit Above, we showed the example of a basic `incidence_fit_list` class with two objects representing the fits before and after the peak of an epicurve. However, it is often useful evaluate fits for different groups separately. Here, we will construct an incidence object, but define groups by gender: ```{r incidence_by_gender} gen <- ebola_sim$linelist$gender ig <- incidence(dat, interval = "week", group = gen) plot(ig, border = "grey98") ``` Now if we calculate an optimal fit split, we will end up with four different fits: two for each defined gender. ```{r fit_gender} fg <- fit_optim_split(ig) plot(ig, fit = fg$fit, border = "grey98", stack = FALSE) ``` If we look at the fit object, we can see again that it is an `incidence_fit_list` but this time with four fits defined. ```{r fit_gender_print} fg$fit str(fg$fit, max.level = 3) ``` > Notice that the nested lists themselves are of class `incidence_fit_list`. Now, even though the fits within nested lists, the 'locations' attributes still defines where they are within the object so that the `get_info()` function still operates normally: ```{r get_info_gender} get_info(fg$fit, "r.conf") ``` If you need to access all the fits easily, a convenience function to flatten the list is available in `get_fit()`: ```{r get_fit} str(get_fit(fg$fit), max.level = 2) ``` Because all that defines an `incidence_fit_list` is the class definition and the 'locations' attribute that defines the positions of the `incidence_fit` objects within the nesting, then it's also possible to define the output of `fit_optim_split()` as an `incidence_fit_list` class: ```{r incidence_fit_listify} print(locs <- attributes(fg$fit)$locations) for (i in seq_along(locs)) { locs[[i]] <- c("fit", locs[[i]]) } print(locs) fg.ifl <- fg attributes(fg.ifl)$locations<- locs class(fg.ifl) <- "incidence_fit_list" ``` Now when we print the object, we can see that it prints only the information related to the `incidence_fit_list`: ```{r new_fit_list_print} fg.ifl ``` But, we still retain all of the extra information in the list: ```{r list_stuff} str(fg.ifl, max.level = 1) fg.ifl$split fg.ifl$df fg.ifl$plot ``` incidence/vignettes/incidence_class.Rmd 0000644 0001762 0000144 00000012635 14621104516 017764 0 ustar ligges users --- title: "Details of the incidence class" author: "Thibaut Jombart, Zhian N. Kamvar" date: "`r Sys.Date()`" output: rmarkdown::html_vignette: toc: true toc_depth: 3 vignette: > %\VignetteIndexEntry{Incidence class} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r, options, echo = FALSE} knitr::opts_chunk$set( collapse = TRUE, comment = "#>", fig.width=7, fig.height=5 ) ``` This vignette details the structure of *incidence* objects, as produced by the `incidence` function.
# Structure of an *incidence* object. We generate a toy dataset of dates to examine the content of *incidence* objects. ```{r, data} library(incidence) set.seed(1) dat <- sample(1:50, 200, replace = TRUE, prob = 1 + exp(1:50 * 0.1)) sex <- sample(c("female", "male"), 200, replace = TRUE) ``` The incidence by 48h period is computed as: ```{r, i} i <- incidence(dat, interval = 2) i plot(i) ``` We also compute incidence by gender: ```{r, sex} i.sex <- incidence(dat, interval = 2, group = sex) i.sex plot(i.sex) ``` The object `i` is a `list` with the class *incidence*: ```{r, names} class(i) is.list(i) names(i) ``` Items in `i` can be accessed using the same indexing as any lists, but it's safer to use the accessors for each item: ```{r, access} ## use name head(i$dates) head(get_dates(i)) ``` In the following sections, we examine each of the components of the object. ## `$dates` The `$dates` component contains a vector for all the dates for which incidence have been computed, in the format of the input dataset (e.g. `Date`, `numeric`, `integer`). ```{r, dates1} date_bins <- get_dates(i) class(date_bins) class(dat) date_bins ``` The dates correspond to the lower bounds of the time intervals used as bins for the incidence. Bins always include the lower bound and exclude the upper bound. In the example provided above, this means that the first bin counts events that happened at day 5-6, the second bin counts events from 7-8, etc. Note that if we had actual `Date`-class dates, they would be returned as dates ```{r date-dates1} dat_Date <- as.Date("2018-10-31") + dat head(dat_Date) i.date <- incidence(dat_Date, interval = 2, group = sex) i.date get_dates(i.date) class(get_dates(i.date)) ``` These can be converted to integers, counting the number of days from the first date. ```{r get-dates-integer} get_dates(i.date, count_days = TRUE) get_dates(i, count_days = TRUE) ``` To facilitate modelling, it's also possible to get the center of the interval by using the `position = "center"` argument: ```{r get-dates-center} get_dates(i.date, position = "center") get_dates(i.date, position = "center", count_days = TRUE) ``` ## `$counts` The `$counts` component contains the actual incidence, i.e. counts of events for the defined bins. It is a `matrix` of `integers` where rows correspond to time intervals, with one column for each group for which incidence is computed (a single, unnamed column if no groups were provided). If groups were provided, columns are named after the groups. We illustrate the difference comparing the two objects `i` and `i.sex`: ```{r, counts1} counts <- get_counts(i) class(counts) storage.mode(counts) counts get_counts(i.sex) ``` You can see the dimensions of the incidence object by using `dim()`, `ncol()`, and `nrow()`, which returns the dimensions of the counts matrix: ```{r counts1.1} dim(get_counts(i.sex)) dim(i.sex) nrow(i.sex) # number of date bins ncol(i.sex) # number of groups ``` There are also accessors for handling groups: ```{r groups} # Number of groups ncol(i.sex) ncol(i) # Names of groups group_names(i.sex) group_names(i) # You can also rename the groups group_names(i.sex) <- c("F", "M") group_names(i.sex) ``` Note that a `data.frame` containing *dates* and *counts* can be obtained using `as.data.frame`: ```{r, as.data.frame} ## basic conversion as.data.frame(i) as.data.frame(i.sex) ## long format for ggplot2 as.data.frame(i.sex, long = TRUE) ``` Note that `incidence` has an argument called `na_as_group` which is `TRUE` by default, which will pool all missing groups into a separate group, in which case it will be a separate column in `$counts`. ## `$timespan` The `$timespan` component stores the length of the time period covered by the object: ```{r, timespan} get_timespan(i) print(date_range <- range(get_dates(i))) diff(date_range) + 1 ``` ## `$interval` The `$interval` component contains the length of the time interval for the bins: ```{r, interval} get_interval(i) diff(get_dates(i)) ``` ## `$n` The `$n` component stores the total number of events in the data: ```{r, n} get_n(i) ``` Note that to obtain the number of cases by groups, one can use: ```{r, n2} colSums(get_counts(i.sex)) ``` ## `$weeks` The `$weeks` component is optional, and used to store [aweek](https://www.repidemicsconsortium.org/aweek/) objects whenever they have been used. Weeks are used by default when weekly incidence is computed from dates (see argument `standard` in `?incidence`). ```{r, isoweek} library(outbreaks) dat <- ebola_sim$linelist$date_of_onset i.7 <- incidence(dat, "1 epiweek", standard = TRUE) i.7 i.7$weeks ``` Because `$weeks` is an optional element, it does not have a dedicated accessor. If the element is not present, attempting to access it will result in a `NULL`: ```{r isoweek-null} i$weeks ``` Both dates and weeks are returned when converting an `incidence` object to `data.frame`: ```{r, isoweek3} head(as.data.frame(i.7)) ``` incidence/R/ 0000755 0001762 0000144 00000000000 14621104516 012374 5 ustar ligges users incidence/R/check_interval.R 0000644 0001762 0000144 00000001556 14621104516 015507 0 ustar ligges users #' Check the interval between bins #' #' This enforces that an interval is: #' - strictly positive #' - integer (rounded) OR compatibile with date #' - finite #' - of length 1 #' #' @param x an integer or numeric interval #' @return an integer interval #' @noRd check_interval <- function(x, standard = TRUE){ if (missing(x) || is.null(x)) { stop("Interval is missing or NULL") } if (length(x) != 1L) { stop(sprintf( "Exactly one value should be provided as interval (%d provided)", length(x))) } if (!is.finite(x)) { if (is.character(x)) { x <- valid_interval_character(x, standard) } else { stop("Interval is not finite") } } if (is.numeric(x)) { x <- as.integer(round(old <- x)) } if (x < 1L) { stop(sprintf( "Interval must be at least 1 (input: %.3f; after rounding: %d)", old, x)) } x } incidence/R/print.R 0000644 0001762 0000144 00000006651 14621104516 013663 0 ustar ligges users #' @export #' @rdname incidence #' @param x An 'incidence' object. print.incidence <- function(x, ...) { cat("
- \n\n")
cat("attr(x, 'locations'): list of vectors with the locations of each incidence_fit object\n\n")
locations <- attr(x, "locations")
cat(sprintf("'%s'", vapply(locations, paste, character(1), collapse = "', '")), sep = "\n")
cat("\n")
cat("$model: regression of log-incidence over time\n\n")
cat("$info: list containing the following items:\n")
cat(" $r (daily growth rate):\n")
print(get_info(x, "r"))
cat("\n $r.conf (confidence interval):\n")
print(get_info(x, "r.conf"))
if (any(get_info(x, "r") > 0)) {
cat("\n $doubling (doubling time in days):\n")
print(get_info(x, "doubling", na.rm = TRUE))
cat("\n $doubling.conf (confidence interval):\n")
print(get_info(x, "doubling.conf", na.rm = TRUE))
}
if (any(get_info(x, "r") < 0)) {
cat("\n $halving (halving time in days):\n")
print(get_info(x, "halving", na.rm = TRUE))
cat("\n $halving.conf (confidence interval):\n")
print(get_info(x, "halving.conf", na.rm = TRUE))
}
preds <- get_info(x, "pred")
cat(sprintf(
"\n $pred: data.frame of incidence predictions (%d rows, %d columns)\n",
nrow(preds), ncol(preds)))
invisible(x)
}
incidence/R/group_names.R 0000644 0001762 0000144 00000005410 14621104516 015036 0 ustar ligges users #' extract and set group names
#' @param x an [incidence()] object.
#' @param value character vector used to rename groups
#' @return an integer indicating the number of groups present in the incidence
#' object.
#' @details This accessor will return a
#' @export
#' @examples
#' i <- incidence(dates = sample(10, 100, replace = TRUE),
#' interval = 1L,
#' groups = sample(letters[1:3], 100, replace = TRUE))
#' i
#' group_names(i)
#'
#' # change the names of the groups
#' group_names(i) <- c("Group 1", "Group 2", "Group 3")
#' i
#'
#' # example if there are mistakes in the original data, e.g.
#' # something is misspelled
#' set.seed(50)
#' grps <- sample(c("child", "adult", "adlut"), 100, replace = TRUE, prob = c(0.45, 0.45, 0.05))
#' i <- incidence(dates = sample(10, 100, replace = TRUE),
#' interval = 1L,
#' groups = grps)
#' colSums(get_counts(i))
#'
#' # If you change the name of the mis-spelled group, it will be merged with the
#' # correctly-spelled group
#' gname <- group_names(i)
#' gname[gname == "adlut"] <- "adult"
#' # without side-effects
#' print(ii <- group_names(i, gname))
#' colSums(get_counts(i)) # original still has three groups
#' colSums(get_counts(ii))
#' # with side-effects
#' group_names(i) <- gname
#' colSums(get_counts(i))
group_names <- function(x, value) {
UseMethod("group_names", x)
}
#' @export
#' @rdname group_names
"group_names<-" <- function(x, value) {
UseMethod("group_names<-", x)
}
#' @rdname group_names
#' @export
#' @aliases group_names.default
group_names.default <- function(x, value) {
stop(sprintf("Not implemented for class %s",
paste(class(x), collapse = ", ")))
}
#' @rdname group_names
#' @export
#' @aliases `group_names<-`.default
"group_names<-.default" <- function(x, value) {
stop(sprintf("Not implemented for class %s",
paste(class(x), collapse = ", ")))
}
#' @rdname group_names
#' @export
#' @keywords accessors
group_names.incidence <- function(x, value = NULL){
if (is.null(value)) {
colnames(x$counts)
} else {
`group_names<-`(x, value)
}
}
#' @rdname group_names
#' @export
"group_names<-.incidence" <- function(x, value) {
if (length(value) != ncol(x)) {
stop("value must be the same length as the number of groups.")
}
if (anyNA(value <- as.character(value))) {
stop("value must be able to be coerced to a character vector")
}
uval <- unique(value)
if (identical(uval, value)) {
colnames(x$counts) <- value
} else {
the_counts <- x$counts
out <- matrix(integer(nrow(the_counts)*length(uval)),
nrow = nrow(the_counts),
ncol = length(uval)
)
colnames(out) <- uval
for (i in uval) {
out[, i] <- rowSums(the_counts[, value == i, drop = FALSE])
}
x$counts <- out
}
x
}
incidence/R/get_fit.R 0000644 0001762 0000144 00000002773 14621104516 014151 0 ustar ligges users #' Accessors for `incidence_fit` objects
#'
#' @param x an `incidence_fit` or `incidence_fit_list`
#' object.
#' @return a list of `incidence_fit` objects.
#' @export
#' @examples
#'
#' if (require(outbreaks)) { withAutoprint({
#'
#' dat <- ebola_sim$linelist$date_of_onset
#'
#' ## EXAMPLE WITH A SINGLE MODEL
#'
#' ## compute weekly incidence
#' sex <- ebola_sim$linelist$gender
#' i.sex <- incidence(dat, interval = 7, group = sex)
#'
#' ## Compute the optimal split for each group separately
#' fits <- fit_optim_split(i.sex, separate_split = TRUE)
#'
#' ## `fits` contains an `incidence_fit_list` object
#' fits$fit
#'
#' ## Grab the list of `incidence_fit` objects
#' get_fit(fits$fit)
#'
#' ## Get the predictions for all groups
#' get_info(fits$fit, "pred", groups = 1)
#'
#' ## Get the predictions, but set `groups` to "before" and "after"
#' get_info(fits$fit, "pred", groups = 2)
#'
#' ## Get the reproduction number
#' get_info(fits$fit, "r")
#'
#' ## Get the doubling confidence interval
#' get_info(fits$fit, "doubling.conf")
#'
#' ## Get the halving confidence interval
#' get_info(fits$fit, "halving.conf")
#' })}
get_fit <- function(x) {
UseMethod("get_fit")
}
#' @rdname get_fit
#' @export
get_fit.incidence_fit <- function(x) {
x
}
#' @rdname get_fit
#' @export
get_fit.incidence_fit_list <- function(x) {
locations <- attr(x, "locations")
res <- lapply(locations, function(i) x[[i]])
names(res) <- vapply(locations, paste, character(1), collapse = "_")
res
}
incidence/R/get_counts.R 0000644 0001762 0000144 00000003437 14621104516 014700 0 ustar ligges users #' Get counts from an incidence object
#'
#' @param x an `incidence` object.
#' @param groups if there are groups, use this to specify a group or groups to
#' subset. Defaults to `NULL` indicating that all groups are returned.
#'
#' @return a matrix of counts where each row represents a date bin
#' @export
#' @examples
#' if (require(outbreaks)) { withAutoprint({
#' dat <- ebola_sim$linelist$date_of_onset
#' gend <- ebola_sim$linelist$gender
#' i <- incidence(dat, interval = "week", groups = gend)
#'
#' ## Use with an object and no arguments gives the counts matrix
#' head(get_counts(i))
#'
#' ## Specifying a position or group name will return a matrix subset to that
#' ## group
#' head(get_counts(i, 1L))
#' head(get_counts(i, "f"))
#'
#' ## Specifying multiple groups allows you to rearrange columns
#' head(get_counts(i, c("m", "f")))
#'
#' ## If you want a vector, you can use drop
#' drop(get_counts(i, "f"))
#' })}
get_counts <- function(x, groups = NULL) {
UseMethod("get_counts")
}
#' @rdname get_counts
#' @export
get_counts.incidence <- function(x, groups = NULL){
if (is.null(groups) || ncol(x$counts) == 1) {
return(x$counts)
}
if (is.character(groups)) {
correct_groups <- groups[groups %in% colnames(x$counts)]
}
if (is.numeric(groups)) {
correct_groups <- groups[groups %in% seq(ncol(x$counts))]
}
if (!identical(correct_groups, groups)) {
grps <- paste(setdiff(groups, correct_groups), collapse = ", ")
msg <- sprintf("The following groups were not recognised: %s", grps)
message(msg)
}
if (length(correct_groups) == 0) {
grps <- paste(colnames(x$counts), collapse = ", ")
stop(sprintf("No groups matched those present in the data: %s", grps))
}
return(x$counts[, correct_groups, drop = FALSE])
}
incidence/R/check_groups.R 0000644 0001762 0000144 00000001576 14621104516 015204 0 ustar ligges users #' Enforce cromulence of groups
#'
#' This enforces that groups is either:
#'
#' - NULL
#' - a factor and the same length as dates
#' It also treats missing groups (NA) as a separate group is needed.
#'
#' @param x a vector denoting groups
#' @param dates a vector representing dates
#' @param na_as_group a logical indicating whether or not NA should be
#' considered a separate group.
#' @noRd
check_groups <- function(x, dates, na_as_group){
if (is.null(x)) {
return(NULL)
}
x <- factor(x)
lev <- levels(x)
if (na_as_group && any(is.na(x))) {
x <- as.character(x)
x[is.na(x)] <- "NA"
lev <- c(lev, "NA")
}
if (length(x) != length(dates)) {
stop(sprintf(
"'x' does not have the same length as dates (%d vs %d)",
length(x),
length(dates)
)
)
}
factor(x, levels = lev)
}
incidence/R/zzz.R 0000644 0001762 0000144 00000000361 14621104516 013354 0 ustar ligges users .onLoad <- function(...) {
op <- options()
op.incidence <- list(incidence.max.days = 18262,
incidence.warn.first_date = TRUE)
toset <- !names(op.incidence) %in% op
if (any(toset)) options(op.incidence[toset])
}
incidence/R/subset.R 0000644 0001762 0000144 00000007305 14621104516 014031 0 ustar ligges users ##' Subsetting 'incidence' objects
##'
##' Two functions can be used to subset incidence objects. The function
##' `subset` permits to retain dates within a specified range and,
##' optionally, specific groups. The operator "[" can be used as for matrices,
##' using the syntax `x[i,j]` where 'i' is a subset of dates, and 'j' is a
##' subset of groups.
##'
##' @author Thibaut Jombart \email{thibautjombart@@gmail.com}
##'
##' @export
##'
##' @rdname subset
##'
##' @aliases "subset.incidence" "[.incidence"
##'
##' @seealso The [incidence()] function to generate the 'incidence'
##' objects.
##'
##' @param x An incidence object, generated by the function
##' [incidence()].
##'
##' @param from The starting date; data strictly before this date are discarded.
##'
##' @param to The ending date; data strictly after this date are discarded.
##'
##' @param groups (optional) The groups to retained, indicated as subsets of the
##' columns of x$counts.
##'
##' @param ... Further arguments passed to other methods (not used).
##'
##' @examples
##' ## example using simulated dataset
##' if(require(outbreaks)) { withAutoprint({
##' onset <- ebola_sim$linelist$date_of_onset
##'
##' ## weekly incidence
##' inc <- incidence(onset, interval = 7)
##' inc
##' inc[1:10] # first 10 weeks
##' plot(inc[1:10])
##' inc[-c(11:15)] # remove weeks 11-15
##' plot(inc[-c(11:15)])
##' })}
##'
subset.incidence <- function(x, ..., from = min(x$dates), to = max(x$dates),
groups = TRUE){
## We need to make sure the comparison with dates is going to work. As for the
## [ operator, 'from' and 'to' are assumed to be expressed in the same way as
## the x$dates.
is_date <- inherits(x$dates, "Date")
numeric_from <- is.numeric(from)
numeric_to <- is.numeric(to)
if (is_date && (numeric_from || numeric_to)) {
the_intervals <- get_interval(x, integer = TRUE)
if (length(the_intervals) == 1L) {
the_intervals <- rep(the_intervals, length(x$dates))
}
the_intervals <- cumsum(c(0, the_intervals))
}
if (is_date && numeric_from) {
if (from <= 0) {
from <- 0L
} else if (from >= length(the_intervals) - 1L) {
from <- the_intervals[length(the_intervals) - 1L]
} else {
from <- the_intervals[from]
}
from <- min(x$dates) + from
}
if (is_date && numeric_to) {
if (to <= 0) {
to <- 0L
} else if (to >= length(the_intervals) - 1L) {
to <- the_intervals[length(the_intervals) - 1L]
} else {
to <- the_intervals[to]
}
to <- min(x$dates) + to
}
to.keep <- x$dates >= from & x$dates <= to
if (sum(to.keep) < 1) {
stop("No data retained.")
}
x[to.keep, groups]
}
##' @export
##' @rdname subset
##' @param i a subset of dates to retain
##' @param j a subset of groups to retain
"[.incidence" <- function(x, i, j){
if (missing(i)) {
i <- TRUE
}
if (missing(j)) {
j <- TRUE
}
out <- x
if (is.character(j) && !all(j %in% group_names(x))) {
odd_names <- j[!j %in% group_names(x)]
groups <- if (length(odd_names) > 1) "groups do" else "group does"
odd_names <- paste(j[!j %in% group_names(x)], collapse = "', '")
msg <- sprintf("The following %s not exist: '%s'", groups, odd_names)
stop(msg)
}
out$counts <- out$counts[i, j, drop = FALSE]
out$dates <- out$dates[i]
if ("weeks" %in% names(x)) {
out$weeks <- out$weeks[i]
out$isoweeks <- out$isoweeks[i]
}
# Need to use 1L here to keep things type-stable:
# double + integer = double
# integer + integer = integer
# Date + integer = Date
out$timespan <- diff(range(out$dates, na.rm = TRUE)) + 1L
out$n <- sum(out$counts)
out
}
incidence/R/get_week.R 0000644 0001762 0000144 00000003313 14621104516 014311 0 ustar ligges users #' translate user input to the start date of the week
#'
#' @param a weekday specification: ISOweek, MMWRweek, EPIweek, Mon-week, Tue-week, etc.
#'
#' @return the corresponding weekday
#' @keywords internal
#' @noRd
#' @examples
#' get_week_start("ISOweek")
#' get_week_start("MMWRweek")
#' get_week_start("EPIweek")
#'
#' # weeks that start on saturday
#'
#' get_week_start("Sat-week")
#' get_week_start("week: Saturday")
#' get_week_start("2 weeks: Saturday")
#' get_week_start("epiweek: Saturday")
get_week_start <- function(weekday) {
wkdy <- gsub("weeks?", "", tolower(weekday))
wkdy <- gsub('[[:punct:][:blank:][:digit:]]*', "", wkdy)
wkdy <- if (wkdy == "") "monday" else wkdy # the input was "weeks"
res <- switch(wkdy,
"mmwr" = "sunday", # MMWR == CDC epiweek
"epi" = "sunday", # CDC epiweek
"iso" = "monday", # ISOweek == WHO epiweek
wkdy # all others
)
gsub("epi", "", res) # if they specify something like "epiweek:saturday"
}
#' Translate a custom interval to a valid interval
#'
#' @param the_interval an interval like 2 epiweeks or 1 ISOweek
#' @return an interval compatible with `seq.Date()`
#' @keywords internal
#' @noRd
#' @examples
#' get_week_duration("2 weeks (wednesday)") # 2 weeks
#' get_week_duration("2 epiweeks") # 2 weeks
get_week_duration <- function(the_interval) {
if (the_interval == 7) return(the_interval)
res <- gsub('^(\\d*) ?.*(weeks?).*$', '\\1 \\2', tolower(the_interval), perl = TRUE)
trimws(res)
}
get_type_of_week <- function(x) {
switch(as.character(attr(x$weeks, "week_start")),
"1" = "ISO",
"7" = "MMWR",
sprintf("(%s)", weekdays(x$dates[1]))
)
}
incidence/R/check_boundaries.R 0000644 0001762 0000144 00000002237 14621104516 016013 0 ustar ligges users #' A cromulence check for first_date and _last date
#'
#' This will create a boundary from the data if there is none provided.
#'
#' @param dates a vector of dates, integers, or numerics
#' @param boundary a date, integer, numeric, or character string that can resolve to a date
#' @param what "first" or "last" for the first_date and last_date arguments
#'
#' @return a date or integer
#' @noRd
#' @keywords internal
check_boundaries <- function(dates, boundary = NULL, what = "first") {
if (is.null(boundary)) {
MINMAX <- if (what == "first") min else max
boundary <- MINMAX(dates, na.rm = TRUE)
}
msg <- "%s_date (%s) could not be converted to Date."
if (is.character(boundary) && !grepl("^[0-9]{4}-[01][0-9]-[0-3][0-9]$", boundary)) {
msg <- paste(msg, 'Dates must be in ISO 8601 standard format (yyyy-mm-dd).')
stop(sprintf(msg, what, boundary), call. = FALSE)
}
res <- try(check_dates(boundary), silent = TRUE)
if (inherits(res, "try-error")) {
msg <- paste(msg, "Accepted formats are:",
"\n Date, POSIXct, integer, numeric, character.")
stop(sprintf(msg, what, deparse(substitute(boundary))), call. = FALSE)
}
res
}
incidence/R/cumulate.R 0000644 0001762 0000144 00000002420 14621104516 014334 0 ustar ligges users #' Compute cumulative 'incidence'
#'
#' `cumulate` is an S3 generic to compute cumulative numbers, with methods
#' for different types of objects:
#'
#' \itemize{
#'
#' \item default method is a wrapper for `cumsum`
#'
#' \item `incidence` objects: computes cumulative incidence over time
#'
#' \item `projections` objects: same, for `projections` objects,
#' implemented in the similarly named package; see `?cumulate.projections`
#' for more information, after loading the package
#'
#' }
#'
#'
#' @author Thibaut Jombart \email{thibautjombart@@gmail.com}
#'
#' @seealso The [incidence()] function to generate the 'incidence'
#' objects.
#'
#' @param x An incidence object.
#'
#' @export
#'
#' @examples
#' dat <- as.integer(c(0,1,2,2,3,5,7))
#' group <- factor(c(1, 2, 3, 3, 3, 3, 1))
#' i <- incidence(dat, groups = group)
#' i
#' plot(i)
#'
#' i_cum <- cumulate(i)
#' i_cum
#' plot(i_cum)
#'
#' @rdname cumulate
cumulate <- function(x) {
UseMethod("cumulate", x)
}
#' @rdname cumulate
#' @export
cumulate.default <- function(x) {
cumsum(x)
}
#' @rdname cumulate
#' @export
cumulate.incidence <- function(x) {
if (isTRUE(x$cumulative)) {
stop("x is already a cumulative incidence")
}
out <- x
out$counts <- apply(x$counts, 2, cumsum)
out$cumulative <- TRUE
out
}
incidence/R/scale_x_incidence.R 0000644 0001762 0000144 00000006372 14621104516 016146 0 ustar ligges users #' @param ... arguments passed to [ggplot2::scale_x_date()],
#' [ggplot2::scale_x_datetime()], or [ggplot2::scale_x_continuous()], depending
#' on how the `$date` element is stored in the incidence object.
#' @export
#' @rdname plot.incidence
scale_x_incidence <- function(x, n_breaks = 6, labels_week = TRUE, ...) {
breaks <- make_breaks(x, n_breaks, labels_week)
if (inherits(x$dates, "Date")) {
out <- ggplot2::scale_x_date(breaks = breaks$breaks,
labels = breaks$labels,
...)
} else if (inherits(x$dates, "POSIXt")) {
breaks$breaks <- as.POSIXct(as.POSIXlt(breaks$breaks))
out <- ggplot2::scale_x_datetime(breaks = breaks$breaks,
labels = breaks$labels,
timezone = "UTC",
...
)
} else {
out <- ggplot2::scale_x_continuous(breaks = breaks$breaks, ...)
}
out
}
#' @export
#' @rdname plot.incidence
make_breaks <- function(x, n_breaks = 6L, labels_week = TRUE) {
stopifnot(inherits(x, "incidence"), is.logical(labels_week), is.numeric(n_breaks))
## Defining breaks for the x axis --------------------------------------------
##
## The x axis can either be integers, Dates, or POSIXt scales. Moreover,
## we need to make sure that the breaks align with the left-hand side of the
## bins (for now). This section first defines what the breaks should be
## and then treats them according to whether or not the interval was specified
## as a character.
if (n_breaks == nrow(x)) {
# The number of breaks are equal to the number of dates... don't worry about
# adjusting
breaks <- x$dates
} else {
# adjust breaks to force first date to beginning.
breaks <- pretty(x$dates, n_breaks)
breaks <- breaks + (x$dates[1] - breaks[1])
}
## Defining the x axis scale -------------------------------------------------
##
## Choosing between scale_x_date, scale_x_datetime, and scale_x_continuous
# labels should be dates or numbers
if (is.character(x$interval)) {
# The interval is a character like "2 weeks" and we have to figure out how
# to split these manually
has_number <- grepl("\\d", x$interval)
tims <- ceiling(x$timespan/(n_breaks*mean(get_interval(x, integer = TRUE))))
if (has_number) {
ni <- as.integer(strsplit(x$interval, " ", fixed = TRUE)[[1L]][1L])
# the replacement should be a multiple of the number
replacement <- if (tims <= ni) ni else ceiling(tims/ni)*ni
db <- gsub("\\d+", replacement, x$interval)
} else if (x$interval == "quarter") {
db <- paste(tims * 3, "months")
} else {
db <- sprintf("%d %s", tims, x$interval)
}
breaks <- seq(x$dates[1], x$dates[nrow(x)], by = db)
}
if (!is.null(x$weeks)) {
# If the data are in weeks, we should make sure that the line up correctly
w <- aweek::date2week(breaks,
week_start = attr(x$weeks, "week_start"),
floor_day = TRUE)
breaks <- aweek::week2date(w)
labels <- if (labels_week) w else ggplot2::waiver()
} else {
labels <- ggplot2::waiver()
}
list(breaks = breaks, labels = labels)
}
incidence/R/check_dots.R 0000644 0001762 0000144 00000003113 14621104516 014623 0 ustar ligges users #' Check the user-fed arguments and give warnings if they are wrong.
#'
#' @param dots a list of user-supplied arguments
#' @param args names of arguments appropriate for the function.
#'
#' @return dots, modified if necessary
#' @noRd
#' @keywords internal
#'
#' @examples
#' dots <- c(hAy = 1, "lsdflk" = 1, "stuperman" = TRUE, iso_week = TRUE)
#' args <- c("superman", "hey", "ho", "lets", "go", "standard")
#' check_dots(dots, args)
check_dots <- function(dots, args) {
if (length(dots) == 0) {
return(dots)
}
dnames <- names(dots)
scores <- utils::adist(paste0("^", dnames), args, fixed = FALSE) < 2
recognized <- rowSums(scores) > 0
msg <- ""
if (sum(scores) > 0) {
words <- apply(scores[recognized, , drop = FALSE], 1,
function(i) paste(args[i], collapse = ", "))
errs <- paste(format(dnames[recognized]), format(words), sep = " : ")
errs <- paste(errs, collapse = "\n\t")
msg <- sprintf("\n\nPotentially misspelled options:\n\t%s", errs)
}
if (sum(!recognized) > 0) {
dre <- paste(dnames[!recognized & dnames != "iso_week"], collapse = ", ")
msg <- if (dre != "") paste0(msg, "\n\nUnrecognised options:\n\t", dre) else msg
}
if ("iso_week" %in% dnames) {
warning(paste("The parameter `iso_week` has been deprecated as of incidence",
"version 1.3. Please use `standard` instead."),
call. = FALSE
)
names(dots)[dnames == "iso_week"] <- "standard"
}
MSG <- "Misspelled or unrecognized options were found."
if (msg != "") {
stop(paste(MSG, msg), call. = FALSE)
}
dots
}
incidence/R/make_breaks.R 0000644 0001762 0000144 00000007074 14621104516 014773 0 ustar ligges users #' Make breaks with dates
#'
#' Because Date objects have a specific `seq` method, it's possible
#' to make breaks with both integers and date objects. This function
#' will check to make sure that the interval is valid.
#'
#' @param date an integer, numeric, or Date vector
#' @param the_interval an integer or character
#' @param last_date an integer, numeric, or Date
#' @param first_date an integer, numeric, or Date
#' @param dots a named list of options
#'
#' @author Zhian Kamvar
#' @return a vector of integers or Dates
#' @noRd
#' @examples
#'
#' set.seed(999)
#' d <- sample(10, replace = TRUE)
#' make_breaks_easier(d, 2L)
make_breaks_easier <- function(dates, the_interval, first_date = NULL,
last_date = NULL, dots = 1L) {
the_interval <- valid_interval_character(the_interval)
date_interval <- is.character(the_interval) && is_date_interval(the_interval)
is_month <- grepl("month", the_interval, ignore.case = TRUE)
is_quarter <- grepl("quarter", the_interval, ignore.case = TRUE)
is_year <- grepl("year", the_interval, ignore.case = TRUE)
uneven_interval <- date_interval && (is_month || is_quarter || is_year)
# getting information about the date
fd <- as.character(first_date)
the_day <- as.integer(substr(fd, 9, 10))
the_month <- as.integer(substr(fd, 6, 7))
if ("standard" %in% names(dots)) {
if (isTRUE(dots$standard)) {
is_a_week <- !uneven_interval && check_week(the_interval)
if (is_a_week) {
week_start <- get_week_start(the_interval)
the_interval <- get_week_duration(the_interval)
# This returns something like 2018-W29
first_isoweek <- aweek::date2week(first_date, week_start, floor_day = TRUE)
# here we convert it back to a date
first_date <- aweek::week2date(first_isoweek)
}
if (uneven_interval) {
# Replace the day with the first day of the month
substr(fd, 9, 10) <- "01"
if (is_quarter) {
# Replace the month with the first month of the quarter
m <- (as.integer(substr(fd, 6, 7)) - 1L) %/% 3L
substr(fd, 6, 7) <- sprintf("%02d", (m * 3) + 1L)
}
if (is_year) {
# Replace the month with the first month of the year
substr(fd, 6, 7) <- "01"
}
# re-cast the date
first_date <- as.Date(fd)
}
} else {
if (uneven_interval && !is_year && the_day > 28) {
# The first date represents a day that doesn't occur in all months
msg <- paste("The first_date (%s) represents a day that does not",
"occur in all months. Because of this, bins may not",
"conform to monthly boundaries. To prevent this",
"behavior, plese specify a different first_date that",
"represents a day within [1, 28]."
)
msg <- paste(strwrap(msg), collapse = "\n")
warning(sprintf(msg, fd), call. = FALSE)
}
if (is_year && the_month == 2 && the_day == 29) {
# The first date occurs on a leap day.
msg <- paste("The first_date (%s) represents a day that does not",
"occur in all years. Because of this, bins may not",
"fall on the same day. To prevent this behavior, please",
"specify a first_date that represents a different day."
)
msg <- paste(strwrap(msg), collapse = "\n")
warning(sprintf(msg, fd), call. = FALSE)
}
}
}
seq(first_date, last_date, by = the_interval)
}
incidence/R/get_timespan.R 0000644 0001762 0000144 00000001062 14621104516 015175 0 ustar ligges users #' @return
#' - `get_timespan()`: an `integer` denoting the timespan represented by the
#' incidence object.
#' @export
#' @rdname accessors
#' @aliases get_timespan
get_timespan <- function(x) {
UseMethod("get_timespan")
}
#' @export
#' @rdname accessors
#' @aliases get_timespan.default
get_timespan.default <- function(x) {
stop(sprintf("Not implemented for class %s",
paste(class(x), collapse = ", ")))
}
#' @export
#' @rdname accessors
#' @aliases get_timespan.incidence
get_timespan.incidence <- function(x) {
x$timespan
}
incidence/R/fit_optim_split.R 0000644 0001762 0000144 00000011023 14621104516 015721 0 ustar ligges users #' @export
#' @rdname fit
#'
#' @param window The size, in days, of the time window either side of the
#' split.
#'
#' @param plot A logical indicating whether a plot should be added to the
#' output (`TRUE`, default), showing the mean R2 for various splits.
#'
#' @param separate_split If groups are present, should separate split dates be
#' determined for each group? Defaults to `TRUE`, in which separate split dates
#' and thus, separate models will be constructed for each group. When `FALSE`,
#' the split date will be determined from the pooled data and modelled with the
#' groups as main effects and interactions with date.
#'
fit_optim_split <- function(x, window = x$timespan/4, plot = TRUE,
quiet = TRUE, separate_split = TRUE) {
if (ncol(x$counts) > 1 && separate_split) {
# Calculate split for each group separately --------------------------------
res <- vector(mode = "list", length = ncol(x$counts))
names(res) <- colnames(x$counts)
for (i in names(res)) {
res[[i]] <- fit_optim_split(x[, i], separate_split = FALSE, plot = FALSE)
}
# Rearrange data -----------------------------------------------------------
# The resulting object will have the follwing structure
# $df
# $plot
# $group1
$model: The model fit to anincidenceobject. Currently, this represents a log-linear model, but it can be any model.$info: Information derived from the modelrThe growth rater.confthe confidence interval ofrpreda data frame containing the predictions of the model using the true dates (dates), their numeric version used in the model (dates.x), the predicted value (fit), and the lower (lwr) and upper (upr) bounds of the associated confidence interval.doublingthe predicted doubling time in days (only ifris positive)doubling.confthe confidence interval of the doubling timehalvingthe predicted halving time in days (only ifris negative)halving.confthe confidence interval of the halving time
$origin: the date corresponding to day ‘0’- It consists of a named list containing one or more
incidence_fitobjects or lists containingincidence_fitobjects. - An attribute called “locations” contains a list whose length is
equal to the number of
incidence_fitobjects in the object. Each list element contains a vector that defines where anincidence_fitobject is within theincidence_fit_list. ‘exports’: conversion from an incidence object to another type of object; this can be useful for processing incidence data in another software, or for reporting results.
‘imports’conversion from already computed incidence into an incidence object; this can be useful for using features of the incidence package for data handling and plotting with incidence data computed elsewhere.
incidence: compute incidence from dates in various formats; any fixed time interval can be used; the returned object is an instance of the (S3) class incidence.plot: this method (see?plot.incidencefor details) plots incidence objects, and can also add predictions of the model(s) contained in an incidence_fit object (or a list of such objects).fit: fit one or two exponential models (i.e. linear regression on log-incidence) to an incidence object; two models are calibrated only if a date is provided to split the time series in two (argumentsplit); this is typically useful to model the two phases of exponential growth, and decrease of an outbreak; each model returned is an instance of the (S3) class incidence_fit, each of which contains various useful information (e.g. growth rate r, doubling/halving time, predictions and confidence intervals); results can be plotted usingplot, or added to an existinguncudenceplot using the piping-friendly functionadd_incidence_fit.fit_optim_split: finds the optimal date to split the time series in two, typically around the peak of the epidemic.[: lower-level subsetting of incidence objects, permitting to specify which dates and groups to retain; uses a syntax similar to matrices, i.e.x[i, j], wherexis the incidence object,ia subset of dates, andja subset of groups.subset: subset an incidence object by specifying a time window.pool: pool incidence from different groups into one global incidence time series.cumulate: computes cumulative incidence over time from andincidenceobject.as.data.frame: converts an incidence object into adata.framecontaining dates and incidence values.bootstrap: generates a bootstrapped incidence object by re-sampling, with replacement, the original dates of events.find_peak: locates the peak time of the epicurve.estimate_peak: uses bootstrap to estimate the peak time (and related confidence interval) of a partially observed outbreak.- “r”, the daily growth rate
- “doubling” the rate of doubling in days (if “r” is positive)
- “halving” the rate of halving in days (if “r” is negative)
- “pred” a data frame of incidence predictions
incidence 1.0.1 (2016-11-23) ================== ### NEW FEATURES * The README.Rmd / README.md now contains information about various websites for *incidence* as well as guidelines for posting questions on the RECON forum. * incidence now has a dedicated website [https://www.repidemicsconsortium.org/incidence/](https://www.repidemicsconsortium.org/incidence/) generated with *pkgdown* ### MINOR IMPROVEMENTS * Vignettes titles are now correctly displayed on CRAN (they read '*Vignette title*').
incidence 1.0.0 (2016-11-03) ================== First release of the incidence package on CRAN! incidence/MD5 0000644 0001762 0000144 00000016353 14626320772 012524 0 ustar ligges users e4802e2236d5a4e29875f3fc5e7e2df1 *DESCRIPTION eca4b40065e4dfda3e24fd8669252c25 *LICENSE c267d6e4ac6af6199ed6ef51ffc13a79 *NAMESPACE 46791eacba437b4b03d02b11e733eb63 *NEWS.md 1b60f3806bf4ebc9555d460586d4d9ef *R/bootstrap.R 700af6fa1ffb4dee9a4a3f6246495214 *R/check_boundaries.R 0332144a9ca17f79421356b4bb61c6c0 *R/check_dates.R 855adc028e1f007f1cf7e3bca469da2c *R/check_dots.R 11d91173d7bb9570c8e6d4c27844c03d *R/check_groups.R 52aa69c4ef51561f342d307b3215287c *R/check_interval.R bba33e7776e720a07b3287775852c399 *R/check_timespan.R 4580363cc816383080b98927b3a905f8 *R/check_week.R 37f049a1a6f2e823db40df470dbbbd57 *R/conversion.R 0cdc9bb86130b44a85b9bc232668cd5c *R/cumulate.R a7ef1071b64eef80ea248a634e3e3e25 *R/dim.R bac7bdf837ff3713502d658149039415 *R/estimate_peak.R 8b8215e236816de5fbbd9da0e0c4c26e *R/extract_info.R 88b3307c0d2077f966bbf262a0d3555f *R/find_peak.R 36cecaf104c395e1fa0b62eddcf67f91 *R/fit.R 126f4983aaa7388220c5258caff55207 *R/fit_optim_split.R 95d41836d27a2afda0b7b5d61794e70a *R/get_counts.R 852326cf7498110334ce88cd85241f21 *R/get_dates.R 92d1dfae0fe75878e90bcde1ad6f657a *R/get_fit.R 36a425a9828a536ead27a8d2fd54ab36 *R/get_info.R 8af487e3806f47cac06bcc11c4bd92c6 *R/get_interval.R cc05e33bb43da9323929ff1f8cfee523 *R/get_n.R e58abd179a572e9febf60b993d8f2448 *R/get_timespan.R dd9d23d317d221f4f597b85fc4553a17 *R/get_week.R faacaeaf8d4560f5ad974c7174156623 *R/group_names.R 3c0c8d3a08b1e8be3d9f9d5ee176af0c *R/incidence.R 90ff6f62bed5f64c5ff8a75c236361eb *R/internals.R 3624191ec26b75f37dd00e2d3d9a4ac4 *R/make_breaks.R 7ddc2a055095574e6f36724ee54392b4 *R/make_incidence.R 8fc2a044587c969dbff4fc95a1a5128e *R/palettes.R 667f11a8df0d7fda53b4f38e7b15837c *R/plot.R 7f52e65e748732b185a2968da0d9dc2a *R/pool.R 2663204ed57f0ad3aabde34c800f7033 *R/print.R 7a979a48ad26e41259418c755e173ce5 *R/scale_x_incidence.R f98beeee30931baa02999379845b8e8b *R/subset.R 3b3f2f856f216280566a7ca4e45e3182 *R/trim_observations.R e72baa216b6091bfd7f168472b43ccc5 *R/valid_interval.R 390deccd3e91a620e72854d14da41520 *R/zzz.R 176953a23c9250aecf3f2493660faae7 *build/vignette.rds 04de2be6f208bba13353da3f06da1e5a *demo/00Index e4d55577beddbb60225f4624edfddefb *demo/incidence-demo.R 26251717636cb3f700e094d800e0318c *inst/CITATION 864c55119b696b088339e854a868814d *inst/WORDLIST a88bdf7162e7b299b7c7340a08b0e27b *inst/doc/conversions.R 18670cb185ae7cb42cc4d5adc2a48971 *inst/doc/conversions.Rmd b9de99191bd9658fbbd42b3dbf1e383f *inst/doc/conversions.html 8b8322e03888b6adcdf88343db0440d8 *inst/doc/customize_plot.R 93312c28fa69277b756be634a9527f49 *inst/doc/customize_plot.Rmd 9fd96db4db10eec5dd4c156cadcaf207 *inst/doc/customize_plot.html 1a4b44af9a30de2155edb7646fb37bc7 *inst/doc/incidence_class.R 762b11741e3fdf20c87bff3322b421ba *inst/doc/incidence_class.Rmd cae252be69f2b3f628de7d5db9599317 *inst/doc/incidence_class.html d987907fbbe733e777abba57086a42fe *inst/doc/incidence_fit_class.R c1fa6b93b93f12b855df217ad70a08ec *inst/doc/incidence_fit_class.Rmd acd2cd3768c3b8224aa406863ff049f5 *inst/doc/incidence_fit_class.html 7eacdbc25831cc8e9c09c8e8b7902f35 *inst/doc/overview.R cde40f2dd28872a787e76566b604e86f *inst/doc/overview.Rmd 0332d7e3806420e46b98ec1a6bae66fe *inst/doc/overview.html 9053939178bef4f18c504366a254a21b *man/accessors.Rd c8d463ebb00eb71b05acfc68293301ff *man/bootstrap.Rd b48296d578a2edea7236360debb1c9b3 *man/conversions.Rd 50f8330f97d8199b7c38aa50c0c33fbb *man/cumulate.Rd 54ca31f140cbb44bf43ea20ad703236a *man/estimate_peak.Rd 9e19272466b9440bd152f234defde4d1 *man/find_peak.Rd 3b86d9a9f5f52b0b8c625f53fba4be6c *man/fit.Rd d6a9b63cbb04dbd29990e69cb355cfd6 *man/get_counts.Rd 74e94e869f8ac8272b0cbbfee14e6090 *man/get_dates.Rd debd0c93057985e7e23b2e9892835cb4 *man/get_fit.Rd 4156c32ac13f582ec1ec1681806b435b *man/group_names.Rd daff75878d0dadaddf7b5797cf2e56e6 *man/incidence.Rd f5ec27dd1ad381482271838783d3b457 *man/palettes.Rd 8a0bd65d186a093cd30229dff8e2cc31 *man/plot.incidence.Rd 2f1ed63649f5fba0f54c20fbda26c1b7 *man/pool.Rd b484cc22c537b25f858db9d52e161da8 *man/subset.Rd 3d28024bfb7b679ea6bf1f4814a32697 *tests/testthat.R 49749a093e92a1ff7b0372f91205e4f7 *tests/testthat/data_cache/mfcat.rds 04c435031d599d6975cb158a52d538fe *tests/testthat/data_cache/mfdat.rds 8b5e1df8a711a9500070045381f925b7 *tests/testthat/rds/df.rds 31fdfb9f33c66b91907925188fc44162 *tests/testthat/rds/df2.rds d8ac02fa57da9a6e9fb8523bde7b20dc *tests/testthat/rds/df3.rds 7750a0ea82256a95f270a3b69ebfe40d *tests/testthat/rds/df5.rds e12b745a407a4a81d337b9e6ae0f1415 *tests/testthat/rds/df6.rds 7d3405e64c951a3b5d932dec9f7659a5 *tests/testthat/rds/dfl.rds 2e93158c0255b2cdd90844835dc74b3a *tests/testthat/rds/fit.i.rds da39a68587d56ae83a373a33fa1196d5 *tests/testthat/rds/fit.i.sex.rds 6fd3d6377b5ff0270537ad8a2257b896 *tests/testthat/rds/incidence.res1.rds fa1aab2b57af9818659e9662aa4f4d04 *tests/testthat/rds/incidence.res2.rds 51ebe13ae57c2469ac86c56c80e563cc *tests/testthat/rds/incidence.res3.rds afc0318670a26bbbea7ad3634279d58c *tests/testthat/rds/incidence.res4.rds df4de2db2a6504b71c241c10564b7486 *tests/testthat/rds/incidence.res5.rds 5057091a4b224746cc54385d59d57d30 *tests/testthat/rds/incidence.res6.rds 1d7b009cc985909b55962b19cf60de4b *tests/testthat/rds/incidence.res7.rds 7909f6ce2d63d0580b6cca636722aff5 *tests/testthat/rds/incidence.res8.rds a24b4e372b592b386fb2f78b2ac6d071 *tests/testthat/rds/o.fit.i.rds 0242a9b30adbdb07ce2015039a360d63 *tests/testthat/rds/o.fit.i.sex.rds 31961b4142df30d5e012ad8fce06f67d *tests/testthat/rds/print.fit.i.rds 269fc45cd4b24b85bde0112081699cf2 *tests/testthat/rds/print.fit.sex.rds 95c32b7dce302d5f18d62f03fec06bf4 *tests/testthat/rds/print1.rds 61a8a650741b3736b00f1ae1c68f9cc2 *tests/testthat/rds/print2.rds bcbaaadac5c9080f468917483d65b947 *tests/testthat/rds/print3.rds 0f43d7d91754679e97dab57990ab5f87 *tests/testthat/rds/res.g.1.rds e5b0554f70f67164cf0169d17f83e347 *tests/testthat/rds/res.g.2.rds b451537eec4575210bbbb9943265cf1c *tests/testthat/rds/res.g.3.rds fc4ba9a7cfc3339606bdbb3d082a6157 *tests/testthat/rds/x.sub1.rds dbc17ce8fb86a619c7e930d003004754 *tests/testthat/rds/x.sub2.rds 11970747d47061b824d769ca9a49c8ad *tests/testthat/rds/x.sub3.rds 5231f0421410ad4f62801766e2310d16 *tests/testthat/rds/x.sub4.rds 3b5c7ace07b16ab5b5b5e51bb553c85b *tests/testthat/rds/x.sub5.rds 82c1f82d508e3efcf82c46cdeab7f164 *tests/testthat/rds/y.sub1.rds 23afa37e8b21b2508e7a57109d6bdc31 *tests/testthat/test-accessors.R 8401035ce255073f72e06a270a94d688 *tests/testthat/test-bootstrap.R 4859d51e124340a47fbd41f83f1b6c61 *tests/testthat/test-conversions.R e79e8c8b2580df95b34df430a0ae63c7 *tests/testthat/test-cumulate.R 4c8cc0c64d43aa4fad98ce96ea486d2c *tests/testthat/test-fit.R 19ca8f4ed2ff7dc93e88c2b85708902d *tests/testthat/test-incidence.R 9e4507a2c852124961f5c1d82f995395 *tests/testthat/test-non-exported.R 435e145a6bc93b732218e55ec2d0eec6 *tests/testthat/test-palettes.R 5498c9b6c633d7849178c1969b151688 *tests/testthat/test-plot.R 66c8dd3934e1340a4c4ff392451ec55e *tests/testthat/test-pool.R 21bd181b6c1e2a39d1220cb9271102bf *tests/testthat/test-standards.R 820e2a55ce144a2141e708210f2e2e15 *tests/testthat/test-subset.R 18670cb185ae7cb42cc4d5adc2a48971 *vignettes/conversions.Rmd 93312c28fa69277b756be634a9527f49 *vignettes/customize_plot.Rmd 762b11741e3fdf20c87bff3322b421ba *vignettes/incidence_class.Rmd c1fa6b93b93f12b855df217ad70a08ec *vignettes/incidence_fit_class.Rmd cde40f2dd28872a787e76566b604e86f *vignettes/overview.Rmd incidence/inst/ 0000755 0001762 0000144 00000000000 14626316445 013163 5 ustar ligges users incidence/inst/doc/ 0000755 0001762 0000144 00000000000 14626316445 013730 5 ustar ligges users incidence/inst/doc/customize_plot.html 0000644 0001762 0000144 00002672346 14626316440 017715 0 ustar ligges users
Customize plots of incidence
Thibaut Jombart, Zhian N. Kamvar
2024-05-31
This vignette provides some tips for the most common customisations
of graphics produced by plot.incidence. Our graphics use
ggplot2, which is a distinct graphical system from base
graphics. If you want advanced customisation of your incidence plots, we
recommend following an introduction to ggplot2.
Example data: simulated Ebola outbreak
This example uses the simulated Ebola Virus Disease (EVD) outbreak
from the package outbreaks:
ebola_sim_clean.
First, we load the data:
library(outbreaks)
library(ggplot2)
library(incidence)
onset <- ebola_sim_clean$linelist$date_of_onset
class(onset)
#> [1] "Date"head(onset)
#> [1] "2014-04-07" "2014-04-15" "2014-04-21" "2014-04-27" "2014-04-26"
#> [6] "2014-04-25"We compute the weekly incidence:
i <- incidence(onset, interval = 7)
i
#> <incidence object>
#> [5829 cases from days 2014-04-07 to 2015-04-27]
#> [5829 cases from ISO weeks 2014-W15 to 2015-W18]
#>
#> $counts: matrix with 56 rows and 1 columns
#> $n: 5829 cases in total
#> $dates: 56 dates marking the left-side of bins
#> $interval: 7 days
#> $timespan: 386 days
#> $cumulative: FALSE
i.sex <- incidence(onset, interval = 7, group = ebola_sim_clean$linelist$gender)
i.sex
#> <incidence object>
#> [5829 cases from days 2014-04-07 to 2015-04-27]
#> [5829 cases from ISO weeks 2014-W15 to 2015-W18]
#> [2 groups: f, m]
#>
#> $counts: matrix with 56 rows and 2 columns
#> $n: 5829 cases in total
#> $dates: 56 dates marking the left-side of bins
#> $interval: 7 days
#> $timespan: 386 days
#> $cumulative: FALSE
i.hosp <- incidence(onset, interval = 7, group = ebola_sim_clean$linelist$hospital)
i.hosp
#> <incidence object>
#> [5829 cases from days 2014-04-07 to 2015-04-27]
#> [5829 cases from ISO weeks 2014-W15 to 2015-W18]
#> [6 groups: Connaught Hospital, Military Hospital, other, Princess Christian Maternity Hospital (PCMH), Rokupa Hospital, NA]
#>
#> $counts: matrix with 56 rows and 6 columns
#> $n: 5829 cases in total
#> $dates: 56 dates marking the left-side of bins
#> $interval: 7 days
#> $timespan: 386 days
#> $cumulative: FALSEThe plot.incidence function
When calling plot on an incidence object, the
function plot.incidence is implicitly used. To access its
documentation, use ?plot.incidence. In this section, we
illustrate existing customisations.
Default behaviour
By default, the function uses grey for single time series, and colors
from the color palette incidence_pal1 when incidence is
computed by groups:
However, some of these defaults can be altered through the various arguments of the function:
Changing colors
The default palette
A color palette is a function which outputs a specified number of
colors. By default, the color used in incidence is called
incidence_pal1. Its behaviour is different from usual
palettes, in the sense that the first 4 colours are not
interpolated:
par(mfrow = c(3, 1), mar = c(4,2,1,1))
barplot(1:2, col = incidence_pal1(2))
barplot(1:4, col = incidence_pal1(4))
barplot(1:20, col = incidence_pal1(20))
This palette also has a light and a dark version:
par(mfrow = c(3,1))
barplot(1:20, col = incidence_pal1_dark(20), main = "palette: incidence_pal1_dark")
barplot(1:20, col = incidence_pal1(20), main = "palette: incidence_pal1")
barplot(1:20, col = incidence_pal1_light(20), main = "palette: incidence_pal1_light")
Using different palettes
Other color palettes can be provided via col_pal.
Various palettes are part of the base R distribution, and many more are
provided in additional packages. We provide a couple of examples:
Specifying colors manually
Colors can be specified manually using the argument
color; note that whenever incidence is computed by groups,
the number of colors must match the number of groups, otherwise
color is ignored.
Example 2: changing several colors (note that naming colors is optional)
Useful ggplot2 tweaks
Numerous tweaks for ggplot2 are documented online. In the following, we merely provide a few useful tips in the context of incidence.
Changing dates on the x-axis
Changing date format
By default, the dates indicated on the x-axis of an
incidence plot may not have the suitable format. The package
scales can be used to change the way dates are labeled (see
?strptime for possible formats):
library(scales)
plot(i, labels_week = FALSE) +
scale_x_date(labels = date_format("%d %b %Y"))
#> Scale for x is already present.
#> Adding another scale for x, which will replace the existing scale.
Notice how the labels are all situated at the first of the month? If
you want to make sure the labels are situated in a different
orientation, you can use the make_breaks() function to
calculate breaks for the plot:
b <- make_breaks(i, labels_week = FALSE)
b
#> $breaks
#> [1] "2014-04-07" "2014-07-07" "2014-10-06" "2015-01-05" "2015-04-06"
#> [6] "2015-07-06"
#>
#> $labels
#> list()
#> attr(,"class")
#> [1] "waiver"plot(i) +
scale_x_date(breaks = b$breaks,
labels = date_format("%d %b %Y"))
#> Scale for x is already present.
#> Adding another scale for x, which will replace the existing scale.
And for another example, with a subset of the data (first 50 weeks), using more detailed dates and rotating the annotations:
plot(i[1:50]) +
scale_x_date(breaks = b$breaks, labels = date_format("%a %d %B %Y")) +
theme(axis.text.x = element_text(angle = 45, hjust = 1, size = 12))
#> Scale for x is already present.
#> Adding another scale for x, which will replace the existing scale.
Note that you can save customisations for later use:
Changing the grid
The last example above illustrates that it can be useful to have denser annotations of the x-axis, especially over short time periods. Here, we provide an example where we try to zoom on the peak of the epidemic, using the data by hospital:
Let us look at the data 40 days before and after the 1st of October:
period <- as.Date("2014-10-01") + c(-40, 40)
i.zoom <- subset(i.hosp, from = period[1], to = period[2])
detailed.x <- scale_x_date(labels = date_format("%a %d %B %Y"),
date_breaks = "2 weeks",
date_minor_breaks = "week")
plot(i.zoom, border = "black") + detailed.x + rotate.big
#> Scale for x is already present.
#> Adding another scale for x, which will replace the existing scale.
Handling non-ISO weeks
If you have weekly incidence that starts on a day other than monday, then the above solution may produce breaks that fall inside of the bins:
i.sat <- incidence(onset, interval = "1 week: saturday", groups = ebola_sim_clean$linelist$hospital)
i.szoom <- subset(i.sat, from = period[1], to = period[2])
plot(i.szoom, border = "black") + detailed.x + rotate.big
#> Scale for x is already present.
#> Adding another scale for x, which will replace the existing scale.
In this case, you may want to either calculate breaks using
make_breaks() or use the scale_x_incidence()
function to automatically calculate these for you:
plot(i.szoom, border = "black") +
scale_x_incidence(i.szoom, n_breaks = nrow(i.szoom)/2, labels_week = FALSE) +
rotate.big
#> Scale for x is already present.
#> Adding another scale for x, which will replace the existing scale.
sat_breaks <- make_breaks(i.szoom, n_breaks = nrow(i.szoom)/2)
plot(i.szoom, border = "black") +
scale_x_date(breaks = sat_breaks$breaks, labels = date_format("%a %d %B %Y")) +
rotate.big
#> Scale for x is already present.
#> Adding another scale for x, which will replace the existing scale.
Changing the legend
The previous plot has a fairly large legend which we may want to move
around. Let us save the plot as a new object p and
customize the legend:
p <- plot(i.zoom, border = "black") + detailed.x + rotate.big
#> Scale for x is already present.
#> Adding another scale for x, which will replace the existing scale.p + theme(axis.text.x = element_text(angle = 45, hjust = 1, size = 12),
legend.position = "top", legend.direction = "horizontal",
legend.title = element_blank())
Applying the style of European Programme for Intervention Epidemiology Training (EPIET)
Display individual cases
For small datasets it is convention of EPIET to display individual
cases as rectangles. It can be done by doing two things: first, adding
using the option show_cases = TRUE with a white border and
second, setting the background to white. We also add
coord_equal() which forces each case to be a square.
i.small <- incidence(onset[160:180])
plot(i.small, border = "white", show_cases = TRUE) +
theme(panel.background = element_rect(fill = "white")) +
rotate.big +
coord_equal() 
# Installing the package To install the current stable, CRAN version of the package, type: ```{r install, eval=FALSE} install.packages("incidence") ``` To benefit from the latest features and bug fixes, install the development, *github* version of the package using: ```{r install2, eval=FALSE} devtools::install_github("reconhub/incidence") ``` Note that this requires the package *devtools* installed.
# What does it do? The main functions of the package include: - **`incidence`**: compute incidence from dates in various formats; any fixed time interval can be used; the returned object is an instance of the (S3) class *incidence*. - **`plot`**: this method (see `?plot.incidence` for details) plots *incidence* objects, and can also add predictions of the model(s) contained in an *incidence_fit* object (or a list of such objects). - **`fit`**: fit one or two exponential models (i.e. linear regression on log-incidence) to an *incidence* object; two models are calibrated only if a date is provided to split the time series in two (argument `split`); this is typically useful to model the two phases of exponential growth, and decrease of an outbreak; each model returned is an instance of the (S3) class *incidence_fit*, each of which contains various useful information (e.g. growth rate *r*, doubling/halving time, predictions and confidence intervals); results can be plotted using `plot`, or added to an existing `uncudence` plot using the piping-friendly function `add_incidence_fit`. - **`fit_optim_split`**: finds the optimal date to split the time series in two, typically around the peak of the epidemic. - **`[`**: lower-level subsetting of *incidence* objects, permitting to specify which dates and groups to retain; uses a syntax similar to matrices, i.e. `x[i, j]`, where `x` is the *incidence* object, `i` a subset of dates, and `j` a subset of groups. - **`subset`**: subset an *incidence* object by specifying a time window. - **`pool`**: pool incidence from different groups into one global incidence time series. - **`cumulate`**: computes cumulative incidence over time from and `incidence` object. - **`as.data.frame`**: converts an *incidence* object into a `data.frame` containing dates and incidence values. - **`bootstrap`**: generates a bootstrapped *incidence* object by re-sampling, with replacement, the original dates of events. - **`find_peak`**: locates the peak time of the epicurve. - **`estimate_peak`**: uses bootstrap to estimate the peak time (and related confidence interval) of a partially observed outbreak. # Worked example: simulated Ebola outbreak ## Loading the data This example uses the simulated Ebola Virus Disease (EVD) outbreak from the package [*outbreaks*](https://cran.r-project.org/package=outbreaks). We will compute incidence for various time steps, calibrate two exponential models around the peak of the epidemic, and analyse the results. First, we load the data: ```{r, data} library(outbreaks) library(ggplot2) library(incidence) dat <- ebola_sim$linelist$date_of_onset class(dat) head(dat) ``` ## Computing and plotting incidence We compute the daily incidence: ```{r, incid1} i <- incidence(dat) i plot(i) ``` The daily incidence is quite noisy, but we can easily compute other incidence using larger time intervals: ```{r, interv} # weekly, starting on Monday (ISO week, default) i.7 <- incidence(dat, interval = "1 week") plot(i.7) # semi-weekly, starting on Saturday i.14 <- incidence(dat, interval = "2 saturday weeks") plot(i.14, border = "white") ## monthly i.month <- incidence(dat, interval = "1 month") plot(i.month, border = "white") ``` `incidence` can also compute incidence by specified groups using the `groups` argument. For instance, we can compute incidence by gender: ```{r, gender} i.7.sex <- incidence(dat, interval = "1 week", groups = ebola_sim$linelist$gender) i.7.sex plot(i.7.sex, stack = TRUE, border = "grey") ``` We can do the same for hospitals, using the 'clean' version of the dataset, with some customization of the legend: ```{r, hosp} i.7.hosp <- with(ebola_sim_clean$linelist, incidence(date_of_onset, interval = "week", groups = hospital)) i.7.hosp head(get_counts(i.7.hosp)) plot(i.7.hosp, stack=TRUE) + theme(legend.position= "top") + labs(fill="") ``` ## Handling `incidence` objects `incidence` objects can be manipulated easily. The `[` operator implements subsetting of dates (first argument) and groups (second argument). For instance, to keep only the peak of the distribution: ```{r, middle} i[100:250] plot(i[100:250]) ``` Or to keep every other week: ```{r, stripes} i.7[c(TRUE,FALSE)] plot(i.7[c(TRUE,FALSE)]) ``` Some temporal subsetting can be even simpler using `subset`, which permits to retain data within a specified time window: ```{r, tail} i.tail <- subset(i, from=as.Date("2015-01-01")) i.tail plot(i.tail, border="white") ``` Subsetting groups can also matter. For instance, let's try and visualise the incidence based on onset of symptoms by outcome: ```{r, i7outcome} i.7.outcome <- incidence(dat, 7, groups=ebola_sim$linelist$outcome) i.7.outcome plot(i.7.outcome, stack = TRUE, border = "grey") ``` By default, `incidence` treats missing data (NA) as a separate group (see argument `na_as_group`). We could disable this to retain only known outcomes, but alternatively we can simply subset the object to exclude the last (3rd) group: ```{r, groupsub} i.7.outcome[,1:2] plot(i.7.outcome[,1:2], stack = TRUE, border = "grey") ``` Groups can also be collapsed into a single time series using `pool`: ```{r, pool} i.pooled <- pool(i.7.outcome) i.pooled identical(i.7$counts, i.pooled$counts) ``` ## Modelling incidence Incidence data, excluding zeros, can be modelled using log-linear regression of the form: log(*y*) = *r* x *t* + *b* where *y* is the incidence, *r* is the growth rate, *t* is the number of days since a specific point in time (typically the start of the outbreak), and *b* is the intercept. Such model can be fitted to any incidence object using `fit`. Of course, a single log-linear model is not sufficient for modelling our epidemic curve, as there is clearly an growing and a decreasing phase. As a start, we can calibrate a model on the first 20 weeks of the epidemic: ```{r, fit1} plot(i.7[1:20]) early.fit <- fit(i.7[1:20]) early.fit ``` The resulting objects (known as `incidence_fit` objects) can be plotted, in which case the prediction and its confidence interval is displayed: ```{r} plot(early.fit) ``` However, a better way to display these predictions is adding them to the incidence plot using the argument `fit`: ```{r} plot(i.7[1:20], fit = early.fit) ``` In this case, we would ideally like to fit two models, before and after the peak of the epidemic. This is possible using the following approach, if you know what date to use to split the data in two phases: ```{r, fit.both} fit.both <- fit(i.7, split=as.Date("2014-10-15")) fit.both plot(i.7, fit=fit.both) ``` This is much better, but the splitting date is not completely optimal. To look for the best possible splitting date (i.e. the one maximizing the average fit of both models), we use: ```{r, optim} best.fit <- fit_optim_split(i.7) best.fit plot(i.7, fit=best.fit$fit) ``` These models are very good approximation of these data, showing a doubling time of `r round(get_info(best.fit$fit, "doubling"), 1)` days during the first phase, and a halving time of `r round(get_info(best.fit$fit, "halving"), 1)` days during the second. To access these parameters, you can use the `get_info()` function. The possible parameters are: - "r", the daily growth rate - "doubling" the rate of doubling in days (if "r" is positive) - "halving" the rate of halving in days (if "r" is negative) - "pred" a data frame of incidence predictions For "r", "doubling", and "halving", you can also add ".conf" to get the confidence intervals. Here's how you can get the doubling and halving times of the above epi curve: ```{r, get_info} get_info(best.fit$fit, "doubling") # doubling time get_info(best.fit$fit, "doubling.conf") # confidence interval get_info(best.fit$fit, "halving") get_info(best.fit$fit, "halving.conf") ``` Note that `fit` will also take groups into account if incidence has been computed for several groups: ```{r, optim2} best.fit2 <- fit_optim_split(i.7.sex) best.fit2 plot(i.7.sex, fit=best.fit2$fit) ``` Using `get_info()` on this fit object will return all groups together: ```{r, get_info_groups} get_info(best.fit2$fit, "doubling") # doubling time get_info(best.fit2$fit, "doubling.conf") # confidence interval get_info(best.fit2$fit, "halving") get_info(best.fit2$fit, "halving.conf") ``` incidence/inst/doc/conversions.R 0000644 0001762 0000144 00000003601 14626316436 016423 0 ustar ligges users ## ----echo = FALSE------------------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>", fig.width=7, fig.height=5 ) ## ----example------------------------------------------------------------------ library(outbreaks) library(incidence) dat <- ebola_sim$linelist$date_of_onset i_14 <- incidence(dat, interval = "2 epiweeks", groups = ebola_sim$linelist$gender) i_14 plot(i_14, border = "white") ## ----------------------------------------------------------------------------- as.data.frame(i_14) ## ----long--------------------------------------------------------------------- df <- as.data.frame(i_14, long = TRUE) head(df) tail(df) ## example of custom plot using steps: library(ggplot2) ggplot(df, aes(x = dates, y = counts)) + geom_step(aes(color = groups)) ## ----iso---------------------------------------------------------------------- i_7 <- incidence(dat, interval = "week") i_7 plot(i_7, border = "white") head(as.data.frame(i_7)) tail(as.data.frame(i_7)) ## ----conversions-------------------------------------------------------------- args(incidence:::as.incidence.matrix) ## ----------------------------------------------------------------------------- vec <- c(1,2,3,0,3,2,4,1,2,1) i <- as.incidence(vec) i plot(vec, type = "s") plot(i, border = "white") ## ----------------------------------------------------------------------------- i <- as.incidence(vec, interval = 7) i plot(i, border = "white") ## ----------------------------------------------------------------------------- i$dates ## ----round_trip--------------------------------------------------------------- ## convertion: incidence --> data.frame: i_14 df <- as.data.frame(i_14) head(df) tail(df) ## conversion: data.frame --> incidence new_i <- as.incidence(df[group_names(i_14)], df$dates, interval = "2 epiweeks") new_i ## check round trip identical(new_i, i_14) incidence/inst/doc/incidence_class.html 0000644 0001762 0000144 00000265324 14626316441 017734 0 ustar ligges users
Details of the incidence class
Thibaut Jombart, Zhian N. Kamvar
2024-05-31
This vignette details the structure of incidence objects, as
produced by the incidence function.
Structure of an incidence object.
We generate a toy dataset of dates to examine the content of incidence objects.
library(incidence)
set.seed(1)
dat <- sample(1:50, 200, replace = TRUE, prob = 1 + exp(1:50 * 0.1))
sex <- sample(c("female", "male"), 200, replace = TRUE)The incidence by 48h period is computed as:
i <- incidence(dat, interval = 2)
i
#> <incidence object>
#> [200 cases from days 5 to 49]
#>
#> $counts: matrix with 23 rows and 1 columns
#> $n: 200 cases in total
#> $dates: 23 dates marking the left-side of bins
#> $interval: 2 days
#> $timespan: 45 days
#> $cumulative: FALSE
We also compute incidence by gender:
i.sex <- incidence(dat, interval = 2, group = sex)
i.sex
#> <incidence object>
#> [200 cases from days 5 to 49]
#> [2 groups: female, male]
#>
#> $counts: matrix with 23 rows and 2 columns
#> $n: 200 cases in total
#> $dates: 23 dates marking the left-side of bins
#> $interval: 2 days
#> $timespan: 45 days
#> $cumulative: FALSE
The object i is a list with the class
incidence:
Items in i can be accessed using the same indexing as
any lists, but it’s safer to use the accessors for each item:
In the following sections, we examine each of the components of the object.
$dates
The $dates component contains a vector for all the dates
for which incidence have been computed, in the format of the input
dataset (e.g. Date, numeric,
integer).
The dates correspond to the lower bounds of the time intervals used as bins for the incidence. Bins always include the lower bound and exclude the upper bound. In the example provided above, this means that the first bin counts events that happened at day 5-6, the second bin counts events from 7-8, etc.
Note that if we had actual Date-class dates, they would
be returned as dates
dat_Date <- as.Date("2018-10-31") + dat
head(dat_Date)
#> [1] "2018-12-17" "2018-12-16" "2018-12-12" "2018-11-26" "2018-12-18"
#> [6] "2018-11-27"i.date <- incidence(dat_Date, interval = 2, group = sex)
i.date
#> <incidence object>
#> [200 cases from days 2018-11-05 to 2018-12-19]
#> [2 groups: female, male]
#>
#> $counts: matrix with 23 rows and 2 columns
#> $n: 200 cases in total
#> $dates: 23 dates marking the left-side of bins
#> $interval: 2 days
#> $timespan: 45 days
#> $cumulative: FALSEget_dates(i.date)
#> [1] "2018-11-05" "2018-11-07" "2018-11-09" "2018-11-11" "2018-11-13"
#> [6] "2018-11-15" "2018-11-17" "2018-11-19" "2018-11-21" "2018-11-23"
#> [11] "2018-11-25" "2018-11-27" "2018-11-29" "2018-12-01" "2018-12-03"
#> [16] "2018-12-05" "2018-12-07" "2018-12-09" "2018-12-11" "2018-12-13"
#> [21] "2018-12-15" "2018-12-17" "2018-12-19"These can be converted to integers, counting the number of days from the first date.
get_dates(i.date, count_days = TRUE)
#> [1] 0 2 4 6 8 10 12 14 16 18 20 22 24 26 28 30 32 34 36 38 40 42 44get_dates(i, count_days = TRUE)
#> [1] 0 2 4 6 8 10 12 14 16 18 20 22 24 26 28 30 32 34 36 38 40 42 44To facilitate modelling, it’s also possible to get the center of the
interval by using the position = "center" argument:
get_dates(i.date, position = "center")
#> [1] "2018-11-06" "2018-11-08" "2018-11-10" "2018-11-12" "2018-11-14"
#> [6] "2018-11-16" "2018-11-18" "2018-11-20" "2018-11-22" "2018-11-24"
#> [11] "2018-11-26" "2018-11-28" "2018-11-30" "2018-12-02" "2018-12-04"
#> [16] "2018-12-06" "2018-12-08" "2018-12-10" "2018-12-12" "2018-12-14"
#> [21] "2018-12-16" "2018-12-18" "2018-12-20"$counts
The $counts component contains the actual incidence,
i.e. counts of events for the defined bins. It is a matrix
of integers where rows correspond to time intervals, with
one column for each group for which incidence is computed (a single,
unnamed column if no groups were provided). If groups were provided,
columns are named after the groups. We illustrate the difference
comparing the two objects i and i.sex:
counts
#> [,1]
#> [1,] 3
#> [2,] 0
#> [3,] 1
#> [4,] 0
#> [5,] 1
#> [6,] 0
#> [7,] 1
#> [8,] 0
#> [9,] 3
#> [10,] 3
#> [11,] 3
#> [12,] 5
#> [13,] 9
#> [14,] 4
#> [15,] 5
#> [16,] 12
#> [17,] 13
#> [18,] 16
#> [19,] 15
#> [20,] 25
#> [21,] 28
#> [22,] 28
#> [23,] 25get_counts(i.sex)
#> female male
#> [1,] 2 1
#> [2,] 0 0
#> [3,] 0 1
#> [4,] 0 0
#> [5,] 1 0
#> [6,] 0 0
#> [7,] 0 1
#> [8,] 0 0
#> [9,] 2 1
#> [10,] 1 2
#> [11,] 1 2
#> [12,] 2 3
#> [13,] 3 6
#> [14,] 3 1
#> [15,] 0 5
#> [16,] 6 6
#> [17,] 8 5
#> [18,] 7 9
#> [19,] 7 8
#> [20,] 17 8
#> [21,] 15 13
#> [22,] 12 16
#> [23,] 12 13You can see the dimensions of the incidence object by using
dim(), ncol(), and nrow(), which
returns the dimensions of the counts matrix:
There are also accessors for handling groups:
# You can also rename the groups
group_names(i.sex) <- c("F", "M")
group_names(i.sex)
#> [1] "F" "M"Note that a data.frame containing dates and
counts can be obtained using as.data.frame:
## basic conversion
as.data.frame(i)
#> dates counts
#> 1 5 3
#> 2 7 0
#> 3 9 1
#> 4 11 0
#> 5 13 1
#> 6 15 0
#> 7 17 1
#> 8 19 0
#> 9 21 3
#> 10 23 3
#> 11 25 3
#> 12 27 5
#> 13 29 9
#> 14 31 4
#> 15 33 5
#> 16 35 12
#> 17 37 13
#> 18 39 16
#> 19 41 15
#> 20 43 25
#> 21 45 28
#> 22 47 28
#> 23 49 25as.data.frame(i.sex)
#> dates F M
#> 1 5 2 1
#> 2 7 0 0
#> 3 9 0 1
#> 4 11 0 0
#> 5 13 1 0
#> 6 15 0 0
#> 7 17 0 1
#> 8 19 0 0
#> 9 21 2 1
#> 10 23 1 2
#> 11 25 1 2
#> 12 27 2 3
#> 13 29 3 6
#> 14 31 3 1
#> 15 33 0 5
#> 16 35 6 6
#> 17 37 8 5
#> 18 39 7 9
#> 19 41 7 8
#> 20 43 17 8
#> 21 45 15 13
#> 22 47 12 16
#> 23 49 12 13
## long format for ggplot2
as.data.frame(i.sex, long = TRUE)
#> dates counts groups
#> 1 5 2 F
#> 2 7 0 F
#> 3 9 0 F
#> 4 11 0 F
#> 5 13 1 F
#> 6 15 0 F
#> 7 17 0 F
#> 8 19 0 F
#> 9 21 2 F
#> 10 23 1 F
#> 11 25 1 F
#> 12 27 2 F
#> 13 29 3 F
#> 14 31 3 F
#> 15 33 0 F
#> 16 35 6 F
#> 17 37 8 F
#> 18 39 7 F
#> 19 41 7 F
#> 20 43 17 F
#> 21 45 15 F
#> 22 47 12 F
#> 23 49 12 F
#> 24 5 1 M
#> 25 7 0 M
#> 26 9 1 M
#> 27 11 0 M
#> 28 13 0 M
#> 29 15 0 M
#> 30 17 1 M
#> 31 19 0 M
#> 32 21 1 M
#> 33 23 2 M
#> 34 25 2 M
#> 35 27 3 M
#> 36 29 6 M
#> 37 31 1 M
#> 38 33 5 M
#> 39 35 6 M
#> 40 37 5 M
#> 41 39 9 M
#> 42 41 8 M
#> 43 43 8 M
#> 44 45 13 M
#> 45 47 16 M
#> 46 49 13 MNote that incidence has an argument called
na_as_group which is TRUE by default, which
will pool all missing groups into a separate group, in which case it
will be a separate column in $counts.
$timespan
The $timespan component stores the length of the time
period covered by the object:
$interval
The $interval component contains the length of the time
interval for the bins:
$n
The $n component stores the total number of events in
the data:
Note that to obtain the number of cases by groups, one can use:
$weeks
The $weeks component is optional, and used to store aweek objects
whenever they have been used. Weeks are used by default when weekly
incidence is computed from dates (see argument standard in
?incidence).
library(outbreaks)
dat <- ebola_sim$linelist$date_of_onset
i.7 <- incidence(dat, "1 epiweek", standard = TRUE)
i.7
#> <incidence object>
#> [5888 cases from days 2014-04-06 to 2015-04-26]
#> [5888 cases from MMWR weeks 2014-W15 to 2015-W17]
#>
#> $counts: matrix with 56 rows and 1 columns
#> $n: 5888 cases in total
#> $dates: 56 dates marking the left-side of bins
#> $interval: 1 week
#> $timespan: 386 days
#> $cumulative: FALSEi.7$weeks
#> <aweek start: Sunday>
#> [1] "2014-W15" "2014-W16" "2014-W17" "2014-W18" "2014-W19" "2014-W20"
#> [7] "2014-W21" "2014-W22" "2014-W23" "2014-W24" "2014-W25" "2014-W26"
#> [13] "2014-W27" "2014-W28" "2014-W29" "2014-W30" "2014-W31" "2014-W32"
#> [19] "2014-W33" "2014-W34" "2014-W35" "2014-W36" "2014-W37" "2014-W38"
#> [25] "2014-W39" "2014-W40" "2014-W41" "2014-W42" "2014-W43" "2014-W44"
#> [31] "2014-W45" "2014-W46" "2014-W47" "2014-W48" "2014-W49" "2014-W50"
#> [37] "2014-W51" "2014-W52" "2014-W53" "2015-W01" "2015-W02" "2015-W03"
#> [43] "2015-W04" "2015-W05" "2015-W06" "2015-W07" "2015-W08" "2015-W09"
#> [49] "2015-W10" "2015-W11" "2015-W12" "2015-W13" "2015-W14" "2015-W15"
#> [55] "2015-W16" "2015-W17"Because $weeks is an optional element, it does not have
a dedicated accessor. If the element is not present, attempting to
access it will result in a NULL:
Both dates and weeks are returned when converting an
incidence object to data.frame:
# Exporting results To export results, we first compute semi-weekly incidence (with weeks starting on Sunday, the beginning of the CDC epiweek) by gender from the simulated Ebola data used in the [overview vignette](https://www.repidemicsconsortium.org/incidence/articles/overview.html): ```{r example} library(outbreaks) library(incidence) dat <- ebola_sim$linelist$date_of_onset i_14 <- incidence(dat, interval = "2 epiweeks", groups = ebola_sim$linelist$gender) i_14 plot(i_14, border = "white") ``` To export the data to a `data.frame`, one simply needs: ```{r} as.data.frame(i_14) ``` The first column contains the dates marking the (inclusive) left side of the time intervals used for computing incidence, and the other columns give counts for the different groups. This function also has an option for exporting data as a 'long' format, i.e. with a column for 'groups' and a column for counts. This format can be useful especially when working with *ggplot2*, which expect data in this shape: ```{r, long} df <- as.data.frame(i_14, long = TRUE) head(df) tail(df) ## example of custom plot using steps: library(ggplot2) ggplot(df, aes(x = dates, y = counts)) + geom_step(aes(color = groups)) ``` Finally, note that when ISO weeks are used, these are also reported in the output: ```{r, iso} i_7 <- incidence(dat, interval = "week") i_7 plot(i_7, border = "white") head(as.data.frame(i_7)) tail(as.data.frame(i_7)) ```
# Importing pre-computed incidence The function `as.incidence` facilitates the conversion of pre-computed incidences to an *incidence* object. Typically, the input will be imported into R from a *.csv* file or other spreadsheet formats. `as.incidence` is a generic with methods for several types of objects (see `?as.incidence`). The main method is `matrix`, as other types are coerced to `matrix` first and then passed to `as.incidence.matrix`: ```{r, conversions} args(incidence:::as.incidence.matrix) ``` The only mandatory argument `x` is a table of counts, with time intervals in rows and groups in columns; if there are no groups, then the column doesn't need a name; but if there are several groups, then columns should be named to indicate group labels. Optionally, `dates` can be provided to indicate the (inclusive) lower bounds of the time intervals, corresponding to the rows of `x`; most sensible date formats will do; if indicated as a character string, make sure the format is `YYYY-mm-dd`, e.g. `2017-04-01` for the 1st April 2017. Let us illustrate the conversion using a simple vector of incidence: ```{r} vec <- c(1,2,3,0,3,2,4,1,2,1) i <- as.incidence(vec) i plot(vec, type = "s") plot(i, border = "white") ``` Assuming the above incidences are computed weekly, we would then use: ```{r} i <- as.incidence(vec, interval = 7) i plot(i, border = "white") ``` Note that in this case, incidences have been treated as per week, and corresponding dates in days have been computed during the conversion (the first day is always '1'), so that the first days of weeks 1, 2, 3... are: ```{r} i$dates ``` In practice, it is best to provide the actual dates marking the lower bounds of the time intervals. We can illustrate this by a round trip using the example of the previous section: ```{r, round_trip} ## convertion: incidence --> data.frame: i_14 df <- as.data.frame(i_14) head(df) tail(df) ## conversion: data.frame --> incidence new_i <- as.incidence(df[group_names(i_14)], df$dates, interval = "2 epiweeks") new_i ## check round trip identical(new_i, i_14) ``` incidence/inst/doc/customize_plot.Rmd 0000644 0001762 0000144 00000020120 14621106437 017440 0 ustar ligges users --- title: "Customize plots of incidence" author: "Thibaut Jombart, Zhian N. Kamvar" date: "`r Sys.Date()`" output: rmarkdown::html_vignette: toc: true toc_depth: 4 vignette: > %\VignetteIndexEntry{Customise graphics} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r, echo = FALSE} knitr::opts_chunk$set( collapse = TRUE, comment = "#>", fig.width=7, fig.height=5 ) ``` This vignette provides some tips for the most common customisations of graphics produced by `plot.incidence`. Our graphics use *ggplot2*, which is a distinct graphical system from base graphics. If you want advanced customisation of your incidence plots, we recommend following an introduction to *ggplot2*.
# Example data: simulated Ebola outbreak This example uses the simulated Ebola Virus Disease (EVD) outbreak from the package [*outbreaks*](https://cran.r-project.org/package=outbreaks): `ebola_sim_clean`. First, we load the data: ```{r, data} library(outbreaks) library(ggplot2) library(incidence) onset <- ebola_sim_clean$linelist$date_of_onset class(onset) head(onset) ``` We compute the weekly incidence: ```{r, incid1} i <- incidence(onset, interval = 7) i i.sex <- incidence(onset, interval = 7, group = ebola_sim_clean$linelist$gender) i.sex i.hosp <- incidence(onset, interval = 7, group = ebola_sim_clean$linelist$hospital) i.hosp ```
# The `plot.incidence` function When calling `plot` on an *incidence* object, the function `plot.incidence` is implicitly used. To access its documentation, use `?plot.incidence`. In this section, we illustrate existing customisations. ## Default behaviour By default, the function uses grey for single time series, and colors from the color palette `incidence_pal1` when incidence is computed by groups: ```{r, default} plot(i) plot(i.sex) plot(i.hosp) ``` However, some of these defaults can be altered through the various arguments of the function: ```{r, args} args(incidence:::plot.incidence) ``` ## Changing colors ### The default palette A color palette is a function which outputs a specified number of colors. By default, the color used in *incidence* is called `incidence_pal1`. Its behaviour is different from usual palettes, in the sense that the first 4 colours are not interpolated: ```{r, incidence_pal1, fig.height = 8} par(mfrow = c(3, 1), mar = c(4,2,1,1)) barplot(1:2, col = incidence_pal1(2)) barplot(1:4, col = incidence_pal1(4)) barplot(1:20, col = incidence_pal1(20)) ``` This palette also has a light and a dark version: ```{r, pal2, fig.height = 8} par(mfrow = c(3,1)) barplot(1:20, col = incidence_pal1_dark(20), main = "palette: incidence_pal1_dark") barplot(1:20, col = incidence_pal1(20), main = "palette: incidence_pal1") barplot(1:20, col = incidence_pal1_light(20), main = "palette: incidence_pal1_light") ``` ### Using different palettes Other color palettes can be provided via `col_pal`. Various palettes are part of the base R distribution, and many more are provided in additional packages. We provide a couple of examples: ```{r, palettes} plot(i.hosp, col_pal = rainbow) plot(i.sex, col_pal = cm.colors) ``` ### Specifying colors manually Colors can be specified manually using the argument `color`; note that whenever incidence is computed by groups, the number of colors must match the number of groups, otherwise `color` is ignored. #### Example 1: changing a single color ```{r, colors1} plot(i, color = "darkred") ``` #### Example 2: changing several colors (note that naming colors is optional) ```{r, colors2} plot(i.sex, color = c(m = "orange2", f = "purple3")) ``` #### Example 3: using color to highlight specific groups ```{r, colors3} plot(i.hosp, color = c("#ac3973", "#6666ff", "white", "white", "white", "white")) ```
# Useful *ggplot2* tweaks Numerous tweaks for *ggplot2* are documented online. In the following, we merely provide a few useful tips in the context of *incidence*. ## Changing dates on the *x*-axis ### Changing date format By default, the dates indicated on the *x*-axis of an incidence plot may not have the suitable format. The package *scales* can be used to change the way dates are labeled (see `?strptime` for possible formats): ```{r, scales1} library(scales) plot(i, labels_week = FALSE) + scale_x_date(labels = date_format("%d %b %Y")) ``` Notice how the labels are all situated at the first of the month? If you want to make sure the labels are situated in a different orientation, you can use the `make_breaks()` function to calculate breaks for the plot: ```{r scales_breaks} b <- make_breaks(i, labels_week = FALSE) b plot(i) + scale_x_date(breaks = b$breaks, labels = date_format("%d %b %Y")) ``` And for another example, with a subset of the data (first 50 weeks), using more detailed dates and rotating the annotations: ```{r, scales2} plot(i[1:50]) + scale_x_date(breaks = b$breaks, labels = date_format("%a %d %B %Y")) + theme(axis.text.x = element_text(angle = 45, hjust = 1, size = 12)) ``` Note that you can save customisations for later use: ```{r, scales3} rotate.big <- theme(axis.text.x = element_text(angle = 45, hjust = 1, size = 12)) ``` ### Changing the grid The last example above illustrates that it can be useful to have denser annotations of the *x*-axis, especially over short time periods. Here, we provide an example where we try to zoom on the peak of the epidemic, using the data by hospital: ```{r, grid1} plot(i.hosp) ``` Let us look at the data 40 days before and after the 1st of October: ```{r, grid2} period <- as.Date("2014-10-01") + c(-40, 40) i.zoom <- subset(i.hosp, from = period[1], to = period[2]) detailed.x <- scale_x_date(labels = date_format("%a %d %B %Y"), date_breaks = "2 weeks", date_minor_breaks = "week") plot(i.zoom, border = "black") + detailed.x + rotate.big ``` ### Handling non-ISO weeks If you have weekly incidence that starts on a day other than monday, then the above solution may produce breaks that fall inside of the bins: ```{r, saturday-epiweek} i.sat <- incidence(onset, interval = "1 week: saturday", groups = ebola_sim_clean$linelist$hospital) i.szoom <- subset(i.sat, from = period[1], to = period[2]) plot(i.szoom, border = "black") + detailed.x + rotate.big ``` In this case, you may want to either calculate breaks using `make_breaks()` or use the `scale_x_incidence()` function to automatically calculate these for you: ```{r, saturday-epiweek2} plot(i.szoom, border = "black") + scale_x_incidence(i.szoom, n_breaks = nrow(i.szoom)/2, labels_week = FALSE) + rotate.big ``` ```{r, saturday-epiweek3} sat_breaks <- make_breaks(i.szoom, n_breaks = nrow(i.szoom)/2) plot(i.szoom, border = "black") + scale_x_date(breaks = sat_breaks$breaks, labels = date_format("%a %d %B %Y")) + rotate.big ``` ### Labelling every bin Sometimes you may want to label every bin of the incidence object. To do this, you can simply set `n_breaks` to the number of rows in your incidence object: ```{r label-bins} plot(i.szoom, n_breaks = nrow(i.szoom), border = "black") + rotate.big ``` ## Changing the legend The previous plot has a fairly large legend which we may want to move around. Let us save the plot as a new object `p` and customize the legend: ```{r, legend1} p <- plot(i.zoom, border = "black") + detailed.x + rotate.big p + theme(axis.text.x = element_text(angle = 45, hjust = 1, size = 12), legend.position = "top", legend.direction = "horizontal", legend.title = element_blank()) ``` ## Applying the style of European Programme for Intervention Epidemiology Training (EPIET) ### Display individual cases For small datasets it is convention of EPIET to display individual cases as rectangles. It can be done by doing two things: first, adding using the option `show_cases = TRUE` with a white border and second, setting the background to white. We also add `coord_equal()` which forces each case to be a square. ```{r, EPIET1} i.small <- incidence(onset[160:180]) plot(i.small, border = "white", show_cases = TRUE) + theme(panel.background = element_rect(fill = "white")) + rotate.big + coord_equal() ``` incidence/inst/doc/customize_plot.R 0000644 0001762 0000144 00000011462 14626316440 017132 0 ustar ligges users ## ----echo = FALSE------------------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>", fig.width=7, fig.height=5 ) ## ----data--------------------------------------------------------------------- library(outbreaks) library(ggplot2) library(incidence) onset <- ebola_sim_clean$linelist$date_of_onset class(onset) head(onset) ## ----incid1------------------------------------------------------------------- i <- incidence(onset, interval = 7) i i.sex <- incidence(onset, interval = 7, group = ebola_sim_clean$linelist$gender) i.sex i.hosp <- incidence(onset, interval = 7, group = ebola_sim_clean$linelist$hospital) i.hosp ## ----default------------------------------------------------------------------ plot(i) plot(i.sex) plot(i.hosp) ## ----args--------------------------------------------------------------------- args(incidence:::plot.incidence) ## ----incidence_pal1, fig.height = 8----------------------------------------- par(mfrow = c(3, 1), mar = c(4,2,1,1)) barplot(1:2, col = incidence_pal1(2)) barplot(1:4, col = incidence_pal1(4)) barplot(1:20, col = incidence_pal1(20)) ## ----pal2, fig.height = 8----------------------------------------------------- par(mfrow = c(3,1)) barplot(1:20, col = incidence_pal1_dark(20), main = "palette: incidence_pal1_dark") barplot(1:20, col = incidence_pal1(20), main = "palette: incidence_pal1") barplot(1:20, col = incidence_pal1_light(20), main = "palette: incidence_pal1_light") ## ----palettes----------------------------------------------------------------- plot(i.hosp, col_pal = rainbow) plot(i.sex, col_pal = cm.colors) ## ----colors1------------------------------------------------------------------ plot(i, color = "darkred") ## ----colors2------------------------------------------------------------------ plot(i.sex, color = c(m = "orange2", f = "purple3")) ## ----colors3------------------------------------------------------------------ plot(i.hosp, color = c("#ac3973", "#6666ff", "white", "white", "white", "white")) ## ----scales1------------------------------------------------------------------ library(scales) plot(i, labels_week = FALSE) + scale_x_date(labels = date_format("%d %b %Y")) ## ----scales_breaks------------------------------------------------------------ b <- make_breaks(i, labels_week = FALSE) b plot(i) + scale_x_date(breaks = b$breaks, labels = date_format("%d %b %Y")) ## ----scales2------------------------------------------------------------------ plot(i[1:50]) + scale_x_date(breaks = b$breaks, labels = date_format("%a %d %B %Y")) + theme(axis.text.x = element_text(angle = 45, hjust = 1, size = 12)) ## ----scales3------------------------------------------------------------------ rotate.big <- theme(axis.text.x = element_text(angle = 45, hjust = 1, size = 12)) ## ----grid1-------------------------------------------------------------------- plot(i.hosp) ## ----grid2-------------------------------------------------------------------- period <- as.Date("2014-10-01") + c(-40, 40) i.zoom <- subset(i.hosp, from = period[1], to = period[2]) detailed.x <- scale_x_date(labels = date_format("%a %d %B %Y"), date_breaks = "2 weeks", date_minor_breaks = "week") plot(i.zoom, border = "black") + detailed.x + rotate.big ## ----saturday-epiweek--------------------------------------------------------- i.sat <- incidence(onset, interval = "1 week: saturday", groups = ebola_sim_clean$linelist$hospital) i.szoom <- subset(i.sat, from = period[1], to = period[2]) plot(i.szoom, border = "black") + detailed.x + rotate.big ## ----saturday-epiweek2-------------------------------------------------------- plot(i.szoom, border = "black") + scale_x_incidence(i.szoom, n_breaks = nrow(i.szoom)/2, labels_week = FALSE) + rotate.big ## ----saturday-epiweek3-------------------------------------------------------- sat_breaks <- make_breaks(i.szoom, n_breaks = nrow(i.szoom)/2) plot(i.szoom, border = "black") + scale_x_date(breaks = sat_breaks$breaks, labels = date_format("%a %d %B %Y")) + rotate.big ## ----label-bins--------------------------------------------------------------- plot(i.szoom, n_breaks = nrow(i.szoom), border = "black") + rotate.big ## ----legend1------------------------------------------------------------------ p <- plot(i.zoom, border = "black") + detailed.x + rotate.big p + theme(axis.text.x = element_text(angle = 45, hjust = 1, size = 12), legend.position = "top", legend.direction = "horizontal", legend.title = element_blank()) ## ----EPIET1------------------------------------------------------------------- i.small <- incidence(onset[160:180]) plot(i.small, border = "white", show_cases = TRUE) + theme(panel.background = element_rect(fill = "white")) + rotate.big + coord_equal() incidence/inst/doc/incidence_fit_class.html 0000644 0001762 0000144 00001322572 14626316442 020577 0 ustar ligges users
Details of the incidence_fit class
Zhian N. Kamvar
2024-05-31
This vignette details the structure and construction of the
incidence_fit and incidence_fit_list classes,
which are produced by the fit() and
fit_optim_split() functions, respectively. By the end of
this tutorial, you should be able to construct
incidence_fit and incidence_fit_list objects
for use with your own models.
Structure of an incidence_fit object
An incidence_fit object contains three elements:
Internally, when fit() is run, these elements are
constructed by function incidence:::extract_info(). First
we need to setup data. We will use simulated Ebola outbreak data from
the outbreaks package over weekly intervals and calculate the
fit for the first 20 weeks:
library(outbreaks)
library(incidence)
dat <- ebola_sim$linelist$date_of_onset
i <- incidence(dat, interval = "week")
i
#> <incidence object>
#> [5888 cases from days 2014-04-07 to 2015-04-27]
#> [5888 cases from ISO weeks 2014-W15 to 2015-W18]
#>
#> $counts: matrix with 56 rows and 1 columns
#> $n: 5888 cases in total
#> $dates: 56 dates marking the left-side of bins
#> $interval: 1 week
#> $timespan: 386 days
#> $cumulative: FALSEf <- fit(i[1:20])
f
#> <incidence_fit object>
#>
#> $model: regression of log-incidence over time
#>
#> $info: list containing the following items:
#> $r (daily growth rate):
#> [1] 0.03175771
#>
#> $r.conf (confidence interval):
#> 2.5 % 97.5 %
#> [1,] 0.02596229 0.03755314
#>
#> $doubling (doubling time in days):
#> [1] 21.8261
#>
#> $doubling.conf (confidence interval):
#> 2.5 % 97.5 %
#> [1,] 18.45777 26.69823
#>
#> $pred: data.frame of incidence predictions (20 rows, 5 columns)
As you can see, the incidence_fit object has a print
method and a plot method. If you want to access individual elements in
the $info element, you can use the get_info()
function:
This will be important later when we combine several
incidence_fit objects into a single
incidence_fit_list.
Building an incidence_fit object from scratch
The incidence_fit object can be constructed from any
model from which you can derive the daily growth rate, doubling/halving
times, predictions, and confidence intervals. The following three steps
show roughly how it is done from model fitting to construction.
Step 1: create the model
The default model for fit() is a log-linear model on the
intervals between dates. To fit this model, we will need to create a
data frame with the counts and the midpoints of the intervals:
# ensure all dates have at least one incidence
i2 <- i[1:20]
i2 <- i2[apply(get_counts(i2), 1, min) > 0]
df <- as.data.frame(i2, long = TRUE)
df$dates.x <- get_dates(i2, position = "center", count_days = TRUE)
head(df)
#> dates weeks isoweeks counts dates.x
#> 1 2014-04-07 2014-W15 2014-W15 1 3.5
#> 2 2014-04-14 2014-W16 2014-W16 1 10.5
#> 3 2014-04-21 2014-W17 2014-W17 5 17.5
#> 4 2014-04-28 2014-W18 2014-W18 4 24.5
#> 5 2014-05-05 2014-W19 2014-W19 12 31.5
#> 6 2014-05-12 2014-W20 2014-W20 18 38.5lm1 <- stats::lm(log(counts) ~ dates.x, data = df)
lm1
#>
#> Call:
#> stats::lm(formula = log(counts) ~ dates.x, data = df)
#>
#> Coefficients:
#> (Intercept) dates.x
#> 0.81660 0.03176If we compare that to the $model element produced from
fit(), we can see that it is identical:
Step 2: creation of the $info list:
The $info list is created directly from the model
itself:
r <- stats::coef(lm1)["dates.x"]
r.conf <- stats::confint(lm1, "dates.x", 0.95)
new.data <- data.frame(dates.x = sort(unique(lm1$model$dates.x)))
pred <- exp(stats::predict(lm1, newdata = new.data, interval = "confidence",
level = 0.95))
pred <- cbind.data.frame(new.data, pred)
info_list <- list(
r = r,
r.conf = r.conf,
doubling = log(2) / r,
doubling.conf = log(2) / r.conf,
pred = pred
)
info_list
#> $r
#> dates.x
#> 0.03175771
#>
#> $r.conf
#> 2.5 % 97.5 %
#> dates.x 0.02596229 0.03755314
#>
#> $doubling
#> dates.x
#> 21.8261
#>
#> $doubling.conf
#> 2.5 % 97.5 %
#> dates.x 26.69823 18.45777
#>
#> $pred
#> dates.x fit lwr upr
#> 1 3.5 2.528815 1.611099 3.969283
#> 2 10.5 3.158367 2.082082 4.791013
#> 3 17.5 3.944645 2.687383 5.790104
#> 4 24.5 4.926668 3.463102 7.008763
#> 5 31.5 6.153167 4.453513 8.501484
#> 6 38.5 7.685004 5.711842 10.339797
#> 7 45.5 9.598194 7.300398 12.619220
#> 8 52.5 11.987674 9.289763 15.469105
#> 9 59.5 14.972017 11.757263 19.065771
#> 10 66.5 18.699315 14.786028 23.648299
#> 11 73.5 23.354529 18.467024 29.535566
#> 12 80.5 29.168662 22.905640 37.144163
#> 13 87.5 36.430229 28.231348 47.010209
#> 14 94.5 45.499570 34.607028 59.820534
#> 15 101.5 56.826734 42.236196 76.457588
#> 16 108.5 70.973805 51.369116 98.060497
#> 17 115.5 88.642805 62.309665 126.104782
#> 18 122.5 110.710519 75.424156 162.505217
#> 19 129.5 138.272012 91.152689 209.748604
#> 20 136.5 172.694966 110.023332 271.065700Step 3: combine lists and create object
the last step is to combine everything into a list and create the object.
origin <- min(get_dates(i2))
info_list$pred$dates <- origin + info_list$pred$dates.x
the_fit <- list(
lm = lm1,
info = info_list,
origin = min(get_dates(i2))
)
class(the_fit) <- "incidence_fit"
the_fit
#> <incidence_fit object>
#>
#> $model: regression of log-incidence over time
#>
#> $info: list containing the following items:
#> $r (daily growth rate):
#> dates.x
#> 0.03175771
#>
#> $r.conf (confidence interval):
#> 2.5 % 97.5 %
#> dates.x 0.02596229 0.03755314
#>
#> $doubling (doubling time in days):
#> dates.x
#> 21.8261
#>
#> $doubling.conf (confidence interval):
#> 2.5 % 97.5 %
#> dates.x 26.69823 18.45777
#>
#> $pred: data.frame of incidence predictions (20 rows, 5 columns)
Structure of an incidence_fit_list object
There are several reasons for having multiple fits to a single
incidence object. One may want to have a separate fit for
different groups represented in the object, or one may want to split the
fits at the peak of the epidemic. To aid in plotting and summarizing the
different fits, we’ve created the incidence_fit_list class.
This class has two defining features:
The reason for this structure is because it is sometimes necessary to
nest lists of incidence_fit objects within lists. When this
happens, accessing individual elements of the objects cumbersome. To
alleviate this, each object has a distinct path within the named list in
the “locations” attribute that allows one to access the object directly
since R allows you to traverse the elements of a nested list by
subsetting with a vector:
l <- list(a = list(b = 1, c = 2),d = list(e = list(f = 3, g = 4), h = 5))
str(l)
#> List of 2
#> $ a:List of 2
#> ..$ b: num 1
#> ..$ c: num 2
#> $ d:List of 2
#> ..$ e:List of 2
#> .. ..$ f: num 3
#> .. ..$ g: num 4
#> ..$ h: num 5Example: A tale of two fits
The function fit_optim_split() attempts to find the
optimal split point in an epicurve, producing an
incidence_fit_list object in the $fit element
of the returned list:
fl <- fit_optim_split(i)
fl$fit
#> <list of incidence_fit objects>
#>
#> attr(x, 'locations'): list of vectors with the locations of each incidence_fit object
#>
#> 'before'
#> 'after'
#>
#> $model: regression of log-incidence over time
#>
#> $info: list containing the following items:
#> $r (daily growth rate):
#> before after
#> 0.02982209 -0.01016191
#>
#> $r.conf (confidence interval):
#> 2.5 % 97.5 %
#> before 0.02608945 0.033554736
#> after -0.01102526 -0.009298561
#>
#> $doubling (doubling time in days):
#> before
#> 23.24274
#>
#> $doubling.conf (confidence interval):
#> 2.5 % 97.5 %
#> before 20.65721 26.5681
#>
#> $halving (halving time in days):
#> after
#> 68.21031
#>
#> $halving.conf (confidence interval):
#> 2.5 % 97.5 %
#> after 62.86899 74.54349
#>
#> $pred: data.frame of incidence predictions (57 rows, 6 columns)
Here you can see that the object looks very similar to the
incidence_fit object, but it has extra information. The
first thing you may notice is the fact that both “doubling” and
“halving” are shown. This is because the two fits have different signs
for the daily growth rate. The second thing you may notice is the fact
that there is something called attr(x, 'locations'). This
attribute gives the location of the incidence_fit objects
within the list. We can illustrate how this works if we look at the
structure of the object:
str(fl$fit, max.level = 2)
#> List of 2
#> $ before:List of 3
#> ..$ model :List of 12
#> .. ..- attr(*, "class")= chr "lm"
#> ..$ info :List of 5
#> ..$ origin: Date[1:1], format: "2014-04-07"
#> ..- attr(*, "class")= chr "incidence_fit"
#> $ after :List of 3
#> ..$ model :List of 12
#> .. ..- attr(*, "class")= chr "lm"
#> ..$ info :List of 5
#> ..$ origin: Date[1:1], format: "2014-09-22"
#> ..- attr(*, "class")= chr "incidence_fit"
#> - attr(*, "locations")=List of 2
#> ..$ : chr "before"
#> ..$ : chr "after"
#> - attr(*, "class")= chr "incidence_fit_list"Internally, all of the methods for incidence_fit_list
use the ‘locations’ attribute to navigate:
methods(class = "incidence_fit_list")
#> [1] get_fit get_info plot print
#> see '?methods' for accessing help and source codeFor example, it’s often useful to extract the growth rate for all
models at once. The get_info() method allows us to do this
easily:
get_info(fl$fit, "r.conf")
#> 2.5 % 97.5 %
#> before 0.02608945 0.033554736
#> after -0.01102526 -0.009298561Because doubling or halving is determined by whether or not
r is negative, we automatically filter out the results that
don’t make sense, but you can include them with
na.rm = FALSE:
Example: Nested incidence_fit
Above, we showed the example of a basic
incidence_fit_list class with two objects representing the
fits before and after the peak of an epicurve. However, it is often
useful evaluate fits for different groups separately. Here, we will
construct an incidence object, but define groups by gender:
gen <- ebola_sim$linelist$gender
ig <- incidence(dat, interval = "week", group = gen)
plot(ig, border = "grey98")
Now if we calculate an optimal fit split, we will end up with four different fits: two for each defined gender.
fg <- fit_optim_split(ig)
plot(ig, fit = fg$fit, border = "grey98", stack = FALSE)
#> Scale for colour is already present.
#> Adding another scale for colour, which will replace the existing scale.
#> Scale for colour is already present.
#> Adding another scale for colour, which will replace the existing scale.
#> Scale for colour is already present.
#> Adding another scale for colour, which will replace the existing scale.
#> Scale for colour is already present.
#> Adding another scale for colour, which will replace the existing scale.
If we look at the fit object, we can see again that it is an
incidence_fit_list but this time with four fits
defined.
fg$fit
#> <list of incidence_fit objects>
#>
#> attr(x, 'locations'): list of vectors with the locations of each incidence_fit object
#>
#> 'f', 'before'
#> 'm', 'before'
#> 'f', 'after'
#> 'm', 'after'
#>
#> $model: regression of log-incidence over time
#>
#> $info: list containing the following items:
#> $r (daily growth rate):
#> f_before m_before f_after m_after
#> 0.02570604 0.02883607 -0.01002297 -0.01038307
#>
#> $r.conf (confidence interval):
#> 2.5 % 97.5 %
#> f_before 0.02289333 0.028518743
#> m_before 0.02502254 0.032649606
#> f_after -0.01102735 -0.009018595
#> m_after -0.01138910 -0.009377034
#>
#> $doubling (doubling time in days):
#> f_before m_before
#> 26.96437 24.03750
#>
#> $doubling.conf (confidence interval):
#> 2.5 % 97.5 %
#> f_before 24.30497 30.27725
#> m_before 21.22988 27.70091
#>
#> $halving (halving time in days):
#> f_after m_after
#> 69.15586 66.75746
#>
#> $halving.conf (confidence interval):
#> 2.5 % 97.5 %
#> f_after 62.85711 76.85756
#> m_after 60.86059 73.91966
#>
#> $pred: data.frame of incidence predictions (111 rows, 7 columns)str(fg$fit, max.level = 3)
#> List of 2
#> $ f:List of 2
#> ..$ before:List of 3
#> .. ..$ model :List of 12
#> .. .. ..- attr(*, "class")= chr "lm"
#> .. ..$ info :List of 5
#> .. ..$ origin: Date[1:1], format: "2014-04-07"
#> .. ..- attr(*, "class")= chr "incidence_fit"
#> ..$ after :List of 3
#> .. ..$ model :List of 12
#> .. .. ..- attr(*, "class")= chr "lm"
#> .. ..$ info :List of 5
#> .. ..$ origin: Date[1:1], format: "2014-09-22"
#> .. ..- attr(*, "class")= chr "incidence_fit"
#> ..- attr(*, "locations")=List of 2
#> .. ..$ : chr "before"
#> .. ..$ : chr "after"
#> ..- attr(*, "class")= chr "incidence_fit_list"
#> $ m:List of 2
#> ..$ before:List of 3
#> .. ..$ model :List of 12
#> .. .. ..- attr(*, "class")= chr "lm"
#> .. ..$ info :List of 5
#> .. ..$ origin: Date[1:1], format: "2014-04-14"
#> .. ..- attr(*, "class")= chr "incidence_fit"
#> ..$ after :List of 3
#> .. ..$ model :List of 12
#> .. .. ..- attr(*, "class")= chr "lm"
#> .. ..$ info :List of 5
#> .. ..$ origin: Date[1:1], format: "2014-09-15"
#> .. ..- attr(*, "class")= chr "incidence_fit"
#> ..- attr(*, "locations")=List of 2
#> .. ..$ : chr "before"
#> .. ..$ : chr "after"
#> ..- attr(*, "class")= chr "incidence_fit_list"
#> - attr(*, "locations")=List of 4
#> ..$ : chr [1:2] "f" "before"
#> ..$ : chr [1:2] "m" "before"
#> ..$ : chr [1:2] "f" "after"
#> ..$ : chr [1:2] "m" "after"
#> - attr(*, "class")= chr "incidence_fit_list"Notice that the nested lists themselves are of class
incidence_fit_list.
Now, even though the fits within nested lists, the ‘locations’
attributes still defines where they are within the object so that the
get_info() function still operates normally:
get_info(fg$fit, "r.conf")
#> 2.5 % 97.5 %
#> f_before 0.02289333 0.028518743
#> m_before 0.02502254 0.032649606
#> f_after -0.01102735 -0.009018595
#> m_after -0.01138910 -0.009377034If you need to access all the fits easily, a convenience function to
flatten the list is available in get_fit():
str(get_fit(fg$fit), max.level = 2)
#> List of 4
#> $ f_before:List of 3
#> ..$ model :List of 12
#> .. ..- attr(*, "class")= chr "lm"
#> ..$ info :List of 5
#> ..$ origin: Date[1:1], format: "2014-04-07"
#> ..- attr(*, "class")= chr "incidence_fit"
#> $ m_before:List of 3
#> ..$ model :List of 12
#> .. ..- attr(*, "class")= chr "lm"
#> ..$ info :List of 5
#> ..$ origin: Date[1:1], format: "2014-04-14"
#> ..- attr(*, "class")= chr "incidence_fit"
#> $ f_after :List of 3
#> ..$ model :List of 12
#> .. ..- attr(*, "class")= chr "lm"
#> ..$ info :List of 5
#> ..$ origin: Date[1:1], format: "2014-09-22"
#> ..- attr(*, "class")= chr "incidence_fit"
#> $ m_after :List of 3
#> ..$ model :List of 12
#> .. ..- attr(*, "class")= chr "lm"
#> ..$ info :List of 5
#> ..$ origin: Date[1:1], format: "2014-09-15"
#> ..- attr(*, "class")= chr "incidence_fit"Because all that defines an incidence_fit_list is the
class definition and the ‘locations’ attribute that defines the
positions of the incidence_fit objects within the nesting,
then it’s also possible to define the output of
fit_optim_split() as an incidence_fit_list
class:
print(locs <- attributes(fg$fit)$locations)
#> [[1]]
#> [1] "f" "before"
#>
#> [[2]]
#> [1] "m" "before"
#>
#> [[3]]
#> [1] "f" "after"
#>
#> [[4]]
#> [1] "m" "after"
for (i in seq_along(locs)) {
locs[[i]] <- c("fit", locs[[i]])
}
print(locs)
#> [[1]]
#> [1] "fit" "f" "before"
#>
#> [[2]]
#> [1] "fit" "m" "before"
#>
#> [[3]]
#> [1] "fit" "f" "after"
#>
#> [[4]]
#> [1] "fit" "m" "after"Now when we print the object, we can see that it prints only the
information related to the incidence_fit_list:
fg.ifl
#> <list of incidence_fit objects>
#>
#> attr(x, 'locations'): list of vectors with the locations of each incidence_fit object
#>
#> 'fit', 'f', 'before'
#> 'fit', 'm', 'before'
#> 'fit', 'f', 'after'
#> 'fit', 'm', 'after'
#>
#> $model: regression of log-incidence over time
#>
#> $info: list containing the following items:
#> $r (daily growth rate):
#> fit_f_before fit_m_before fit_f_after fit_m_after
#> 0.02570604 0.02883607 -0.01002297 -0.01038307
#>
#> $r.conf (confidence interval):
#> 2.5 % 97.5 %
#> fit_f_before 0.02289333 0.028518743
#> fit_m_before 0.02502254 0.032649606
#> fit_f_after -0.01102735 -0.009018595
#> fit_m_after -0.01138910 -0.009377034
#>
#> $doubling (doubling time in days):
#> fit_f_before fit_m_before
#> 26.96437 24.03750
#>
#> $doubling.conf (confidence interval):
#> 2.5 % 97.5 %
#> fit_f_before 24.30497 30.27725
#> fit_m_before 21.22988 27.70091
#>
#> $halving (halving time in days):
#> fit_f_after fit_m_after
#> 69.15586 66.75746
#>
#> $halving.conf (confidence interval):
#> 2.5 % 97.5 %
#> fit_f_after 62.85711 76.85756
#> fit_m_after 60.86059 73.91966
#>
#> $pred: data.frame of incidence predictions (111 rows, 7 columns)But, we still retain all of the extra information in the list:
str(fg.ifl, max.level = 1)
#> List of 4
#> $ df :'data.frame': 26 obs. of 3 variables:
#> $ plot :List of 11
#> ..- attr(*, "class")= chr [1:2] "gg" "ggplot"
#> $ split: Date[1:2], format: "2014-09-22" "2014-09-15"
#> ..- attr(*, "names")="f" "m"
#> $ fit :List of 2
#> ..- attr(*, "locations")=List of 4
#> ..- attr(*, "class")= chr "incidence_fit_list"
#> - attr(*, "locations")=List of 4
#> - attr(*, "class")= chr "incidence_fit_list"fg.ifl$df
#> dates mean.R2 groups
#> 1 2014-08-04 0.7546016 f
#> 2 2014-08-11 0.8096672 f
#> 3 2014-08-18 0.8513743 f
#> 4 2014-08-25 0.8864424 f
#> 5 2014-09-01 0.9165063 f
#> 6 2014-09-08 0.9270248 f
#> 7 2014-09-15 0.9345352 f
#> 8 2014-09-22 0.9350323 f
#> 9 2014-09-29 0.9339121 f
#> 10 2014-10-06 0.9288956 f
#> 11 2014-10-13 0.9226037 f
#> 12 2014-10-20 0.9122727 f
#> 13 2014-10-27 0.9027890 f
#> 14 2014-08-04 0.7566712 m
#> 15 2014-08-11 0.8164693 m
#> 16 2014-08-18 0.8567850 m
#> 17 2014-08-25 0.8820669 m
#> 18 2014-09-01 0.9006668 m
#> 19 2014-09-08 0.9166004 m
#> 20 2014-09-15 0.9271862 m
#> 21 2014-09-22 0.9263339 m
#> 22 2014-09-29 0.9260695 m
#> 23 2014-10-06 0.9216350 m
#> 24 2014-10-13 0.9144120 m
#> 25 2014-10-20 0.9077086 m
#> 26 2014-10-27 0.8966333 m
Conversions to and from the incidence class
Thibaut Jombart, Zhian N. Kamvar
2024-05-31
This vignette documents to types of conversion which can be made using the incidence class:
Exporting results
To export results, we first compute semi-weekly incidence (with weeks starting on Sunday, the beginning of the CDC epiweek) by gender from the simulated Ebola data used in the overview vignette:
library(outbreaks)
library(incidence)
dat <- ebola_sim$linelist$date_of_onset
i_14 <- incidence(dat, interval = "2 epiweeks", groups = ebola_sim$linelist$gender)
i_14
#> <incidence object>
#> [5888 cases from days 2014-04-06 to 2015-04-19]
#> [5888 cases from MMWR weeks 2014-W15 to 2015-W16]
#> [2 groups: f, m]
#>
#> $counts: matrix with 28 rows and 2 columns
#> $n: 5888 cases in total
#> $dates: 28 dates marking the left-side of bins
#> $interval: 2 weeks
#> $timespan: 379 days
#> $cumulative: FALSE
To export the data to a data.frame, one simply
needs:
as.data.frame(i_14)
#> dates weeks f m
#> 1 2014-04-06 2014-W15 1 1
#> 2 2014-04-20 2014-W17 7 1
#> 3 2014-05-04 2014-W19 16 11
#> 4 2014-05-18 2014-W21 19 20
#> 5 2014-06-01 2014-W23 18 22
#> 6 2014-06-15 2014-W25 27 28
#> 7 2014-06-29 2014-W27 26 43
#> 8 2014-07-13 2014-W29 72 43
#> 9 2014-07-27 2014-W31 89 78
#> 10 2014-08-10 2014-W33 115 133
#> 11 2014-08-24 2014-W35 181 188
#> 12 2014-09-07 2014-W37 280 266
#> 13 2014-09-21 2014-W39 319 282
#> 14 2014-10-05 2014-W41 279 282
#> 15 2014-10-19 2014-W43 249 265
#> 16 2014-11-02 2014-W45 211 202
#> 17 2014-11-16 2014-W47 152 166
#> 18 2014-11-30 2014-W49 138 148
#> 19 2014-12-14 2014-W51 122 127
#> 20 2014-12-28 2014-W53 94 101
#> 21 2015-01-11 2015-W02 112 96
#> 22 2015-01-25 2015-W04 85 83
#> 23 2015-02-08 2015-W06 76 71
#> 24 2015-02-22 2015-W08 75 81
#> 25 2015-03-08 2015-W10 59 70
#> 26 2015-03-22 2015-W12 64 45
#> 27 2015-04-05 2015-W14 44 40
#> 28 2015-04-19 2015-W16 32 33The first column contains the dates marking the (inclusive) left side of the time intervals used for computing incidence, and the other columns give counts for the different groups. This function also has an option for exporting data as a ‘long’ format, i.e. with a column for ‘groups’ and a column for counts. This format can be useful especially when working with ggplot2, which expect data in this shape:
df <- as.data.frame(i_14, long = TRUE)
head(df)
#> dates weeks counts groups
#> 1 2014-04-06 2014-W15 1 f
#> 2 2014-04-20 2014-W17 7 f
#> 3 2014-05-04 2014-W19 16 f
#> 4 2014-05-18 2014-W21 19 f
#> 5 2014-06-01 2014-W23 18 f
#> 6 2014-06-15 2014-W25 27 ftail(df)
#> dates weeks counts groups
#> 51 2015-02-08 2015-W06 71 m
#> 52 2015-02-22 2015-W08 81 m
#> 53 2015-03-08 2015-W10 70 m
#> 54 2015-03-22 2015-W12 45 m
#> 55 2015-04-05 2015-W14 40 m
#> 56 2015-04-19 2015-W16 33 m
## example of custom plot using steps:
library(ggplot2)
ggplot(df, aes(x = dates, y = counts)) + geom_step(aes(color = groups))
Finally, note that when ISO weeks are used, these are also reported in the output:
i_7 <- incidence(dat, interval = "week")
i_7
#> <incidence object>
#> [5888 cases from days 2014-04-07 to 2015-04-27]
#> [5888 cases from ISO weeks 2014-W15 to 2015-W18]
#>
#> $counts: matrix with 56 rows and 1 columns
#> $n: 5888 cases in total
#> $dates: 56 dates marking the left-side of bins
#> $interval: 1 week
#> $timespan: 386 days
#> $cumulative: FALSEplot(i_7, border = "white")
#> Warning: The `guide` argument in `scale_*()` cannot be `FALSE`. This was deprecated in
#> ggplot2 3.3.4.
#> ℹ Please use "none" instead.
#> ℹ The deprecated feature was likely used in the incidence package.
#> Please report the issue at <https://github.com/reconhub/incidence/issues>.
#> This warning is displayed once every 8 hours.
#> Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
#> generated.
head(as.data.frame(i_7))
#> dates weeks isoweeks counts
#> 1 2014-04-07 2014-W15 2014-W15 1
#> 2 2014-04-14 2014-W16 2014-W16 1
#> 3 2014-04-21 2014-W17 2014-W17 5
#> 4 2014-04-28 2014-W18 2014-W18 4
#> 5 2014-05-05 2014-W19 2014-W19 12
#> 6 2014-05-12 2014-W20 2014-W20 18tail(as.data.frame(i_7))
#> dates weeks isoweeks counts
#> 51 2015-03-23 2015-W13 2015-W13 51
#> 52 2015-03-30 2015-W14 2015-W14 54
#> 53 2015-04-06 2015-W15 2015-W15 42
#> 54 2015-04-13 2015-W16 2015-W16 45
#> 55 2015-04-20 2015-W17 2015-W17 40
#> 56 2015-04-27 2015-W18 2015-W18 19Importing pre-computed incidence
The function as.incidence facilitates the conversion of
pre-computed incidences to an incidence object. Typically, the
input will be imported into R from a .csv file or other
spreadsheet formats.
as.incidence is a generic with methods for several types
of objects (see ?as.incidence). The main method is
matrix, as other types are coerced to matrix
first and then passed to as.incidence.matrix:
args(incidence:::as.incidence.matrix)
#> function (x, dates = NULL, interval = NULL, standard = TRUE,
#> isoweeks = standard, ...)
#> NULLThe only mandatory argument x is a table of counts, with
time intervals in rows and groups in columns; if there are no groups,
then the column doesn’t need a name; but if there are several groups,
then columns should be named to indicate group labels. Optionally,
dates can be provided to indicate the (inclusive) lower
bounds of the time intervals, corresponding to the rows of
x; most sensible date formats will do; if indicated as a
character string, make sure the format is YYYY-mm-dd,
e.g. 2017-04-01 for the 1st April 2017.
Let us illustrate the conversion using a simple vector of incidence:
vec <- c(1,2,3,0,3,2,4,1,2,1)
i <- as.incidence(vec)
i
#> <incidence object>
#> [19 cases from days 1 to 10]
#>
#> $counts: matrix with 10 rows and 1 columns
#> $n: 19 cases in total
#> $dates: 10 dates marking the left-side of bins
#> $interval: 1 day
#> $timespan: 10 days
#> $cumulative: FALSE
Assuming the above incidences are computed weekly, we would then use:
i <- as.incidence(vec, interval = 7)
i
#> <incidence object>
#> [19 cases from days 1 to 64]
#>
#> $counts: matrix with 10 rows and 1 columns
#> $n: 19 cases in total
#> $dates: 10 dates marking the left-side of bins
#> $interval: 7 days
#> $timespan: 64 days
#> $cumulative: FALSE
Note that in this case, incidences have been treated as per week, and corresponding dates in days have been computed during the conversion (the first day is always ‘1’), so that the first days of weeks 1, 2, 3… are:
In practice, it is best to provide the actual dates marking the lower bounds of the time intervals. We can illustrate this by a round trip using the example of the previous section:
## convertion: incidence --> data.frame:
i_14
#> <incidence object>
#> [5888 cases from days 2014-04-06 to 2015-04-19]
#> [5888 cases from MMWR weeks 2014-W15 to 2015-W16]
#> [2 groups: f, m]
#>
#> $counts: matrix with 28 rows and 2 columns
#> $n: 5888 cases in total
#> $dates: 28 dates marking the left-side of bins
#> $interval: 2 weeks
#> $timespan: 379 days
#> $cumulative: FALSEdf <- as.data.frame(i_14)
head(df)
#> dates weeks f m
#> 1 2014-04-06 2014-W15 1 1
#> 2 2014-04-20 2014-W17 7 1
#> 3 2014-05-04 2014-W19 16 11
#> 4 2014-05-18 2014-W21 19 20
#> 5 2014-06-01 2014-W23 18 22
#> 6 2014-06-15 2014-W25 27 28tail(df)
#> dates weeks f m
#> 23 2015-02-08 2015-W06 76 71
#> 24 2015-02-22 2015-W08 75 81
#> 25 2015-03-08 2015-W10 59 70
#> 26 2015-03-22 2015-W12 64 45
#> 27 2015-04-05 2015-W14 44 40
#> 28 2015-04-19 2015-W16 32 33
## conversion: data.frame --> incidence
new_i <- as.incidence(df[group_names(i_14)], df$dates, interval = "2 epiweeks")
new_i
#> <incidence object>
#> [5888 cases from days 2014-04-06 to 2015-04-19]
#> [5888 cases from MMWR weeks 2014-W15 to 2015-W16]
#> [2 groups: f, m]
#>
#> $counts: matrix with 28 rows and 2 columns
#> $n: 5888 cases in total
#> $dates: 28 dates marking the left-side of bins
#> $interval: 2 weeks
#> $timespan: 379 days
#> $cumulative: FALSE# Structure of an *incidence* object. We generate a toy dataset of dates to examine the content of *incidence* objects. ```{r, data} library(incidence) set.seed(1) dat <- sample(1:50, 200, replace = TRUE, prob = 1 + exp(1:50 * 0.1)) sex <- sample(c("female", "male"), 200, replace = TRUE) ``` The incidence by 48h period is computed as: ```{r, i} i <- incidence(dat, interval = 2) i plot(i) ``` We also compute incidence by gender: ```{r, sex} i.sex <- incidence(dat, interval = 2, group = sex) i.sex plot(i.sex) ``` The object `i` is a `list` with the class *incidence*: ```{r, names} class(i) is.list(i) names(i) ``` Items in `i` can be accessed using the same indexing as any lists, but it's safer to use the accessors for each item: ```{r, access} ## use name head(i$dates) head(get_dates(i)) ``` In the following sections, we examine each of the components of the object. ## `$dates` The `$dates` component contains a vector for all the dates for which incidence have been computed, in the format of the input dataset (e.g. `Date`, `numeric`, `integer`). ```{r, dates1} date_bins <- get_dates(i) class(date_bins) class(dat) date_bins ``` The dates correspond to the lower bounds of the time intervals used as bins for the incidence. Bins always include the lower bound and exclude the upper bound. In the example provided above, this means that the first bin counts events that happened at day 5-6, the second bin counts events from 7-8, etc. Note that if we had actual `Date`-class dates, they would be returned as dates ```{r date-dates1} dat_Date <- as.Date("2018-10-31") + dat head(dat_Date) i.date <- incidence(dat_Date, interval = 2, group = sex) i.date get_dates(i.date) class(get_dates(i.date)) ``` These can be converted to integers, counting the number of days from the first date. ```{r get-dates-integer} get_dates(i.date, count_days = TRUE) get_dates(i, count_days = TRUE) ``` To facilitate modelling, it's also possible to get the center of the interval by using the `position = "center"` argument: ```{r get-dates-center} get_dates(i.date, position = "center") get_dates(i.date, position = "center", count_days = TRUE) ``` ## `$counts` The `$counts` component contains the actual incidence, i.e. counts of events for the defined bins. It is a `matrix` of `integers` where rows correspond to time intervals, with one column for each group for which incidence is computed (a single, unnamed column if no groups were provided). If groups were provided, columns are named after the groups. We illustrate the difference comparing the two objects `i` and `i.sex`: ```{r, counts1} counts <- get_counts(i) class(counts) storage.mode(counts) counts get_counts(i.sex) ``` You can see the dimensions of the incidence object by using `dim()`, `ncol()`, and `nrow()`, which returns the dimensions of the counts matrix: ```{r counts1.1} dim(get_counts(i.sex)) dim(i.sex) nrow(i.sex) # number of date bins ncol(i.sex) # number of groups ``` There are also accessors for handling groups: ```{r groups} # Number of groups ncol(i.sex) ncol(i) # Names of groups group_names(i.sex) group_names(i) # You can also rename the groups group_names(i.sex) <- c("F", "M") group_names(i.sex) ``` Note that a `data.frame` containing *dates* and *counts* can be obtained using `as.data.frame`: ```{r, as.data.frame} ## basic conversion as.data.frame(i) as.data.frame(i.sex) ## long format for ggplot2 as.data.frame(i.sex, long = TRUE) ``` Note that `incidence` has an argument called `na_as_group` which is `TRUE` by default, which will pool all missing groups into a separate group, in which case it will be a separate column in `$counts`. ## `$timespan` The `$timespan` component stores the length of the time period covered by the object: ```{r, timespan} get_timespan(i) print(date_range <- range(get_dates(i))) diff(date_range) + 1 ``` ## `$interval` The `$interval` component contains the length of the time interval for the bins: ```{r, interval} get_interval(i) diff(get_dates(i)) ``` ## `$n` The `$n` component stores the total number of events in the data: ```{r, n} get_n(i) ``` Note that to obtain the number of cases by groups, one can use: ```{r, n2} colSums(get_counts(i.sex)) ``` ## `$weeks` The `$weeks` component is optional, and used to store [aweek](https://www.repidemicsconsortium.org/aweek/) objects whenever they have been used. Weeks are used by default when weekly incidence is computed from dates (see argument `standard` in `?incidence`). ```{r, isoweek} library(outbreaks) dat <- ebola_sim$linelist$date_of_onset i.7 <- incidence(dat, "1 epiweek", standard = TRUE) i.7 i.7$weeks ``` Because `$weeks` is an optional element, it does not have a dedicated accessor. If the element is not present, attempting to access it will result in a `NULL`: ```{r isoweek-null} i$weeks ``` Both dates and weeks are returned when converting an `incidence` object to `data.frame`: ```{r, isoweek3} head(as.data.frame(i.7)) ``` incidence/inst/doc/overview.html 0000644 0001762 0000144 00002607435 14626316445 016505 0 ustar ligges users
Overview of the incidence package
Thibaut Jombart, Zhian N. Kamvar
2024-05-31
incidence implements functions and classes to compute,
handle, visualise and model incidences from dates data. This vignette
provides an overview of current features. It largely reproduces the
content of REAME.md.
Installing the package
To install the current stable, CRAN version of the package, type:
To benefit from the latest features and bug fixes, install the development, github version of the package using:
Note that this requires the package devtools installed.
What does it do?
The main functions of the package include:
Worked example: simulated Ebola outbreak
Loading the data
This example uses the simulated Ebola Virus Disease (EVD) outbreak from the package outbreaks. We will compute incidence for various time steps, calibrate two exponential models around the peak of the epidemic, and analyse the results.
First, we load the data:
Computing and plotting incidence
We compute the daily incidence:
i <- incidence(dat)
i
#> <incidence object>
#> [5888 cases from days 2014-04-07 to 2015-04-30]
#>
#> $counts: matrix with 389 rows and 1 columns
#> $n: 5888 cases in total
#> $dates: 389 dates marking the left-side of bins
#> $interval: 1 day
#> $timespan: 389 days
#> $cumulative: FALSE
The daily incidence is quite noisy, but we can easily compute other incidence using larger time intervals:
# weekly, starting on Monday (ISO week, default)
i.7 <- incidence(dat, interval = "1 week")
plot(i.7)
# semi-weekly, starting on Saturday
i.14 <- incidence(dat, interval = "2 saturday weeks")
plot(i.14, border = "white")
incidence can also compute incidence by specified groups
using the groups argument. For instance, we can compute
incidence by gender:
i.7.sex <- incidence(dat, interval = "1 week", groups = ebola_sim$linelist$gender)
i.7.sex
#> <incidence object>
#> [5888 cases from days 2014-04-07 to 2015-04-27]
#> [5888 cases from ISO weeks 2014-W15 to 2015-W18]
#> [2 groups: f, m]
#>
#> $counts: matrix with 56 rows and 2 columns
#> $n: 5888 cases in total
#> $dates: 56 dates marking the left-side of bins
#> $interval: 1 week
#> $timespan: 386 days
#> $cumulative: FALSE
We can do the same for hospitals, using the ‘clean’ version of the dataset, with some customization of the legend:
i.7.hosp <- with(ebola_sim_clean$linelist,
incidence(date_of_onset, interval = "week", groups = hospital))
i.7.hosp
#> <incidence object>
#> [5829 cases from days 2014-04-07 to 2015-04-27]
#> [5829 cases from ISO weeks 2014-W15 to 2015-W18]
#> [6 groups: Connaught Hospital, Military Hospital, other, Princess Christian Maternity Hospital (PCMH), Rokupa Hospital, NA]
#>
#> $counts: matrix with 56 rows and 6 columns
#> $n: 5829 cases in total
#> $dates: 56 dates marking the left-side of bins
#> $interval: 1 week
#> $timespan: 386 days
#> $cumulative: FALSEhead(get_counts(i.7.hosp))
#> Connaught Hospital Military Hospital other
#> [1,] 0 1 0
#> [2,] 1 0 0
#> [3,] 0 0 3
#> [4,] 1 0 0
#> [5,] 3 5 1
#> [6,] 2 4 5
#> Princess Christian Maternity Hospital (PCMH) Rokupa Hospital NA
#> [1,] 0 0 0
#> [2,] 0 0 0
#> [3,] 0 0 2
#> [4,] 1 1 1
#> [5,] 1 1 1
#> [6,] 1 1 4
Handling incidence objects
incidence objects can be manipulated easily. The
[ operator implements subsetting of dates (first argument)
and groups (second argument). For instance, to keep only the peak of the
distribution:
i[100:250]
#> <incidence object>
#> [4103 cases from days 2014-07-15 to 2014-12-12]
#>
#> $counts: matrix with 151 rows and 1 columns
#> $n: 4103 cases in total
#> $dates: 151 dates marking the left-side of bins
#> $interval: 1 day
#> $timespan: 151 days
#> $cumulative: FALSE
Or to keep every other week:
i.7[c(TRUE,FALSE)]
#> <incidence object>
#> [2891 cases from days 2014-04-07 to 2015-04-20]
#> [2891 cases from ISO weeks 2014-W15 to 2015-W17]
#>
#> $counts: matrix with 28 rows and 1 columns
#> $n: 2891 cases in total
#> $dates: 28 dates marking the left-side of bins
#> $interval: 1 week
#> $timespan: 379 days
#> $cumulative: FALSE
Some temporal subsetting can be even simpler using
subset, which permits to retain data within a specified
time window:
i.tail <- subset(i, from=as.Date("2015-01-01"))
i.tail
#> <incidence object>
#> [1205 cases from days 2015-01-01 to 2015-04-30]
#>
#> $counts: matrix with 120 rows and 1 columns
#> $n: 1205 cases in total
#> $dates: 120 dates marking the left-side of bins
#> $interval: 1 day
#> $timespan: 120 days
#> $cumulative: FALSE
Subsetting groups can also matter. For instance, let’s try and visualise the incidence based on onset of symptoms by outcome:
i.7.outcome <- incidence(dat, 7, groups=ebola_sim$linelist$outcome)
i.7.outcome
#> <incidence object>
#> [5888 cases from days 2014-04-07 to 2015-04-27]
#> [5888 cases from ISO weeks 2014-W15 to 2015-W18]
#> [3 groups: Death, Recover, NA]
#>
#> $counts: matrix with 56 rows and 3 columns
#> $n: 5888 cases in total
#> $dates: 56 dates marking the left-side of bins
#> $interval: 7 days
#> $timespan: 386 days
#> $cumulative: FALSE
By default, incidence treats missing data (NA) as a
separate group (see argument na_as_group). We could disable
this to retain only known outcomes, but alternatively we can simply
subset the object to exclude the last (3rd) group:
i.7.outcome[,1:2]
#> <incidence object>
#> [4565 cases from days 2014-04-07 to 2015-04-27]
#> [4565 cases from ISO weeks 2014-W15 to 2015-W18]
#> [2 groups: Death, Recover]
#>
#> $counts: matrix with 56 rows and 2 columns
#> $n: 4565 cases in total
#> $dates: 56 dates marking the left-side of bins
#> $interval: 7 days
#> $timespan: 386 days
#> $cumulative: FALSE
Groups can also be collapsed into a single time series using
pool:
i.pooled <- pool(i.7.outcome)
i.pooled
#> <incidence object>
#> [5888 cases from days 2014-04-07 to 2015-04-27]
#> [5888 cases from ISO weeks 2014-W15 to 2015-W18]
#>
#> $counts: matrix with 56 rows and 1 columns
#> $n: 5888 cases in total
#> $dates: 56 dates marking the left-side of bins
#> $interval: 7 days
#> $timespan: 386 days
#> $cumulative: FALSEModelling incidence
Incidence data, excluding zeros, can be modelled using log-linear regression of the form: log(y) = r x t + b
where y is the incidence, r is the growth rate, t is the number of days since a specific point in time (typically the start of the outbreak), and b is the intercept.
Such model can be fitted to any incidence object using
fit. Of course, a single log-linear model is not sufficient
for modelling our epidemic curve, as there is clearly an growing and a
decreasing phase. As a start, we can calibrate a model on the first 20
weeks of the epidemic:
early.fit <- fit(i.7[1:20])
early.fit
#> <incidence_fit object>
#>
#> $model: regression of log-incidence over time
#>
#> $info: list containing the following items:
#> $r (daily growth rate):
#> [1] 0.03175771
#>
#> $r.conf (confidence interval):
#> 2.5 % 97.5 %
#> [1,] 0.02596229 0.03755314
#>
#> $doubling (doubling time in days):
#> [1] 21.8261
#>
#> $doubling.conf (confidence interval):
#> 2.5 % 97.5 %
#> [1,] 18.45777 26.69823
#>
#> $pred: data.frame of incidence predictions (20 rows, 5 columns)The resulting objects (known as incidence_fit objects)
can be plotted, in which case the prediction and its confidence interval
is displayed:
However, a better way to display these predictions is adding them to
the incidence plot using the argument fit:
In this case, we would ideally like to fit two models, before and after the peak of the epidemic. This is possible using the following approach, if you know what date to use to split the data in two phases:
fit.both <- fit(i.7, split=as.Date("2014-10-15"))
fit.both
#> <list of incidence_fit objects>
#>
#> attr(x, 'locations'): list of vectors with the locations of each incidence_fit object
#>
#> 'before'
#> 'after'
#>
#> $model: regression of log-incidence over time
#>
#> $info: list containing the following items:
#> $r (daily growth rate):
#> before after
#> 0.02741985 -0.01014465
#>
#> $r.conf (confidence interval):
#> 2.5 % 97.5 %
#> before 0.02407933 0.030760379
#> after -0.01127733 -0.009011981
#>
#> $doubling (doubling time in days):
#> before
#> 25.27902
#>
#> $doubling.conf (confidence interval):
#> 2.5 % 97.5 %
#> before 22.53377 28.78598
#>
#> $halving (halving time in days):
#> after
#> 68.32636
#>
#> $halving.conf (confidence interval):
#> 2.5 % 97.5 %
#> after 61.46379 76.91397
#>
#> $pred: data.frame of incidence predictions (56 rows, 6 columns)
This is much better, but the splitting date is not completely optimal. To look for the best possible splitting date (i.e. the one maximizing the average fit of both models), we use:
best.fit <- fit_optim_split(i.7)
best.fit
#> $df
#> dates mean.R2
#> 1 2014-08-04 0.7650406
#> 2 2014-08-11 0.8203351
#> 3 2014-08-18 0.8598316
#> 4 2014-08-25 0.8882682
#> 5 2014-09-01 0.9120857
#> 6 2014-09-08 0.9246023
#> 7 2014-09-15 0.9338797
#> 8 2014-09-22 0.9339813
#> 9 2014-09-29 0.9333246
#> 10 2014-10-06 0.9291131
#> 11 2014-10-13 0.9232523
#> 12 2014-10-20 0.9160439
#> 13 2014-10-27 0.9071665
#>
#> $split
#> [1] "2014-09-22"
#>
#> $fit
#> <list of incidence_fit objects>
#>
#> attr(x, 'locations'): list of vectors with the locations of each incidence_fit object
#>
#> 'before'
#> 'after'
#>
#> $model: regression of log-incidence over time
#>
#> $info: list containing the following items:
#> $r (daily growth rate):
#> before after
#> 0.02982209 -0.01016191
#>
#> $r.conf (confidence interval):
#> 2.5 % 97.5 %
#> before 0.02608945 0.033554736
#> after -0.01102526 -0.009298561
#>
#> $doubling (doubling time in days):
#> before
#> 23.24274
#>
#> $doubling.conf (confidence interval):
#> 2.5 % 97.5 %
#> before 20.65721 26.5681
#>
#> $halving (halving time in days):
#> after
#> 68.21031
#>
#> $halving.conf (confidence interval):
#> 2.5 % 97.5 %
#> after 62.86899 74.54349
#>
#> $pred: data.frame of incidence predictions (57 rows, 6 columns)
#>
#> $plot
These models are very good approximation of these data, showing a
doubling time of 23.2 days during the first phase, and a halving time of
68.2 days during the second. To access these parameters, you can use the
get_info() function.
The possible parameters are:
For “r”, “doubling”, and “halving”, you can also add “.conf” to get the confidence intervals. Here’s how you can get the doubling and halving times of the above epi curve:
get_info(best.fit$fit, "doubling.conf") # confidence interval
#> 2.5 % 97.5 %
#> before 20.65721 26.5681Note that fit will also take groups into account if
incidence has been computed for several groups:
best.fit2 <- fit_optim_split(i.7.sex)
best.fit2
#> $df
#> dates mean.R2 groups
#> 1 2014-08-04 0.7546016 f
#> 2 2014-08-11 0.8096672 f
#> 3 2014-08-18 0.8513743 f
#> 4 2014-08-25 0.8864424 f
#> 5 2014-09-01 0.9165063 f
#> 6 2014-09-08 0.9270248 f
#> 7 2014-09-15 0.9345352 f
#> 8 2014-09-22 0.9350323 f
#> 9 2014-09-29 0.9339121 f
#> 10 2014-10-06 0.9288956 f
#> 11 2014-10-13 0.9226037 f
#> 12 2014-10-20 0.9122727 f
#> 13 2014-10-27 0.9027890 f
#> 14 2014-08-04 0.7566712 m
#> 15 2014-08-11 0.8164693 m
#> 16 2014-08-18 0.8567850 m
#> 17 2014-08-25 0.8820669 m
#> 18 2014-09-01 0.9006668 m
#> 19 2014-09-08 0.9166004 m
#> 20 2014-09-15 0.9271862 m
#> 21 2014-09-22 0.9263339 m
#> 22 2014-09-29 0.9260695 m
#> 23 2014-10-06 0.9216350 m
#> 24 2014-10-13 0.9144120 m
#> 25 2014-10-20 0.9077086 m
#> 26 2014-10-27 0.8966333 m
#>
#> $plot
#>
#> $split
#> f m
#> "2014-09-22" "2014-09-15"
#>
#> $fit
#> <list of incidence_fit objects>
#>
#> attr(x, 'locations'): list of vectors with the locations of each incidence_fit object
#>
#> 'f', 'before'
#> 'm', 'before'
#> 'f', 'after'
#> 'm', 'after'
#>
#> $model: regression of log-incidence over time
#>
#> $info: list containing the following items:
#> $r (daily growth rate):
#> f_before m_before f_after m_after
#> 0.02570604 0.02883607 -0.01002297 -0.01038307
#>
#> $r.conf (confidence interval):
#> 2.5 % 97.5 %
#> f_before 0.02289333 0.028518743
#> m_before 0.02502254 0.032649606
#> f_after -0.01102735 -0.009018595
#> m_after -0.01138910 -0.009377034
#>
#> $doubling (doubling time in days):
#> f_before m_before
#> 26.96437 24.03750
#>
#> $doubling.conf (confidence interval):
#> 2.5 % 97.5 %
#> f_before 24.30497 30.27725
#> m_before 21.22988 27.70091
#>
#> $halving (halving time in days):
#> f_after m_after
#> 69.15586 66.75746
#>
#> $halving.conf (confidence interval):
#> 2.5 % 97.5 %
#> f_after 62.85711 76.85756
#> m_after 60.86059 73.91966
#>
#> $pred: data.frame of incidence predictions (111 rows, 7 columns)plot(i.7.sex, fit=best.fit2$fit)
#> Scale for colour is already present.
#> Adding another scale for colour, which will replace the existing scale.
#> Scale for colour is already present.
#> Adding another scale for colour, which will replace the existing scale.
#> Scale for colour is already present.
#> Adding another scale for colour, which will replace the existing scale.
#> Scale for colour is already present.
#> Adding another scale for colour, which will replace the existing scale.
Using get_info() on this fit object will return all
groups together: