style: fu

Author: dajmcdon

R/layer_residual_quantiles.R

@@ -126,10 +126,11 @@ slather.layer_residual_quantiles <-
 
     r <- r %>%
       summarize(dstn = quantile_pred(matrix(quantile(
-        c(.resid, s * .resid), probs = object$quantile_levels, na.rm = TRUE
+        c(.resid, s * .resid),
+        probs = object$quantile_levels, na.rm = TRUE
       ), nrow = 1), quantile_levels = object$quantile_levels))
     # Check for NA
-    if (anyNA(as.matrix(r$dstn)))  {
+    if (anyNA(as.matrix(r$dstn))) {
       cli_abort(c(
         "Residual quantiles could not be calculated due to missing residuals.",
         i = "This may be due to `n_train` < `ahead` in your {.cls epi_recipe}."

R/quantile_pred-methods.R

@@ -133,7 +133,7 @@ quantile_internal <- function(x, tau_out, middle) {
   # short circuit if we aren't actually extrapolating
   # matches to ~15 decimals
   if (all(tau_out %in% tau) && !anyNA(qvals)) {
-    return(qvals[ , match(tau_out, tau), drop = FALSE])
+    return(qvals[, match(tau_out, tau), drop = FALSE])
   }
   if (length(tau) < 2) {
     cli_abort(paste(
@@ -152,7 +152,9 @@ quantile_internal <- function(x, tau_out, middle) {
 extrapolate_quantiles_single <- function(qvals, tau, tau_out, middle) {
   qvals_out <- rep(NA, length(tau_out))
   good <- !is.na(qvals)
-  if (!any(good)) return(qvals_out)
+  if (!any(good)) {
+    return(qvals_out)
+  }
   qvals <- qvals[good]
   tau <- tau[good]
 
@@ -169,21 +171,22 @@ extrapolate_quantiles_single <- function(qvals, tau, tau_out, middle) {
 
   if (middle == "cubic") {
     method <- "cubic"
-    result <- tryCatch({
-      Q <- stats::splinefun(tau, qvals, method = "hyman")
-      quartiles <- Q(c(.25, .5, .75))
-    },
-    error = function(e) {
-      return(NA)
-    })
+    result <- tryCatch(
+      {
+        Q <- stats::splinefun(tau, qvals, method = "hyman")
+        quartiles <- Q(c(.25, .5, .75))
+      },
+      error = function(e) {
+        return(NA)
+      }
+    )
   }
   if (middle == "linear" || any(is.na(result))) {
     method <- "linear"
     quartiles <- stats::approx(tau, qvals, c(.25, .5, .75))$y
   }
   if (any(indm)) {
-    qvals_out[indm] <- switch(
-      method,
+    qvals_out[indm] <- switch(method,
       linear = stats::approx(tau, qvals, tau_out[indm])$y,
       cubic = Q(tau_out[indm])
     )

tests/testthat/test-pivot_quantiles.R

@@ -40,14 +40,13 @@ test_that("quantile pivotting longer behaves", {
   expect_length(pivot_quantiles_longer(tib, d1), 4L)
   expect_identical(nrow(pivot_quantiles_longer(tib, d1)), 6L)
   expect_identical(pivot_quantiles_longer(tib, d1)$d1_value, c(1:3, 2:4))
-
 })
 
 test_that("nested_quantiles is deprecated, but works where possible", {
   expect_snapshot(d <- dist_quantiles(list(1:4, 2:5), 1:4 / 5))
   expect_snapshot(o <- nested_quantiles(d))
   res <- as_tibble(hardhat::quantile_pred(
-    matrix(c(1:4, 2:5), nrow = 2, byrow = TRUE), 1:4 / 5)
-  )
+    matrix(c(1:4, 2:5), nrow = 2, byrow = TRUE), 1:4 / 5
+  ))
   expect_identical(o |> mutate(.row = dplyr::row_number()) |> unnest(data), res)
 })

tests/testthat/test-quantile_pred.R

@@ -78,7 +78,6 @@ test_that("unary math works on quantiles", {
     1:4 / 5
   )
   expect_identical(log(dstn), dstn2)
-
 })
 
 test_that("arithmetic works on quantiles", {

tests/testthat/test-step_adjust_latency.R

@@ -243,7 +243,8 @@ test_that("epi_adjust_latency extends multiple aheads", {
   expect_error(
     expect_warning(
       fit3 <- fit(epi_wf, data = x),
-      class = "epipredict__prep.step_latency__very_large_latency"),
+      class = "epipredict__prep.step_latency__very_large_latency"
+    ),
     class = "simpleError"
   )
   # real date example

tests/testthat/test-wis-quantile_pred.R

@@ -51,7 +51,8 @@ test_that("wis dispatches and produces the correct values", {
   ))
   expect_true(is.na(
     weighted_interval_score(
-      quantile_pred(rbind(1:4), 1:4 / 5), 2.5, 1:9 / 10, na_handling = "fail"
+      quantile_pred(rbind(1:4), 1:4 / 5), 2.5, 1:9 / 10,
+      na_handling = "fail"
     )
   ))
 })