style change in response to lintr warnings

R/estimate_secondary.R

@@ -299,38 +299,36 @@ secondary_opts <- function(type = "incidence", ...) {
 #' update_secondary_args(data, priors)
 update_secondary_args <- function(data, priors, verbose = TRUE) {
   priors <- data.table::as.data.table(priors)
-  if (!missing(priors)) {
-    if (!is.null(priors) && nrow(priors) > 0) {
-      if (verbose) {
-        message(
-          "Replacing specified priors with those from the passed in prior dataframe" # nolint
+  if (!missing(priors) && !is.null(priors) && nrow(priors) > 0) {
+    if (verbose) {
+      message(
+        "Replacing specified priors with those from the passed in prior dataframe" # nolint
+      )
+    }
+    # replace scaling if present in the prior
+    scale <- priors[grepl("frac_obs", variable, fixed = TRUE)]
+    if (nrow(scale) > 0) {
+      data$obs_scale_mean <- as.array(signif(scale$mean, 3))
+      data$obs_scale_sd <- as.array(signif(scale$sd, 3))
+    }
+    # replace delay parameters if present
+    delay_mean <- priors[grepl("delay_mean", variable, fixed = TRUE)]
+    delay_sd <- priors[grepl("delay_sd", variable, fixed = TRUE)]
+    if (nrow(delay_mean) > 0) {
+      if (is.null(data$delay_mean_mean)) {
+        warning(
+          "Cannot replace delay distribution parameters as no default has been set" # nolint
         )
       }
-      # replace scaling if present in the prior
-      scale <- priors[grepl("frac_obs", variable, fixed = TRUE)]
-      if (nrow(scale) > 0) {
-        data$obs_scale_mean <- as.array(signif(scale$mean, 3))
-        data$obs_scale_sd <- as.array(signif(scale$sd, 3))
-      }
-      # replace delay parameters if present
-      delay_mean <- priors[grepl("delay_mean", variable, fixed = TRUE)]
-      delay_sd <- priors[grepl("delay_sd", variable, fixed = TRUE)]
-      if (nrow(delay_mean) > 0) {
-        if (is.null(data$delay_mean_mean)) {
-          warning(
-            "Cannot replace delay distribution parameters as no default has been set" # nolint
-          )
-        }
-        data$delay_mean_mean <- as.array(signif(delay_mean$mean, 3))
-        data$delay_mean_sd <- as.array(signif(delay_mean$sd, 3))
-        data$delay_sd_mean <- as.array(signif(delay_sd$mean, 3))
-        data$delay_sd_sd <- as.array(signif(delay_sd$sd, 3))
-      }
-      phi <- priors[grepl("rep_phi", variable, fixed = TRUE)]
-      if (nrow(phi) > 0) {
-        data$phi_mean <- signif(phi$mean, 3)
-        data$phi_sd <- signif(phi$sd, 3)
-      }
+      data$delay_mean_mean <- as.array(signif(delay_mean$mean, 3))
+      data$delay_mean_sd <- as.array(signif(delay_mean$sd, 3))
+      data$delay_sd_mean <- as.array(signif(delay_sd$mean, 3))
+      data$delay_sd_sd <- as.array(signif(delay_sd$sd, 3))
+    }
+    phi <- priors[grepl("rep_phi", variable, fixed = TRUE)]
+    if (nrow(phi) > 0) {
+      data$phi_mean <- signif(phi$mean, 3)
+      data$phi_sd <- signif(phi$sd, 3)
     }
   }
   return(data)
@@ -687,7 +685,7 @@ forecast_secondary <- function(estimate,
     summarise_by = "date",
     CrIs = CrIs
   )
-  summarised <- summarised[, purrr::map(.SD, ~ round(., 1))]
+  summarised <- summarised[, purrr::map(.SD, round, digits = 1)]
 
   # construct output
   out <- list()

R/estimate_truncation.R

@@ -178,6 +178,7 @@ estimate_truncation <- function(obs, max_truncation, trunc_max = 10,
       phi = abs(rnorm(1, 0, 1)),
       sigma = abs(rnorm(1, 0, 1))
     )
+    cat(unlist(data), "\n")
     return(data)
   }
 

R/extract.R

@@ -212,9 +212,9 @@ extract_parameter_samples <- function(stan_fit, data, reported_dates,
 extract_stan_param <- function(fit, params = NULL,
                                CrIs = c(0.2, 0.5, 0.9), var_names = FALSE) {
   # generate symmetric CrIs
-  CrIs <- CrIs[order(CrIs)]
+  CrIs <- sort(CrIs)
   sym_CrIs <- c(0.5, 0.5 - CrIs / 2, 0.5 + CrIs / 2)
-  sym_CrIs <- sym_CrIs[order(sym_CrIs)]
+  sym_CrIs <- sort(sym_CrIs)
   CrIs <- round(100 * CrIs, 0)
   CrIs <- c(paste0("lower_", rev(CrIs)), "median", paste0("upper_", CrIs))
   args <- list(object = fit, probs = sym_CrIs)

R/get.R

@@ -17,7 +17,7 @@ get_regions <- function(results_dir) {
 
   # put into alphabetical order
   regions <- regions[!(regions %in% "runtimes.csv")]
-  regions <- regions[order(regions)]
+  regions <- sort(regions)
   names(regions) <- regions
   return(regions)
 }

R/plot.R

@@ -170,10 +170,8 @@ plot_estimates <- function(estimate, reported, ylab = "Cases", hline,
       )
       estimate <- estimate[, max := max_cases_to_plot]
     }
-    estimate <- estimate[, lapply(.SD, function(var) {
-      pmin(var, max)
-    }),
-    by = setdiff(colnames(estimate), sd_cols), .SDcols = sd_cols
+    estimate <- estimate[, lapply(.SD, pmin, max),
+      by = setdiff(colnames(estimate), sd_cols), .SDcols = sd_cols
     ]
   }
 

R/report.R

@@ -165,9 +165,7 @@ report_summary <- function(summarised_estimates,
 
   # extract latest R estimate
   R_latest <- summarised_estimates[variable == "R"][,
-    variable := NULL][,
-    purrr::map(.SD, ~ signif(., 2))
-  ]
+    variable := NULL][, purrr::map(.SD, signif, digits = 2)]
 
   # estimate probability of control
   prob_control <- rt_samples[,
@@ -183,8 +181,7 @@ report_summary <- function(summarised_estimates,
 
   # get individual estimates
   r_latest <- summarised_estimates[variable == "growth_rate"][,
-    variable := NULL][,
-    purrr::map(.SD, ~ signif(., 2))
+    variable := NULL][, purrr::map(.SD, signif, digits = 2)
   ]
 
   doubling_time <- function(r) {

R/simulate_infections.R

@@ -103,10 +103,8 @@ simulate_infections <- function(estimates,
                                 batch_size = 10,
                                 verbose = interactive()) {
   ## check batch size
-  if (!is.null(batch_size)) {
-    if (batch_size <= 1) {
-      stop("batch_size must be greater than 1")
-    }
+  if (!is.null(batch_size) && batch_size <= 1) {
+    stop("batch_size must be greater than 1")
   }
   ## extract samples from given stanfit object
   draws <- extract(estimates$fit,
@@ -128,10 +126,8 @@ simulate_infections <- function(estimates,
 
   # if R is given, update trajectories in stanfit object
   if (!is.null(R)) {
-    if (inherits(R, "data.frame")) {
-      if (is.null(R$sample)) {
-        R <- R$value
-      }
+    if (inherits(R, "data.frame") && is.null(R$sample)) {
+      R <- R$value
     }
     if (inherits(R, "data.frame")) {
       R <- as.data.table(R)
@@ -266,7 +262,7 @@ simulate_infections <- function(estimates,
   ## join batches
   out <- compact(out)
   out <- transpose(out)
-  out <- map(out, ~ data.table::rbindlist(.))
+  out <- map(out, rbindlist)
 
   ## format output
   format_out <- format_fit(

R/summarise.R

@@ -658,7 +658,7 @@ calc_CrI <- function(samples, summarise_by = NULL, CrI = 0.9) {
 #' # add 90% credible interval grouped by type
 #' calc_CrIs(samples, summarise_by = "type")
 calc_CrIs <- function(samples, summarise_by = NULL, CrIs = c(0.2, 0.5, 0.9)) {
-  CrIs <- CrIs[order(CrIs)]
+  CrIs <- sort(CrIs)
   with_CrIs <- purrr::map(CrIs, ~ calc_CrI(
     samples = samples,
     summarise_by = summarise_by,

R/utilities.R

@@ -210,9 +210,7 @@ match_output_arguments <- function(input_args = NULL,
   names(output_args) <- supported_args
 
   # get arguments supplied and linked to supported args
-  found_args <- lapply(input_args, function(arg) {
-    grep(arg, supported_args, value = TRUE)
-  })
+  found_args <- lapply(input_args, grep, x = supported_args, value = TRUE)
   found_args <- unlist(found_args)
   found_args <- unique(found_args)