Merge branch 'main' of https://github.com/dajmcdon/epiprocess into km/remove-gginnards

Author: kenmawer

.Rbuildignore

@@ -5,3 +5,4 @@
 ^docs$
 ^_pkgdown.yml
 ^index\.md$
+^data-raw$

DESCRIPTION

@@ -52,3 +52,6 @@ Encoding: UTF-8
 LazyData: true
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.1.2
+Depends: 
+    R (>= 2.10)
+

NAMESPACE

@@ -59,6 +59,7 @@ importFrom(dplyr,group_modify)
 importFrom(dplyr,mutate)
 importFrom(dplyr,relocate)
 importFrom(dplyr,rename)
+importFrom(dplyr,select)
 importFrom(dplyr,slice)
 importFrom(dplyr,ungroup)
 importFrom(lubridate,days)

R/archive.R

@@ -448,6 +448,23 @@ epi_archive =
 #'   ```
 #'
 #' @export
+#' @examples 
+#' df <- data.frame (geo_value  = c(replicate(2, "ca"), replicate(2, "fl")),
+#'                  county = c(1, 3, 2, 5),
+#'                  time_value = c("2020-06-01", 
+#'                  "2020-06-02", 
+#'                  "2020-06-01", 
+#'                  "2020-06-02"),
+#'                  version = c("2020-06-02", 
+#'                  "2020-06-03", 
+#'                  "2020-06-02",
+#'                  "2020-06-03"),
+#'                  cases = c(1, 2, 3, 4),
+#'                  cases_rate = c(0.01, 0.02, 0.01, 0.05))
+#'
+#' x <- df %>% as_epi_archive(geo_type = "state", 
+#'                           time_type = "day", 
+#'                           other_keys = "county")
 as_epi_archive = function(x, geo_type, time_type, other_keys,
                           additional_metadata = list()) {
   epi_archive$new(x, geo_type, time_type, other_keys, additional_metadata)
@@ -459,6 +476,9 @@ as_epi_archive = function(x, geo_type, time_type, other_keys,
 #' @return `TRUE` if the object inherits from `epi_archive`.
 #'
 #' @export
+#' @examples
+#' is_epi_archive(jhu_csse_daily) # FALSE 
+#' is_epi_archive(archive_cases_dv) # TRUE 
 is_epi_archive = function(x) {
   inherits(x, "epi_archive")
 }

R/correlation.R

@@ -40,6 +40,33 @@
 #' @importFrom rlang .data !! !!! enquo syms
 #' @importFrom tidyselect eval_select
 #' @export
+#' @examples
+#'  
+#' # linear association of case and death rates on any given day
+#' epi_cor(x = jhu_csse_daily, 
+#'         var1 = case_rate_7d_av, 
+#'         var2 = death_rate_7d_av, 
+#'         cor_by = "time_value")
+#' 
+#' # correlation of death rates and lagged case rates
+#' epi_cor(x = jhu_csse_daily, 
+#'         var1 = case_rate_7d_av, 
+#'         var2 = death_rate_7d_av, 
+#'         cor_by = time_value, 
+#'         dt1 = -10)
+#' 
+#' # correlation grouped by location 
+#' epi_cor(x = jhu_csse_daily, 
+#'         var1 = case_rate_7d_av, 
+#'         var2 = death_rate_7d_av, 
+#'         cor_by = geo_value)
+#' 
+#' # correlation grouped by location and incorporates lagged cases rates
+#' epi_cor(x = jhu_csse_daily, 
+#'         var1 = case_rate_7d_av, 
+#'         var2 = death_rate_7d_av, 
+#'         cor_by = geo_value, 
+#'         dt1 = -10)
 epi_cor = function(x, var1, var2, dt1 = 0, dt2 = 0, shift_by = geo_value,
                    cor_by = geo_value, use = "na.or.complete",
                    method = c("pearson", "kendall", "spearman")) {

R/data.R

@@ -0,0 +1,45 @@
+#' JHU daily cases and deaths from California and Florida
+#'
+#' This data source of confirmed COVID-19 cases and deaths 
+#' is based on reports made available by the Center for 
+#' Systems Science and Engineering at Johns Hopkins University. 
+#' This example data ranges from June 1 to June 15, 2020. 
+#'
+#' @format A tibble with 30 rows and 6 variables:
+#' \describe{
+#'   \item{geo_value}{the geographic value associated with each row of measurements.}
+#'   \item{time_value}{the time value associated with each row of measurements.}
+#'   \item{case_rate_7d_av}{7-day average signal of number of new confirmed COVID-19 cases per 100,000 population, daily}
+#'   \item{death_rate_7d_av}{7-day average signal of number of new confirmed deaths due to COVID-19 per 100,000 population, daily}
+#'   \item{cases}{Number of new confirmed COVID-19 cases, daily}
+#'   \item{cases_7d_av}{7-day average signal of number of new confirmed COVID-19 cases, daily}
+#' }
+#' @source COVID-19 Data Repository by the Center for Systems Science and Engineering (CSSE) at Johns Hopkins University. 
+#' \url{https://github.com/CSSEGISandData/COVID-19}
+"jhu_csse_daily"
+
+
+#' Daily doctor visits and cases from California and Florida in archive format
+#'
+#' This data source is based on information about outpatient visits, 
+#' provided to us by health system partners, and also contains confirmed 
+#' COVID-19 cases based on reports made available by the Center for 
+#' Systems Science and Engineering at Johns Hopkins University. 
+#' This example data ranges from June 1 to June 15, 2020. 
+#'
+#' @format An `epi_archive` data format. The data table DT has 160 rows and 5 columns:
+#' \describe{
+#'   \item{geo_value}{the geographic value associated with each row of measurements.}
+#'   \item{time_value}{the time value associated with each row of measurements.}
+#'   \item{version}{ the time value specifying the version for each row of measurements. }
+#'   \item{percent_cli}{percentage of doctor’s visits with CLI (COVID-like illness) computed from medical insurance claims}
+#'   \item{case_rate}{7-day average signal of number of new confirmed deaths due to COVID-19 per 100,000 population, daily}
+#' }
+#' @source These data sources are provided under the terms of the 
+#' \href{https://creativecommons.org/licenses/by/4.0/}{Creative Commons Attribution license:}
+#' * \href{https://cmu-delphi.github.io/delphi-epidata/api/covidcast-signals/doctor-visits.html}{Doctor Visits}
+#' 
+#' COVID-19 Data Repository by the Center for Systems Science and Engineering (CSSE) at Johns Hopkins University. 
+#' \url{https://github.com/CSSEGISandData/COVID-19}
+"archive_cases_dv"
+

R/methods-epi_archive.R

@@ -27,6 +27,9 @@
 #'   ```
 #' 
 #' @export 
+#' @examples 
+#' epix_as_of(x = archive_cases_dv, 
+#'            max_version = max(archive_cases_dv$DT$version))
 epix_as_of = function(x, max_version, min_time_value = -Inf) {
   if (!inherits(x, "epi_archive")) Abort("`x` must be of class `epi_archive`.")
   return(x$as_of(max_version, min_time_value))
@@ -67,6 +70,17 @@ epix_as_of = function(x, max_version, min_time_value = -Inf) {
 #'   ```
 #' 
 #' @export
+#' @examples 
+#' # create two example epi_archive datasets
+#' x <- archive_cases_dv$DT %>% 
+#'   dplyr::select(geo_value,time_value,version,case_rate) %>% 
+#'   as_epi_archive()
+#' y <- archive_cases_dv$DT %>% 
+#'   dplyr::select(geo_value,time_value,version,percent_cli) %>% 
+#'   as_epi_archive()
+#'   
+#' # a full join stored in x
+#' epix_merge(x, y, all = TRUE) 
 epix_merge = function(x, y, ..., locf = TRUE, nan = NA) {
   if (!inherits(x, "epi_archive")) Abort("`x` must be of class `epi_archive`.")
   return(x$merge(y, ..., locf = locf, nan = nan))
@@ -167,6 +181,17 @@ epix_merge = function(x, y, ..., locf = TRUE, nan = NA) {
 #' 
 #' @importFrom rlang enquo
 #' @export
+#' @examples 
+#' # every date is a reference time point for the 3 day average sliding window
+#' fc_time_values <- seq(as.Date("2020-06-01"),
+#'                       as.Date("2020-06-15"),
+#'                       by = "1 day")
+#' epix_slide(x = archive_cases_dv, 
+#'            f = ~ mean(.x$case_rate), 
+#'            n = 3, 
+#'            group_by = geo_value,
+#'            ref_time_values = fc_time_values,
+#'            new_col_name = 'case_rate_3d_av')
 epix_slide = function(x, f, ..., n = 7, group_by, ref_time_values,
                       time_step, new_col_name = "slide_value",
                       as_list_col = FALSE, names_sep = "_", all_rows = FALSE) {

R/outliers.R

@@ -44,6 +44,33 @@
 #'   STL decomposition.
 #' 
 #' @export
+#' @importFrom dplyr select
+#' @examples
+#'  detection_methods = dplyr::bind_rows(
+#'    dplyr::tibble(method = "rm",
+#'           args = list(list(detect_negatives = TRUE,
+#'                            detection_multiplier = 2.5)),
+#'           abbr = "rm"),
+#'    dplyr::tibble(method = "stl",
+#'           args = list(list(detect_negatives = TRUE,
+#'                            detection_multiplier = 2.5,
+#'                            seasonal_period = 7)),
+#'           abbr = "stl_seasonal"),
+#'    dplyr::tibble(method = "stl",
+#'           args = list(list(detect_negatives = TRUE,
+#'                            detection_multiplier = 2.5,
+#'                            seasonal_period = NULL)),
+#'           abbr = "stl_nonseasonal"))  
+#'  
+#'  x <- jhu_csse_daily %>% 
+#'    dplyr::select(geo_value,time_value,cases) %>% 
+#'    as_epi_df()%>% 
+#'    group_by(geo_value) %>%
+#'    mutate(outlier_info  = detect_outlr(
+#'      x = time_value, y = cases,
+#'      methods = detection_methods,
+#'      combiner = "median")) %>%
+#'    unnest(outlier_info)
 detect_outlr = function(x = seq_along(y), y,
                         methods = tibble::tibble(method = "rm",
                                          args = list(list()),
@@ -120,6 +147,15 @@ detect_outlr = function(x = seq_along(y), y,
 #'   `lower`, `upper`, and `replacement`.
 #'
 #' @export
+#' @examples 
+# # Detect outliers based on a rolling median
+#' jhu_csse_daily %>% 
+#'   dplyr::select(geo_value,time_value,cases) %>% 
+#'   as_epi_df()%>% 
+#'   group_by(geo_value) %>%
+#'   mutate(outlier_info  = detect_outlr_rm(
+#'     x = time_value, y = cases)) %>%
+#'   unnest(outlier_info)
 detect_outlr_rm = function(x = seq_along(y), y, n = 21,
                            log_transform = FALSE,
                            detect_negatives = FALSE,
@@ -208,6 +244,16 @@ detect_outlr_rm = function(x = seq_along(y), y, n = 21,
 #' @importFrom stats median
 #' @importFrom tidyselect starts_with
 #' @export
+#' @examples 
+# # Detects outliers based on a seasonal-trend decomposition using LOESS 
+#' jhu_csse_daily %>% 
+#'   dplyr::select(geo_value,time_value,cases) %>% 
+#'   as_epi_df()%>% 
+#'   group_by(geo_value) %>%
+#'   mutate(outlier_info  = detect_outlr_stl(
+#'     x = time_value, y = cases,
+#'     seasonal_period = 7 )) %>% # weekly seasonality for daily data
+#'   unnest(outlier_info)
 detect_outlr_stl = function(x = seq_along(y), y,
                             n_trend = 21,
                             n_seasonal = 21,

R/slide.R

@@ -88,6 +88,25 @@
 #' @importFrom lubridate days weeks
 #' @importFrom rlang .data .env !! enquo enquos sym
 #' @export
+#' @examples 
+#'  # slide a 7-day trailing average formula on cases
+#'   jhu_csse_daily %>%
+#'   group_by(geo_value) %>%
+#'   epi_slide(cases_7dav = mean(cases), n = 7, 
+#'             align = "right")
+#'  
+#'  # slide a left-aligned 7-day trailing average
+#'   jhu_csse_daily %>%
+#'   group_by(geo_value) %>%
+#'   epi_slide(cases_7dav = mean(cases), n = 7, 
+#'             align = "left")
+#'  
+#'  # nested new columns
+#'  jhu_csse_daily %>% 
+#'  group_by(geo_value) %>%
+#'  epi_slide(a = data.frame(cases_2dav = mean(cases), 
+#'                           cases_2dma = mad(cases)),
+#'            n = 2, as_list_col = TRUE)
 epi_slide = function(x, f, ..., n = 7, ref_time_values,
                      align = c("right", "center", "left"), before, time_step, 
                      new_col_name = "slide_value", as_list_col = FALSE,

data-raw/archive_cases_dv.R

@@ -0,0 +1,34 @@
+library(delphi.epidata)
+library(epiprocess)
+library(data.table)
+library(dplyr)
+
+archive_cases_dv <- covidcast(
+  data_source = "doctor-visits",
+  signals = "smoothed_adj_cli",
+  time_type = "day",
+  geo_type = "state",
+  time_value = epirange(20200601, 20200615),
+  geo_values = "ca,fl",
+  issues = epirange(20200601, 20200615)
+) %>% 
+  fetch_tbl() %>%
+  select(geo_value, time_value, version = issue, percent_cli = value) %>%
+  as_epi_archive()
+
+case_rate <- covidcast(
+  data_source = "jhu-csse",
+  signals = "confirmed_7dav_incidence_prop",
+  time_type = "day",
+  geo_type = "state",
+  time_value = epirange(20200601, 20200615),
+  geo_values = "ca,fl",
+  issues = epirange(20200601, 20200615)
+) %>%
+  fetch_tbl() %>%
+  select(geo_value, time_value, version = issue, case_rate = value) %>%
+  as_epi_archive()
+
+epix_merge(archive_cases_dv, case_rate, all = TRUE)
+
+usethis::use_data(archive_cases_dv, overwrite = TRUE)

data-raw/jhu_csse_daily.R

@@ -0,0 +1,62 @@
+library(delphi.epidata)
+library(epiprocess)
+library(dplyr)
+
+confirmed_7dav_incidence_prop <- covidcast(
+  data_source = "jhu-csse",
+  signals = "confirmed_7dav_incidence_prop",
+  time_type = "day",
+  geo_type = "state",
+  time_values = epirange(20200601, 20200615),
+  geo_values = "ca,fl"
+) %>%
+  fetch_tbl() %>%
+  select(geo_value, time_value, case_rate_7d_av = value) %>%
+  arrange(geo_value, time_value) 
+
+deaths_7dav_incidence_prop <- covidcast(
+  data_source = "jhu-csse",
+  signals = "deaths_7dav_incidence_prop",
+  time_type = "day",
+  geo_type = "state",
+  time_values = epirange(20200601, 20200615),
+  geo_values = "ca,fl"
+) %>%
+  fetch_tbl() %>%
+  select(geo_value, time_value, death_rate_7d_av = value) %>%
+  arrange(geo_value, time_value) 
+
+confirmed_incidence_num <- covidcast(
+  data_source = "jhu-csse",
+  signals = "confirmed_incidence_num",
+  time_type = "day",
+  geo_type = "state",
+  time_values = epirange(20200601, 20200615),
+  geo_values = "ca,fl"
+) %>%
+  fetch_tbl() %>%
+  select(geo_value, time_value, cases = value) %>%
+  arrange(geo_value, time_value) 
+
+confirmed_7dav_incidence_num <- covidcast(
+  data_source = "jhu-csse",
+  signals = "confirmed_7dav_incidence_num",
+  time_type = "day",
+  geo_type = "state",
+  time_values = epirange(20200601, 20200615),
+  geo_values = "ca,fl"
+) %>%
+  fetch_tbl() %>%
+  select(geo_value, time_value, cases_7d_av = value) %>%
+  arrange(geo_value, time_value)
+
+jhu_csse_daily <- confirmed_7dav_incidence_prop %>%
+   full_join(deaths_7dav_incidence_prop, 
+             by = c("geo_value", "time_value")) %>%
+  full_join(confirmed_incidence_num, 
+            by = c("geo_value", "time_value")) %>%
+  full_join(confirmed_7dav_incidence_num, 
+            by = c("geo_value", "time_value")) %>%
+   as_epi_df()
+
+usethis::use_data(jhu_csse_daily, overwrite = TRUE)