Merge pull request #1 from cmu-delphi/pkg-init

Just initialize the R package

Author: dajmcdon

.Rbuildignore

@@ -0,0 +1,3 @@
+^epipredict\.Rproj$
+^\.Rproj\.user$
+^LICENSE\.md$

.gitignore

@@ -0,0 +1,4 @@
+.Rproj.user
+.Rhistory
+.RData
+.Ruserdata

DESCRIPTION

@@ -0,0 +1,24 @@
+Package: epipredict
+Title: Basic epidemiology forecasting methods
+Version: 0.0.1
+Authors@R: 
+  c(
+  person(given = "Jacob",
+         family = "Bien",
+         role = "aut"),
+  person(given = "Daniel",
+         family = "McDonald",
+         role = "aut"),
+  person(given = "Ryan",
+         family = "Tibshirani",
+         role = c("aut", "cre"),
+         email = "[email protected]"))
+Description: What the package does (one paragraph).
+License: MIT + file LICENSE
+Encoding: UTF-8
+Roxygen: list(markdown = TRUE)
+RoxygenNote: 7.1.2
+Imports: 
+    dplyr,
+    magrittr,
+    data.table

LICENSE

@@ -0,0 +1,2 @@
+YEAR: 2022
+COPYRIGHT HOLDER: epipredict authors

LICENSE.md

@@ -0,0 +1,21 @@
+# MIT License
+
+Copyright (c) 2022 epipredict authors
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.

NAMESPACE

@@ -0,0 +1,4 @@
+# Generated by roxygen2: do not edit by hand
+
+export("%>%")
+importFrom(magrittr,"%>%")

R/prob_ar.R

@@ -0,0 +1,34 @@
+prob_ar <- function(y, lags = c(0, 7, 14), ahead = 7, min_train_window = 20,
+                    lower_level = 0.05, upper_level = 0.95, symmetrize = TRUE,
+                    nonneg = TRUE) {
+  # Return NA if insufficient training data
+  if (length(y) < min_train_window + max(lags) + ahead) {
+    return(data.frame(point = NA, lower = NA, upper = NA))
+  }
+
+  # Build features and response for the AR model
+  dat <- do.call(
+    data.frame,
+    purrr::map(lags, function(lag) dplyr::lag(y, n = lag))
+  )
+  dat$y <- dplyr::lead(y, n = ahead)
+
+  # Now fit the AR model and make a prediction
+  obj <- lm(y ~ ., data = dat)
+  point <- predict(obj, newdata = tail(dat, 1))
+
+  # Compute a band
+  r <- residuals(obj)
+  s <- ifelse(symmetrize, -1, NA) # Should the residuals be symmetrized?
+  q <- quantile(c(r, s * r), probs = c(lower_level, upper_level), na.rm = TRUE)
+  lower <- point + q[1]
+  upper <- point + q[2]
+
+  # Clip at zero if we need to, then return
+  if (nonneg) {
+    point = max(point, 0)
+    lower = max(lower, 0)
+    upper = max(upper, 0)
+  }
+  return(data.frame(point = point, lower = lower, upper = upper))
+}

R/prob_arx.R

@@ -0,0 +1,50 @@
+prob_arx <- function(x, y, geo_value, time_value, lags = c(0, 7, 14),
+                     ahead = 7, min_train_window = 20, lower_level = 0.05,
+                     upper_level = 0.95, symmetrize = TRUE, nonneg = TRUE) {
+  # Return NA if insufficient training data
+  if (length(y) < min_train_window + max(lags) + ahead) {
+    return(data.frame(point = NA, lower = NA, upper = NA))
+  }
+
+  # Useful transformations
+  if (!missing(x)) x <- data.frame(x, y)
+  else x <- data.frame(y)
+  if (!is.list(lags)) lags <- list(lags)
+  lags = rep(lags, length.out = ncol(x))
+
+  # Build features and response for the AR model, and then fit it
+  dat <- do.call(
+    data.frame,
+    unlist( # Below we loop through and build the lagged features
+      purrr::map(1:ncol(x), function(i) {
+        purrr::map(lags[[i]], function(lag) dplyr::lag(x[,i], n = lag))
+      }),
+      recursive = FALSE
+    )
+  )
+  dat$y <- dplyr::lead(y, n = ahead)
+  obj <- lm(y ~ ., data = dat)
+
+  # Use LOCF to fill NAs in the latest feature values, make a prediction
+  data.table::setnafill(dat, type = "locf")
+  dat <- cbind(dat, data.frame(geo_value, time_value))
+  point <- predict(obj, newdata = dat %>%
+                     dplyr::group_by(geo_value) %>%
+                     dplyr::filter(time_value == max(time_value)))
+
+  # Compute a band
+  r <- residuals(obj)
+  s <- ifelse(symmetrize, -1, NA) # Should the residuals be symmetrized?
+  q <- quantile(c(r, s * r), probs = c(lower_level, upper_level), na.rm = TRUE)
+  lower <- point + q[1]
+  upper <- point + q[2]
+
+  # Clip at zero if we need to, then return
+  if (nonneg) {
+    point = pmax(point, 0)
+    lower = pmax(lower, 0)
+    upper = pmax(upper, 0)
+  }
+  return(data.frame(geo_value = unique(geo_value), # Must include geo value!
+                    point = point, lower = lower, upper = upper))
+}

R/utils-pipe.R

@@ -0,0 +1,14 @@
+#' Pipe operator
+#'
+#' See \code{magrittr::\link[magrittr:pipe]{\%>\%}} for details.
+#'
+#' @name %>%
+#' @rdname pipe
+#' @keywords internal
+#' @export
+#' @importFrom magrittr %>%
+#' @usage lhs \%>\% rhs
+#' @param lhs A value or the magrittr placeholder.
+#' @param rhs A function call using the magrittr semantics.
+#' @return The result of calling `rhs(lhs)`.
+NULL

epipredict.Rproj

@@ -0,0 +1,22 @@
+Version: 1.0
+
+RestoreWorkspace: No
+SaveWorkspace: No
+AlwaysSaveHistory: Default
+
+EnableCodeIndexing: Yes
+UseSpacesForTab: Yes
+NumSpacesForTab: 2
+Encoding: UTF-8
+
+RnwWeave: Sweave
+LaTeX: pdfLaTeX
+
+AutoAppendNewline: Yes
+StripTrailingWhitespace: Yes
+LineEndingConversion: Posix
+
+BuildType: Package
+PackageUseDevtools: Yes
+PackageInstallArgs: --no-multiarch --with-keep.source
+PackageRoxygenize: rd,collate,namespace