Substitute nested ifelse with data.table::fcase()

.gitignore

@@ -31,4 +31,6 @@ CRAN-RELEASE
 # C++ object files
 inst/include/*.o
 # avoid rstantools generated files
-src
+src
+
+.DS_Store

DESCRIPTION

@@ -2,7 +2,7 @@ Type: Package
 Package: EpiNow2
 Title: Estimate Real-Time Case Counts and Time-Varying
     Epidemiological Parameters
-Version: 1.3.6.2000
+Version: 1.3.6.2001
 Authors@R: 
     c(person(given = "Sam",
              family = "Abbott",
@@ -67,6 +67,11 @@ Authors@R:
              family = "Chapman",
              role = "ctb",
              email = "lloyd.chapman1@lshtm.ac.uk "),
+      person(given = "James M.",
+             family = "Azam",
+             role = "ctb",
+             email = "james.azam@lshtm.ac.uk",
+             comment = c(ORCID = "0000-0001-5782-7330")),
       person(given = "EpiForecasts",
              role = "aut"),
       person(given = "Sebastian",

NAMESPACE

@@ -102,6 +102,7 @@ importFrom(data.table,as.data.table)
 importFrom(data.table,copy)
 importFrom(data.table,data.table)
 importFrom(data.table,dcast)
+importFrom(data.table,fcase)
 importFrom(data.table,fifelse)
 importFrom(data.table,frollmean)
 importFrom(data.table,frollsum)

NEWS.md

@@ -1,4 +1,6 @@
-# EpiNow2 1.3.6.2000
+# EpiNow2 (development version)
+
+# EpiNow2 1.3.6.2001
 
 This release is in development. For a stable release install 1.3.5 from CRAN.
 
@@ -10,6 +12,8 @@ This release is in development. For a stable release install 1.3.5 from CRAN.
 * Added a GitHub Action to build the README when it is altered.
 * Added handling of edge case where we sample from the negative binomial with
   mean close or equal to 0. By @sbfnk in #366.
+* Replaced use of nested `ifelse()` and `data.table::fifelse()` in the
+  code base with `data.table::fcase()`.
 
 # EpiNow2 1.3.5
 

R/create.R

@@ -263,6 +263,7 @@ create_rt_data <- function(rt = rt_opts(), breakpoints = NULL,
 #' define the back calculation. Defaults to `backcalc_opts()`.
 #'
 #' @seealso backcalc_opts
+#' @importFrom data.table fcase
 #' @return A list of settings defining the Gaussian process
 #' @export
 #' @author Sam Abbott
@@ -282,18 +283,17 @@ create_rt_data <- function(rt = rt_opts(), breakpoints = NULL,
 #'
 #' # custom lengthscale
 #' create_gp_data(gp_opts(ls_mean = 14), data)
-create_backcalc_data <- function(backcalc = backcalc_opts) {
+create_backcalc_data <- function(backcalc = backcalc_opts()) {
   data <- list(
-    rt_half_window = as.integer((backcalc$rt_window - 1) / 2),
-    # nolint start
-    backcalc_prior = ifelse(backcalc$prior == "none", 0,
-      ifelse(backcalc$prior == "reports", 1,
-        ifelse(backcalc$prior == "infections", 2, 0)
-      )
-    )
-    # nolint end
-  )
-  return(data)
+   rt_half_window = as.integer((backcalc$rt_window - 1) / 2),
+   backcalc_prior = data.table::fcase(
+     backcalc$prior == "none", 0,
+     backcalc$prior == "reports", 1,
+     backcalc$prior == "infections", 2,
+     default = 0
+   )
+ )
+ return(data)
 }
 #' Create Gaussian Process Data
 #'
@@ -305,6 +305,7 @@ create_backcalc_data <- function(backcalc = backcalc_opts) {
 #' Gaussian process.
 #' @param data A list containing the following numeric values:
 #' `t`, `seeding_time`, `horizon`.
+#' @importFrom data.table fcase
 #' @seealso gp_opts
 #' @return A list of settings defining the Gaussian process
 #' @export
@@ -325,6 +326,7 @@ create_backcalc_data <- function(backcalc = backcalc_opts) {
 #'
 #' # custom lengthscale
 #' create_gp_data(gp_opts(ls_mean = 14), data)
+
 create_gp_data <- function(gp = gp_opts(), data) {
   # Define if GP is on or off
   if (is.null(gp)) {
@@ -347,19 +349,19 @@ create_gp_data <- function(gp = gp_opts(), data) {
 
   # map settings to underlying gp stan requirements
   gp_data <- list(
-    fixed = as.numeric(fixed),
-    M = M,
-    L = gp$boundary_scale,
-    ls_meanlog = convert_to_logmean(gp$ls_mean, gp$ls_sd),
-    ls_sdlog = convert_to_logsd(gp$ls_mean, gp$ls_sd),
-    ls_min = gp$ls_min,
-    ls_max = data$t - data$seeding_time - data$horizon,
-    alpha_sd = gp$alpha_sd,
-    # nolint start
-    gp_type = ifelse(gp$kernel == "se", 0,
-      ifelse(gp$kernel == "matern", 1, 0)
+  fixed = as.numeric(fixed),
+  M = M,
+  L = gp$boundary_scale,
+  ls_meanlog = convert_to_logmean(gp$ls_mean, gp$ls_sd),
+  ls_sdlog = convert_to_logsd(gp$ls_mean, gp$ls_sd),
+  ls_min = gp$ls_min,
+  ls_max = data$t - data$seeding_time - data$horizon,
+  alpha_sd = gp$alpha_sd,
+  gp_type = data.table::fcase(
+    gp$kernel == "se", 0,
+    gp$kernel == "matern", 1,
+    default = 0
     )
-    # nolint end
   )
 
   gp_data <- c(data, gp_data)
@@ -538,6 +540,7 @@ create_stan_data <- function(reported_cases, generation_time,
 #' @return An initial condition generating function
 #' @importFrom purrr map2_dbl
 #' @importFrom truncnorm rtruncnorm
+#' @importFrom data.table fcase
 #' @export
 #  @author Sam Abbott
 #  @author Sebastian Funk
@@ -581,13 +584,13 @@ create_initial_conditions <- function(data) {
         meanlog = data$ls_meanlog,
         sdlog = ifelse(data$ls_sdlog > 0, data$ls_sdlog * 0.1, 0.01)
       ))
-      # nolint start
-      out$rho <- ifelse(out$rho > data$ls_max, data$ls_max - 0.001,
-        ifelse(out$rho < data$ls_min, data$ls_min + 0.001,
-          out$rho
-        )
-      )
-      # nolint end
+
+      out$rho <- array(data.table::fcase(
+        out$rho > data$ls_max, data$ls_max - 0.001,
+        out$rho < data$ls_min, data$ls_min + 0.001,
+        default = out$rho
+        ))
+
       out$alpha <- array(
         truncnorm::rtruncnorm(1, a = 0, mean = 0, sd = data$alpha_sd)
       )

R/dist.R

@@ -206,7 +206,6 @@ dist_fit <- function(values = NULL, samples = NULL, cores = 1,
   if (samples < 1000) {
     samples <- 1000
   }
-
   # model parameters
   lows <- values - 1
   lows <- ifelse(lows <= 0, 1e-6, lows)

R/estimate_infections.R

@@ -678,7 +678,7 @@ fit_model_with_vb <- function(args, future = FALSE, id = "stan") {
 #' @param start_date Date, earliest date with data.
 #'
 #' @inheritParams calc_summary_measures
-#' @importFrom data.table fifelse rbindlist
+#' @importFrom data.table fcase rbindlist
 #' @importFrom lubridate days
 #' @importFrom futile.logger flog.info
 #' @return A list of samples and summarised posterior parameter estimates.
@@ -695,20 +695,16 @@ format_fit <- function(posterior_samples, horizon, shift, burn_in, start_date,
     format_out$samples <- format_out$samples[, strat := NA]
   }
   # add type based on horizon
-  # nolint start
   format_out$samples <- format_out$samples[
     ,
-    type := data.table::fifelse(
-      date > (max(date, na.rm = TRUE) - horizon),
-      "forecast",
-      data.table::fifelse(
-        date > (max(date, na.rm = TRUE) - horizon - shift),
-        "estimate based on partial data",
-        "estimate"
+    type := data.table::fcase(
+      date > (max(date, na.rm = TRUE) - horizon), "forecast",
+      date > (max(date, na.rm = TRUE) - horizon - shift),
+      "estimate based on partial data",
+      is.na(date), NA_character_,
+      default = "estimate"
       )
-    )
-  ]
-  # nolint end
+    ]
 
   # remove burn in period if specified
   if (burn_in > 0) {

R/stanmodels.R

@@ -17,7 +17,7 @@ Rcpp::loadModule("stan_fit4tune_inv_gamma_mod", what = TRUE)
 # instantiate each stanmodel object
 stanmodels <- sapply(stanmodels, function(model_name) {
   # create C++ code for stan model
-  stan_file <- if (dir.exists("stan")) "stan" else file.path("inst", "stan")
+  stan_file <- if(dir.exists("stan")) "stan" else file.path("inst", "stan")
   stan_file <- file.path(stan_file, paste0(model_name, ".stan"))
   stanfit <- rstan::stanc_builder(stan_file,
                                   allow_undefined = TRUE,

R/summarise.R

@@ -162,7 +162,7 @@ summarise_results <- function(regions,
 #' @inheritParams epinow
 #' @importFrom purrr map_chr compact
 #' @importFrom ggplot2 coord_cartesian guides guide_legend ggsave ggplot_build
-#' @importFrom data.table setDT
+#' @importFrom data.table setDT fcase
 #' @importFrom futile.logger flog.info
 #' @examples
 #' \donttest{
@@ -336,10 +336,11 @@ regional_summary <- function(regional_output = NULL,
         )
       }
       save_ggplot(summary_plot, "summary_plot.png",
-        width = ifelse(length(regions) > 60,
-          ifelse(length(regions) > 120, 36, 24), # nolint
-          12
-        )
+        width = data.table::fcase(
+          length(regions) > 60 & length(regions) > 120, 36,
+          length(regions) > 60 & !(length(regions) > 120), 24,
+          default = 12
+          )
       )
     }
     # extract regions with highest number of reported cases in the last week
@@ -370,11 +371,11 @@ regional_summary <- function(regional_output = NULL,
     }
 
     if (all_regions) {
-      # nolint start
-      plots_per_row <- ifelse(length(regions) > 60,
-        ifelse(length(regions) > 120, 8, 5), 3
-      ) 
-      # nolint end
+      plots_per_row <- data.table::fcase(
+        length(regions) > 60 & length(regions) > 120, 8,
+        length(regions) > 60 & !(length(regions) > 120), 5,
+        default = 3
+      )
 
       plots <- report_plots(
         summarised_estimates = results$estimates$summarised,
@@ -669,7 +670,7 @@ calc_CrIs <- function(samples, summarise_by = NULL, CrIs = c(0.2, 0.5, 0.9)) {
   # nolint start
   order_CrIs <- c(
     paste0("lower_", rev(scale_CrIs)), paste0("upper_", scale_CrIs)
-  ) 
+  )
   # nolint end
   with_CrIs <- data.table::dcast(
     with_CrIs, ... ~ factor(CrI, levels = order_CrIs),

R/utilities.R

@@ -77,6 +77,7 @@ make_conf <- function(value, CrI = 90, reverse = FALSE) {
 #' "Likely decreasing" (< 0.95), "Decreasing" (<= 1)
 #' @param var Numeric variable to be categorised
 #'
+#' @importFrom data.table fcase
 #' @return A character variable.
 #' @export
 #' @examples
@@ -85,17 +86,15 @@ make_conf <- function(value, CrI = 90, reverse = FALSE) {
 #'
 #' map_prob_change(var)
 map_prob_change <- function(var) {
-  # nolint start
-  var <- ifelse(var < 0.05, "Increasing",
-    ifelse(var < 0.4, "Likely increasing",
-      ifelse(var < 0.6, "Stable",
-        ifelse(var < 0.95, "Likely decreasing",
-          "Decreasing"
-        )
-      )
-    )
-  ) 
-  # nolint end
+
+  var <- data.table::fcase(
+    var < 0.05, "Increasing",
+    var < 0.4, "Likely increasing",
+    var < 0.6, "Stable",
+    var < 0.95, "Likely decreasing",
+    var <= 1, "Decreasing"
+  )
+
   var <- factor(var, levels = c(
     "Increasing", "Likely increasing", "Stable",
     "Likely decreasing", "Decreasing"