diff --git a/.Rbuildignore b/.Rbuildignore index f1a8c3636..510725267 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -19,4 +19,5 @@ ^DEVELOPMENT\.md$ ^doc$ ^Meta$ -^.lintr$ \ No newline at end of file +^.lintr$ +^.venv$ \ No newline at end of file diff --git a/DESCRIPTION b/DESCRIPTION index d0366f22b..fc75f091f 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,12 +2,13 @@ Package: epipredict Title: Basic epidemiology forecasting methods Version: 0.1.0 Authors@R: c( - person("Daniel", "McDonald", , "daniel@stat.ubc.ca", role = c("aut", "cre")), + person("Daniel J.", "McDonald", , "daniel@stat.ubc.ca", role = c("aut", "cre")), person("Ryan", "Tibshirani", , "ryantibs@cmu.edu", role = "aut"), + person("Dmitry", "Shemetov", email = "dshemeto@andrew.cmu.edu", role = "aut"), + person("David", "Weber", email = "davidweb@andrew.cmu.edu", role = "aut"), + person("CMU's Delphi Research Group", role = c("cph", "fnd")), person("Logan", "Brooks", role = "aut"), person("Rachel", "Lobay", role = "aut"), - person("Dmitry", "Shemetov", email = "dshemeto@andrew.cmu.edu", role = "ctb"), - person("David", "Weber", email = "davidweb@andrew.cmu.edu", role = "ctb"), person("Maggie", "Liu", role = "ctb"), person("Ken", "Mawer", role = "ctb"), person("Chloe", "You", role = "ctb"), @@ -23,7 +24,7 @@ URL: https://github.com/cmu-delphi/epipredict/, https://cmu-delphi.github.io/epipredict BugReports: https://github.com/cmu-delphi/epipredict/issues/ Depends: - epiprocess (>= 0.7.12), + epiprocess (>= 0.9.0), parsnip (>= 1.0.0), R (>= 3.5.0) Imports: @@ -34,10 +35,11 @@ Imports: generics, ggplot2, glue, - hardhat (>= 1.3.0), + hardhat (>= 1.4.0.9002), + lifecycle, magrittr, recipes (>= 1.0.4), - rlang (>= 1.0.0), + rlang (>= 1.1.0), stats, tibble, tidyr, @@ -68,7 +70,8 @@ VignetteBuilder: Remotes: cmu-delphi/epidatr, cmu-delphi/epiprocess, - dajmcdon/smoothqr + dajmcdon/smoothqr, + tidymodels/hardhat Config/testthat/edition: 3 Encoding: UTF-8 LazyData: true diff --git a/NAMESPACE b/NAMESPACE index c20b8c801..9ba791bec 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,8 +2,6 @@ S3method(Add_model,epi_workflow) S3method(Add_model,workflow) -S3method(Math,dist_quantiles) -S3method(Ops,dist_quantiles) S3method(Remove_model,epi_workflow) S3method(Remove_model,workflow) S3method(Update_model,epi_workflow) @@ -38,20 +36,14 @@ S3method(extract_frosting,default) S3method(extract_frosting,epi_workflow) S3method(extract_layers,frosting) S3method(extract_layers,workflow) -S3method(extrapolate_quantiles,dist_default) -S3method(extrapolate_quantiles,dist_quantiles) -S3method(extrapolate_quantiles,distribution) +S3method(extrapolate_quantiles,quantile_pred) S3method(fit,epi_workflow) S3method(flusight_hub_formatter,canned_epipred) S3method(flusight_hub_formatter,data.frame) S3method(forecast,epi_workflow) -S3method(format,dist_quantiles) -S3method(is.na,dist_quantiles) -S3method(is.na,distribution) S3method(key_colnames,epi_workflow) S3method(key_colnames,recipe) -S3method(mean,dist_quantiles) -S3method(median,dist_quantiles) +S3method(mean,quantile_pred) S3method(predict,epi_workflow) S3method(predict,flatline) S3method(prep,check_enough_train_data) @@ -93,7 +85,7 @@ S3method(print,step_lag_difference) S3method(print,step_naomit) S3method(print,step_population_scaling) S3method(print,step_training_window) -S3method(quantile,dist_quantiles) +S3method(quantile,quantile_pred) S3method(recipe,epi_df) S3method(recipes::recipe,formula) S3method(refresh_blueprint,default_epi_recipe_blueprint) @@ -112,19 +104,17 @@ S3method(slather,layer_residual_quantiles) S3method(slather,layer_threshold) S3method(slather,layer_unnest) S3method(snap,default) -S3method(snap,dist_default) -S3method(snap,dist_quantiles) -S3method(snap,distribution) +S3method(snap,quantile_pred) S3method(tidy,check_enough_train_data) S3method(tidy,frosting) S3method(tidy,layer) S3method(update,layer) -S3method(vec_ptype_abbr,dist_quantiles) -S3method(vec_ptype_full,dist_quantiles) +S3method(vec_arith,quantile_pred) +S3method(vec_arith.numeric,quantile_pred) +S3method(vec_arith.quantile_pred,numeric) +S3method(vec_math,quantile_pred) S3method(weighted_interval_score,default) -S3method(weighted_interval_score,dist_default) -S3method(weighted_interval_score,dist_quantiles) -S3method(weighted_interval_score,distribution) +S3method(weighted_interval_score,quantile_pred) export("%>%") export(Add_model) export(Remove_model) @@ -142,6 +132,7 @@ export(arx_class_epi_workflow) export(arx_classifier) export(arx_fcast_epi_workflow) export(arx_forecaster) +export(as_tibble) export(autoplot) export(bake) export(cdc_baseline_args_list) @@ -150,7 +141,6 @@ export(check_enough_train_data) export(clean_f_name) export(default_epi_recipe_blueprint) export(detect_layer) -export(dist_quantiles) export(epi_recipe) export(epi_workflow) export(extract_argument) @@ -181,10 +171,10 @@ export(layer_quantile_distn) export(layer_residual_quantiles) export(layer_threshold) export(layer_unnest) -export(nested_quantiles) export(pivot_quantiles_longer) export(pivot_quantiles_wider) export(prep) +export(quantile_pred) export(quantile_reg) export(rand_id) export(recipe) @@ -208,22 +198,18 @@ export(update_frosting) export(update_model) export(validate_layer) export(weighted_interval_score) -import(distributional) import(epiprocess) import(parsnip) import(recipes) -importFrom(checkmate,assert) -importFrom(checkmate,assert_character) importFrom(checkmate,assert_class) -importFrom(checkmate,assert_date) -importFrom(checkmate,assert_function) -importFrom(checkmate,assert_int) -importFrom(checkmate,assert_integer) -importFrom(checkmate,assert_integerish) -importFrom(checkmate,assert_logical) -importFrom(checkmate,assert_number) importFrom(checkmate,assert_numeric) -importFrom(checkmate,assert_scalar) +importFrom(checkmate,test_character) +importFrom(checkmate,test_date) +importFrom(checkmate,test_function) +importFrom(checkmate,test_integerish) +importFrom(checkmate,test_logical) +importFrom(checkmate,test_numeric) +importFrom(checkmate,test_scalar) importFrom(cli,cli_abort) importFrom(cli,cli_warn) importFrom(dplyr,across) @@ -256,6 +242,7 @@ importFrom(ggplot2,geom_line) importFrom(ggplot2,geom_linerange) importFrom(ggplot2,geom_point) importFrom(ggplot2,geom_ribbon) +importFrom(hardhat,quantile_pred) importFrom(hardhat,refresh_blueprint) importFrom(hardhat,run_mold) importFrom(magrittr,"%>%") @@ -271,6 +258,7 @@ importFrom(rlang,":=") importFrom(rlang,abort) importFrom(rlang,arg_match) importFrom(rlang,as_function) +importFrom(rlang,caller_arg) importFrom(rlang,caller_env) importFrom(rlang,enquo) importFrom(rlang,enquos) @@ -283,24 +271,15 @@ importFrom(rlang,is_true) importFrom(rlang,set_names) importFrom(rlang,sym) importFrom(stats,as.formula) -importFrom(stats,family) importFrom(stats,lm) -importFrom(stats,median) importFrom(stats,model.frame) importFrom(stats,poly) importFrom(stats,predict) -importFrom(stats,qnorm) importFrom(stats,quantile) importFrom(stats,residuals) importFrom(tibble,as_tibble) importFrom(tibble,tibble) importFrom(tidyr,crossing) -importFrom(vctrs,as_list_of) -importFrom(vctrs,field) -importFrom(vctrs,new_rcrd) -importFrom(vctrs,new_vctr) -importFrom(vctrs,vec_cast) -importFrom(vctrs,vec_data) -importFrom(vctrs,vec_ptype_abbr) -importFrom(vctrs,vec_ptype_full) -importFrom(vctrs,vec_recycle_common) +importFrom(vctrs,vec_arith) +importFrom(vctrs,vec_arith.numeric) +importFrom(vctrs,vec_math) diff --git a/NEWS.md b/NEWS.md index 15aa6de29..8edddae92 100644 --- a/NEWS.md +++ b/NEWS.md @@ -57,3 +57,7 @@ Pre-1.0.0 numbering scheme: 0.x will indicate releases, while 0.0.x will indicat - Add `step_epi_slide` to produce generic sliding computations over an `epi_df` - Add quantile random forests (via `{grf}`) as a parsnip engine - Replace `epi_keys()` with `epiprocess::key_colnames()`, #352 +- More descriptive error messages from `arg_is_*()`, #287 +- Fix bug where `fit()` drops the `epi_workflow` class (also error if + non-`epi_df` data is given to `epi_recipe()`), #363 +- Try to retain the `epi_df` class during baking to the extent possible, #376 diff --git a/R/autoplot.R b/R/autoplot.R index dab763fe0..1d4883684 100644 --- a/R/autoplot.R +++ b/R/autoplot.R @@ -131,7 +131,7 @@ autoplot.epi_workflow <- function( if (length(extra_keys) == 0L) extra_keys <- NULL edf <- as_epi_df(edf, as_of = object$fit$meta$as_of, - additional_metadata = list(other_keys = extra_keys) + other_keys = extra_keys %||% character() ) if (is.null(predictions)) { return(autoplot( @@ -248,7 +248,7 @@ plot_bands <- function( ntarget_dates <- dplyr::n_distinct(predictions$time_value) predictions <- predictions %>% - mutate(.pred_distn = dist_quantiles(quantile(.pred_distn, l), l)) %>% + mutate(.pred_distn = quantile_pred(quantile(.pred_distn, l), l)) %>% pivot_quantiles_wider(.pred_distn) qnames <- setdiff(names(predictions), innames) diff --git a/R/cdc_baseline_forecaster.R b/R/cdc_baseline_forecaster.R index 976255fb8..e5005fb03 100644 --- a/R/cdc_baseline_forecaster.R +++ b/R/cdc_baseline_forecaster.R @@ -29,11 +29,11 @@ #' mutate(deaths = pmax(death_rate / 1e5 * pop * 7, 0)) %>% #' select(-pop, -death_rate) %>% #' group_by(geo_value) %>% -#' epi_slide(~ sum(.$deaths), before = 6, new_col_name = "deaths") %>% +#' epi_slide(~ sum(.$deaths), .window_size = 7, .new_col_name = "deaths_7dsum") %>% #' ungroup() %>% #' filter(weekdays(time_value) == "Saturday") #' -#' cdc <- cdc_baseline_forecaster(weekly_deaths, "deaths") +#' cdc <- cdc_baseline_forecaster(weekly_deaths, "deaths_7dsum") #' preds <- pivot_quantiles_wider(cdc$predictions, .pred_distn) #' #' library(ggplot2) diff --git a/R/dist_quantiles.R b/R/dist_quantiles.R deleted file mode 100644 index dd97ec809..000000000 --- a/R/dist_quantiles.R +++ /dev/null @@ -1,295 +0,0 @@ -#' @importFrom vctrs field vec_cast new_rcrd -new_quantiles <- function(values = double(1), quantile_levels = double(1)) { - arg_is_probabilities(quantile_levels) - - vec_cast(values, double()) - vec_cast(quantile_levels, double()) - values <- unname(values) - if (length(values) == 0L) { - return(new_rcrd( - list( - values = rep(NA_real_, length(quantile_levels)), - quantile_levels = quantile_levels - ), - class = c("dist_quantiles", "dist_default") - )) - } - stopifnot(length(values) == length(quantile_levels)) - - stopifnot(!vctrs::vec_duplicate_any(quantile_levels)) - if (is.unsorted(quantile_levels)) { - o <- vctrs::vec_order(quantile_levels) - values <- values[o] - quantile_levels <- quantile_levels[o] - } - if (is.unsorted(values, na.rm = TRUE)) { - cli::cli_abort("`values[order(quantile_levels)]` produces unsorted quantiles.") - } - - new_rcrd(list(values = values, quantile_levels = quantile_levels), - class = c("dist_quantiles", "dist_default") - ) -} - - - -#' @importFrom vctrs vec_ptype_abbr vec_ptype_full -#' @export -vec_ptype_abbr.dist_quantiles <- function(x, ...) "dist_qntls" -#' @export -vec_ptype_full.dist_quantiles <- function(x, ...) "dist_quantiles" - -#' @export -format.dist_quantiles <- function(x, digits = 2, ...) { - m <- suppressWarnings(median(x)) - paste0("quantiles(", round(m, digits), ")[", vctrs::vec_size(x), "]") -} - - -#' A distribution parameterized by a set of quantiles -#' -#' @param values A vector (or list of vectors) of values. -#' @param quantile_levels A vector (or list of vectors) of probabilities -#' corresponding to `values`. -#' -#' When creating multiple sets of `values`/`quantile_levels` resulting in -#' different distributions, the sizes must match. See the examples below. -#' -#' @return A vector of class `"distribution"`. -#' -#' @export -#' -#' @examples -#' dist_quantiles(1:4, 1:4 / 5) -#' dist_quantiles(list(1:3, 1:4), list(1:3 / 4, 1:4 / 5)) -#' dstn <- dist_quantiles(list(1:4, 8:11), c(.2, .4, .6, .8)) -#' dstn -#' -#' quantile(dstn, p = c(.1, .25, .5, .9)) -#' median(dstn) -#' -#' # it's a bit annoying to inspect the data -#' distributional::parameters(dstn[1]) -#' nested_quantiles(dstn[1])[[1]] -#' -#' @importFrom vctrs as_list_of vec_recycle_common new_vctr -dist_quantiles <- function(values, quantile_levels) { - if (!is.list(quantile_levels)) { - assert_numeric(quantile_levels, lower = 0, upper = 1, any.missing = FALSE, min.len = 1L) - quantile_levels <- list(quantile_levels) - } - if (!is.list(values)) { - if (length(values) == 0L) values <- NA_real_ - values <- list(values) - } - - values <- as_list_of(values, .ptype = double()) - quantile_levels <- as_list_of(quantile_levels, .ptype = double()) - args <- vec_recycle_common(values = values, quantile_levels = quantile_levels) - - qntls <- as_list_of( - map2(args$values, args$quantile_levels, new_quantiles), - .ptype = new_quantiles(NA_real_, 0.5) - ) - new_vctr(qntls, class = "distribution") -} - -validate_dist_quantiles <- function(values, quantile_levels) { - map(quantile_levels, arg_is_probabilities) - common_length <- vctrs::vec_size_common( # aborts internally - values = values, - quantile_levels = quantile_levels - ) - length_diff <- vctrs::list_sizes(values) != vctrs::list_sizes(quantile_levels) - if (any(length_diff)) { - cli::cli_abort(c( - "`values` and `quantile_levels` must have common length.", - i = "Mismatches found at position(s): {.val {which(length_diff)}}." - )) - } - level_duplication <- map_lgl(quantile_levels, vctrs::vec_duplicate_any) - if (any(level_duplication)) { - cli::cli_abort(c( - "`quantile_levels` must not be duplicated.", - i = "Duplicates found at position(s): {.val {which(level_duplication)}}." - )) - } -} - - -is_dist_quantiles <- function(x) { - is_distribution(x) & all(stats::family(x) == "quantiles") -} - - - -#' @export -#' @importFrom stats median qnorm family -median.dist_quantiles <- function(x, na.rm = FALSE, ..., middle = c("cubic", "linear")) { - quantile_levels <- field(x, "quantile_levels") - values <- field(x, "values") - if (0.5 %in% quantile_levels) { - return(values[match(0.5, quantile_levels)]) - } - if (length(quantile_levels) < 2 || min(quantile_levels) > 0.5 || max(quantile_levels) < 0.5) { - return(NA) - } - if (length(quantile_levels) < 3 || min(quantile_levels) > .25 || max(quantile_levels) < .75) { - return(stats::approx(quantile_levels, values, xout = 0.5)$y) - } - quantile(x, 0.5, ..., middle = middle) -} - -# placeholder to avoid errors, but not ideal -#' @export -mean.dist_quantiles <- function(x, na.rm = FALSE, ..., middle = c("cubic", "linear")) { - median(x, ..., middle = middle) -} - -#' @export -#' @importFrom stats quantile -#' @import distributional -quantile.dist_quantiles <- function(x, p, ..., middle = c("cubic", "linear")) { - arg_is_probabilities(p) - p <- sort(p) - middle <- match.arg(middle) - quantile_extrapolate(x, p, middle) -} - - -quantile_extrapolate <- function(x, tau_out, middle) { - tau <- field(x, "quantile_levels") - qvals <- field(x, "values") - nas <- is.na(qvals) - qvals_out <- rep(NA, length(tau_out)) - qvals <- qvals[!nas] - tau <- tau[!nas] - - # short circuit if we aren't actually extrapolating - # matches to ~15 decimals - if (all(tau_out %in% tau)) { - return(qvals[match(tau_out, tau)]) - } - if (length(tau) < 2) { - cli::cli_abort( - "Quantile extrapolation is not possible with fewer than 2 quantiles." - ) - return(qvals_out) - } - - indl <- tau_out < min(tau) - indr <- tau_out > max(tau) - indm <- !indl & !indr - - 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) - } - ) - } - 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, - linear = stats::approx(tau, qvals, tau_out[indm])$y, - cubic = Q(tau_out[indm]) - ) - } - if (any(indl) || any(indr)) { - qv <- data.frame( - q = c(tau, tau_out[indm]), - v = c(qvals, qvals_out[indm]) - ) %>% - dplyr::distinct(q, .keep_all = TRUE) %>% - dplyr::arrange(q) - } - if (any(indl)) { - qvals_out[indl] <- tail_extrapolate(tau_out[indl], utils::head(qv, 2)) - } - if (any(indr)) { - qvals_out[indr] <- tail_extrapolate(tau_out[indr], utils::tail(qv, 2)) - } - qvals_out -} - -logit <- function(p) { - p <- pmax(pmin(p, 1), 0) - log(p) - log(1 - p) -} - -# extrapolates linearly on the logistic scale using -# the two points nearest the tail -tail_extrapolate <- function(tau_out, qv) { - if (nrow(qv) == 1L) { - return(rep(qv$v[1], length(tau_out))) - } - x <- logit(qv$q) - x0 <- logit(tau_out) - y <- qv$v - m <- diff(y) / diff(x) - m * (x0 - x[1]) + y[1] -} - - -#' @method Math dist_quantiles -#' @export -Math.dist_quantiles <- function(x, ...) { - quantile_levels <- field(x, "quantile_levels") - values <- field(x, "values") - values <- vctrs::vec_math(.Generic, values, ...) - new_quantiles(values = values, quantile_levels = quantile_levels) -} - -#' @method Ops dist_quantiles -#' @export -Ops.dist_quantiles <- function(e1, e2) { - is_quantiles <- c( - inherits(e1, "dist_quantiles"), - inherits(e2, "dist_quantiles") - ) - is_dist <- c(inherits(e1, "dist_default"), inherits(e2, "dist_default")) - tau1 <- tau2 <- NULL - if (is_quantiles[1]) { - q1 <- field(e1, "values") - tau1 <- field(e1, "quantile_levels") - } - if (is_quantiles[2]) { - q2 <- field(e2, "values") - tau2 <- field(e2, "quantile_levels") - } - tau <- union(tau1, tau2) - if (all(is_dist)) { - cli::cli_abort( - "You can't perform arithmetic between two distributions like this." - ) - } else { - if (is_quantiles[1]) { - q2 <- e2 - } else { - q1 <- e1 - } - } - q <- vctrs::vec_arith(.Generic, q1, q2) - new_quantiles(values = q, quantile_levels = tau) -} - -#' @method is.na distribution -#' @export -is.na.distribution <- function(x) { - sapply(vec_data(x), is.na) -} - -#' @method is.na dist_quantiles -#' @export -is.na.dist_quantiles <- function(x) { - q <- field(x, "values") - all(is.na(q)) -} diff --git a/R/epi_recipe.R b/R/epi_recipe.R index c3a18d3cb..3cb742350 100644 --- a/R/epi_recipe.R +++ b/R/epi_recipe.R @@ -1,7 +1,11 @@ #' @import recipes #' @export epi_recipe <- function(x, ...) { - deprecate_soft("This function is being deprecated. Use `recipe()` instead.") + lifecycle::deprecate_soft( + when = "0.2.0", + what = "epi_recipe()", + with = "recipe()" + ) UseMethod("epi_recipe") } @@ -280,7 +284,7 @@ bake.epi_recipe <- function(object, new_data, ..., composition = "epi_df") { new_data, as_of = meta$as_of, # avoid NULL if meta is from saved older epi_df: - additional_metadata = meta$additional_metadata %||% list() + other_keys = meta$other_keys %||% character(0L) ) } new_data diff --git a/R/epi_workflow.R b/R/epi_workflow.R index 369b96eb1..bbe798a6d 100644 --- a/R/epi_workflow.R +++ b/R/epi_workflow.R @@ -98,11 +98,14 @@ is_epi_workflow <- function(x) { fit.epi_workflow <- function(object, data, ..., control = workflows::control_workflow()) { object$fit$meta <- list( max_time_value = max(data$time_value), - as_of = attributes(data)$metadata$as_of + as_of = attr(data, "metadata")$as_of, + other_keys = attr(data, "metadata")$other_keys ) object$original_data <- data - NextMethod() + res <- NextMethod() + class(res) <- c("epi_workflow", class(res)) + res } #' Predict from an epi_workflow diff --git a/R/epipredict-package.R b/R/epipredict-package.R index 6460b65e4..ad0f95295 100644 --- a/R/epipredict-package.R +++ b/R/epipredict-package.R @@ -1,15 +1,17 @@ ## usethis namespace: start -#' @importFrom tibble as_tibble -#' @importFrom rlang := !! %||% as_function global_env set_names !!! -#' is_logical is_true inject enquo enquos expr sym arg_match -#' @importFrom stats poly predict lm residuals quantile -#' @importFrom dplyr arrange across all_of any_of bind_cols bind_rows group_by -#' summarize filter mutate select left_join rename ungroup full_join -#' relocate summarise everything -#' @importFrom cli cli_abort cli_warn -#' @importFrom checkmate assert assert_character assert_int assert_scalar -#' assert_logical assert_numeric assert_number assert_integer -#' assert_integerish assert_date assert_function assert_class #' @import epiprocess parsnip +#' @importFrom checkmate assert_class assert_numeric +#' @importFrom checkmate test_character test_date test_function +#' @importFrom checkmate test_integerish test_logical +#' @importFrom checkmate test_numeric test_scalar +#' @importFrom cli cli_abort cli_warn +#' @importFrom dplyr arrange across all_of any_of bind_cols bind_rows group_by +#' @importFrom dplyr full_join relocate summarise everything +#' @importFrom dplyr summarize filter mutate select left_join rename ungroup +#' @importFrom rlang := !! %||% as_function global_env set_names !!! caller_arg +#' @importFrom rlang is_logical is_true inject enquo enquos expr sym arg_match +#' @importFrom stats poly predict lm residuals quantile +#' @importFrom tibble as_tibble +na_chr <- NA_character_ ## usethis namespace: end NULL diff --git a/R/extrapolate_quantiles.R b/R/extrapolate_quantiles.R index 3362e339e..c7a9a3b6b 100644 --- a/R/extrapolate_quantiles.R +++ b/R/extrapolate_quantiles.R @@ -1,65 +1,53 @@ #' Summarize a distribution with a set of quantiles #' -#' @param x a `distribution` vector +#' This function takes a `quantile_pred` vector and returns the same +#' type of object, expanded to include +#' *additional* quantiles computed at `probs`. If you want behaviour more +#' similar to [stats::quantile()], then `quantile(x,...)` may be more +#' appropriate. +#' +#' @param x A vector of class `quantile_pred`. #' @param probs a vector of probabilities at which to calculate quantiles #' @param replace_na logical. If `x` contains `NA`'s, these are imputed if -#' possible (if `TRUE`) or retained (if `FALSE`). This only effects -#' elements of class `dist_quantiles`. +#' possible (if `TRUE`) or retained (if `FALSE`). #' @param ... additional arguments passed on to the `quantile` method #' -#' @return a `distribution` vector containing `dist_quantiles`. Any elements -#' of `x` which were originally `dist_quantiles` will now have a superset +#' @return a `quantile_pred` vector. Each element +#' of `x` will now have a superset #' of the original `quantile_values` (the union of those and `probs`). #' @export #' #' @examples -#' library(distributional) -#' dstn <- dist_normal(c(10, 2), c(5, 10)) -#' extrapolate_quantiles(dstn, probs = c(.25, 0.5, .75)) -#' -#' dstn <- dist_quantiles(list(1:4, 8:11), list(c(.2, .4, .6, .8))) -#' # because this distribution is already quantiles, any extra quantiles are -#' # appended -#' extrapolate_quantiles(dstn, probs = c(.25, 0.5, .75)) -#' -#' dstn <- c( -#' dist_normal(c(10, 2), c(5, 10)), -#' dist_quantiles(list(1:4, 8:11), list(c(.2, .4, .6, .8))) -#' ) -#' extrapolate_quantiles(dstn, probs = c(.25, 0.5, .75)) +#' dstn <- quantile_pred(rbind(1:4, 8:11), c(.2, .4, .6, .8)) +#' # extra quantiles are appended +#' as_tibble(extrapolate_quantiles(dstn, probs = c(.25, 0.5, .75))) extrapolate_quantiles <- function(x, probs, replace_na = TRUE, ...) { UseMethod("extrapolate_quantiles") } #' @export -#' @importFrom vctrs vec_data -extrapolate_quantiles.distribution <- function(x, probs, replace_na = TRUE, ...) { - rlang::check_dots_empty() +extrapolate_quantiles.quantile_pred <- function(x, probs, replace_na = TRUE, ...) { arg_is_lgl_scalar(replace_na) arg_is_probabilities(probs) if (is.unsorted(probs)) probs <- sort(probs) - dstn <- lapply(vec_data(x), extrapolate_quantiles, probs = probs, replace_na = replace_na) - new_vctr(dstn, vars = NULL, class = "distribution") -} + orig_probs <- x %@% "quantile_levels" + orig_values <- as.matrix(x) -#' @export -extrapolate_quantiles.dist_default <- function(x, probs, replace_na = TRUE, ...) { - values <- quantile(x, probs, ...) - new_quantiles(values = values, quantile_levels = probs) -} - -#' @export -extrapolate_quantiles.dist_quantiles <- function(x, probs, replace_na = TRUE, ...) { - orig_probs <- field(x, "quantile_levels") - orig_values <- field(x, "values") - new_probs <- c(orig_probs, probs) - dups <- duplicated(new_probs) if (!replace_na || !anyNA(orig_values)) { - new_values <- c(orig_values, quantile(x, probs, ...)) + all_values <- cbind(orig_values, quantile(x, probs, ...)) } else { - nas <- is.na(orig_values) - orig_values[nas] <- quantile(x, orig_probs[nas], ...) - new_values <- c(orig_values, quantile(x, probs, ...)) + newx <- quantile(x, orig_probs, ...) %>% + hardhat::quantile_pred(orig_probs) + all_values <- cbind(as.matrix(newx), quantile(newx, probs, ...)) } - new_quantiles(new_values[!dups], new_probs[!dups]) + all_probs <- c(orig_probs, probs) + dups <- duplicated(all_probs) + all_values <- all_values[, !dups, drop = FALSE] + all_probs <- all_probs[!dups] + o <- order(all_probs) + + hardhat::quantile_pred( + all_values[, o, drop = FALSE], + quantile_levels = all_probs[o] + ) } diff --git a/R/flusight_hub_formatter.R b/R/flusight_hub_formatter.R index c91f738ae..f8298c807 100644 --- a/R/flusight_hub_formatter.R +++ b/R/flusight_hub_formatter.R @@ -67,11 +67,11 @@ abbr_to_location <- function(abbr) { #' mutate(deaths = pmax(death_rate / 1e5 * pop * 7, 0)) %>% #' select(-pop, -death_rate) %>% #' group_by(geo_value) %>% -#' epi_slide(~ sum(.$deaths), before = 6, new_col_name = "deaths") %>% +#' epi_slide(~ sum(.$deaths), .window_size = 7, .new_col_name = "deaths_7dsum") %>% #' ungroup() %>% #' filter(weekdays(time_value) == "Saturday") #' -#' cdc <- cdc_baseline_forecaster(weekly_deaths, "deaths") +#' cdc <- cdc_baseline_forecaster(weekly_deaths, "deaths_7dsum") #' flusight_hub_formatter(cdc) #' flusight_hub_formatter(cdc, target = "wk inc covid deaths") #' flusight_hub_formatter(cdc, target = paste(horizon, "wk inc covid deaths")) @@ -105,12 +105,11 @@ flusight_hub_formatter.data.frame <- function( object <- object %>% # combine the predictions and the distribution - mutate(.pred_distn = nested_quantiles(.pred_distn)) %>% - tidyr::unnest(.pred_distn) %>% + pivot_quantiles_longer(.pred_distn) %>% # now we create the correct column names rename( - value = values, - output_type_id = quantile_levels, + value = .pred_distn_value, + output_type_id = .pred_distn_quantile_level, reference_date = forecast_date ) %>% # convert to fips codes, and add any constant cols passed in ... diff --git a/R/import-standalone-lifecycle.R b/R/import-standalone-lifecycle.R deleted file mode 100644 index a1be17134..000000000 --- a/R/import-standalone-lifecycle.R +++ /dev/null @@ -1,254 +0,0 @@ -# Standalone file: do not edit by hand -# Source: -# ---------------------------------------------------------------------- -# -# --- -# repo: r-lib/rlang -# file: standalone-lifecycle.R -# last-updated: 2023-02-23 -# license: https://unlicense.org -# imports: rlang (>= 1.0.0) -# --- -# -# This file serves as a reference for currently unexported rlang -# lifecycle functions. These functions require rlang in your `Imports` -# DESCRIPTION field but you don't need to import rlang in your -# namespace. -# -# ## Changelog -# -# 2023-02-23 -# -# - Updated the API and internals to match modern lifecycle tools. -# -# -# 2021-04-19 -# -# - Removed `lifecycle()` function. You can now use the following in -# your roxygen documentation to inline a badge: -# -# ``` -# `r lifecycle::badge()` -# ``` -# -# This is a build-time dependency on lifecycle so there is no need -# to add lifecycle to Imports just to use badges. See also -# `?usethis::use_lifecycle()` for importing or updating the badge -# images in your package. -# -# - Soft-namespaced private objects. -# -# nocov start - - -#' Signal deprecation -#' -#' @description -#' These functions provide two levels of verbosity for deprecation -#' warnings. -#' -#' * `deprecate_soft()` warns only if called directly: from the global -#' environment (so the user can change their script) or from the -#' package currently being tested (so the package developer can fix -#' the package). -#' -#' * `deprecate_warn()` warns unconditionally. -#' -#' * `deprecate_stop()` fails unconditionally. -#' -#' Both functions warn only once per session by default to avoid -#' overwhelming the user with repeated warnings. -#' -#' @param msg The deprecation message. -#' @param id The id of the deprecation. A warning is issued only once -#' for each `id`. Defaults to `msg`, but you should give a unique ID -#' when the message is built programmatically and depends on inputs. -#' @param user_env The environment in which the deprecated function -#' was called. The verbosity depends on whether the deprecated -#' feature was called directly, see [rlang::env_is_user_facing()] and the -#' documentation in the lifecycle package. -#' -#' @section Controlling verbosity: -#' -#' The verbosity of retirement warnings can be controlled with global -#' options. You'll generally want to set these options locally with -#' one of these helpers: -#' -#' * `with_lifecycle_silence()` disables all soft-deprecation and -#' deprecation warnings. -#' -#' * `with_lifecycle_warnings()` enforces warnings for both -#' soft-deprecated and deprecated functions. The warnings are -#' repeated rather than signalled once per session. -#' -#' * `with_lifecycle_errors()` enforces errors for both -#' soft-deprecated and deprecated functions. -#' -#' All the `with_` helpers have `scoped_` variants that are -#' particularly useful in testthat blocks. -#' -#' @noRd -NULL - -deprecate_soft <- function(msg, - id = msg, - user_env = rlang::caller_env(2)) { - .rlang_lifecycle_signal_stage(msg, "deprecated") - - id <- paste(id, collapse = "\n") - verbosity <- .rlang_lifecycle_verbosity() - - invisible(switch( - verbosity, - quiet = NULL, - warning = , - default = - if (rlang::env_is_user_facing(user_env)) { - always <- verbosity == "warning" - trace <- rlang::trace_back(bottom = caller_env()) - .rlang_lifecycle_deprecate_warn0( - msg, - id = id, - trace = trace, - always = always - ) - }, - error = deprecate_stop(msg) - )) -} - -deprecate_warn <- function(msg, - id = msg, - always = FALSE, - user_env = rlang::caller_env(2)) { - .rlang_lifecycle_signal_stage(msg, "deprecated") - - id <- paste(id, collapse = "\n") - verbosity <- .rlang_lifecycle_verbosity() - - invisible(switch( - verbosity, - quiet = NULL, - warning = , - default = { - direct <- rlang::env_is_user_facing(user_env) - always <- direct && (always || verbosity == "warning") - - trace <- tryCatch( - rlang::trace_back(bottom = rlang::caller_env()), - error = function(...) NULL - ) - - .rlang_lifecycle_deprecate_warn0( - msg, - id = id, - trace = trace, - always = always - ) - }, - error = deprecate_stop(msg), - )) -} - -.rlang_lifecycle_deprecate_warn0 <- function(msg, - id = msg, - trace = NULL, - always = FALSE, - call = rlang::caller_env()) { - if (always) { - freq <- "always" - } else { - freq <- "regularly" - } - - rlang::warn( - msg, - class = "lifecycle_warning_deprecated", - .frequency = freq, - .frequency_id = id - ) -} - -deprecate_stop <- function(msg) { - msg <- cli::format_error(msg) - .rlang_lifecycle_signal_stage(msg, "deprecated") - - stop(rlang::cnd( - c("defunctError", "error", "condition"), - old = NULL, - new = NULL, - package = NULL, - message = msg - )) -} - -.rlang_lifecycle_signal_stage <- function(msg, stage) { - rlang::signal(msg, "lifecycle_stage", stage = stage) -} - -expect_deprecated <- function(expr, regexp = NULL, ...) { - rlang::local_options(lifecycle_verbosity = "warning") - - if (!is.null(regexp) && rlang::is_na(regexp)) { - rlang::abort("`regexp` can't be `NA`.") - } - - testthat::expect_warning( - {{ expr }}, - regexp = regexp, - class = "lifecycle_warning_deprecated", - ... - ) -} - -local_lifecycle_silence <- function(frame = rlang::caller_env()) { - rlang::local_options( - .frame = frame, - lifecycle_verbosity = "quiet" - ) -} -with_lifecycle_silence <- function(expr) { - local_lifecycle_silence() - expr -} - -local_lifecycle_warnings <- function(frame = rlang::caller_env()) { - rlang::local_options( - .frame = frame, - lifecycle_verbosity = "warning" - ) -} -with_lifecycle_warnings <- function(expr) { - local_lifecycle_warnings() - expr -} - -local_lifecycle_errors <- function(frame = rlang::caller_env()) { - rlang::local_options( - .frame = frame, - lifecycle_verbosity = "error" - ) -} -with_lifecycle_errors <- function(expr) { - local_lifecycle_errors() - expr -} - -.rlang_lifecycle_verbosity <- function() { - opt <- getOption("lifecycle_verbosity", "default") - - if (!rlang::is_string(opt, c("quiet", "default", "warning", "error"))) { - options(lifecycle_verbosity = "default") - rlang::warn(glue::glue( - " - The `lifecycle_verbosity` option must be set to one of: - \"quiet\", \"default\", \"warning\", or \"error\". - Resetting to \"default\". - " - )) - } - - opt -} - -# nocov end diff --git a/R/key_colnames.R b/R/key_colnames.R index c69d1a628..b9ebde5dc 100644 --- a/R/key_colnames.R +++ b/R/key_colnames.R @@ -1,19 +1,20 @@ #' @export key_colnames.recipe <- function(x, ...) { - possible_keys <- c("geo_value", "time_value", "key") - keys <- x$var_info$variable[x$var_info$role %in% possible_keys] - keys[order(match(keys, possible_keys))] %||% character(0L) + geo_key <- x$var_info$variable[x$var_info$role %in% "geo_value"] + time_key <- x$var_info$variable[x$var_info$role %in% "time_value"] + keys <- x$var_info$variable[x$var_info$role %in% "key"] + c(geo_key, keys, time_key) %||% character(0L) } #' @export key_colnames.epi_workflow <- function(x, ...) { # safer to look at the mold than the preprocessor mold <- hardhat::extract_mold(x) - possible_keys <- c("geo_value", "time_value", "key") molded_names <- names(mold$extras$roles) - keys <- map(mold$extras$roles[molded_names %in% possible_keys], names) - keys <- unname(unlist(keys)) - keys[order(match(keys, possible_keys))] %||% character(0L) + geo_key <- names(mold$extras$roles[molded_names %in% "geo_value"]$geo_value) + time_key <- names(mold$extras$roles[molded_names %in% "time_value"]$time_value) + keys <- names(mold$extras$roles[molded_names %in% "key"]$key) + c(geo_key, keys, time_key) %||% character(0L) } kill_time_value <- function(v) { diff --git a/R/layer_add_forecast_date.R b/R/layer_add_forecast_date.R index 0c15998ac..c03124684 100644 --- a/R/layer_add_forecast_date.R +++ b/R/layer_add_forecast_date.R @@ -104,6 +104,7 @@ slather.layer_add_forecast_date <- function(object, components, workflow, workflows::extract_preprocessor(workflow)$template, "metadata" )$time_type if (expected_time_type == "week") expected_time_type <- "day" + if (expected_time_type == "integer") expected_time_type <- "year" validate_date( forecast_date, expected_time_type, call = rlang::expr(layer_add_forecast_date()) diff --git a/R/layer_add_target_date.R b/R/layer_add_target_date.R index eb2f76c6a..5ce720391 100644 --- a/R/layer_add_target_date.R +++ b/R/layer_add_target_date.R @@ -90,6 +90,7 @@ slather.layer_add_target_date <- function(object, components, workflow, workflows::extract_preprocessor(workflow)$template, "metadata" )$time_type if (expected_time_type == "week") expected_time_type <- "day" + if (expected_time_type == "integer") expected_time_type <- "year" if (!is.null(object$target_date)) { target_date <- object$target_date diff --git a/R/layer_cdc_flatline_quantiles.R b/R/layer_cdc_flatline_quantiles.R index 926198e11..1c60536fc 100644 --- a/R/layer_cdc_flatline_quantiles.R +++ b/R/layer_cdc_flatline_quantiles.R @@ -51,7 +51,7 @@ #' in an additional `` named `.pred_distn_all` containing 2-column #' [tibble::tibble()]'s. For each #' desired combination of `key`'s, the tibble will contain one row per ahead -#' with the associated [dist_quantiles()]. +#' with the associated [quantile_pred()]. #' @export #' #' @examples @@ -266,11 +266,10 @@ propagate_samples <- function( } } res <- res[aheads] + res_quantiles <- map(res, quantile, probs = quantile_levels) list(tibble( ahead = aheads, - .pred_distn = map_vec( - res, ~ dist_quantiles(quantile(.x, quantile_levels), quantile_levels) - ) + .pred_distn = quantile_pred(do.call(rbind, res_quantiles), quantile_levels) )) } diff --git a/R/layer_predictive_distn.R b/R/layer_predictive_distn.R index 6cbb58cfb..e6cf6ef52 100644 --- a/R/layer_predictive_distn.R +++ b/R/layer_predictive_distn.R @@ -45,6 +45,12 @@ layer_predictive_distn <- function(frosting, truncate = c(-Inf, Inf), name = ".pred_distn", id = rand_id("predictive_distn")) { + if (!requireNamespace("distributional", quietly = TRUE)) { + cli_abort(paste( + "You must install the {.pkg distributional} package for", + "this functionality." + )) + } rlang::check_dots_empty() arg_is_chr_scalar(name, id) dist_type <- match.arg(dist_type) diff --git a/R/layer_quantile_distn.R b/R/layer_quantile_distn.R index d1c3a9d24..7fa1942c4 100644 --- a/R/layer_quantile_distn.R +++ b/R/layer_quantile_distn.R @@ -79,15 +79,22 @@ layer_quantile_distn_new <- function(quantile_levels, truncate, name, id) { slather.layer_quantile_distn <- function(object, components, workflow, new_data, ...) { dstn <- components$predictions$.pred - if (!inherits(dstn, "distribution")) { + is_supported <- inherits(dstn, "distribution") || inherits(dstn, "quantile_pred") + if (!is_supported) { cli_abort(c( - "`layer_quantile_distn()` requires distributional predictions.", + "`layer_quantile_distn()` requires distributional or quantile predictions.", "These are of class {.cls {class(dstn)}}." )) } + if (inherits(dstn, "distribution") && !requireNamespace("distributional", quietly = TRUE)) { + cli_abort(paste( + "You must install the {.pkg distributional} package for", + "this functionality." + )) + } rlang::check_dots_empty() - dstn <- dist_quantiles( + dstn <- quantile_pred( quantile(dstn, object$quantile_levels), object$quantile_levels ) diff --git a/R/layer_residual_quantiles.R b/R/layer_residual_quantiles.R index 2e08494f2..69d49e4fa 100644 --- a/R/layer_residual_quantiles.R +++ b/R/layer_residual_quantiles.R @@ -123,15 +123,17 @@ slather.layer_residual_quantiles <- } } - r <- r %>% - summarize( - dstn = list(quantile( - c(.resid, s * .resid), - probs = object$quantile_levels, na.rm = TRUE - )) + r <- summarize( + r, + dstn = quantile_pred( + matrix(quantile( + c(.resid, s * .resid), probs = object$quantile_levels, na.rm = TRUE + ), nrow = 1), + quantile_levels = object$quantile_levels ) + ) # Check for NA - if (any(sapply(r$dstn, is.na))) { + if (any(is.na(as.matrix(r$dstn)))) { cli::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}." @@ -139,9 +141,7 @@ slather.layer_residual_quantiles <- } estimate <- components$predictions$.pred - res <- tibble( - .pred_distn = dist_quantiles(map2(estimate, r$dstn, "+"), object$quantile_levels) - ) + res <- tibble(.pred_distn = r$dstn + estimate) res <- check_pname(res, components$predictions, object) components$predictions <- mutate(components$predictions, !!!res) components diff --git a/R/layer_threshold_preds.R b/R/layer_threshold_preds.R index da397fb18..f29db3b93 100644 --- a/R/layer_threshold_preds.R +++ b/R/layer_threshold_preds.R @@ -72,26 +72,13 @@ snap.default <- function(x, lower, upper, ...) { pmin(pmax(x, lower), upper) } -#' @export -snap.distribution <- function(x, lower, upper, ...) { - rlang::check_dots_empty() - arg_is_scalar(lower, upper) - dstn <- lapply(vec_data(x), snap, lower = lower, upper = upper) - distributional:::wrap_dist(dstn) -} - -#' @export -snap.dist_default <- function(x, lower, upper, ...) { - rlang::check_dots_empty() - x -} #' @export -snap.dist_quantiles <- function(x, lower, upper, ...) { - values <- field(x, "values") - quantile_levels <- field(x, "quantile_levels") - values <- snap(values, lower, upper) - new_quantiles(values = values, quantile_levels = quantile_levels) +snap.quantile_pred <- function(x, lower, upper, ...) { + values <- as.matrix(x) + quantile_levels <- x %@% "quantile_levels" + values <- map(vctrs::vec_chop(values), ~ snap(.x, lower, upper)) + quantile_pred(do.call(rbind, values), quantile_levels = quantile_levels) } #' @export diff --git a/R/make_grf_quantiles.R b/R/make_grf_quantiles.R index 253ea1ac7..da3383566 100644 --- a/R/make_grf_quantiles.R +++ b/R/make_grf_quantiles.R @@ -163,12 +163,12 @@ make_grf_quantiles <- function() { ) ) - # turn the predictions into a tibble with a dist_quantiles column + # turn the predictions into a tibble with a quantile_pred column process_qrf_preds <- function(x, object) { quantile_levels <- parsnip::extract_fit_engine(object)$quantiles.orig x <- x$predictions out <- lapply(vctrs::vec_chop(x), function(x) sort(drop(x))) - out <- dist_quantiles(out, list(quantile_levels)) + out <- hardhat::quantile_pred(do.call(rbind, out), quantile_levels) return(dplyr::tibble(.pred = out)) } diff --git a/R/make_quantile_reg.R b/R/make_quantile_reg.R index 2157aa470..305a81941 100644 --- a/R/make_quantile_reg.R +++ b/R/make_quantile_reg.R @@ -108,21 +108,13 @@ make_quantile_reg <- function() { process_rq_preds <- function(x, object) { object <- parsnip::extract_fit_engine(object) - type <- class(object)[1] - - # can't make a method because object is second - out <- switch(type, - rq = dist_quantiles(unname(as.list(x)), object$quantile_levels), # one quantile - rqs = { - x <- lapply(vctrs::vec_chop(x), function(x) sort(drop(x))) - dist_quantiles(x, list(object$tau)) - }, - cli_abort(c( - "Prediction is not implemented for this `rq` type.", - i = "See {.fun quantreg::rq}." - )) - ) - return(dplyr::tibble(.pred = out)) + if (!is.matrix(x)) { + x <- as.matrix(x) + } + rownames(x) <- NULL + n_pred_quantiles <- ncol(x) + quantile_levels <- object$tau + tibble(.pred = hardhat::quantile_pred(x, quantile_levels)) } parsnip::set_pred( diff --git a/R/make_smooth_quantile_reg.R b/R/make_smooth_quantile_reg.R index 448ee0fa5..72294140a 100644 --- a/R/make_smooth_quantile_reg.R +++ b/R/make_smooth_quantile_reg.R @@ -48,13 +48,12 @@ #' ) #' pl <- pl %>% #' unnest(.pred) %>% -#' mutate(distn = nested_quantiles(distn)) %>% -#' unnest(distn) %>% +#' pivot_quantiles_longer(distn) %>% #' mutate( #' x = x[length(x) - 20] + ahead / 100 * 2 * pi, #' ahead = NULL #' ) %>% -#' pivot_wider(names_from = quantile_levels, values_from = values) +#' pivot_wider(names_from = distn_quantile_level, values_from = distn_value) #' plot(x, y, pch = 16, xlim = c(pi, 2 * pi), col = "lightgrey") #' curve(sin(x), add = TRUE) #' abline(v = fd, lty = 2) @@ -178,7 +177,7 @@ make_smooth_quantile_reg <- function() { x <- lapply(unname(split( p, seq(nrow(p)) )), function(q) unname(sort(q, na.last = TRUE))) - dist_quantiles(x, list(object$tau)) + quantile_pred(do.call(rbind, x), object$tau) }) n_preds <- length(list_of_pred_distns[[1]]) nout <- length(list_of_pred_distns) diff --git a/R/pivot_quantiles.R b/R/pivot_quantiles.R index c8601b4f6..68358134e 100644 --- a/R/pivot_quantiles.R +++ b/R/pivot_quantiles.R @@ -1,164 +1,96 @@ -#' Turn a vector of quantile distributions into a list-col +#' Pivot a column containing `quantile_pred` longer #' -#' @param x a `distribution` containing `dist_quantiles` -#' -#' @return a list-col -#' @export -#' -#' @examples -#' library(dplyr) -#' library(tidyr) -#' edf <- case_death_rate_subset[1:3, ] -#' edf$q <- dist_quantiles(list(1:5, 2:4, 3:10), list(1:5 / 6, 2:4 / 5, 3:10 / 11)) -#' -#' edf_nested <- edf %>% mutate(q = nested_quantiles(q)) -#' edf_nested %>% unnest(q) -nested_quantiles <- function(x) { - stopifnot(is_dist_quantiles(x)) - distributional:::dist_apply(x, .f = function(z) { - as_tibble(vec_data(z)) %>% - mutate(across(everything(), as.double)) %>% - vctrs::list_of() - }) -} - - -#' Pivot columns containing `dist_quantile` longer -#' -#' Selected columns that contain `dist_quantiles` will be "lengthened" with +#' A column that contains `quantile_pred` will be "lengthened" with #' the quantile levels serving as 1 column and the values as another. If #' multiple columns are selected, these will be prefixed with the column name. #' #' @param .data A data frame, or a data frame extension such as a tibble or #' epi_df. -#' @param ... <[`tidy-select`][dplyr::dplyr_tidy_select]> One or more unquoted +#' @param ... <[`tidy-select`][dplyr::dplyr_tidy_select]> One unquoted #' expressions separated by commas. Variable names can be used as if they #' were positions in the data frame, so expressions like `x:y` can -#' be used to select a range of variables. -#' @param .ignore_length_check If multiple columns are selected, as long as -#' each row has contains the same number of quantiles, the result will be -#' reasonable. But if, for example, `var1[1]` has 5 quantiles while `var2[1]` -#' has 7, then the only option would be to recycle everything, creating a -#' _very_ long result. By default, this would throw an error. But if this is -#' really the goal, then the error can be bypassed by setting this argument -#' to `TRUE`. The quantiles in the first selected column will vary the fastest. +#' be used to select a range of variables. Note that only one variable +#' can be selected for this operation #' #' @return An object of the same class as `.data`. #' @export #' #' @examples -#' d1 <- c(dist_quantiles(1:3, 1:3 / 4), dist_quantiles(2:4, 1:3 / 4)) -#' d2 <- c(dist_quantiles(2:4, 2:4 / 5), dist_quantiles(3:5, 2:4 / 5)) +#' d1 <- quantile_pred(rbind(1:3, 2:4), 1:3 / 4) +#' d2 <- quantile_pred(rbind(2:4, 3:5), 2:4 / 5) #' tib <- tibble(g = c("a", "b"), d1 = d1, d2 = d2) #' #' pivot_quantiles_longer(tib, "d1") #' pivot_quantiles_longer(tib, dplyr::ends_with("1")) -#' pivot_quantiles_longer(tib, d1, d2) -pivot_quantiles_longer <- function(.data, ..., .ignore_length_check = FALSE) { - cols <- validate_pivot_quantiles(.data, ...) - .data <- .data %>% mutate(across(all_of(cols), nested_quantiles)) - if (length(cols) > 1L) { - lengths_check <- .data %>% - dplyr::transmute(across(all_of(cols), ~ map_int(.x, vctrs::vec_size))) %>% - as.matrix() %>% - apply(1, function(x) dplyr::n_distinct(x) == 1L) %>% - all() - if (lengths_check) { - .data <- tidyr::unnest(.data, all_of(cols), names_sep = "_") - } else { - if (.ignore_length_check) { - for (col in cols) { - .data <- .data %>% tidyr::unnest(all_of(col), names_sep = "_") - } - } else { - cli::cli_abort(c( - "Some selected columns contain different numbers of quantiles.", - "The result would be a {.emph very} long {.cls tibble}.", - "To do this anyway, rerun with `.ignore_length_check = TRUE`." - )) - } - } - } else { - .data <- .data %>% tidyr::unnest(all_of(cols)) - } - .data +#' pivot_quantiles_longer(tib, d2) +pivot_quantiles_longer <- function(.data, ...) { + col <- validate_pivot_quantiles(.data, ...) + .data$.row <- seq_len(vctrs::vec_size(.data)) + long_tib <- as_tibble(.data[[col]]) + .data <- select(.data, !all_of(col)) + names(long_tib)[1:2] <- c(glue::glue("{col}_value"), glue::glue("{col}_quantile_level")) + left_join(.data, long_tib, by = ".row") %>% + select(!.row) } -#' Pivot columns containing `dist_quantile` wider +#' Pivot a column containing `quantile_pred` wider #' -#' Any selected columns that contain `dist_quantiles` will be "widened" with +#' Any selected columns that contain `quantile_pred` will be "widened" with #' the "taus" (quantile) serving as names and the values in the data frame. #' When pivoting multiple columns, the original column name will be used as #' a prefix. #' #' @param .data A data frame, or a data frame extension such as a tibble or #' epi_df. -#' @param ... <[`tidy-select`][dplyr::dplyr_tidy_select]> One or more unquoted +#' @param ... <[`tidy-select`][dplyr::dplyr_tidy_select]> One unquoted #' expressions separated by commas. Variable names can be used as if they #' were positions in the data frame, so expressions like `x:y` can -#' be used to select a range of variables. +#' be used to select a range of variables. Note that only one variable +#' can be selected for this operation #' #' @return An object of the same class as `.data` #' @export #' #' @examples -#' d1 <- c(dist_quantiles(1:3, 1:3 / 4), dist_quantiles(2:4, 1:3 / 4)) -#' d2 <- c(dist_quantiles(2:4, 2:4 / 5), dist_quantiles(3:5, 2:4 / 5)) -#' tib <- tibble::tibble(g = c("a", "b"), d1 = d1, d2 = d2) +#' d1 <- quantile_pred(rbind(1:3, 2:4), 1:3 / 4) +#' d2 <- quantile_pred(rbind(2:4, 3:5), 2:4 / 5) +#' tib <- tibble(g = c("a", "b"), d1 = d1, d2 = d2) #' -#' pivot_quantiles_wider(tib, c("d1", "d2")) -#' pivot_quantiles_wider(tib, dplyr::starts_with("d")) +#' pivot_quantiles_wider(tib, "d1") +#' pivot_quantiles_wider(tib, dplyr::ends_with("2")) #' pivot_quantiles_wider(tib, d2) pivot_quantiles_wider <- function(.data, ...) { - cols <- validate_pivot_quantiles(.data, ...) - .data <- .data %>% mutate(across(all_of(cols), nested_quantiles)) - checks <- map_lgl(cols, ~ diff(range(vctrs::list_sizes(.data[[.x]]))) == 0L) - if (!all(checks)) { - nms <- cols[!checks] - cli::cli_abort(c( - "Quantiles must be the same length and have the same set of taus.", - i = "Check failed for variables(s) {.var {nms}}." - )) - } - - # tidyr::pivot_wider can crash if there are duplicates, this generally won't - # happen in our context. To avoid, silently add an index column and remove it - # later - .hidden_index <- seq_len(nrow(.data)) - .data <- tibble::add_column(.data, .hidden_index = .hidden_index) - if (length(cols) > 1L) { - for (col in cols) { - .data <- .data %>% - tidyr::unnest(all_of(col)) %>% - tidyr::pivot_wider( - names_from = "quantile_levels", values_from = "values", - names_prefix = paste0(col, "_") - ) - } - } else { - .data <- .data %>% - tidyr::unnest(all_of(cols)) %>% - tidyr::pivot_wider(names_from = "quantile_levels", values_from = "values") - } - select(.data, -.hidden_index) + col <- validate_pivot_quantiles(.data, ...) + .data$.row <- seq_len(vctrs::vec_size(.data)) + wide_tib <- as_tibble(.data[[col]]) %>% + tidyr::pivot_wider(names_from = .quantile_levels, values_from = .pred_quantile) + .data <- select(.data, !all_of(col)) + left_join(.data, wide_tib, by = ".row") %>% + select(!.row) } + pivot_quantiles <- function(.data, ...) { msg <- c( "{.fn pivot_quantiles} was deprecated in {.pkg epipredict} 0.0.6", i = "Please use {.fn pivot_quantiles_wider} instead." ) - deprecate_stop(msg) + lifecycle::deprecate_stop(msg) } -validate_pivot_quantiles <- function(.data, ...) { +validate_pivot_quantiles <- function(.data, ..., call = caller_env()) { expr <- rlang::expr(c(...)) cols <- names(tidyselect::eval_select(expr, .data)) - dqs <- map_lgl(cols, ~ is_dist_quantiles(.data[[.x]])) - if (!all(dqs)) { - nms <- cols[!dqs] - cli::cli_abort( - "Variables(s) {.var {nms}} are not `dist_quantiles`. Cannot pivot them." + if (length(cols) > 1L) { + cli_abort( + "Only one column can be pivotted. Can not pivot all of: {.var {cols}}.", + call = call + ) + } + if (!inherits(.data[[cols]], "quantile_pred")) { + cli_abort( + "{.var {cols}} is not {.cls `quantile_pred`}. Cannot pivot it.", + call = call ) } cols diff --git a/R/quantile_pred-methods.R b/R/quantile_pred-methods.R new file mode 100644 index 000000000..768bbd65e --- /dev/null +++ b/R/quantile_pred-methods.R @@ -0,0 +1,165 @@ +#' @importFrom hardhat quantile_pred +#' @export +hardhat::quantile_pred + + +# placeholder to avoid errors, but not ideal +#' @export +mean.quantile_pred <- function(x, na.rm = FALSE, ...) { + median(x, ...) +} + + +# quantiles by treating quantile_pred like a distribution ----------------- + + +#' @export +#' @importFrom stats quantile +quantile.quantile_pred <- function(x, p, na.rm = FALSE, ..., + middle = c("cubic", "linear")) { + arg_is_probabilities(p) + p <- sort(p) + middle <- rlang::arg_match(middle) + quantile_internal(x, p, middle) +} + + +quantile_internal <- function(x, tau_out, middle) { + tau <- x %@% "quantile_levels" + qvals <- as.matrix(x) + + # 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]) + } + if (length(tau) < 2) { + cli_abort(paste( + "Quantile extrapolation is not possible when fewer than 2 quantiles", + "are available." + )) + } + qvals_out <- map( + vctrs::vec_chop(qvals), + ~ extrapolate_quantiles_single(.x, tau, tau_out, middle) + ) + qvals_out <- do.call(rbind, qvals_out) # ensure a matrix of the proper dims + qvals_out +} + +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) + qvals <- qvals[good] + tau <- tau[good] + + # in case we only have one point, and it matches something we wanted + if (length(good) < 2) { + matched_one <- tau_out %in% tau + qvals_out[matched_one] <- qvals[matched_one] + return(qvals_out) + } + + indl <- tau_out < min(tau) + indr <- tau_out > max(tau) + indm <- !indl & !indr + + 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) + }) + } + 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, + linear = stats::approx(tau, qvals, tau_out[indm])$y, + cubic = Q(tau_out[indm]) + ) + } + if (any(indl) || any(indr)) { + qv <- data.frame( + q = c(tau, tau_out[indm]), + v = c(qvals, qvals_out[indm]) + ) %>% + dplyr::distinct(q, .keep_all = TRUE) %>% + dplyr::arrange(q) + } + if (any(indl)) { + qvals_out[indl] <- tail_extrapolate(tau_out[indl], utils::head(qv, 2)) + } + if (any(indr)) { + qvals_out[indr] <- tail_extrapolate(tau_out[indr], utils::tail(qv, 2)) + } + qvals_out +} + +logit <- function(p) { + p <- pmax(pmin(p, 1), 0) + log(p) - log(1 - p) +} + +# extrapolates linearly on the logistic scale using +# the two points nearest the tail +tail_extrapolate <- function(tau_out, qv) { + if (nrow(qv) == 1L) { + return(rep(qv$v[1], length(tau_out))) + } + x <- logit(qv$q) + x0 <- logit(tau_out) + y <- qv$v + m <- diff(y) / diff(x) + m * (x0 - x[1]) + y[1] +} + + +# mathematical operations on the values ----------------------------------- + + +#' @importFrom vctrs vec_math +#' @export +#' @method vec_math quantile_pred +vec_math.quantile_pred <- function(.fn, .x, ...) { + fn <- .fn + .fn <- getExportedValue("base", .fn) + if (fn %in% c("any", "all", "prod", "sum", "cumsum", "cummax", "cummin", "cumprod")) { + cli_abort("{.fn {fn}} is not a supported operation for {.cls quantile_pred}.") + } + quantile_levels <- .x %@% "quantile_levels" + .x <- as.matrix(.x) + quantile_pred(.fn(.x), quantile_levels) +} + +#' @importFrom vctrs vec_arith vec_arith.numeric +#' @export +#' @method vec_arith quantile_pred +vec_arith.quantile_pred <- function(op, x, y, ...) { + UseMethod("vec_arith.quantile_pred", y) +} + +#' @export +#' @method vec_arith.quantile_pred numeric +vec_arith.quantile_pred.numeric <- function(op, x, y, ...) { + op_fn <- getExportedValue("base", op) + l <- vctrs::vec_recycle_common(x = x, y = y) + out <- op_fn(as.matrix(l$x), l$y) + quantile_pred(out, x %@% "quantile_levels") +} + +#' @export +#' @method vec_arith.numeric quantile_pred +vec_arith.numeric.quantile_pred <- function(op, x, y, ...) { + op_fn <- getExportedValue("base", op) + l <- vctrs::vec_recycle_common(x = x, y = y) + out <- op_fn(l$x, as.matrix(l$y)) + quantile_pred(out, y %@% "quantile_levels") +} diff --git a/R/recipe.epi_df.R b/R/recipe.epi_df.R index 6cfcf3170..4187ec6af 100644 --- a/R/recipe.epi_df.R +++ b/R/recipe.epi_df.R @@ -74,7 +74,7 @@ recipe.formula <- function(formula, data, ...) { add_epi_df_roles_to_recipe <- function(r, epi_df) { edf_keys <- key_colnames(epi_df) - edf_roles <- c("geo_value", "time_value", rep("key", length(edf_keys) - 2)) + edf_roles <- c("geo_value", rep("key", length(edf_keys) - 2), "time_value") types <- unname(lapply(epi_df[, edf_keys], recipes::.get_data_types)) info <- tibble( variable = edf_keys, diff --git a/R/reexports-tidymodels.R b/R/reexports-tidymodels.R index 5b53914a8..2c87878ea 100644 --- a/R/reexports-tidymodels.R +++ b/R/reexports-tidymodels.R @@ -27,6 +27,11 @@ recipes::rand_id #' @export tibble::tibble +#' @importFrom tibble as_tibble +#' @export +tibble::as_tibble + + #' @importFrom generics tidy #' @export generics::tidy diff --git a/R/step_epi_slide.R b/R/step_epi_slide.R index 8afc84a48..9a0f284ee 100644 --- a/R/step_epi_slide.R +++ b/R/step_epi_slide.R @@ -19,13 +19,18 @@ #' argument must be named `.x`. A common, though very difficult to debug #' error is using something like `function(x) mean`. This will not work #' because it returns the function mean, rather than `mean(x)` -#' @param before,after the size of the sliding window on the left and the right -#' of the center. Usually non-negative integers for data indexed by date, but -#' more restrictive in other cases (see [epiprocess::epi_slide()] for details). -#' @param f_name a character string of at most 20 characters that describes -#' the function. This will be combined with `prefix` and the columns in `...` -#' to name the result using `{prefix}{f_name}_{column}`. By default it will be determined -#' automatically using `clean_f_name()`. +#' @param .window_size the size of the sliding window, required. Usually a +#' non-negative integer will suffice (e.g. for data indexed by date, but more +#' restrictive in other time_type cases (see [epiprocess::epi_slide()] for +#' details). For example, set to 7 for a 7-day window. +#' @param .align a character string indicating how the window should be aligned. +#' By default, this is "right", meaning the slide_window will be anchored with +#' its right end point on the reference date. (see [epiprocess::epi_slide()] +#' for details). +#' @param f_name a character string of at most 20 characters that describes the +#' function. This will be combined with `prefix` and the columns in `...` to +#' name the result using `{prefix}{f_name}_{column}`. By default it will be +#' determined automatically using `clean_f_name()`. #' #' @template step-return #' @@ -36,54 +41,56 @@ #' filter(time_value >= as.Date("2021-01-01"), geo_value %in% c("ca", "ny")) #' rec <- recipe(jhu) %>% #' step_epi_slide(case_rate, death_rate, -#' .f = function(x) mean(x, na.rm = TRUE), -#' before = 6L +#' .f = \(x) mean(x, na.rm = TRUE), +#' .window_size = 7L #' ) #' bake(prep(rec, jhu), new_data = NULL) -step_epi_slide <- - function(recipe, - ..., - .f, - before = 0L, - after = 0L, - role = "predictor", - prefix = "epi_slide_", - f_name = clean_f_name(.f), - skip = FALSE, - id = rand_id("epi_slide")) { - if (!is_epi_recipe(recipe)) { - cli_abort("This recipe step can only operate on an {.cls epi_recipe}.") - } - .f <- validate_slide_fun(.f) - epiprocess:::validate_slide_window_arg(before, attributes(recipe$template)$metadata$time_type) - epiprocess:::validate_slide_window_arg(after, attributes(recipe$template)$metadata$time_type) - arg_is_chr_scalar(role, prefix, id) - arg_is_lgl_scalar(skip) +step_epi_slide <- function(recipe, + ..., + .f, + .window_size = NULL, + .align = c("right", "center", "left"), + role = "predictor", + prefix = "epi_slide_", + f_name = clean_f_name(.f), + skip = FALSE, + id = rand_id("epi_slide")) { + if (!is_epi_recipe(recipe)) { + cli_abort("This recipe step can only operate on an {.cls epi_recipe}.") + } + .f <- validate_slide_fun(.f) + if (is.null(.window_size)) { + cli_abort("step_epi_slide: `.window_size` must be specified.") + } + epiprocess:::validate_slide_window_arg(.window_size, attributes(recipe$template)$metadata$time_type) + .align <- rlang::arg_match(.align) + arg_is_chr_scalar(role, prefix, id) + arg_is_lgl_scalar(skip) - recipes::add_step( - recipe, - step_epi_slide_new( - terms = enquos(...), - before = before, - after = after, - .f = .f, - f_name = f_name, - role = role, - trained = FALSE, - prefix = prefix, - keys = key_colnames(recipe), - columns = NULL, - skip = skip, - id = id - ) + recipes::add_step( + recipe, + step_epi_slide_new( + terms = enquos(...), + .window_size = .window_size, + .align = .align, + .f = .f, + f_name = f_name, + role = role, + trained = FALSE, + prefix = prefix, + keys = key_colnames(recipe), + columns = NULL, + skip = skip, + id = id ) - } + ) +} step_epi_slide_new <- function(terms, - before, - after, + .window_size, + .align, .f, f_name, role, @@ -96,8 +103,8 @@ step_epi_slide_new <- recipes::step( subclass = "epi_slide", terms = terms, - before = before, - after = after, + .window_size = .window_size, + .align = .align, .f = .f, f_name = f_name, role = role, @@ -119,8 +126,8 @@ prep.step_epi_slide <- function(x, training, info = NULL, ...) { step_epi_slide_new( terms = x$terms, - before = x$before, - after = x$after, + .window_size = x$.window_size, + .align = x$.align, .f = x$.f, f_name = x$f_name, role = x$role, @@ -165,8 +172,8 @@ bake.step_epi_slide <- function(object, new_data, ...) { # } epi_slide_wrapper( new_data, - object$before, - object$after, + object$.window_size, + object$.align, object$columns, c(object$.f), object$f_name, @@ -190,7 +197,7 @@ bake.step_epi_slide <- function(object, new_data, ...) { #' @importFrom dplyr bind_cols group_by ungroup #' @importFrom epiprocess epi_slide #' @keywords internal -epi_slide_wrapper <- function(new_data, before, after, columns, fns, fn_names, group_keys, name_prefix) { +epi_slide_wrapper <- function(new_data, .window_size, .align, columns, fns, fn_names, group_keys, name_prefix) { cols_fns <- tidyr::crossing(col_name = columns, fn_name = fn_names, fn = fns) # Iterate over the rows of cols_fns. For each row number, we will output a # transformed column. The first result returns all the original columns along @@ -204,10 +211,10 @@ epi_slide_wrapper <- function(new_data, before, after, columns, fns, fn_names, g result <- new_data %>% group_by(across(all_of(group_keys))) %>% epi_slide( - before = before, - after = after, - new_col_name = result_name, - f = function(slice, geo_key, ref_time_value) { + .window_size = .window_size, + .align = .align, + .new_col_name = result_name, + .f = function(slice, geo_key, ref_time_value) { fn(slice[[col_name]]) } ) %>% diff --git a/R/utils-arg.R b/R/utils-arg.R index b4242eaf9..081d153fb 100644 --- a/R/utils-arg.R +++ b/R/utils-arg.R @@ -10,87 +10,184 @@ handle_arg_list <- function(..., .tests) { walk2(names, values, .tests) } -arg_is_scalar <- function(..., allow_null = FALSE, allow_na = FALSE) { +arg_is_scalar <- function(..., allow_null = FALSE, allow_na = FALSE, + call = caller_env()) { handle_arg_list(..., .tests = function(name, value) { - assert_scalar(value, null.ok = allow_null, na.ok = allow_na, .var.name = name) + ok <- test_scalar(value, null.ok = allow_null, na.ok = allow_na) + if (!ok) { + cli_abort("{.arg {name}} must be a scalar.", call = call) + } }) } -arg_is_lgl <- function(..., allow_null = FALSE, allow_na = FALSE, allow_empty = FALSE) { +arg_is_lgl <- function(..., allow_null = FALSE, allow_na = FALSE, + allow_empty = FALSE, call = caller_env()) { handle_arg_list(..., .tests = function(name, value) { - assert_logical(value, null.ok = allow_null, any.missing = allow_na, min.len = as.integer(!allow_empty), .var.name = name) + ok <- test_logical(value, + null.ok = allow_null, any.missing = allow_na, + min.len = as.integer(!allow_empty) + ) + if (!ok) { + cli_abort("{.arg {name}} must be of type {.cls logical}.", call = call) + } }) } -arg_is_lgl_scalar <- function(..., allow_null = FALSE, allow_na = FALSE) { +arg_is_lgl_scalar <- function(..., allow_null = FALSE, allow_na = FALSE, + call = caller_env()) { handle_arg_list(..., .tests = function(name, value) { - assert_logical(value, null.ok = allow_null, any.missing = allow_na, min.len = 1, max.len = 1, .var.name = name) + ok <- test_logical(value, + null.ok = allow_null, any.missing = allow_na, + min.len = 1, max.len = 1 + ) + if (!ok) { + cli_abort( + "{.arg {name}} must be a scalar of type {.cls logical}.", + call = call + ) + } }) } -arg_is_numeric <- function(..., allow_null = FALSE) { +arg_is_numeric <- function(..., allow_null = FALSE, call = caller_env()) { handle_arg_list(..., .tests = function(name, value) { - assert_numeric(value, null.ok = allow_null, any.missing = FALSE, .var.name = name) + ok <- test_numeric(value, null.ok = allow_null, any.missing = FALSE) + if (!ok) { + cli_abort("{.arg {name}} must be of type {.cls numeric}.", call = call) + } }) } -arg_is_pos <- function(..., allow_null = FALSE) { +arg_is_pos <- function(..., allow_null = FALSE, call = caller_env()) { handle_arg_list(..., .tests = function(name, value) { - assert_numeric(value, lower = 1, null.ok = allow_null, any.missing = FALSE, .var.name = name) + ok <- test_numeric( + value, + lower = .Machine$double.eps, + null.ok = allow_null, any.missing = FALSE + ) + if (!ok) { + len <- length(value) + cli_abort( + "{.arg {name}} must be {cli::qty(len)} {?a/} strictly positive number{?s}.", + call = call + ) + } }) } -arg_is_nonneg <- function(..., allow_null = FALSE) { +arg_is_nonneg <- function(..., allow_null = FALSE, call = caller_env()) { handle_arg_list(..., .tests = function(name, value) { - assert_numeric(value, lower = 0, null.ok = allow_null, any.missing = FALSE, .var.name = name) + ok <- test_numeric(value, lower = 0, null.ok = allow_null, any.missing = FALSE) + if (!ok) { + len <- length(value) + cli_abort( + "{.arg {name}} must be {cli::qty(len)} {?a/} non-negative number{?s}.", + call = call + ) + } }) } -arg_is_int <- function(..., allow_null = FALSE) { +arg_is_int <- function(..., allow_null = FALSE, call = caller_env()) { handle_arg_list(..., .tests = function(name, value) { - assert_integerish(value, null.ok = allow_null, .var.name = name) + ok <- test_integerish(value, null.ok = allow_null) + if (!ok) { + len <- length(value) + cli_abort( + "{.arg {name}} must be {cli::qty(len)} {?a/} integer{?s}.", + call = call + ) + } }) } -arg_is_pos_int <- function(..., allow_null = FALSE) { +arg_is_pos_int <- function(..., allow_null = FALSE, call = caller_env()) { handle_arg_list(..., .tests = function(name, value) { - assert_integerish(value, null.ok = allow_null, lower = 1, any.missing = FALSE, .var.name = name) + ok <- test_integerish(value, null.ok = allow_null, lower = 1, any.missing = FALSE) + if (!ok) { + len <- length(value) + cli_abort( + "{.arg {name}} must be {cli::qty(len)} {?a/} positive integer{?s}.", + call = call + ) + } }) } -arg_is_nonneg_int <- function(..., allow_null = FALSE) { +arg_is_nonneg_int <- function(..., allow_null = FALSE, call = caller_env()) { handle_arg_list(..., .tests = function(name, value) { - assert_integerish(value, null.ok = allow_null, lower = 0, any.missing = FALSE, .var.name = name) + ok <- test_integerish(value, null.ok = allow_null, lower = 0, any.missing = FALSE) + if (!ok) { + len <- length(value) + cli_abort( + "{.arg {name}} must be {cli::qty(len)} {?a/} non-negative integer{?s}.", + call = call + ) + } }) } -arg_is_date <- function(..., allow_null = FALSE) { +arg_is_date <- function(..., allow_null = FALSE, call = caller_env()) { handle_arg_list(..., .tests = function(name, value) { - assert_date(value, null.ok = allow_null, .var.name = name) + ok <- test_date(value, null.ok = allow_null) + if (!ok) { + len <- length(value) + cli_abort( + "{.arg {name}} must be {cli::qty(len)} {?a/} date{?s}.", + call = call + ) + } }) } -arg_is_probabilities <- function(..., allow_null = FALSE, allow_na = FALSE) { +arg_is_probabilities <- function(..., allow_null = FALSE, allow_na = FALSE, + call = caller_env()) { handle_arg_list(..., .tests = function(name, value) { - assert_numeric(value, lower = 0, upper = 1, null.ok = allow_null, any.missing = allow_na, .var.name = name) + ok <- test_numeric(value, + lower = 0, upper = 1, null.ok = allow_null, + any.missing = allow_na + ) + if (!ok) { + cli_abort("{.arg {name}} must lie in [0, 1].", call = call) + } }) } -arg_is_chr <- function(..., allow_null = FALSE, allow_na = FALSE, allow_empty = FALSE) { +arg_is_chr <- function(..., allow_null = FALSE, allow_na = FALSE, allow_empty = FALSE, + call = caller_env()) { handle_arg_list(..., .tests = function(name, value) { - assert_character(value, null.ok = allow_null, any.missing = allow_na, min.len = as.integer(!allow_empty), .var.name = name) + ok <- test_character(value, + null.ok = allow_null, any.missing = allow_na, + min.len = as.integer(!allow_empty) + ) + if (!ok) { + cli_abort("{.arg {name}} must be of type {.cls character}.", call = call) + } }) } -arg_is_chr_scalar <- function(..., allow_null = FALSE, allow_na = FALSE) { +arg_is_chr_scalar <- function(..., allow_null = FALSE, allow_na = FALSE, + call = caller_env()) { handle_arg_list(..., .tests = function(name, value) { - assert_character(value, null.ok = allow_null, any.missing = allow_na, min.len = 1, max.len = 1, .var.name = name) + ok <- test_character(value, + null.ok = allow_null, any.missing = allow_na, + len = 1L + ) + if (!ok) { + cli_abort( + "{.arg {name}} must be a scalar of type {.cls character}.", + call = call + ) + } }) } -arg_is_function <- function(..., allow_null = FALSE) { +arg_is_function <- function(..., allow_null = FALSE, call = caller_env()) { handle_arg_list(..., .tests = function(name, value) { - assert_function(value, null.ok = allow_null, .var.name = name) + ok <- test_function(value, null.ok = allow_null) + if (!ok) { + cli_abort("{.arg {name}} must be of type {.cls function}.", call = call) + } }) } diff --git a/R/utils-misc.R b/R/utils-misc.R index af064b37c..b4d1c28b7 100644 --- a/R/utils-misc.R +++ b/R/utils-misc.R @@ -33,15 +33,14 @@ check_pname <- function(res, preds, object, newname = NULL) { grab_forged_keys <- function(forged, workflow, new_data) { - keys <- c("geo_value", "time_value", "key") forged_roles <- names(forged$extras$roles) - extras <- dplyr::bind_cols(forged$extras$roles[forged_roles %in% keys]) + extras <- dplyr::bind_cols(forged$extras$roles[forged_roles %in% c("geo_value", "time_value", "key")]) # 1. these are the keys in the test data after prep/bake new_keys <- names(extras) # 2. these are the keys in the training data old_keys <- key_colnames(workflow) # 3. these are the keys in the test data as input - new_df_keys <- key_colnames(new_data, extra_keys = setdiff(new_keys, keys[1:2])) + new_df_keys <- key_colnames(new_data, extra_keys = setdiff(new_keys, c("geo_value", "time_value"))) if (!(setequal(old_keys, new_df_keys) && setequal(new_keys, new_df_keys))) { cli::cli_warn(c( "Not all epi keys that were present in the training data are available", @@ -49,12 +48,11 @@ grab_forged_keys <- function(forged, workflow, new_data) { )) } if (is_epi_df(new_data)) { - extras <- as_epi_df(extras) - attr(extras, "metadata") <- attr(new_data, "metadata") - } else if (all(keys[1:2] %in% new_keys)) { - l <- list() - if (length(new_keys) > 2) l <- list(other_keys = new_keys[-c(1:2)]) - extras <- as_epi_df(extras, additional_metadata = l) + meta <- attr(new_data, "metadata") + extras <- as_epi_df(extras, as_of = meta$as_of, other_keys = meta$other_keys %||% character()) + } else if (all(c("geo_value", "time_value") %in% new_keys)) { + if (length(new_keys) > 2) other_keys <- new_keys[!new_keys %in% c("geo_value", "time_value")] + extras <- as_epi_df(extras, other_keys = other_keys %||% character()) } extras } diff --git a/R/weighted_interval_score.R b/R/weighted_interval_score.R index cd67bbee9..ddeeced17 100644 --- a/R/weighted_interval_score.R +++ b/R/weighted_interval_score.R @@ -7,12 +7,21 @@ #' al. (2020)](https://arxiv.org/abs/2005.12881) for discussion in the context #' of COVID-19 forecasting. #' -#' @param x distribution. A vector of class distribution. Ideally, this vector -#' contains `dist_quantiles()`, though other distributions are supported when -#' `quantile_levels` is specified. See below. +#' @param x A vector of class `quantile_pred`. #' @param actual double. Actual value(s) #' @param quantile_levels probabilities. If specified, the score will be -#' computed at this set of levels. +#' computed at this set of levels. Otherwise, those present in `x` will be +#' used. +#' @param na_handling character. Determines missing values are handled. +#' For `"impute"`, missing values will be +#' calculated if possible using the available quantiles. For `"drop"`, +#' explicitly missing values are ignored in the calculation of the score, but +#' implicitly missing values are imputed if possible. +#' For `"propogate"`, the resulting score will be `NA` if any missing values +#' exist. Finally, if +#' `quantile_levels` is specified, `"fail"` will result in +#' the score being `NA` when any required quantile levels (implicit or explicit) +#' do not have corresponding values. #' @param ... not used #' #' @return a vector of nonnegative scores. @@ -20,24 +29,23 @@ #' @export #' @examples #' quantile_levels <- c(.2, .4, .6, .8) -#' predq_1 <- 1:4 # -#' predq_2 <- 8:11 -#' dstn <- dist_quantiles(list(predq_1, predq_2), quantile_levels) +#' predq1 <- 1:4 # +#' predq2 <- 8:11 +#' dstn <- quantile_pred(rbind(predq1, predq2), quantile_levels) #' actual <- c(3.3, 7.1) #' weighted_interval_score(dstn, actual) #' weighted_interval_score(dstn, actual, c(.25, .5, .75)) #' -#' library(distributional) -#' dstn <- dist_normal(c(.75, 2)) -#' weighted_interval_score(dstn, 1, c(.25, .5, .75)) -#' #' # Missing value behaviours -#' dstn <- dist_quantiles(c(1, 2, NA, 4), 1:4 / 5) +#' dstn <- quantile_pred(matrix(c(1, 2, NA, 4), nrow = 1), 1:4 / 5) #' weighted_interval_score(dstn, 2.5) #' weighted_interval_score(dstn, 2.5, 1:9 / 10) #' weighted_interval_score(dstn, 2.5, 1:9 / 10, na_handling = "drop") #' weighted_interval_score(dstn, 2.5, na_handling = "propagate") -#' weighted_interval_score(dist_quantiles(1:4, 1:4 / 5), 2.5, 1:9 / 10, +#' weighted_interval_score( +#' quantile_pred(matrix(1:4, nrow = 1), 1:4 / 5), +#' actual = 2.5, +#' quantile_levels = 1:9 / 10, #' na_handling = "fail" #' ) #' @@ -58,90 +66,56 @@ #' ) %>% #' mutate(wis = weighted_interval_score(.pred_distn, actual)) #' preds -weighted_interval_score <- function(x, actual, quantile_levels = NULL, ...) { +weighted_interval_score <- function( + x, + actual, + quantile_levels = NULL, + na_handling = c("impute", "drop", "propagate", "fail"), + ...) { UseMethod("weighted_interval_score") } #' @export -weighted_interval_score.default <- function(x, actual, - quantile_levels = NULL, ...) { - cli_abort(c( +weighted_interval_score.default <- function( + x, actual, + quantile_levels = NULL, + na_handling = c("impute", "drop", "propagate", "fail"), + ...) { + cli_abort(paste( "Weighted interval score can only be calculated if `x`", - "has class {.cls distribution}." + "has class {.cls quantile_pred}." )) } #' @export -weighted_interval_score.distribution <- function( - x, actual, - quantile_levels = NULL, ...) { - assert_numeric(actual, finite = TRUE) - l <- vctrs::vec_recycle_common(x = x, actual = actual) - map2_dbl( - .x = vctrs::vec_data(l$x), - .y = l$actual, - .f = weighted_interval_score, - quantile_levels = quantile_levels, - ... - ) -} - -#' @export -weighted_interval_score.dist_default <- function(x, actual, - quantile_levels = NULL, ...) { - rlang::check_dots_empty() - if (is.null(quantile_levels)) { - cli_warn(c( - "Weighted interval score isn't implemented for {.cls {class(x)}}", - "as we don't know what set of quantile levels to use.", - "Use a {.cls dist_quantiles} or pass `quantile_levels`.", - "The result for this element will be `NA`." - )) - return(NA) - } - x <- extrapolate_quantiles(x, probs = quantile_levels) - weighted_interval_score(x, actual, quantile_levels = NULL) -} - -#' @param na_handling character. Determines how `quantile_levels` without a -#' corresponding `value` are handled. For `"impute"`, missing values will be -#' calculated if possible using the available quantiles. For `"drop"`, -#' explicitly missing values are ignored in the calculation of the score, but -#' implicitly missing values are imputed if possible. -#' For `"propogate"`, the resulting score will be `NA` if any missing values -#' exist in the original `quantile_levels`. Finally, if -#' `quantile_levels` is specified, `"fail"` will result in -#' the score being `NA` when any required quantile levels (implicit or explicit) -#' are do not have corresponding values. -#' @describeIn weighted_interval_score Weighted interval score with -#' `dist_quantiles` allows for different `NA` behaviours. -#' @export -weighted_interval_score.dist_quantiles <- function( +weighted_interval_score.quantile_pred <- function( x, actual, quantile_levels = NULL, na_handling = c("impute", "drop", "propagate", "fail"), ...) { rlang::check_dots_empty() - if (is.na(actual)) { - return(NA) - } - if (all(is.na(vctrs::field(x, "values")))) { - return(NA) - } + n <- vctrs::vec_size(x) + if (length(actual) == 1L) actual <- rep(actual, n) + assert_numeric(actual, finite = TRUE, len = n) + assert_numeric(quantile_levels, lower = 0, upper = 1, null.ok = TRUE) na_handling <- rlang::arg_match(na_handling) - old_quantile_levels <- field(x, "quantile_levels") + old_quantile_levels <- x %@% "quantile_levels" if (na_handling == "fail") { if (is.null(quantile_levels)) { cli_abort('`na_handling = "fail"` requires `quantile_levels` to be specified.') } - old_values <- field(x, "values") - if (!all(quantile_levels %in% old_quantile_levels) || any(is.na(old_values))) { - return(NA) + if (!all(quantile_levels %in% old_quantile_levels)) { + return(rep(NA_real_, n)) } } tau <- quantile_levels %||% old_quantile_levels - x <- extrapolate_quantiles(x, probs = tau, replace_na = (na_handling == "impute")) - q <- field(x, "values")[field(x, "quantile_levels") %in% tau] + x <- extrapolate_quantiles(x, tau, replace_na = (na_handling == "impute")) + x <- as.matrix(x)[, attr(x, "quantile_levels") %in% tau, drop = FALSE] na_rm <- (na_handling == "drop") + map2_dbl(vctrs::vec_chop(x), actual, ~ wis_one_quantile(.x, tau, .y, na_rm)) +} + +wis_one_quantile <- function(q, tau, actual, na_rm) { 2 * mean(pmax(tau * (actual - q), (1 - tau) * (q - actual)), na.rm = na_rm) } + diff --git a/_pkgdown.yml b/_pkgdown.yml index b213cf986..60e55790a 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -76,6 +76,7 @@ reference: contents: - quantile_reg - smooth_quantile_reg + - grf_quantiles - title: Custom panel data forecasting workflows contents: - recipe.epi_df diff --git a/data-raw/grad_employ_subset.R b/data-raw/grad_employ_subset.R index ae063d22f..38719a02e 100644 --- a/data-raw/grad_employ_subset.R +++ b/data-raw/grad_employ_subset.R @@ -101,6 +101,6 @@ ncol(gemploy) grad_employ_subset <- gemploy %>% as_epi_df( as_of = "2022-07-19", - additional_metadata = list(other_keys = c("age_group", "edu_qual")) + other_keys = c("age_group", "edu_qual") ) usethis::use_data(grad_employ_subset, overwrite = TRUE) diff --git a/data/grad_employ_subset.rda b/data/grad_employ_subset.rda index 3d74741cb..9380b43b5 100644 Binary files a/data/grad_employ_subset.rda and b/data/grad_employ_subset.rda differ diff --git a/man/cdc_baseline_forecaster.Rd b/man/cdc_baseline_forecaster.Rd index 3d451b275..793afb780 100644 --- a/man/cdc_baseline_forecaster.Rd +++ b/man/cdc_baseline_forecaster.Rd @@ -44,11 +44,11 @@ weekly_deaths <- case_death_rate_subset \%>\% mutate(deaths = pmax(death_rate / 1e5 * pop * 7, 0)) \%>\% select(-pop, -death_rate) \%>\% group_by(geo_value) \%>\% - epi_slide(~ sum(.$deaths), before = 6, new_col_name = "deaths") \%>\% + epi_slide(~ sum(.$deaths), .window_size = 7, .new_col_name = "deaths_7dsum") \%>\% ungroup() \%>\% filter(weekdays(time_value) == "Saturday") -cdc <- cdc_baseline_forecaster(weekly_deaths, "deaths") +cdc <- cdc_baseline_forecaster(weekly_deaths, "deaths_7dsum") preds <- pivot_quantiles_wider(cdc$predictions, .pred_distn) library(ggplot2) diff --git a/man/dist_quantiles.Rd b/man/dist_quantiles.Rd deleted file mode 100644 index 1a3226e36..000000000 --- a/man/dist_quantiles.Rd +++ /dev/null @@ -1,37 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/dist_quantiles.R -\name{dist_quantiles} -\alias{dist_quantiles} -\title{A distribution parameterized by a set of quantiles} -\usage{ -dist_quantiles(values, quantile_levels) -} -\arguments{ -\item{values}{A vector (or list of vectors) of values.} - -\item{quantile_levels}{A vector (or list of vectors) of probabilities -corresponding to \code{values}. - -When creating multiple sets of \code{values}/\code{quantile_levels} resulting in -different distributions, the sizes must match. See the examples below.} -} -\value{ -A vector of class \code{"distribution"}. -} -\description{ -A distribution parameterized by a set of quantiles -} -\examples{ -dist_quantiles(1:4, 1:4 / 5) -dist_quantiles(list(1:3, 1:4), list(1:3 / 4, 1:4 / 5)) -dstn <- dist_quantiles(list(1:4, 8:11), c(.2, .4, .6, .8)) -dstn - -quantile(dstn, p = c(.1, .25, .5, .9)) -median(dstn) - -# it's a bit annoying to inspect the data -distributional::parameters(dstn[1]) -nested_quantiles(dstn[1])[[1]] - -} diff --git a/man/epi_slide_wrapper.Rd b/man/epi_slide_wrapper.Rd index 0c05b7650..d67db1c88 100644 --- a/man/epi_slide_wrapper.Rd +++ b/man/epi_slide_wrapper.Rd @@ -6,8 +6,8 @@ \usage{ epi_slide_wrapper( new_data, - before, - after, + .window_size, + .align, columns, fns, fn_names, diff --git a/man/extrapolate_quantiles.Rd b/man/extrapolate_quantiles.Rd index 4b1d1282c..bd460dbe9 100644 --- a/man/extrapolate_quantiles.Rd +++ b/man/extrapolate_quantiles.Rd @@ -7,37 +7,29 @@ extrapolate_quantiles(x, probs, replace_na = TRUE, ...) } \arguments{ -\item{x}{a \code{distribution} vector} +\item{x}{A vector of class \code{quantile_pred}.} \item{probs}{a vector of probabilities at which to calculate quantiles} \item{replace_na}{logical. If \code{x} contains \code{NA}'s, these are imputed if -possible (if \code{TRUE}) or retained (if \code{FALSE}). This only effects -elements of class \code{dist_quantiles}.} +possible (if \code{TRUE}) or retained (if \code{FALSE}).} \item{...}{additional arguments passed on to the \code{quantile} method} } \value{ -a \code{distribution} vector containing \code{dist_quantiles}. Any elements -of \code{x} which were originally \code{dist_quantiles} will now have a superset +a \code{quantile_pred} vector. Each element +of \code{x} will now have a superset of the original \code{quantile_values} (the union of those and \code{probs}). } \description{ -Summarize a distribution with a set of quantiles +This function takes a \code{quantile_pred} vector and returns the same +type of object, expanded to include +\emph{additional} quantiles computed at \code{probs}. If you want behaviour more +similar to \code{\link[stats:quantile]{stats::quantile()}}, then \code{quantile(x,...)} may be more +appropriate. } \examples{ -library(distributional) -dstn <- dist_normal(c(10, 2), c(5, 10)) -extrapolate_quantiles(dstn, probs = c(.25, 0.5, .75)) - -dstn <- dist_quantiles(list(1:4, 8:11), list(c(.2, .4, .6, .8))) -# because this distribution is already quantiles, any extra quantiles are -# appended -extrapolate_quantiles(dstn, probs = c(.25, 0.5, .75)) - -dstn <- c( - dist_normal(c(10, 2), c(5, 10)), - dist_quantiles(list(1:4, 8:11), list(c(.2, .4, .6, .8))) -) -extrapolate_quantiles(dstn, probs = c(.25, 0.5, .75)) +dstn <- quantile_pred(rbind(1:4, 8:11), c(.2, .4, .6, .8)) +# extra quantiles are appended +as_tibble(extrapolate_quantiles(dstn, probs = c(.25, 0.5, .75))) } diff --git a/man/flusight_hub_formatter.Rd b/man/flusight_hub_formatter.Rd index b43bc0ac2..b2be9b4fe 100644 --- a/man/flusight_hub_formatter.Rd +++ b/man/flusight_hub_formatter.Rd @@ -52,11 +52,11 @@ weekly_deaths <- case_death_rate_subset \%>\% mutate(deaths = pmax(death_rate / 1e5 * pop * 7, 0)) \%>\% select(-pop, -death_rate) \%>\% group_by(geo_value) \%>\% - epi_slide(~ sum(.$deaths), before = 6, new_col_name = "deaths") \%>\% + epi_slide(~ sum(.$deaths), .window_size = 7, .new_col_name = "deaths_7dsum") \%>\% ungroup() \%>\% filter(weekdays(time_value) == "Saturday") -cdc <- cdc_baseline_forecaster(weekly_deaths, "deaths") +cdc <- cdc_baseline_forecaster(weekly_deaths, "deaths_7dsum") flusight_hub_formatter(cdc) flusight_hub_formatter(cdc, target = "wk inc covid deaths") flusight_hub_formatter(cdc, target = paste(horizon, "wk inc covid deaths")) diff --git a/man/layer_cdc_flatline_quantiles.Rd b/man/layer_cdc_flatline_quantiles.Rd index ac3e1758b..dcd93ba91 100644 --- a/man/layer_cdc_flatline_quantiles.Rd +++ b/man/layer_cdc_flatline_quantiles.Rd @@ -62,7 +62,7 @@ an updated \code{frosting} postprocessor. Calling \code{\link[=predict]{predict( in an additional \verb{} named \code{.pred_distn_all} containing 2-column \code{\link[tibble:tibble]{tibble::tibble()}}'s. For each desired combination of \code{key}'s, the tibble will contain one row per ahead -with the associated \code{\link[=dist_quantiles]{dist_quantiles()}}. +with the associated \code{\link[=quantile_pred]{quantile_pred()}}. } \description{ This layer creates quantile forecasts by taking a sample from the diff --git a/man/nested_quantiles.Rd b/man/nested_quantiles.Rd deleted file mode 100644 index b34b718ca..000000000 --- a/man/nested_quantiles.Rd +++ /dev/null @@ -1,26 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/pivot_quantiles.R -\name{nested_quantiles} -\alias{nested_quantiles} -\title{Turn a vector of quantile distributions into a list-col} -\usage{ -nested_quantiles(x) -} -\arguments{ -\item{x}{a \code{distribution} containing \code{dist_quantiles}} -} -\value{ -a list-col -} -\description{ -Turn a vector of quantile distributions into a list-col -} -\examples{ -library(dplyr) -library(tidyr) -edf <- case_death_rate_subset[1:3, ] -edf$q <- dist_quantiles(list(1:5, 2:4, 3:10), list(1:5 / 6, 2:4 / 5, 3:10 / 11)) - -edf_nested <- edf \%>\% mutate(q = nested_quantiles(q)) -edf_nested \%>\% unnest(q) -} diff --git a/man/pivot_quantiles_longer.Rd b/man/pivot_quantiles_longer.Rd index 9879d5d07..d124defa4 100644 --- a/man/pivot_quantiles_longer.Rd +++ b/man/pivot_quantiles_longer.Rd @@ -2,41 +2,34 @@ % Please edit documentation in R/pivot_quantiles.R \name{pivot_quantiles_longer} \alias{pivot_quantiles_longer} -\title{Pivot columns containing \code{dist_quantile} longer} +\title{Pivot a column containing \code{quantile_pred} longer} \usage{ -pivot_quantiles_longer(.data, ..., .ignore_length_check = FALSE) +pivot_quantiles_longer(.data, ...) } \arguments{ \item{.data}{A data frame, or a data frame extension such as a tibble or epi_df.} -\item{...}{<\code{\link[dplyr:dplyr_tidy_select]{tidy-select}}> One or more unquoted +\item{...}{<\code{\link[dplyr:dplyr_tidy_select]{tidy-select}}> One unquoted expressions separated by commas. Variable names can be used as if they were positions in the data frame, so expressions like \code{x:y} can -be used to select a range of variables.} - -\item{.ignore_length_check}{If multiple columns are selected, as long as -each row has contains the same number of quantiles, the result will be -reasonable. But if, for example, \code{var1[1]} has 5 quantiles while \code{var2[1]} -has 7, then the only option would be to recycle everything, creating a -\emph{very} long result. By default, this would throw an error. But if this is -really the goal, then the error can be bypassed by setting this argument -to \code{TRUE}. The quantiles in the first selected column will vary the fastest.} +be used to select a range of variables. Note that only one variable +can be selected for this operation} } \value{ An object of the same class as \code{.data}. } \description{ -Selected columns that contain \code{dist_quantiles} will be "lengthened" with +A column that contains \code{quantile_pred} will be "lengthened" with the quantile levels serving as 1 column and the values as another. If multiple columns are selected, these will be prefixed with the column name. } \examples{ -d1 <- c(dist_quantiles(1:3, 1:3 / 4), dist_quantiles(2:4, 1:3 / 4)) -d2 <- c(dist_quantiles(2:4, 2:4 / 5), dist_quantiles(3:5, 2:4 / 5)) +d1 <- quantile_pred(rbind(1:3, 2:4), 1:3 / 4) +d2 <- quantile_pred(rbind(2:4, 3:5), 2:4 / 5) tib <- tibble(g = c("a", "b"), d1 = d1, d2 = d2) pivot_quantiles_longer(tib, "d1") pivot_quantiles_longer(tib, dplyr::ends_with("1")) -pivot_quantiles_longer(tib, d1, d2) +pivot_quantiles_longer(tib, d2) } diff --git a/man/pivot_quantiles_wider.Rd b/man/pivot_quantiles_wider.Rd index e477777ca..1ce683c91 100644 --- a/man/pivot_quantiles_wider.Rd +++ b/man/pivot_quantiles_wider.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/pivot_quantiles.R \name{pivot_quantiles_wider} \alias{pivot_quantiles_wider} -\title{Pivot columns containing \code{dist_quantile} wider} +\title{Pivot a column containing \code{quantile_pred} wider} \usage{ pivot_quantiles_wider(.data, ...) } @@ -10,26 +10,27 @@ pivot_quantiles_wider(.data, ...) \item{.data}{A data frame, or a data frame extension such as a tibble or epi_df.} -\item{...}{<\code{\link[dplyr:dplyr_tidy_select]{tidy-select}}> One or more unquoted +\item{...}{<\code{\link[dplyr:dplyr_tidy_select]{tidy-select}}> One unquoted expressions separated by commas. Variable names can be used as if they were positions in the data frame, so expressions like \code{x:y} can -be used to select a range of variables.} +be used to select a range of variables. Note that only one variable +can be selected for this operation} } \value{ An object of the same class as \code{.data} } \description{ -Any selected columns that contain \code{dist_quantiles} will be "widened" with +Any selected columns that contain \code{quantile_pred} will be "widened" with the "taus" (quantile) serving as names and the values in the data frame. When pivoting multiple columns, the original column name will be used as a prefix. } \examples{ -d1 <- c(dist_quantiles(1:3, 1:3 / 4), dist_quantiles(2:4, 1:3 / 4)) -d2 <- c(dist_quantiles(2:4, 2:4 / 5), dist_quantiles(3:5, 2:4 / 5)) -tib <- tibble::tibble(g = c("a", "b"), d1 = d1, d2 = d2) +d1 <- quantile_pred(rbind(1:3, 2:4), 1:3 / 4) +d2 <- quantile_pred(rbind(2:4, 3:5), 2:4 / 5) +tib <- tibble(g = c("a", "b"), d1 = d1, d2 = d2) -pivot_quantiles_wider(tib, c("d1", "d2")) -pivot_quantiles_wider(tib, dplyr::starts_with("d")) +pivot_quantiles_wider(tib, "d1") +pivot_quantiles_wider(tib, dplyr::ends_with("2")) pivot_quantiles_wider(tib, d2) } diff --git a/man/reexports.Rd b/man/reexports.Rd index 6006555b9..910ca9b5d 100644 --- a/man/reexports.Rd +++ b/man/reexports.Rd @@ -1,9 +1,11 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/autoplot.R, R/reexports-tidymodels.R +% Please edit documentation in R/autoplot.R, R/quantile_pred-methods.R, +% R/reexports-tidymodels.R \docType{import} \name{reexports} \alias{reexports} \alias{autoplot} +\alias{quantile_pred} \alias{fit} \alias{forecast} \alias{prep} @@ -11,6 +13,7 @@ \alias{recipe} \alias{rand_id} \alias{tibble} +\alias{as_tibble} \alias{tidy} \title{Objects exported from other packages} \keyword{internal} @@ -23,8 +26,10 @@ below to see their documentation. \item{ggplot2}{\code{\link[ggplot2]{autoplot}}} + \item{hardhat}{\code{\link[hardhat]{quantile_pred}}} + \item{recipes}{\code{\link[recipes]{bake}}, \code{\link[recipes]{prep}}, \code{\link[recipes]{rand_id}}, \code{\link[recipes]{recipe}}} - \item{tibble}{\code{\link[tibble]{tibble}}} + \item{tibble}{\code{\link[tibble]{as_tibble}}, \code{\link[tibble]{tibble}}} }} diff --git a/man/smooth_quantile_reg.Rd b/man/smooth_quantile_reg.Rd index c6b17dd86..7475b6f2c 100644 --- a/man/smooth_quantile_reg.Rd +++ b/man/smooth_quantile_reg.Rd @@ -62,13 +62,12 @@ pl <- predict( ) pl <- pl \%>\% unnest(.pred) \%>\% - mutate(distn = nested_quantiles(distn)) \%>\% - unnest(distn) \%>\% + pivot_quantiles_longer(distn) \%>\% mutate( x = x[length(x) - 20] + ahead / 100 * 2 * pi, ahead = NULL ) \%>\% - pivot_wider(names_from = quantile_levels, values_from = values) + pivot_wider(names_from = distn_quantile_level, values_from = distn_value) plot(x, y, pch = 16, xlim = c(pi, 2 * pi), col = "lightgrey") curve(sin(x), add = TRUE) abline(v = fd, lty = 2) diff --git a/man/step_epi_slide.Rd b/man/step_epi_slide.Rd index 141f279d9..b9cecaf30 100644 --- a/man/step_epi_slide.Rd +++ b/man/step_epi_slide.Rd @@ -8,8 +8,8 @@ step_epi_slide( recipe, ..., .f, - before = 0L, - after = 0L, + .window_size = NULL, + .align = c("right", "center", "left"), role = "predictor", prefix = "epi_slide_", f_name = clean_f_name(.f), @@ -41,19 +41,25 @@ argument must be named \code{.x}. A common, though very difficult to debug error is using something like \code{function(x) mean}. This will not work because it returns the function mean, rather than \code{mean(x)}} -\item{before, after}{the size of the sliding window on the left and the right -of the center. Usually non-negative integers for data indexed by date, but -more restrictive in other cases (see \code{\link[epiprocess:epi_slide]{epiprocess::epi_slide()}} for details).} +\item{.window_size}{the size of the sliding window, required. Usually a +non-negative integer will suffice (e.g. for data indexed by date, but more +restrictive in other time_type cases (see \code{\link[epiprocess:epi_slide]{epiprocess::epi_slide()}} for +details). For example, set to 7 for a 7-day window.} + +\item{.align}{a character string indicating how the window should be aligned. +By default, this is "right", meaning the slide_window will be anchored with +its right end point on the reference date. (see \code{\link[epiprocess:epi_slide]{epiprocess::epi_slide()}} +for details).} \item{role}{For model terms created by this step, what analysis role should they be assigned? \code{lag} is default a predictor while \code{ahead} is an outcome.} \item{prefix}{A character string that will be prefixed to the new column.} -\item{f_name}{a character string of at most 20 characters that describes -the function. This will be combined with \code{prefix} and the columns in \code{...} -to name the result using \verb{\{prefix\}\{f_name\}_\{column\}}. By default it will be determined -automatically using \code{clean_f_name()}.} +\item{f_name}{a character string of at most 20 characters that describes the +function. This will be combined with \code{prefix} and the columns in \code{...} to +name the result using \verb{\{prefix\}\{f_name\}_\{column\}}. By default it will be +determined automatically using \code{clean_f_name()}.} \item{skip}{A logical. Should the step be skipped when the recipe is baked by \code{\link[=bake]{bake()}}? While all operations are baked @@ -79,8 +85,8 @@ jhu <- case_death_rate_subset \%>\% filter(time_value >= as.Date("2021-01-01"), geo_value \%in\% c("ca", "ny")) rec <- recipe(jhu) \%>\% step_epi_slide(case_rate, death_rate, - .f = function(x) mean(x, na.rm = TRUE), - before = 6L + .f = \(x) mean(x, na.rm = TRUE), + .window_size = 7L ) bake(prep(rec, jhu), new_data = NULL) } diff --git a/man/weighted_interval_score.Rd b/man/weighted_interval_score.Rd index 4907e2724..22a616b70 100644 --- a/man/weighted_interval_score.Rd +++ b/man/weighted_interval_score.Rd @@ -2,12 +2,9 @@ % Please edit documentation in R/weighted_interval_score.R \name{weighted_interval_score} \alias{weighted_interval_score} -\alias{weighted_interval_score.dist_quantiles} \title{Compute weighted interval score} \usage{ -weighted_interval_score(x, actual, quantile_levels = NULL, ...) - -\method{weighted_interval_score}{dist_quantiles}( +weighted_interval_score( x, actual, quantile_levels = NULL, @@ -16,27 +13,26 @@ weighted_interval_score(x, actual, quantile_levels = NULL, ...) ) } \arguments{ -\item{x}{distribution. A vector of class distribution. Ideally, this vector -contains \code{dist_quantiles()}, though other distributions are supported when -\code{quantile_levels} is specified. See below.} +\item{x}{A vector of class \code{quantile_pred}.} \item{actual}{double. Actual value(s)} \item{quantile_levels}{probabilities. If specified, the score will be -computed at this set of levels.} - -\item{...}{not used} +computed at this set of levels. Otherwise, those present in \code{x} will be +used.} -\item{na_handling}{character. Determines how \code{quantile_levels} without a -corresponding \code{value} are handled. For \code{"impute"}, missing values will be +\item{na_handling}{character. Determines missing values are handled. +For \code{"impute"}, missing values will be calculated if possible using the available quantiles. For \code{"drop"}, explicitly missing values are ignored in the calculation of the score, but implicitly missing values are imputed if possible. For \code{"propogate"}, the resulting score will be \code{NA} if any missing values -exist in the original \code{quantile_levels}. Finally, if +exist. Finally, if \code{quantile_levels} is specified, \code{"fail"} will result in the score being \code{NA} when any required quantile levels (implicit or explicit) -are do not have corresponding values.} +do not have corresponding values.} + +\item{...}{not used} } \value{ a vector of nonnegative scores. @@ -48,32 +44,25 @@ approximation of the commonly-used continuous ranked probability score generalization of absolute error. For example, see \href{https://arxiv.org/abs/2005.12881}{Bracher et al. (2020)} for discussion in the context of COVID-19 forecasting. } -\section{Methods (by class)}{ -\itemize{ -\item \code{weighted_interval_score(dist_quantiles)}: Weighted interval score with -\code{dist_quantiles} allows for different \code{NA} behaviours. - -}} \examples{ quantile_levels <- c(.2, .4, .6, .8) -predq_1 <- 1:4 # -predq_2 <- 8:11 -dstn <- dist_quantiles(list(predq_1, predq_2), quantile_levels) +predq1 <- 1:4 # +predq2 <- 8:11 +dstn <- quantile_pred(rbind(predq1, predq2), quantile_levels) actual <- c(3.3, 7.1) weighted_interval_score(dstn, actual) weighted_interval_score(dstn, actual, c(.25, .5, .75)) -library(distributional) -dstn <- dist_normal(c(.75, 2)) -weighted_interval_score(dstn, 1, c(.25, .5, .75)) - # Missing value behaviours -dstn <- dist_quantiles(c(1, 2, NA, 4), 1:4 / 5) +dstn <- quantile_pred(matrix(c(1, 2, NA, 4), nrow = 1), 1:4 / 5) weighted_interval_score(dstn, 2.5) weighted_interval_score(dstn, 2.5, 1:9 / 10) weighted_interval_score(dstn, 2.5, 1:9 / 10, na_handling = "drop") weighted_interval_score(dstn, 2.5, na_handling = "propagate") -weighted_interval_score(dist_quantiles(1:4, 1:4 / 5), 2.5, 1:9 / 10, +weighted_interval_score( + quantile_pred(matrix(1:4, nrow = 1), 1:4 / 5), + actual = 2.5, + quantile_levels = 1:9 / 10, na_handling = "fail" ) diff --git a/tests/testthat/_snaps/arg_is_.md b/tests/testthat/_snaps/arg_is_.md new file mode 100644 index 000000000..905599fb6 --- /dev/null +++ b/tests/testthat/_snaps/arg_is_.md @@ -0,0 +1,384 @@ +# logical + + Code + arg_is_lgl(l, ll, n) + Condition + Error: + ! `n` must be of type . + +--- + + Code + arg_is_lgl(x) + Condition + Error: + ! `x` must be of type . + +--- + + Code + arg_is_lgl(l, ll, nn) + Condition + Error: + ! `nn` must be of type . + +# scalar + + Code + arg_is_scalar(x, y, n) + Condition + Error: + ! `n` must be a scalar. + +--- + + Code + arg_is_scalar(x, y, nn) + Condition + Error: + ! `nn` must be a scalar. + +--- + + Code + arg_is_scalar(v, nn) + Condition + Error: + ! `v` must be a scalar. + +--- + + Code + arg_is_scalar(v, nn, allow_na = TRUE) + Condition + Error: + ! `v` must be a scalar. + +--- + + Code + arg_is_scalar(v, n, allow_null = TRUE) + Condition + Error: + ! `v` must be a scalar. + +--- + + Code + arg_is_scalar(nnn, allow_na = TRUE) + Condition + Error: + ! `nnn` must be a scalar. + +# numeric + + Code + arg_is_numeric(a) + Condition + Error: + ! `a` must be of type . + +--- + + Code + arg_is_numeric(i, j, n) + Condition + Error: + ! `n` must be of type . + +--- + + Code + arg_is_numeric(i, nn) + Condition + Error: + ! `nn` must be of type . + +# positive + + Code + arg_is_pos(a) + Condition + Error: + ! `a` must be a strictly positive number. + +--- + + Code + arg_is_pos(i, k) + Condition + Error: + ! `k` must be strictly positive numbers. + +--- + + Code + arg_is_pos(i, j, n) + Condition + Error: + ! `n` must be strictly positive numbers. + +--- + + Code + arg_is_pos(i, nn) + Condition + Error: + ! `nn` must be a strictly positive number. + +--- + + Code + arg_is_pos(a = 0:10) + Condition + Error: + ! `0:10` must be strictly positive numbers. + +# nonneg + + Code + arg_is_nonneg(a) + Condition + Error: + ! `a` must be a non-negative number. + +--- + + Code + arg_is_nonneg(i, k) + Condition + Error: + ! `k` must be non-negative numbers. + +--- + + Code + arg_is_nonneg(i, j, n) + Condition + Error: + ! `n` must be non-negative numbers. + +--- + + Code + arg_is_nonneg(i, nn) + Condition + Error: + ! `nn` must be a non-negative number. + +# nonneg-int + + Code + arg_is_nonneg_int(a) + Condition + Error: + ! `a` must be a non-negative integer. + +--- + + Code + arg_is_nonneg_int(d) + Condition + Error: + ! `d` must be a non-negative integer. + +--- + + Code + arg_is_nonneg_int(i, k) + Condition + Error: + ! `k` must be non-negative integers. + +--- + + Code + arg_is_nonneg_int(i, j, n) + Condition + Error: + ! `n` must be non-negative integers. + +--- + + Code + arg_is_nonneg_int(i, nn) + Condition + Error: + ! `nn` must be a non-negative integer. + +# date + + Code + arg_is_date(d, dd, n) + Condition + Error: + ! `n` must be dates. + +--- + + Code + arg_is_date(d, dd, nn) + Condition + Error: + ! `nn` must be a date. + +--- + + Code + arg_is_date(a) + Condition + Error: + ! `a` must be a date. + +--- + + Code + arg_is_date(v) + Condition + Error: + ! `v` must be dates. + +--- + + Code + arg_is_date(ll) + Condition + Error: + ! `ll` must be dates. + +# probabilities + + Code + arg_is_probabilities(a) + Condition + Error: + ! `a` must lie in [0, 1]. + +--- + + Code + arg_is_probabilities(d) + Condition + Error: + ! `d` must lie in [0, 1]. + +--- + + Code + arg_is_probabilities(i, 1.1) + Condition + Error: + ! `1.1` must lie in [0, 1]. + +--- + + Code + arg_is_probabilities(c(0.4, 0.8), n) + Condition + Error: + ! `n` must lie in [0, 1]. + +--- + + Code + arg_is_probabilities(c(0.4, 0.8), nn) + Condition + Error: + ! `nn` must lie in [0, 1]. + +# chr + + Code + arg_is_chr(a, b, n) + Condition + Error: + ! `n` must be of type . + +--- + + Code + arg_is_chr(a, b, nn) + Condition + Error: + ! `nn` must be of type . + +--- + + Code + arg_is_chr(d) + Condition + Error: + ! `d` must be of type . + +--- + + Code + arg_is_chr(v) + Condition + Error: + ! `v` must be of type . + +--- + + Code + arg_is_chr(ll) + Condition + Error: + ! `ll` must be of type . + +--- + + Code + arg_is_chr(z) + Condition + Error: + ! `z` must be of type . + +# function + + Code + arg_is_function(c(a, b)) + Condition + Error: + ! `c(a, b)` must be of type . + +--- + + Code + arg_is_function(c(f, g)) + Condition + Error: + ! `c(f, g)` must be of type . + +--- + + Code + arg_is_function(f) + Condition + Error: + ! `f` must be of type . + +# coerce scalar to date + + Code + arg_to_date("12345") + Condition + Error in `arg_to_date()`: + ! `x` must be a date. + +--- + + Code + arg_to_date(c("12345", "12345")) + Condition + Error in `arg_to_date()`: + ! `x` must be a scalar. + +# simple surface step test + + Code + recipe(jhu_csse_daily_subset) %>% step_epi_lag(death_rate, lag = "hello") + Condition + Error in `step_epi_lag()`: + ! `lag` must be a non-negative integer. + diff --git a/tests/testthat/_snaps/arx_args_list.md b/tests/testthat/_snaps/arx_args_list.md new file mode 100644 index 000000000..959a5e25b --- /dev/null +++ b/tests/testthat/_snaps/arx_args_list.md @@ -0,0 +1,152 @@ +# arx_args checks inputs + + Code + arx_args_list(ahead = c(0, 4)) + Condition + Error in `arx_args_list()`: + ! `ahead` must be a scalar. + +--- + + Code + arx_args_list(n_training = c(28, 65)) + Condition + Error in `arx_args_list()`: + ! `n_training` must be a scalar. + +--- + + Code + arx_args_list(ahead = -1) + Condition + Error in `arx_args_list()`: + ! `ahead` must be a non-negative integer. + +--- + + Code + arx_args_list(ahead = 1.5) + Condition + Error in `arx_args_list()`: + ! `ahead` must be a non-negative integer. + +--- + + Code + arx_args_list(n_training = -1) + Condition + Error in `arx_args_list()`: + ! `n_training` must be a strictly positive number. + +--- + + Code + arx_args_list(n_training = 1.5) + Condition + Error in `arx_args_list()`: + ! `n_training` must be a positive integer. + +--- + + Code + arx_args_list(lags = c(-1, 0)) + Condition + Error in `arx_args_list()`: + ! `lags` must be non-negative integers. + +--- + + Code + arx_args_list(lags = list(c(1:5, 6.5), 2:8)) + Condition + Error in `arx_args_list()`: + ! `lags` must be non-negative integers. + +--- + + Code + arx_args_list(symmetrize = 4) + Condition + Error in `arx_args_list()`: + ! `symmetrize` must be of type . + +--- + + Code + arx_args_list(nonneg = 4) + Condition + Error in `arx_args_list()`: + ! `nonneg` must be of type . + +--- + + Code + arx_args_list(quantile_levels = -0.1) + Condition + Error in `arx_args_list()`: + ! `quantile_levels` must lie in [0, 1]. + +--- + + Code + arx_args_list(quantile_levels = 1.1) + Condition + Error in `arx_args_list()`: + ! `quantile_levels` must lie in [0, 1]. + +--- + + Code + arx_args_list(target_date = "2022-01-01") + Condition + Error in `arx_args_list()`: + ! `target_date` must be a date. + +--- + + Code + arx_args_list(n_training_min = "de") + Condition + Error in `arx_args_list()`: + ! `...` must be empty. + x Problematic argument: + * n_training_min = "de" + +--- + + Code + arx_args_list(epi_keys = 1) + Condition + Error in `arx_args_list()`: + ! `...` must be empty. + x Problematic argument: + * epi_keys = 1 + +# arx forecaster disambiguates quantiles + + Code + compare_quantile_args(alist, tlist) + Condition + Error in `compare_quantile_args()`: + ! You have specified different, non-default, quantiles in the trainier and `arx_args` options. + i Please only specify quantiles in one location. + +# arx_lags_validator handles named & unnamed lists as expected + + Code + arx_lags_validator(pred_vec, lags_finit_fn_switch2) + Condition + Error in `arx_lags_validator()`: + ! You have requested 2 predictor(s) but 3 different lags. + i Lags must be a vector or a list with length == number of predictors. + +--- + + Code + arx_lags_validator(pred_vec, lags_init_other_name) + Condition + Error in `arx_lags_validator()`: + ! If lags is a named list, then all predictors must be present. + i The predictors are `death_rate` and `case_rate`. + i So lags is missing `case_rate`'. + diff --git a/tests/testthat/_snaps/arx_cargs_list.md b/tests/testthat/_snaps/arx_cargs_list.md new file mode 100644 index 000000000..30ccb4d36 --- /dev/null +++ b/tests/testthat/_snaps/arx_cargs_list.md @@ -0,0 +1,92 @@ +# arx_class_args checks inputs + + Code + arx_class_args_list(ahead = c(0, 4)) + Condition + Error in `arx_class_args_list()`: + ! `ahead` must be a scalar. + +--- + + Code + arx_class_args_list(n_training = c(28, 65)) + Condition + Error in `arx_class_args_list()`: + ! `n_training` must be a scalar. + +--- + + Code + arx_class_args_list(ahead = -1) + Condition + Error in `arx_class_args_list()`: + ! `ahead` must be a non-negative integer. + +--- + + Code + arx_class_args_list(ahead = 1.5) + Condition + Error in `arx_class_args_list()`: + ! `ahead` must be a non-negative integer. + +--- + + Code + arx_class_args_list(n_training = -1) + Condition + Error in `arx_class_args_list()`: + ! `n_training` must be a strictly positive number. + +--- + + Code + arx_class_args_list(n_training = 1.5) + Condition + Error in `arx_class_args_list()`: + ! `n_training` must be a positive integer. + +--- + + Code + arx_class_args_list(lags = c(-1, 0)) + Condition + Error in `arx_class_args_list()`: + ! `lags` must be non-negative integers. + +--- + + Code + arx_class_args_list(lags = list(c(1:5, 6.5), 2:8)) + Condition + Error in `arx_class_args_list()`: + ! `lags` must be non-negative integers. + +--- + + Code + arx_class_args_list(target_date = "2022-01-01") + Condition + Error in `arx_class_args_list()`: + ! `target_date` must be a date. + +--- + + Code + arx_class_args_list(n_training_min = "de") + Condition + Error in `arx_class_args_list()`: + ! `...` must be empty. + x Problematic argument: + * n_training_min = "de" + +--- + + Code + arx_class_args_list(epi_keys = 1) + Condition + Error in `arx_class_args_list()`: + ! `...` must be empty. + x Problematic argument: + * epi_keys = 1 + diff --git a/tests/testthat/_snaps/bake-method.md b/tests/testthat/_snaps/bake-method.md new file mode 100644 index 000000000..6ed38ab5d --- /dev/null +++ b/tests/testthat/_snaps/bake-method.md @@ -0,0 +1,9 @@ +# bake method works in all cases + + Code + bake(prep(r, edf), NULL, composition = "matrix") + Condition + Error in `hardhat::recompose()`: + ! `data` must only contain numeric columns. + i These columns aren't numeric: "time_value" and "geo_value". + diff --git a/tests/testthat/_snaps/check-training-set.md b/tests/testthat/_snaps/check-training-set.md new file mode 100644 index 000000000..e5eec7e7c --- /dev/null +++ b/tests/testthat/_snaps/check-training-set.md @@ -0,0 +1,20 @@ +# training set validation works + + Code + validate_meta_match(t1, template, "geo_type", "abort") + Condition + Error in `validate_meta_match()`: + ! The `geo_type` of the training data appears to be different from that + used to construct the recipe. This may result in unexpected consequences. + i Training `geo_type` is 'county'. + i Originally, it was 'state'. + +--- + + Code + epi_check_training_set(t4, rec) + Condition + Error in `epi_check_training_set()`: + ! The recipe specifies keys which are not in the training data. + i The training set is missing columns for missing_col. + diff --git a/tests/testthat/_snaps/check_enough_train_data.md b/tests/testthat/_snaps/check_enough_train_data.md new file mode 100644 index 000000000..2cdf5bcb8 --- /dev/null +++ b/tests/testthat/_snaps/check_enough_train_data.md @@ -0,0 +1,51 @@ +# check_enough_train_data works on pooled data + + Code + recipe(toy_epi_df) %>% check_enough_train_data(x, y, n = 2 * n + 1, drop_na = FALSE) %>% + prep(toy_epi_df) %>% bake(new_data = NULL) + Condition + Error in `check_enough_train_data()`: + Caused by error in `prep()`: + ! The following columns don't have enough data to predict: x and y. + +--- + + Code + recipe(toy_epi_df) %>% check_enough_train_data(x, y, n = 2 * n - 1, drop_na = TRUE) %>% + prep(toy_epi_df) %>% bake(new_data = NULL) + Condition + Error in `check_enough_train_data()`: + Caused by error in `prep()`: + ! The following columns don't have enough data to predict: x and y. + +# check_enough_train_data works on unpooled data + + Code + recipe(toy_epi_df) %>% check_enough_train_data(x, y, n = n + 1, epi_keys = "geo_value", + drop_na = FALSE) %>% prep(toy_epi_df) %>% bake(new_data = NULL) + Condition + Error in `check_enough_train_data()`: + Caused by error in `prep()`: + ! The following columns don't have enough data to predict: x and y. + +--- + + Code + recipe(toy_epi_df) %>% check_enough_train_data(x, y, n = 2 * n - 3, epi_keys = "geo_value", + drop_na = TRUE) %>% prep(toy_epi_df) %>% bake(new_data = NULL) + Condition + Error in `check_enough_train_data()`: + Caused by error in `prep()`: + ! The following columns don't have enough data to predict: x and y. + +# check_enough_train_data works with all_predictors() downstream of constructed terms + + Code + recipe(toy_epi_df) %>% step_epi_lag(x, lag = c(1, 2)) %>% + check_enough_train_data(all_predictors(), y, n = 2 * n - 5) %>% prep( + toy_epi_df) %>% bake(new_data = NULL) + Condition + Error in `check_enough_train_data()`: + Caused by error in `prep()`: + ! The following columns don't have enough data to predict: lag_1_x, lag_2_x, and y. + diff --git a/tests/testthat/_snaps/enframer.md b/tests/testthat/_snaps/enframer.md new file mode 100644 index 000000000..4b05dbff3 --- /dev/null +++ b/tests/testthat/_snaps/enframer.md @@ -0,0 +1,32 @@ +# enframer errors/works as needed + + Code + enframer(1:5, letters[1]) + Condition + Error in `enframer()`: + ! is.data.frame(df) is not TRUE + +--- + + Code + enframer(data.frame(a = 1:5), 1:3) + Condition + Error in `enframer()`: + ! `x` must be of type . + +--- + + Code + enframer(data.frame(a = 1:5), letters[1:3]) + Condition + Error in `enframer()`: + ! In enframer: some new cols match existing column names + +--- + + Code + enframer(data.frame(aa = 1:5), letters[1:2], fill = 1:4) + Condition + Error in `enframer()`: + ! length(fill) == 1 || length(fill) == nrow(df) is not TRUE + diff --git a/tests/testthat/_snaps/epi_recipe.md b/tests/testthat/_snaps/epi_recipe.md new file mode 100644 index 000000000..b5cfed0a0 --- /dev/null +++ b/tests/testthat/_snaps/epi_recipe.md @@ -0,0 +1,8 @@ +# add/update/adjust/remove epi_recipe works as intended + + Code + workflows::extract_preprocessor(wf)$steps + Condition + Error in `workflows::extract_preprocessor()`: + ! The workflow does not have a preprocessor. + diff --git a/tests/testthat/_snaps/epi_workflow.md b/tests/testthat/_snaps/epi_workflow.md new file mode 100644 index 000000000..5a3a8f02c --- /dev/null +++ b/tests/testthat/_snaps/epi_workflow.md @@ -0,0 +1,17 @@ +# model can be added/updated/removed from epi_workflow + + Code + extract_spec_parsnip(wf) + Condition + Error in `extract_spec_parsnip()`: + ! The workflow does not have a model spec. + +# forecast method errors when workflow not fit + + Code + forecast(wf) + Condition + Error in `forecast()`: + ! You cannot `forecast()` a that has not been trained. + i Please use `fit()` before forecasting. + diff --git a/tests/testthat/_snaps/extract_argument.md b/tests/testthat/_snaps/extract_argument.md new file mode 100644 index 000000000..d4ff44c95 --- /dev/null +++ b/tests/testthat/_snaps/extract_argument.md @@ -0,0 +1,72 @@ +# layer argument extractor works + + Code + extract_argument(f$layers[[1]], "uhoh", "bubble") + Condition + Error in `extract_argument()`: + ! Requested "uhoh" not found. This is a(n) . + +--- + + Code + extract_argument(f$layers[[1]], "layer_predict", "bubble") + Condition + Error in `extract_argument()`: + ! Requested argument "bubble" not found in "layer_predict". + +--- + + Code + extract_argument(f, "layer_thresh", "quantile_levels") + Condition + Error in `extract_argument()`: + ! frosting object does not contain a "layer_thresh". + +--- + + Code + extract_argument(epi_workflow(), "layer_residual_quantiles", "quantile_levels") + Condition + Error in `extract_frosting()`: + ! The epi_workflow does not have a postprocessor. + +--- + + Code + extract_argument(wf, "layer_predict", c("type", "opts")) + Condition + Error in `FUN()`: + ! `arg` must be a scalar of type . + +# recipe argument extractor works + + Code + extract_argument(r$steps[[1]], "uhoh", "bubble") + Condition + Error in `extract_argument()`: + ! Requested "uhoh" not found. This is a . + +--- + + Code + extract_argument(r$steps[[1]], "step_epi_lag", "bubble") + Condition + Error in `extract_argument()`: + ! Requested argument "bubble" not found in "step_epi_lag". + +--- + + Code + extract_argument(r, "step_lightly", "quantile_levels") + Condition + Error in `extract_argument()`: + ! recipe object does not contain a "step_lightly". + +--- + + Code + extract_argument(epi_workflow(), "step_epi_lag", "lag") + Condition + Error in `extract_argument()`: + ! The workflow must have a recipe preprocessor. + diff --git a/tests/testthat/_snaps/flatline_args_list.md b/tests/testthat/_snaps/flatline_args_list.md new file mode 100644 index 000000000..02053f95b --- /dev/null +++ b/tests/testthat/_snaps/flatline_args_list.md @@ -0,0 +1,128 @@ +# flatline_args_list checks inputs + + Code + flatline_args_list(ahead = c(0, 4)) + Condition + Error in `flatline_args_list()`: + ! `ahead` must be a scalar. + +--- + + Code + flatline_args_list(n_training = c(28, 65)) + Condition + Error in `flatline_args_list()`: + ! `n_training` must be a scalar. + +--- + + Code + flatline_args_list(ahead = -1) + Condition + Error in `flatline_args_list()`: + ! `ahead` must be a non-negative integer. + +--- + + Code + flatline_args_list(ahead = 1.5) + Condition + Error in `flatline_args_list()`: + ! `ahead` must be a non-negative integer. + +--- + + Code + flatline_args_list(n_training = -1) + Condition + Error in `flatline_args_list()`: + ! `n_training` must be a strictly positive number. + +--- + + Code + flatline_args_list(n_training = 1.5) + Condition + Error in `flatline_args_list()`: + ! `n_training` must be a positive integer. + +--- + + Code + flatline_args_list(lags = c(-1, 0)) + Condition + Error in `flatline_args_list()`: + ! `...` must be empty. + x Problematic argument: + * lags = c(-1, 0) + +--- + + Code + flatline_args_list(lags = list(c(1:5, 6.5), 2:8)) + Condition + Error in `flatline_args_list()`: + ! `...` must be empty. + x Problematic argument: + * lags = list(c(1:5, 6.5), 2:8) + +--- + + Code + flatline_args_list(symmetrize = 4) + Condition + Error in `flatline_args_list()`: + ! `symmetrize` must be of type . + +--- + + Code + flatline_args_list(nonneg = 4) + Condition + Error in `flatline_args_list()`: + ! `nonneg` must be of type . + +--- + + Code + flatline_args_list(quantile_levels = -0.1) + Condition + Error in `flatline_args_list()`: + ! `quantile_levels` must lie in [0, 1]. + +--- + + Code + flatline_args_list(quantile_levels = 1.1) + Condition + Error in `flatline_args_list()`: + ! `quantile_levels` must lie in [0, 1]. + +--- + + Code + flatline_args_list(target_date = "2022-01-01") + Condition + Error in `flatline_args_list()`: + ! `target_date` must be a date. + +--- + + Code + flatline_args_list(n_training_min = "de") + Condition + Error in `flatline_args_list()`: + ! `...` must be empty. + x Problematic argument: + * n_training_min = "de" + +--- + + Code + flatline_args_list(epi_keys = 1) + Condition + Error in `flatline_args_list()`: + ! `...` must be empty. + x Problematic argument: + * epi_keys = 1 + diff --git a/tests/testthat/_snaps/frosting.md b/tests/testthat/_snaps/frosting.md new file mode 100644 index 000000000..daf7f1ed7 --- /dev/null +++ b/tests/testthat/_snaps/frosting.md @@ -0,0 +1,16 @@ +# frosting validators / constructors work + + Code + wf %>% add_postprocessor(list()) + Condition + Error: + ! `postprocessor` must be a frosting object. + +# frosting can be created/added/updated/adjusted/removed + + Code + frosting(layers = 1:5) + Condition + Error in `frosting()`: + ! Currently, no arguments to `frosting()` are allowed to be non-null. + diff --git a/tests/testthat/_snaps/get_test_data.md b/tests/testthat/_snaps/get_test_data.md new file mode 100644 index 000000000..e65b0715c --- /dev/null +++ b/tests/testthat/_snaps/get_test_data.md @@ -0,0 +1,66 @@ +# expect insufficient training data error + + Code + get_test_data(recipe = r, x = case_death_rate_subset) + Condition + Error in `get_test_data()`: + ! You supplied insufficient recent data for this recipe. + ! You need at least 367 days of data, + ! but `x` contains only 365. + +# expect error that geo_value or time_value does not exist + + Code + get_test_data(recipe = r, x = wrong_epi_df) + Condition + Error in `get_test_data()`: + ! `x` must be an `epi_df`. + +# NA fill behaves as desired + + Code + get_test_data(r, df, "A") + Condition + Error in `get_test_data()`: + ! `fill_locf` must be of type . + +--- + + Code + get_test_data(r, df, TRUE, -3) + Condition + Error in `get_test_data()`: + ! `n_recent` must be a positive integer. + +--- + + Code + get_test_data(r, df2, TRUE) + Condition + Error in `if (recipes::is_trained(recipe)) ...`: + ! argument is of length zero + +# forecast date behaves + + Code + get_test_data(r, df, TRUE, forecast_date = 9) + Condition + Error in `get_test_data()`: + ! `forecast_date` must be the same class as `x$time_value`. + +--- + + Code + get_test_data(r, df, TRUE, forecast_date = 9L) + Condition + Error in `get_test_data()`: + ! `forecast_date` must be no earlier than `max(x$time_value)` + +--- + + Code + get_test_data(r, df, forecast_date = 9L) + Condition + Error in `get_test_data()`: + ! `forecast_date` must be no earlier than `max(x$time_value)` + diff --git a/tests/testthat/_snaps/layer_add_forecast_date.md b/tests/testthat/_snaps/layer_add_forecast_date.md new file mode 100644 index 000000000..9e829be91 --- /dev/null +++ b/tests/testthat/_snaps/layer_add_forecast_date.md @@ -0,0 +1,42 @@ +# layer validation works + + Code + layer_add_forecast_date(f, c("2022-05-31", "2022-05-31")) + Condition + Error in `layer_add_forecast_date()`: + ! `forecast_date` must be a scalar. + +--- + + Code + layer_add_forecast_date(f, "2022-05-31", id = 2) + Condition + Error in `layer_add_forecast_date()`: + ! `id` must be a scalar of type . + +--- + + Code + layer_add_forecast_date(f, "2022-05-31", id = c("a", "b")) + Condition + Error in `layer_add_forecast_date()`: + ! `id` must be a scalar of type . + +# forecast date works for daily + + Code + predict(wf1, latest_yearly) + Condition + Error: + ! Can't convert `data$time_value` to match type of `time_value` . + +--- + + Code + predict(wf3, latest) + Condition + Error in `layer_add_forecast_date()`: + ! The `forecast_date` was given as a "year" while the + ! `time_type` of the training data was "day". + i See `?epiprocess::epi_df` for descriptions of these are determined. + diff --git a/tests/testthat/_snaps/layer_add_target_date.md b/tests/testthat/_snaps/layer_add_target_date.md new file mode 100644 index 000000000..805a4205d --- /dev/null +++ b/tests/testthat/_snaps/layer_add_target_date.md @@ -0,0 +1,8 @@ +# target date works for daily and yearly + + Code + predict(wf1, latest_bad) + Condition + Error: + ! Can't convert `data$time_value` to match type of `time_value` . + diff --git a/tests/testthat/_snaps/layer_residual_quantiles.md b/tests/testthat/_snaps/layer_residual_quantiles.md new file mode 100644 index 000000000..41aa0448d --- /dev/null +++ b/tests/testthat/_snaps/layer_residual_quantiles.md @@ -0,0 +1,18 @@ +# Errors when used with a classifier + + Code + forecast(wf) + Condition + Error in `grab_residuals()`: + ! For meaningful residuals, the predictor should be a regression model. + +# flatline_forecaster correctly errors when n_training < ahead + + Code + flatline_forecaster(jhu, "death_rate", args_list = flatline_args_list(ahead = 10, + n_training = 9)) + Condition + Error in `slather()`: + ! Residual quantiles could not be calculated due to missing residuals. + i This may be due to `n_train` < `ahead` in your . + diff --git a/tests/testthat/_snaps/layers.md b/tests/testthat/_snaps/layers.md new file mode 100644 index 000000000..a0474eab6 --- /dev/null +++ b/tests/testthat/_snaps/layers.md @@ -0,0 +1,24 @@ +# A layer can be updated in frosting + + Code + update(f$layers[[1]], lower = 100) + Condition + Error in `recipes:::update_fields()`: + ! The step you are trying to update, `layer_predict()`, does not have the lower field. + +--- + + Code + update(f$layers[[3]], lower = 100) + Condition + Error in `f$layers[[3]]`: + ! subscript out of bounds + +--- + + Code + update(f$layers[[2]], bad_param = 100) + Condition + Error in `recipes:::update_fields()`: + ! The step you are trying to update, `layer_threshold()`, does not have the bad_param field. + diff --git a/tests/testthat/_snaps/parse_period.md b/tests/testthat/_snaps/parse_period.md new file mode 100644 index 000000000..bc782dea7 --- /dev/null +++ b/tests/testthat/_snaps/parse_period.md @@ -0,0 +1,32 @@ +# parse_period works + + Code + parse_period(c(1, 2)) + Condition + Error in `parse_period()`: + ! `x` must be a scalar. + +--- + + Code + parse_period(c(1.3)) + Condition + Error in `parse_period()`: + ! rlang::is_integerish(x) is not TRUE + +--- + + Code + parse_period("1 year") + Condition + Error in `parse_period()`: + ! incompatible timespan in `aheads`. + +--- + + Code + parse_period("2 weeks later") + Condition + Error in `parse_period()`: + ! incompatible timespan in `aheads`. + diff --git a/tests/testthat/_snaps/parsnip_model_validation.md b/tests/testthat/_snaps/parsnip_model_validation.md new file mode 100644 index 000000000..365e6b2b8 --- /dev/null +++ b/tests/testthat/_snaps/parsnip_model_validation.md @@ -0,0 +1,18 @@ +# forecaster can validate parsnip model + + Code + get_parsnip_mode(l) + Condition + Error in `get_parsnip_mode()`: + ! `trainer` must be a `parsnip` model. + i This trainer has class: . + +--- + + Code + is_classification(l) + Condition + Error in `get_parsnip_mode()`: + ! `trainer` must be a `parsnip` model. + i This trainer has class: . + diff --git a/tests/testthat/_snaps/pivot_quantiles.md b/tests/testthat/_snaps/pivot_quantiles.md new file mode 100644 index 000000000..13dd81916 --- /dev/null +++ b/tests/testthat/_snaps/pivot_quantiles.md @@ -0,0 +1,40 @@ +# quantile pivotting wider behaves + + Code + pivot_quantiles_wider(tib, a) + Condition + Error in `pivot_quantiles_wider()`: + ! `a` is not <`quantile_pred`>. Cannot pivot it. + +--- + + Code + pivot_quantiles_wider(tib, d1, d2) + Condition + Error in `pivot_quantiles_wider()`: + ! Only one column can be pivotted. Can not pivot all of: `d1` and `d2`. + +--- + + Code + pivot_quantiles_longer(tib, d1, d2) + Condition + Error in `pivot_quantiles_longer()`: + ! Only one column can be pivotted. Can not pivot all of: `d1` and `d2`. + +# quantile pivotting longer behaves + + Code + pivot_quantiles_longer(tib, a) + Condition + Error in `pivot_quantiles_longer()`: + ! `a` is not <`quantile_pred`>. Cannot pivot it. + +--- + + Code + pivot_quantiles_longer(tib, d1, d2) + Condition + Error in `pivot_quantiles_longer()`: + ! Only one column can be pivotted. Can not pivot all of: `d1` and `d2`. + diff --git a/tests/testthat/_snaps/population_scaling.md b/tests/testthat/_snaps/population_scaling.md new file mode 100644 index 000000000..5e73d73c9 --- /dev/null +++ b/tests/testthat/_snaps/population_scaling.md @@ -0,0 +1,17 @@ +# expect error if `by` selector does not match + + Code + wf <- epi_workflow(r, parsnip::linear_reg()) %>% fit(jhu) %>% add_frosting(f) + Condition + Error in `step_population_scaling()`: + Caused by error in `hardhat::validate_column_names()`: + ! The following required columns are missing: 'a'. + +--- + + Code + forecast(wf) + Condition + Error in `hardhat::validate_column_names()`: + ! The following required columns are missing: 'nothere'. + diff --git a/tests/testthat/_snaps/quantile_pred.md b/tests/testthat/_snaps/quantile_pred.md new file mode 100644 index 000000000..dd13dcb86 --- /dev/null +++ b/tests/testthat/_snaps/quantile_pred.md @@ -0,0 +1,8 @@ +# arithmetic works on quantiles + + Code + sum(dstn) + Condition + Error in `vec_math()`: + ! `sum()` is not a supported operation for . + diff --git a/tests/testthat/_snaps/shuffle.md b/tests/testthat/_snaps/shuffle.md new file mode 100644 index 000000000..53eea9b92 --- /dev/null +++ b/tests/testthat/_snaps/shuffle.md @@ -0,0 +1,8 @@ +# shuffle works + + Code + shuffle(matrix(NA, 2, 2)) + Condition + Error in `shuffle()`: + ! is.vector(x) is not TRUE + diff --git a/tests/testthat/_snaps/snapshots.md b/tests/testthat/_snaps/snapshots.md index 84abf57d2..52013816a 100644 --- a/tests/testthat/_snaps/snapshots.md +++ b/tests/testthat/_snaps/snapshots.md @@ -2,100 +2,49 @@ structure(list(geo_value = c("ca", "fl", "ga", "ny", "pa", "tx" ), .pred = c(0.1393442, 0.103199, 0.3121244, 0.4218461, 0.7319844, - 0.1975426), .pred_distn = structure(list(structure(list(values = c(0, - 0.34820911), quantile_levels = c(0.05, 0.95)), class = c("dist_quantiles", - "dist_default", "vctrs_rcrd", "vctrs_vctr")), structure(list( - values = c(0, 0.31206391), quantile_levels = c(0.05, 0.95 - )), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr")), structure(list(values = c(0.10325949, 0.52098931 - ), quantile_levels = c(0.05, 0.95)), class = c("dist_quantiles", - "dist_default", "vctrs_rcrd", "vctrs_vctr")), structure(list( - values = c(0.21298119, 0.63071101), quantile_levels = c(0.05, - 0.95)), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr")), structure(list(values = c(0.52311949, 0.94084931 - ), quantile_levels = c(0.05, 0.95)), class = c("dist_quantiles", - "dist_default", "vctrs_rcrd", "vctrs_vctr")), structure(list( - values = c(0, 0.40640751), quantile_levels = c(0.05, 0.95 - )), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr"))), class = c("distribution", "vctrs_vctr", "list" - )), forecast_date = structure(c(18992, 18992, 18992, 18992, 18992, - 18992), class = "Date"), target_date = structure(c(18999, 18999, - 18999, 18999, 18999, 18999), class = "Date")), row.names = c(NA, + 0.1975426), .pred_distn = structure(list(c(0, 0.34820911), c(0, + 0.31206391), c(0.10325949, 0.52098931), c(0.21298119, 0.63071101 + ), c(0.52311949, 0.94084931), c(0, 0.40640751)), quantile_levels = c(0.05, + 0.95), class = c("quantile_pred", "vctrs_vctr", "list")), forecast_date = structure(c(18992, + 18992, 18992, 18992, 18992, 18992), class = "Date"), target_date = structure(c(18999, + 18999, 18999, 18999, 18999, 18999), class = "Date")), row.names = c(NA, -6L), class = c("tbl_df", "tbl", "data.frame")) --- structure(list(geo_value = c("ca", "fl", "ga", "ny", "pa", "tx" ), .pred = c(0.1393442, 0.103199, 0.3121244, 0.4218461, 0.7319844, - 0.1975426), .pred_distn = structure(list(structure(list(values = c(0.084583345, - 0.194105055), quantile_levels = c(0.05, 0.95)), class = c("dist_quantiles", - "dist_default", "vctrs_rcrd", "vctrs_vctr")), structure(list( - values = c(0.048438145, 0.157959855), quantile_levels = c(0.05, - 0.95)), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr")), structure(list(values = c(0.257363545, 0.366885255 - ), quantile_levels = c(0.05, 0.95)), class = c("dist_quantiles", - "dist_default", "vctrs_rcrd", "vctrs_vctr")), structure(list( - values = c(0.367085245, 0.476606955), quantile_levels = c(0.05, - 0.95)), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr")), structure(list(values = c(0.677223545, 0.786745255 - ), quantile_levels = c(0.05, 0.95)), class = c("dist_quantiles", - "dist_default", "vctrs_rcrd", "vctrs_vctr")), structure(list( - values = c(0.142781745, 0.252303455), quantile_levels = c(0.05, - 0.95)), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr"))), class = c("distribution", "vctrs_vctr", "list" - )), forecast_date = structure(c(18992, 18992, 18992, 18992, 18992, - 18992), class = "Date"), target_date = structure(c(18993, 18993, - 18993, 18993, 18993, 18993), class = "Date")), row.names = c(NA, + 0.1975426), .pred_distn = structure(list(c(0.084583345, 0.194105055 + ), c(0.048438145, 0.157959855), c(0.257363545, 0.366885255), + c(0.367085245, 0.476606955), c(0.677223545, 0.786745255), + c(0.142781745, 0.252303455)), quantile_levels = c(0.05, 0.95 + ), class = c("quantile_pred", "vctrs_vctr", "list")), forecast_date = structure(c(18992, + 18992, 18992, 18992, 18992, 18992), class = "Date"), target_date = structure(c(18993, + 18993, 18993, 18993, 18993, 18993), class = "Date")), row.names = c(NA, -6L), class = c("tbl_df", "tbl", "data.frame")) --- structure(list(geo_value = c("ca", "fl", "ga", "ny", "pa", "tx" ), .pred = c(0.1393442, 0.103199, 0.3121244, 0.4218461, 0.7319844, - 0.1975426), .pred_distn = structure(list(structure(list(values = c(0, - 0.34820911), quantile_levels = c(0.05, 0.95)), class = c("dist_quantiles", - "dist_default", "vctrs_rcrd", "vctrs_vctr")), structure(list( - values = c(0, 0.31206391), quantile_levels = c(0.05, 0.95 - )), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr")), structure(list(values = c(0.10325949, 0.52098931 - ), quantile_levels = c(0.05, 0.95)), class = c("dist_quantiles", - "dist_default", "vctrs_rcrd", "vctrs_vctr")), structure(list( - values = c(0.21298119, 0.63071101), quantile_levels = c(0.05, - 0.95)), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr")), structure(list(values = c(0.52311949, 0.94084931 - ), quantile_levels = c(0.05, 0.95)), class = c("dist_quantiles", - "dist_default", "vctrs_rcrd", "vctrs_vctr")), structure(list( - values = c(0, 0.40640751), quantile_levels = c(0.05, 0.95 - )), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr"))), class = c("distribution", "vctrs_vctr", "list" - )), forecast_date = structure(c(18992, 18992, 18992, 18992, 18992, - 18992), class = "Date"), target_date = structure(c(18999, 18999, - 18999, 18999, 18999, 18999), class = "Date")), row.names = c(NA, + 0.1975426), .pred_distn = structure(list(c(0, 0.34820911), c(0, + 0.31206391), c(0.10325949, 0.52098931), c(0.21298119, 0.63071101 + ), c(0.52311949, 0.94084931), c(0, 0.40640751)), quantile_levels = c(0.05, + 0.95), class = c("quantile_pred", "vctrs_vctr", "list")), forecast_date = structure(c(18992, + 18992, 18992, 18992, 18992, 18992), class = "Date"), target_date = structure(c(18999, + 18999, 18999, 18999, 18999, 18999), class = "Date")), row.names = c(NA, -6L), class = c("tbl_df", "tbl", "data.frame")) --- structure(list(geo_value = c("ca", "fl", "ga", "ny", "pa", "tx" ), .pred = c(0.1393442, 0.103199, 0.3121244, 0.4218461, 0.7319844, - 0.1975426), .pred_distn = structure(list(structure(list(values = c(0, - 0.34820911), quantile_levels = c(0.05, 0.95)), class = c("dist_quantiles", - "dist_default", "vctrs_rcrd", "vctrs_vctr")), structure(list( - values = c(0, 0.31206391), quantile_levels = c(0.05, 0.95 - )), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr")), structure(list(values = c(0.10325949, 0.52098931 - ), quantile_levels = c(0.05, 0.95)), class = c("dist_quantiles", - "dist_default", "vctrs_rcrd", "vctrs_vctr")), structure(list( - values = c(0.21298119, 0.63071101), quantile_levels = c(0.05, - 0.95)), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr")), structure(list(values = c(0.52311949, 0.94084931 - ), quantile_levels = c(0.05, 0.95)), class = c("dist_quantiles", - "dist_default", "vctrs_rcrd", "vctrs_vctr")), structure(list( - values = c(0, 0.40640751), quantile_levels = c(0.05, 0.95 - )), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr"))), class = c("distribution", "vctrs_vctr", "list" - )), forecast_date = structure(c(18992, 18992, 18992, 18992, 18992, - 18992), class = "Date"), target_date = structure(c(18993, 18993, - 18993, 18993, 18993, 18993), class = "Date")), row.names = c(NA, + 0.1975426), .pred_distn = structure(list(c(0, 0.34820911), c(0, + 0.31206391), c(0.10325949, 0.52098931), c(0.21298119, 0.63071101 + ), c(0.52311949, 0.94084931), c(0, 0.40640751)), quantile_levels = c(0.05, + 0.95), class = c("quantile_pred", "vctrs_vctr", "list")), forecast_date = structure(c(18992, + 18992, 18992, 18992, 18992, 18992), class = "Date"), target_date = structure(c(18993, + 18993, 18993, 18993, 18993, 18993), class = "Date")), row.names = c(NA, -6L), class = c("tbl_df", "tbl", "data.frame")) # cdc_baseline_forecaster snapshots @@ -110,279 +59,160 @@ 0.7319844, 0.7319844, 0.7319844, 0.1975426, 0.1975426, 0.1975426, 0.1975426, 0.1975426), ahead = c(1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, - 4L, 5L, 1L, 2L, 3L, 4L, 5L), .pred_distn = structure(list(structure(list( - values = c(0, 0, 0, 0.05519342, 0.082372705, 0.0936219, 0.1048711, - 0.1157573, 0.12317806, 0.1302723, 0.1353526, 0.1393442, 0.1433358, - 0.1484161, 0.15551034, 0.1629311, 0.1738173, 0.1850665, 0.196315695, - 0.22349498, 0.309768685, 0.3567520625, 0.439580229), quantile_levels = c(0.01, - 0.025, 0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, - 0.5, 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, - 0.99)), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr")), structure(list(values = c(0, 0, 0, 0, 0.0335550493877939, + 4L, 5L, 1L, 2L, 3L, 4L, 5L), .pred_distn = structure(list(c(0, + 0, 0, 0.05519342, 0.082372705, 0.0936219, 0.1048711, 0.1157573, + 0.12317806, 0.1302723, 0.1353526, 0.1393442, 0.1433358, 0.1484161, + 0.15551034, 0.1629311, 0.1738173, 0.1850665, 0.196315695, 0.22349498, + 0.309768685, 0.3567520625, 0.439580229), c(0, 0, 0, 0, 0.0335550493877939, 0.0604073208819088, 0.0796881899581496, 0.0945180888333883, 0.107218788833388, 0.118830788833388, 0.129717088833388, 0.1393442, 0.148949488833388, 0.159110072060821, 0.171080110623306, 0.184009705322953, 0.19866346102411, 0.218798896615666, 0.250961850618106, 0.300471354816148, 0.368582781136862, - 0.43909595699107, 0.520101234797705), quantile_levels = c(0.01, - 0.025, 0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, - 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, 0.99 - )), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr")), structure(list(values = c(0, 0, 0, 0, 0, 0.0310685196688967, + 0.43909595699107, 0.520101234797705), c(0, 0, 0, 0, 0, 0.0310685196688967, 0.0565901050435504, 0.0768417663716637, 0.0947104815343153, 0.110553706525765, 0.125192081534315, 0.1393442, 0.153133424194392, 0.167807181271713, 0.183769310145952, 0.202099979390294, 0.224139947221972, 0.252840918770688, 0.291417895572206, 0.341073550318203, 0.420604597710477, 0.494523225410904, - 0.573647294116801), quantile_levels = c(0.01, 0.025, 0.05, 0.1, - 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, 0.65, - 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, 0.99)), class = c("dist_quantiles", - "dist_default", "vctrs_rcrd", "vctrs_vctr")), structure(list( - values = c(0, 0, 0, 0, 0, 0.00623643594225938, 0.0360877950479505, - 0.0604332430739307, 0.0824028153516535, 0.102509343235732, - 0.121439405653606, 0.1393442, 0.15780837904264, 0.176333479766098, - 0.1971089199637, 0.219859545844459, 0.246500872561225, 0.279163385675357, - 0.320379296602716, 0.374497727839579, 0.458894379633346, - 0.535545067037845, 0.628776504364044), quantile_levels = c(0.01, - 0.025, 0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, - 0.5, 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, - 0.99)), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr")), structure(list(values = c(0, 0, 0, 0, 0, 0, 0.0192048017017668, - 0.0478501821296211, 0.0723167026720766, 0.0958385084225842, 0.11812331897399, - 0.1393442, 0.161074539705197, 0.184026763327133, 0.207844848454635, - 0.23407004803228, 0.265166265836908, 0.302137478236883, 0.346008752873429, - 0.403205598400084, 0.495260096430714, 0.574198142463125, 0.672941852619816 - ), quantile_levels = c(0.01, 0.025, 0.05, 0.1, 0.15, 0.2, 0.25, - 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, - 0.9, 0.95, 0.975, 0.99)), class = c("dist_quantiles", "dist_default", - "vctrs_rcrd", "vctrs_vctr")), structure(list(values = c(0, 0, - 0, 0, 0.016465765, 0.03549514, 0.05225675, 0.0644172, 0.0749343, + 0.573647294116801), c(0, 0, 0, 0, 0, 0.00623643594225938, 0.0360877950479505, + 0.0604332430739307, 0.0824028153516535, 0.102509343235732, 0.121439405653606, + 0.1393442, 0.15780837904264, 0.176333479766098, 0.1971089199637, + 0.219859545844459, 0.246500872561225, 0.279163385675357, 0.320379296602716, + 0.374497727839579, 0.458894379633346, 0.535545067037845, 0.628776504364044 + ), c(0, 0, 0, 0, 0, 0, 0.0192048017017668, 0.0478501821296211, + 0.0723167026720766, 0.0958385084225842, 0.11812331897399, 0.1393442, + 0.161074539705197, 0.184026763327133, 0.207844848454635, 0.23407004803228, + 0.265166265836908, 0.302137478236883, 0.346008752873429, 0.403205598400084, + 0.495260096430714, 0.574198142463125, 0.672941852619816), c(0, + 0, 0, 0, 0.016465765, 0.03549514, 0.05225675, 0.0644172, 0.0749343, 0.0847941, 0.0966258, 0.103199, 0.1097722, 0.1216039, 0.1314637, 0.1419808, 0.15414125, 0.17090286, 0.189932235, 0.22848398, 0.30542311, - 0.40216399, 0.512353658), quantile_levels = c(0.01, 0.025, 0.05, - 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, 0.65, - 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, 0.99)), class = c("dist_quantiles", - "dist_default", "vctrs_rcrd", "vctrs_vctr")), structure(list( - values = c(0, 0, 0, 0, 0, 0.00331296053340532, 0.0234804643776438, - 0.0414109089650896, 0.0579040140087902, 0.0738391473860739, - 0.0882882738549385, 0.103199, 0.118522737211872, 0.134217143129031, - 0.15174910202592, 0.17076597900759, 0.192368859892349, 0.218887, - 0.254338497855279, 0.307871753369934, 0.407530532639726, - 0.506824682189646, 0.607973477267732), quantile_levels = c(0.01, - 0.025, 0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, - 0.5, 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, - 0.99)), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr")), structure(list(values = c(0, 0, 0, 0, 0, 0, 0, - 0.0185864520320203, 0.0411215858914089, 0.062281046686267, 0.0828222124563246, - 0.103199, 0.123575888447284, 0.144785989158292, 0.167277039342293, - 0.192536265178252, 0.221677797769728, 0.256887836856768, 0.302366681512415, - 0.3669383199518, 0.476508917333523, 0.574293059865274, 0.69194511433946 - ), quantile_levels = c(0.01, 0.025, 0.05, 0.1, 0.15, 0.2, 0.25, - 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, - 0.9, 0.95, 0.975, 0.99)), class = c("dist_quantiles", "dist_default", - "vctrs_rcrd", "vctrs_vctr")), structure(list(values = c(0, 0, - 0, 0, 0, 0, 0, 0, 0.0271019287070871, 0.0535555494987951, 0.0785514374097741, - 0.103199, 0.128043832742677, 0.154157375592856, 0.181874602598776, - 0.212708648669987, 0.247608381738568, 0.289082621291513, 0.342486159511745, - 0.41300665395314, 0.52870334697862, 0.634316186092986, 0.767614547228429 - ), quantile_levels = c(0.01, 0.025, 0.05, 0.1, 0.15, 0.2, 0.25, - 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, - 0.9, 0.95, 0.975, 0.99)), class = c("dist_quantiles", "dist_default", - "vctrs_rcrd", "vctrs_vctr")), structure(list(values = c(0, 0, - 0, 0, 0, 0, 0, 0, 0.0118725894981448, 0.0439446210512103, 0.0736366703227029, - 0.103199, 0.133138617710077, 0.16357656105121, 0.19575459701827, - 0.230475760859608, 0.269323345322203, 0.314976554734947, 0.373424338576786, - 0.452807955824158, 0.578141866759416, 0.690542571738594, 0.837295153768033 - ), quantile_levels = c(0.01, 0.025, 0.05, 0.1, 0.15, 0.2, 0.25, - 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, - 0.9, 0.95, 0.975, 0.99)), class = c("dist_quantiles", "dist_default", - "vctrs_rcrd", "vctrs_vctr")), structure(list(values = c(0, 0, - 0.0813658, 0.14899276, 0.1960782, 0.22542314, 0.2414296, 0.25890318, - 0.2747762, 0.2881148, 0.3027873, 0.3121244, 0.3214615, 0.336134, - 0.3494726, 0.36534562, 0.3828192, 0.39882566, 0.4281706, 0.47525604, - 0.542883, 0.682805397499999, 0.798878314999999), quantile_levels = c(0.01, - 0.025, 0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, - 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, 0.99 - )), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr")), structure(list(values = c(0, 0, 0, 0.0706949, - 0.1267172, 0.1667331, 0.198582473624236, 0.225423180397104, 0.2494327, - 0.2707747, 0.292116312116921, 0.3121244, 0.3321324, 0.353072222341423, - 0.375089999249792, 0.3988256, 0.425831930221552, 0.459232792604326, - 0.501467782274773, 0.562188443556836, 0.685648485782108, 0.80647163752115, - 0.939224788489265), quantile_levels = c(0.01, 0.025, 0.05, 0.1, - 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, 0.65, - 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, 0.99)), class = c("dist_quantiles", - "dist_default", "vctrs_rcrd", "vctrs_vctr")), structure(list( - values = c(0, 0, 0, 0, 0.0704696868359684, 0.121407167925079, - 0.161930580284053, 0.197682797539976, 0.228361656891269, - 0.257706650923509, 0.285717780926109, 0.3121244, 0.338115598498035, - 0.365749693067931, 0.395921877240673, 0.427437934626446, - 0.462388578749537, 0.504066064225642, 0.558443518811788, - 0.636013559040791, 0.771225883005179, 0.89210797204162, 1.02314875759509 - ), quantile_levels = c(0.01, 0.025, 0.05, 0.1, 0.15, 0.2, - 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, 0.65, 0.7, 0.75, - 0.8, 0.85, 0.9, 0.95, 0.975, 0.99)), class = c("dist_quantiles", - "dist_default", "vctrs_rcrd", "vctrs_vctr")), structure(list( - values = c(0, 0, 0, 0, 0.0247190015881658, 0.0834693973257732, - 0.131490031120311, 0.173258318827988, 0.211213742349423, - 0.246202447408474, 0.279926744217642, 0.3121244, 0.344908347408474, - 0.378255200773608, 0.412935547408474, 0.45191576510605, 0.494757615230152, - 0.545060918490786, 0.609312182129471, 0.69704881099591, 0.838550239412991, - 0.962653262246773, 1.11351403170759), quantile_levels = c(0.01, - 0.025, 0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, - 0.5, 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, - 0.99)), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr")), structure(list(values = c(0, 0, 0, 0, 0, 0.0501392705767058, - 0.104248897713977, 0.151994400390804, 0.195087767727627, 0.235544124698047, - 0.274058107118071, 0.3121244, 0.350571341810268, 0.390274666572666, - 0.43048632300908, 0.474320393891039, 0.523839613390634, 0.581010268149082, - 0.652137495469405, 0.748428674762348, 0.898563270096551, 1.03273295410124, - 1.19211145220822), quantile_levels = c(0.01, 0.025, 0.05, 0.1, - 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, 0.65, - 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, 0.99)), class = c("dist_quantiles", - "dist_default", "vctrs_rcrd", "vctrs_vctr")), structure(list( - values = c(0, 0, 0.2148017, 0.31250597, 0.350183905, 0.3745639, - 0.3884161, 0.39746621, 0.404854, 0.4115031, 0.417413315, - 0.4218461, 0.426278885, 0.4321891, 0.4388382, 0.44622599, - 0.4552761, 0.4691283, 0.493508295, 0.53118623, 0.628890499999999, - 1.22043540499999, 1.95905017899999), quantile_levels = c(0.01, - 0.025, 0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, - 0.5, 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, - 0.99)), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr")), structure(list(values = c(0, 0, 0, 0.212369462232823, - 0.289571577546325, 0.324446887783878, 0.351262144469445, 0.37087, - 0.3863844, 0.399682509835098, 0.411036898891089, 0.4218461, 0.432927818676137, - 0.444338520819208, 0.4573077, 0.4728222, 0.492817749438994, 0.519442857224172, - 0.556165331447064, 0.635946057886079, 1.18402232252562, 1.7827032389242, - 2.5561261649726), quantile_levels = c(0.01, 0.025, 0.05, 0.1, - 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, 0.65, - 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, 0.99)), class = c("dist_quantiles", - "dist_default", "vctrs_rcrd", "vctrs_vctr")), structure(list( - values = c(0, 0, 0, 0.0413098183761837, 0.216633655848608, - 0.28006329699657, 0.3175577049983, 0.345923291761818, 0.368957399144641, - 0.38804556403724, 0.405400893204282, 0.4218461, 0.43864616004845, - 0.456105937661177, 0.475585378227632, 0.499018124730147, - 0.5270891900114, 0.564293444378844, 0.630730263388634, 0.898212235100651, - 1.53976520159876, 2.08228809477582, 2.80588762256078), quantile_levels = c(0.01, - 0.025, 0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, - 0.5, 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, - 0.99)), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr")), structure(list(values = c(0, 0, 0, 0, 0.114729892920429, - 0.227785958288583, 0.282278878729037, 0.320407599201492, 0.350577823459785, - 0.37665230304923, 0.39981364198757, 0.4218461, 0.444009706175862, - 0.466962725214852, 0.493098379685547, 0.523708407392674, 0.562100740111401, - 0.619050517814778, 0.754868363055733, 1.1177263295869, 1.76277018354499, - 2.37278671910076, 2.9651652434047), quantile_levels = c(0.01, - 0.025, 0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, - 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, 0.99 - )), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr")), structure(list(values = c(0, 0, 0, 0, 0.0100954501382014, - 0.165091099860099, 0.244964334392844, 0.294577054174442, 0.333357739419644, - 0.365251480804308, 0.394198909379894, 0.4218461, 0.449607812233022, - 0.479120513116631, 0.511271131674317, 0.5506402899964, 0.60295411796593, - 0.690751300611906, 0.913578722060166, 1.30856988553206, 1.94020220543606, - 2.57104934168037, 3.07139639379724), quantile_levels = c(0.01, - 0.025, 0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, - 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, 0.99 - )), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr")), structure(list(values = c(0.303454977, 0.3982330425, - 0.46791125, 0.57642367, 0.631462275, 0.6694025, 0.685048, 0.69857015, - 0.7085162, 0.71633898, 0.7252792, 0.7319844, 0.7386896, 0.74762982, - 0.7554526, 0.76539865, 0.7789208, 0.7945663, 0.832506525, 0.88754513, - 0.99605755, 1.0657357575, 1.160513823), quantile_levels = c(0.01, - 0.025, 0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, - 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, 0.99 - )), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr")), structure(list(values = c(0.188727136659627, - 0.292714653217782, 0.380882595473705, 0.476427609604196, 0.5464739, - 0.6001155, 0.636506664263643, 0.6638148, 0.684726301742618, 0.701811, - 0.7174565, 0.7319844, 0.7465124, 0.7621578, 0.779322149415794, - 0.800154, 0.826981204292293, 0.8649709, 0.918345662372574, 0.987315641681917, - 1.08210087899389, 1.17564510102166, 1.27428433325155), quantile_levels = c(0.01, - 0.025, 0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, - 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, 0.99 - )), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr")), structure(list(values = c(0.0928040444059739, - 0.212569233904214, 0.310718449102641, 0.418013562853928, 0.489917936424114, - 0.546885925424654, 0.593410228218282, 0.631406259421094, 0.661579628218282, - 0.687282906872069, 0.710456666258662, 0.7319844, 0.754131389282943, - 0.776685628218282, 0.802388976168662, 0.832758896293562, 0.869440928218282, - 0.916359694097141, 0.97403912794778, 1.04529048496565, 1.15710382277548, - 1.25675656404419, 1.37098330871205), quantile_levels = c(0.01, - 0.025, 0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, - 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, 0.99 - )), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr")), structure(list(values = c(0.0108404989744699, - 0.144337973117581, 0.250292371898569, 0.367310419323293, 0.44444044802193, - 0.506592035751958, 0.558428768125431, 0.602035095628756, 0.64112383905529, - 0.674354964141041, 0.703707875219752, 0.7319844, 0.760702196782168, - 0.78975826405844, 0.823427572594726, 0.860294897090771, 0.904032120658957, - 0.955736581115011, 1.0165945004053, 1.09529786576616, 1.21614421175967, - 1.32331604019295, 1.45293812780298), quantile_levels = c(0.01, - 0.025, 0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, - 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, 0.99 - )), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr")), structure(list(values = c(0, 0.0783919019408445, - 0.19440762901709, 0.323264916745368, 0.407999619319143, 0.474764568463685, - 0.530890671381964, 0.580852443909739, 0.623441748828038, 0.661393469870099, - 0.69827126098506, 0.7319844, 0.766440770218252, 0.802260162496625, - 0.840536805657307, 0.883133954556946, 0.931565607767828, 0.98815401699637, - 1.05406790404239, 1.138596250043, 1.27030064370239, 1.39007785503355, - 1.5343628053761), quantile_levels = c(0.01, 0.025, 0.05, 0.1, - 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, 0.65, - 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, 0.99)), class = c("dist_quantiles", - "dist_default", "vctrs_rcrd", "vctrs_vctr")), structure(list( - values = c(0, 0, 0.012845105, 0.07040502, 0.09495188, 0.12669976, - 0.1502248, 0.1659163, 0.1761341, 0.18586528, 0.191290375, - 0.1975426, 0.203794825, 0.20921992, 0.2189511, 0.2291689, - 0.2448604, 0.26838544, 0.30013332, 0.32468018, 0.382240095, - 0.5020427625, 0.590302013999998), quantile_levels = c(0.01, - 0.025, 0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, - 0.5, 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, - 0.99)), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr")), structure(list(values = c(0, 0, 0, 0.0133856545472455, + 0.40216399, 0.512353658), c(0, 0, 0, 0, 0, 0.00331296053340532, + 0.0234804643776438, 0.0414109089650896, 0.0579040140087902, 0.0738391473860739, + 0.0882882738549385, 0.103199, 0.118522737211872, 0.134217143129031, + 0.15174910202592, 0.17076597900759, 0.192368859892349, 0.218887, + 0.254338497855279, 0.307871753369934, 0.407530532639726, 0.506824682189646, + 0.607973477267732), c(0, 0, 0, 0, 0, 0, 0, 0.0185864520320203, + 0.0411215858914089, 0.062281046686267, 0.0828222124563246, 0.103199, + 0.123575888447284, 0.144785989158292, 0.167277039342293, 0.192536265178252, + 0.221677797769728, 0.256887836856768, 0.302366681512415, 0.3669383199518, + 0.476508917333523, 0.574293059865274, 0.69194511433946), c(0, + 0, 0, 0, 0, 0, 0, 0, 0.0271019287070871, 0.0535555494987951, + 0.0785514374097741, 0.103199, 0.128043832742677, 0.154157375592856, + 0.181874602598776, 0.212708648669987, 0.247608381738568, 0.289082621291513, + 0.342486159511745, 0.41300665395314, 0.52870334697862, 0.634316186092986, + 0.767614547228429), c(0, 0, 0, 0, 0, 0, 0, 0, 0.0118725894981448, + 0.0439446210512103, 0.0736366703227029, 0.103199, 0.133138617710077, + 0.16357656105121, 0.19575459701827, 0.230475760859608, 0.269323345322203, + 0.314976554734947, 0.373424338576786, 0.452807955824158, 0.578141866759416, + 0.690542571738594, 0.837295153768033), c(0, 0, 0.0813658, 0.14899276, + 0.1960782, 0.22542314, 0.2414296, 0.25890318, 0.2747762, 0.2881148, + 0.3027873, 0.3121244, 0.3214615, 0.336134, 0.3494726, 0.36534562, + 0.3828192, 0.39882566, 0.4281706, 0.47525604, 0.542883, 0.682805397499999, + 0.798878314999999), c(0, 0, 0, 0.0706949, 0.1267172, 0.1667331, + 0.198582473624236, 0.225423180397104, 0.2494327, 0.2707747, 0.292116312116921, + 0.3121244, 0.3321324, 0.353072222341423, 0.375089999249792, 0.3988256, + 0.425831930221552, 0.459232792604326, 0.501467782274773, 0.562188443556836, + 0.685648485782108, 0.80647163752115, 0.939224788489265), c(0, + 0, 0, 0, 0.0704696868359684, 0.121407167925079, 0.161930580284053, + 0.197682797539976, 0.228361656891269, 0.257706650923509, 0.285717780926109, + 0.3121244, 0.338115598498035, 0.365749693067931, 0.395921877240673, + 0.427437934626446, 0.462388578749537, 0.504066064225642, 0.558443518811788, + 0.636013559040791, 0.771225883005179, 0.89210797204162, 1.02314875759509 + ), c(0, 0, 0, 0, 0.0247190015881658, 0.0834693973257732, 0.131490031120311, + 0.173258318827988, 0.211213742349423, 0.246202447408474, 0.279926744217642, + 0.3121244, 0.344908347408474, 0.378255200773608, 0.412935547408474, + 0.45191576510605, 0.494757615230152, 0.545060918490786, 0.609312182129471, + 0.69704881099591, 0.838550239412991, 0.962653262246773, 1.11351403170759 + ), c(0, 0, 0, 0, 0, 0.0501392705767058, 0.104248897713977, 0.151994400390804, + 0.195087767727627, 0.235544124698047, 0.274058107118071, 0.3121244, + 0.350571341810268, 0.390274666572666, 0.43048632300908, 0.474320393891039, + 0.523839613390634, 0.581010268149082, 0.652137495469405, 0.748428674762348, + 0.898563270096551, 1.03273295410124, 1.19211145220822), c(0, + 0, 0.2148017, 0.31250597, 0.350183905, 0.3745639, 0.3884161, + 0.39746621, 0.404854, 0.4115031, 0.417413315, 0.4218461, 0.426278885, + 0.4321891, 0.4388382, 0.44622599, 0.4552761, 0.4691283, 0.493508295, + 0.53118623, 0.628890499999999, 1.22043540499999, 1.95905017899999 + ), c(0, 0, 0, 0.212369462232823, 0.289571577546325, 0.324446887783878, + 0.351262144469445, 0.37087, 0.3863844, 0.399682509835098, 0.411036898891089, + 0.4218461, 0.432927818676137, 0.444338520819208, 0.4573077, 0.4728222, + 0.492817749438994, 0.519442857224172, 0.556165331447064, 0.635946057886079, + 1.18402232252562, 1.7827032389242, 2.5561261649726), c(0, 0, + 0, 0.0413098183761837, 0.216633655848608, 0.28006329699657, 0.3175577049983, + 0.345923291761818, 0.368957399144641, 0.38804556403724, 0.405400893204282, + 0.4218461, 0.43864616004845, 0.456105937661177, 0.475585378227632, + 0.499018124730147, 0.5270891900114, 0.564293444378844, 0.630730263388634, + 0.898212235100651, 1.53976520159876, 2.08228809477582, 2.80588762256078 + ), c(0, 0, 0, 0, 0.114729892920429, 0.227785958288583, 0.282278878729037, + 0.320407599201492, 0.350577823459785, 0.37665230304923, 0.39981364198757, + 0.4218461, 0.444009706175862, 0.466962725214852, 0.493098379685547, + 0.523708407392674, 0.562100740111401, 0.619050517814778, 0.754868363055733, + 1.1177263295869, 1.76277018354499, 2.37278671910076, 2.9651652434047 + ), c(0, 0, 0, 0, 0.0100954501382014, 0.165091099860099, 0.244964334392844, + 0.294577054174442, 0.333357739419644, 0.365251480804308, 0.394198909379894, + 0.4218461, 0.449607812233022, 0.479120513116631, 0.511271131674317, + 0.5506402899964, 0.60295411796593, 0.690751300611906, 0.913578722060166, + 1.30856988553206, 1.94020220543606, 2.57104934168037, 3.07139639379724 + ), c(0.303454977, 0.3982330425, 0.46791125, 0.57642367, 0.631462275, + 0.6694025, 0.685048, 0.69857015, 0.7085162, 0.71633898, 0.7252792, + 0.7319844, 0.7386896, 0.74762982, 0.7554526, 0.76539865, 0.7789208, + 0.7945663, 0.832506525, 0.88754513, 0.99605755, 1.0657357575, + 1.160513823), c(0.188727136659627, 0.292714653217782, 0.380882595473705, + 0.476427609604196, 0.5464739, 0.6001155, 0.636506664263643, 0.6638148, + 0.684726301742618, 0.701811, 0.7174565, 0.7319844, 0.7465124, + 0.7621578, 0.779322149415794, 0.800154, 0.826981204292293, 0.8649709, + 0.918345662372574, 0.987315641681917, 1.08210087899389, 1.17564510102166, + 1.27428433325155), c(0.0928040444059739, 0.212569233904214, 0.310718449102641, + 0.418013562853928, 0.489917936424114, 0.546885925424654, 0.593410228218282, + 0.631406259421094, 0.661579628218282, 0.687282906872069, 0.710456666258662, + 0.7319844, 0.754131389282943, 0.776685628218282, 0.802388976168662, + 0.832758896293562, 0.869440928218282, 0.916359694097141, 0.97403912794778, + 1.04529048496565, 1.15710382277548, 1.25675656404419, 1.37098330871205 + ), c(0.0108404989744699, 0.144337973117581, 0.250292371898569, + 0.367310419323293, 0.44444044802193, 0.506592035751958, 0.558428768125431, + 0.602035095628756, 0.64112383905529, 0.674354964141041, 0.703707875219752, + 0.7319844, 0.760702196782168, 0.78975826405844, 0.823427572594726, + 0.860294897090771, 0.904032120658957, 0.955736581115011, 1.0165945004053, + 1.09529786576616, 1.21614421175967, 1.32331604019295, 1.45293812780298 + ), c(0, 0.0783919019408445, 0.19440762901709, 0.323264916745368, + 0.407999619319143, 0.474764568463685, 0.530890671381964, 0.580852443909739, + 0.623441748828038, 0.661393469870099, 0.69827126098506, 0.7319844, + 0.766440770218252, 0.802260162496625, 0.840536805657307, 0.883133954556946, + 0.931565607767828, 0.98815401699637, 1.05406790404239, 1.138596250043, + 1.27030064370239, 1.39007785503355, 1.5343628053761), c(0, 0, + 0.012845105, 0.07040502, 0.09495188, 0.12669976, 0.1502248, 0.1659163, + 0.1761341, 0.18586528, 0.191290375, 0.1975426, 0.203794825, 0.20921992, + 0.2189511, 0.2291689, 0.2448604, 0.26838544, 0.30013332, 0.32468018, + 0.382240095, 0.5020427625, 0.590302013999998), c(0, 0, 0, 0.0133856545472455, 0.0528330564916649, 0.0825071163605637, 0.107217748074731, 0.130397558147181, 0.151367721571716, 0.1688357, 0.183736649076791, 0.1975426, 0.2111662, 0.226622576069161, 0.244738709634746, 0.265660771838618, 0.289502, 0.3157762, 0.347933515877459, 0.395446576674467, 0.494033943284933, - 0.586036939413118, 0.696507800090321), quantile_levels = c(0.01, - 0.025, 0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, - 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, 0.99 - )), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr")), structure(list(values = c(0, 0, 0, 0, 0.0119984314577645, + 0.586036939413118, 0.696507800090321), c(0, 0, 0, 0, 0.0119984314577645, 0.0497573816250162, 0.081255049503995, 0.108502307388674, 0.132961558931189, 0.156011650575706, 0.177125892134071, 0.1975426, 0.217737120618906, 0.239458499211792, 0.263562581820818, 0.289525383565136, 0.31824420000725, 0.35141305194052, 0.393862560773808, 0.453538799225292, 0.558631806850418, - 0.657452391363313, 0.767918764883928), quantile_levels = c(0.01, - 0.025, 0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, - 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, 0.99 - )), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr")), structure(list(values = c(0, 0, 0, 0, 0, 0.0189057930465303, + 0.657452391363313, 0.767918764883928), c(0, 0, 0, 0, 0, 0.0189057930465303, 0.0558619823820737, 0.0885055048481483, 0.117823094349893, 0.145878789120691, 0.171852417645726, 0.1975426, 0.222526993865839, 0.249029206661066, 0.27731797305948, 0.306704680469104, 0.340659034209842, 0.379550761828618, 0.429562304567396, 0.499209921951019, 0.612206099576094, 0.713714149138691, - 0.835600324727346), quantile_levels = c(0.01, 0.025, 0.05, 0.1, - 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, 0.65, - 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, 0.99)), class = c("dist_quantiles", - "dist_default", "vctrs_rcrd", "vctrs_vctr")), structure(list( - values = c(0, 0, 0, 0, 0, 0, 0.0331956220262204, 0.0710455499705998, - 0.105140687231072, 0.136976315413355, 0.167518817907279, - 0.1975426, 0.226974062486675, 0.257640196272163, 0.289459502055271, - 0.323342029611596, 0.361500312536625, 0.407123841331413, - 0.46286764504675, 0.538379175655057, 0.659249503348734, 0.768470658367656, - 0.898774707571334), quantile_levels = c(0.01, 0.025, 0.05, - 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, - 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, 0.99)), class = c("dist_quantiles", - "dist_default", "vctrs_rcrd", "vctrs_vctr"))), class = c("distribution", - "vctrs_vctr", "list")), forecast_date = structure(c(18992, 18992, + 0.835600324727346), c(0, 0, 0, 0, 0, 0, 0.0331956220262204, 0.0710455499705998, + 0.105140687231072, 0.136976315413355, 0.167518817907279, 0.1975426, + 0.226974062486675, 0.257640196272163, 0.289459502055271, 0.323342029611596, + 0.361500312536625, 0.407123841331413, 0.46286764504675, 0.538379175655057, + 0.659249503348734, 0.768470658367656, 0.898774707571334)), quantile_levels = c(0.01, + 0.025, 0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, + 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, 0.99 + ), class = c("quantile_pred", "vctrs_vctr", "list")), forecast_date = structure(c(18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, - 18992), class = "Date"), target_date = structure(c(18999, 19006, - 19013, 19020, 19027, 18999, 19006, 19013, 19020, 19027, 18999, + 18992, 18992), class = "Date"), target_date = structure(c(18999, 19006, 19013, 19020, 19027, 18999, 19006, 19013, 19020, 19027, 18999, 19006, 19013, 19020, 19027, 18999, 19006, 19013, 19020, - 19027), class = "Date")), row.names = c(NA, -30L), class = c("tbl_df", + 19027, 18999, 19006, 19013, 19020, 19027, 18999, 19006, 19013, + 19020, 19027), class = "Date")), row.names = c(NA, -30L), class = c("tbl_df", "tbl", "data.frame")) --- @@ -397,291 +227,167 @@ 0.7319844, 0.7319844, 0.7319844, 0.1975426, 0.1975426, 0.1975426, 0.1975426, 0.1975426), ahead = c(2L, 3L, 4L, 5L, 6L, 2L, 3L, 4L, 5L, 6L, 2L, 3L, 4L, 5L, 6L, 2L, 3L, 4L, 5L, 6L, 2L, 3L, 4L, - 5L, 6L, 2L, 3L, 4L, 5L, 6L), .pred_distn = structure(list(structure(list( - values = c(0, 0, 0, 0, 0.0344362435566855, 0.0610170086495865, - 0.0798865084778347, 0.0944014546310463, 0.107339121226462, - 0.11899734099851, 0.129600408649586, 0.1393442, 0.149195708649586, - 0.159627982246122, 0.170968308649587, 0.184031805880359, - 0.198909658094331, 0.219058736130861, 0.250692448549235, - 0.300646382944129, 0.368938143197633, 0.440038195052124, - 0.51997011826723), quantile_levels = c(0.01, 0.025, 0.05, - 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, - 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, 0.99)), class = c("dist_quantiles", - "dist_default", "vctrs_rcrd", "vctrs_vctr")), structure(list( - values = c(0, 0, 0, 0, 0, 0.0303364052628526, 0.0557306728227282, - 0.0766736159703596, 0.0942284381264812, 0.11050757203172, - 0.125214601455714, 0.1393442, 0.15359732398729, 0.168500447692877, - 0.184551468093631, 0.202926420944109, 0.22476606802393, 0.253070223293233, - 0.29122995395109, 0.341963643747938, 0.419747975311502, 0.495994046054689, - 0.5748791770223), quantile_levels = c(0.01, 0.025, 0.05, - 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, - 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, 0.99)), class = c("dist_quantiles", - "dist_default", "vctrs_rcrd", "vctrs_vctr")), structure(list( - values = c(0, 0, 0, 0, 0, 0.00603076915889168, 0.0356039073625737, - 0.0609470811194113, 0.0833232869645198, 0.103265350891109, - 0.121507077706427, 0.1393442, 0.157305073932789, 0.176004666813668, - 0.196866917086671, 0.219796529731897, 0.247137200365254, - 0.280371254591746, 0.320842872758278, 0.374783454750148, - 0.461368597638526, 0.539683256474915, 0.632562403391324), - quantile_levels = c(0.01, 0.025, 0.05, 0.1, 0.15, 0.2, 0.25, - 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, - 0.85, 0.9, 0.95, 0.975, 0.99)), class = c("dist_quantiles", - "dist_default", "vctrs_rcrd", "vctrs_vctr")), structure(list( - values = c(0, 0, 0, 0, 0, 0, 0.018869505399304, 0.0471517885822858, - 0.0732707765908659, 0.0969223475714758, 0.118188509171441, - 0.1393442, 0.161036861715017, 0.183255665579256, 0.207206810683007, - 0.23409988698267, 0.265549713886389, 0.302197074524145, 0.346715970732557, - 0.40460690801818, 0.498076490174802, 0.580016068409433, 0.680138975526255 - ), quantile_levels = c(0.01, 0.025, 0.05, 0.1, 0.15, 0.2, - 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, 0.65, 0.7, 0.75, - 0.8, 0.85, 0.9, 0.95, 0.975, 0.99)), class = c("dist_quantiles", - "dist_default", "vctrs_rcrd", "vctrs_vctr")), structure(list( - values = c(0, 0, 0, 0, 0, 0, 0.00232218982614828, 0.0342017690820909, - 0.062828756299263, 0.0893725834453345, 0.114623710996309, - 0.1393442, 0.163790622390774, 0.189495107256772, 0.216754530328403, - 0.247065337260473, 0.281410456107061, 0.32037037400004, 0.367018829587046, - 0.431198706165962, 0.52829547296083, 0.619021148955337, 0.728730172315724 - ), quantile_levels = c(0.01, 0.025, 0.05, 0.1, 0.15, 0.2, - 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, 0.65, 0.7, 0.75, - 0.8, 0.85, 0.9, 0.95, 0.975, 0.99)), class = c("dist_quantiles", - "dist_default", "vctrs_rcrd", "vctrs_vctr")), structure(list( - values = c(0, 0, 0, 0, 0, 0.00233673672776743, 0.0223488000000001, - 0.040304673503435, 0.0576262998104982, 0.0732741199141993, - 0.088455610793058, 0.103199, 0.118707592060121, 0.134185928864089, - 0.151183139276793, 0.1702454, 0.191937, 0.2182298, 0.253577609846549, - 0.307351538752588, 0.407165223924639, 0.502529513927214, - 0.605582108686126), quantile_levels = c(0.01, 0.025, 0.05, - 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, - 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, 0.99)), class = c("dist_quantiles", - "dist_default", "vctrs_rcrd", "vctrs_vctr")), structure(list( - values = c(0, 0, 0, 0, 0, 0, 0, 0.0190621000375005, 0.0420071558734088, - 0.0629230825705257, 0.0833688260410605, 0.103199, 0.124118509153392, - 0.145401945823358, 0.168667287877079, 0.1939090000375, 0.222597428173282, - 0.256984900377504, 0.301709122144422, 0.366495424858649, - 0.475152766217062, 0.572497835146252, 0.693762274318904), - quantile_levels = c(0.01, 0.025, 0.05, 0.1, 0.15, 0.2, 0.25, - 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, - 0.85, 0.9, 0.95, 0.975, 0.99)), class = c("dist_quantiles", - "dist_default", "vctrs_rcrd", "vctrs_vctr")), structure(list( - values = c(0, 0, 0, 0, 0, 0, 0, 0, 0.0269530072946728, 0.0530040092850928, - 0.0782481277003769, 0.103199, 0.12816325599641, 0.154866111682517, - 0.182302899107341, 0.213783044306043, 0.248363904708547, - 0.28995690796288, 0.341627908394784, 0.413707680386504, 0.528381820556805, - 0.635771182105746, 0.77652465912812), quantile_levels = c(0.01, - 0.025, 0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, - 0.5, 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, - 0.99)), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr")), structure(list(values = c(0, 0, 0, 0, 0, 0, 0, + 5L, 6L, 2L, 3L, 4L, 5L, 6L), .pred_distn = structure(list(c(0, + 0, 0, 0, 0.0344362435566855, 0.0610170086495865, 0.0798865084778347, + 0.0944014546310463, 0.107339121226462, 0.11899734099851, 0.129600408649586, + 0.1393442, 0.149195708649586, 0.159627982246122, 0.170968308649587, + 0.184031805880359, 0.198909658094331, 0.219058736130861, 0.250692448549235, + 0.300646382944129, 0.368938143197633, 0.440038195052124, 0.51997011826723 + ), c(0, 0, 0, 0, 0, 0.0303364052628526, 0.0557306728227282, 0.0766736159703596, + 0.0942284381264812, 0.11050757203172, 0.125214601455714, 0.1393442, + 0.15359732398729, 0.168500447692877, 0.184551468093631, 0.202926420944109, + 0.22476606802393, 0.253070223293233, 0.29122995395109, 0.341963643747938, + 0.419747975311502, 0.495994046054689, 0.5748791770223), c(0, + 0, 0, 0, 0, 0.00603076915889168, 0.0356039073625737, 0.0609470811194113, + 0.0833232869645198, 0.103265350891109, 0.121507077706427, 0.1393442, + 0.157305073932789, 0.176004666813668, 0.196866917086671, 0.219796529731897, + 0.247137200365254, 0.280371254591746, 0.320842872758278, 0.374783454750148, + 0.461368597638526, 0.539683256474915, 0.632562403391324), c(0, + 0, 0, 0, 0, 0, 0.018869505399304, 0.0471517885822858, 0.0732707765908659, + 0.0969223475714758, 0.118188509171441, 0.1393442, 0.161036861715017, + 0.183255665579256, 0.207206810683007, 0.23409988698267, 0.265549713886389, + 0.302197074524145, 0.346715970732557, 0.40460690801818, 0.498076490174802, + 0.580016068409433, 0.680138975526255), c(0, 0, 0, 0, 0, 0, 0.00232218982614828, + 0.0342017690820909, 0.062828756299263, 0.0893725834453345, 0.114623710996309, + 0.1393442, 0.163790622390774, 0.189495107256772, 0.216754530328403, + 0.247065337260473, 0.281410456107061, 0.32037037400004, 0.367018829587046, + 0.431198706165962, 0.52829547296083, 0.619021148955337, 0.728730172315724 + ), c(0, 0, 0, 0, 0, 0.00233673672776743, 0.0223488000000001, + 0.040304673503435, 0.0576262998104982, 0.0732741199141993, 0.088455610793058, + 0.103199, 0.118707592060121, 0.134185928864089, 0.151183139276793, + 0.1702454, 0.191937, 0.2182298, 0.253577609846549, 0.307351538752588, + 0.407165223924639, 0.502529513927214, 0.605582108686126), c(0, + 0, 0, 0, 0, 0, 0, 0.0190621000375005, 0.0420071558734088, 0.0629230825705257, + 0.0833688260410605, 0.103199, 0.124118509153392, 0.145401945823358, + 0.168667287877079, 0.1939090000375, 0.222597428173282, 0.256984900377504, + 0.301709122144422, 0.366495424858649, 0.475152766217062, 0.572497835146252, + 0.693762274318904), c(0, 0, 0, 0, 0, 0, 0, 0, 0.0269530072946728, + 0.0530040092850928, 0.0782481277003769, 0.103199, 0.12816325599641, + 0.154866111682517, 0.182302899107341, 0.213783044306043, 0.248363904708547, + 0.28995690796288, 0.341627908394784, 0.413707680386504, 0.528381820556805, + 0.635771182105746, 0.77652465912812), c(0, 0, 0, 0, 0, 0, 0, 0, 0.0133969262208122, 0.0447913089328894, 0.0739787251314013, 0.103199, 0.132965213784838, 0.163644939246192, 0.196475575572506, 0.231647450729907, 0.271208219491195, 0.317741925837459, 0.376214875186902, 0.454693715463155, 0.578781950822058, 0.695278060333427, 0.835521146843828 - ), quantile_levels = c(0.01, 0.025, 0.05, 0.1, 0.15, 0.2, 0.25, - 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, - 0.9, 0.95, 0.975, 0.99)), class = c("dist_quantiles", "dist_default", - "vctrs_rcrd", "vctrs_vctr")), structure(list(values = c(0, 0, - 0, 0, 0, 0, 0, 0, 0.000725156354313476, 0.036290207696477, 0.0701157049196494, - 0.103199, 0.136581757676227, 0.170980571439515, 0.20778982998995, - 0.247087076718167, 0.291689672899979, 0.343587258527985, 0.406717577407724, - 0.490437549306793, 0.620305872542078, 0.740730855925609, 0.888992767585756 - ), quantile_levels = c(0.01, 0.025, 0.05, 0.1, 0.15, 0.2, 0.25, - 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, - 0.9, 0.95, 0.975, 0.99)), class = c("dist_quantiles", "dist_default", - "vctrs_rcrd", "vctrs_vctr")), structure(list(values = c(0, 0, - 0, 0.0701359181289814, 0.126021564763798, 0.165542973066331, - 0.197412078824538, 0.2254231, 0.24849244896414, 0.271074448350284, - 0.292116376731667, 0.3121244, 0.3321324, 0.3534741, 0.375505591313813, - 0.4001594, 0.4268368, 0.459466546351464, 0.501142770839258, 0.562143084394445, - 0.686511993260583, 0.808747521078011, 0.936070949770187), quantile_levels = c(0.01, - 0.025, 0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, - 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, 0.99 - )), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr")), structure(list(values = c(0, 0, 0, 0.00157374045240457, - 0.0698662194634446, 0.120287640452405, 0.16090076400914, 0.195966561494315, - 0.227802919628796, 0.257250456567366, 0.284352940452404, 0.3121244, - 0.338954445099751, 0.366682808562485, 0.395431772465525, 0.428410340452405, - 0.464424683613586, 0.505774640452405, 0.559060310062401, 0.635868688255882, - 0.771213743700187, 0.895124744284645, 1.02835689610128), quantile_levels = c(0.01, - 0.025, 0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, - 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, 0.99 - )), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr")), structure(list(values = c(0, 0, 0, 0, 0.0203251909788099, - 0.0807941084801849, 0.131156594663197, 0.173483742579226, 0.211670557196072, - 0.246244078609487, 0.278363918673537, 0.3121244, 0.345057130768308, - 0.378403757196072, 0.414130127568126, 0.451969178608786, 0.495598517595426, - 0.545136665227352, 0.60807806098831, 0.695394235571256, 0.837130344811698, - 0.966111057134121, 1.11185508502426), quantile_levels = c(0.01, - 0.025, 0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, - 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, 0.99 - )), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr")), structure(list(values = c(0, 0, 0, 0, 0, 0.0477276069251695, - 0.103509981435814, 0.15221877094871, 0.195952578625286, 0.236147272793828, - 0.274650521629366, 0.3121244, 0.349346986282313, 0.388561057230272, - 0.429378978625286, 0.474721256740267, 0.523806740641156, 0.581962784214742, - 0.652062951302463, 0.746838578625286, 0.896492945755508, 1.0340527654686, - 1.19219029825678), quantile_levels = c(0.01, 0.025, 0.05, 0.1, - 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, 0.65, - 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, 0.99)), class = c("dist_quantiles", - "dist_default", "vctrs_rcrd", "vctrs_vctr")), structure(list( - values = c(0, 0, 0, 0, 0, 0.0166039560593608, 0.0776387168354182, - 0.132003170161801, 0.180530886857168, 0.22594722201882, 0.268822337600976, - 0.3121244, 0.354489864523245, 0.398378553881739, 0.444274543339083, - 0.494499388431484, 0.548837448212482, 0.612239188685087, - 0.690272902609576, 0.790473599123991, 0.950950996975469, - 1.09638828065763, 1.26930966690442), quantile_levels = c(0.01, - 0.025, 0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, - 0.5, 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, - 0.99)), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr")), structure(list(values = c(0, 0, 0, 0.214450885057551, - 0.288864871241312, 0.3250653, 0.3516615, 0.3716087, 0.386718885323753, - 0.399682691320713, 0.411042976158862, 0.4218461, 0.4329278, 0.444139278140181, - 0.456951313505885, 0.4720835, 0.4920307, 0.518626803531635, 0.555566110165902, - 0.636745822624727, 1.18069710590251, 1.79487371178211, 2.55270530204625 - ), quantile_levels = c(0.01, 0.025, 0.05, 0.1, 0.15, 0.2, 0.25, - 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, - 0.9, 0.95, 0.975, 0.99)), class = c("dist_quantiles", "dist_default", - "vctrs_rcrd", "vctrs_vctr")), structure(list(values = c(0, 0, + ), c(0, 0, 0, 0, 0, 0, 0, 0, 0.000725156354313476, 0.036290207696477, + 0.0701157049196494, 0.103199, 0.136581757676227, 0.170980571439515, + 0.20778982998995, 0.247087076718167, 0.291689672899979, 0.343587258527985, + 0.406717577407724, 0.490437549306793, 0.620305872542078, 0.740730855925609, + 0.888992767585756), c(0, 0, 0, 0.0701359181289814, 0.126021564763798, + 0.165542973066331, 0.197412078824538, 0.2254231, 0.24849244896414, + 0.271074448350284, 0.292116376731667, 0.3121244, 0.3321324, 0.3534741, + 0.375505591313813, 0.4001594, 0.4268368, 0.459466546351464, 0.501142770839258, + 0.562143084394445, 0.686511993260583, 0.808747521078011, 0.936070949770187 + ), c(0, 0, 0, 0.00157374045240457, 0.0698662194634446, 0.120287640452405, + 0.16090076400914, 0.195966561494315, 0.227802919628796, 0.257250456567366, + 0.284352940452404, 0.3121244, 0.338954445099751, 0.366682808562485, + 0.395431772465525, 0.428410340452405, 0.464424683613586, 0.505774640452405, + 0.559060310062401, 0.635868688255882, 0.771213743700187, 0.895124744284645, + 1.02835689610128), c(0, 0, 0, 0, 0.0203251909788099, 0.0807941084801849, + 0.131156594663197, 0.173483742579226, 0.211670557196072, 0.246244078609487, + 0.278363918673537, 0.3121244, 0.345057130768308, 0.378403757196072, + 0.414130127568126, 0.451969178608786, 0.495598517595426, 0.545136665227352, + 0.60807806098831, 0.695394235571256, 0.837130344811698, 0.966111057134121, + 1.11185508502426), c(0, 0, 0, 0, 0, 0.0477276069251695, 0.103509981435814, + 0.15221877094871, 0.195952578625286, 0.236147272793828, 0.274650521629366, + 0.3121244, 0.349346986282313, 0.388561057230272, 0.429378978625286, + 0.474721256740267, 0.523806740641156, 0.581962784214742, 0.652062951302463, + 0.746838578625286, 0.896492945755508, 1.0340527654686, 1.19219029825678 + ), c(0, 0, 0, 0, 0, 0.0166039560593608, 0.0776387168354182, 0.132003170161801, + 0.180530886857168, 0.22594722201882, 0.268822337600976, 0.3121244, + 0.354489864523245, 0.398378553881739, 0.444274543339083, 0.494499388431484, + 0.548837448212482, 0.612239188685087, 0.690272902609576, 0.790473599123991, + 0.950950996975469, 1.09638828065763, 1.26930966690442), c(0, + 0, 0, 0.214450885057551, 0.288864871241312, 0.3250653, 0.3516615, + 0.3716087, 0.386718885323753, 0.399682691320713, 0.411042976158862, + 0.4218461, 0.4329278, 0.444139278140181, 0.456951313505885, 0.4720835, + 0.4920307, 0.518626803531635, 0.555566110165902, 0.636745822624727, + 1.18069710590251, 1.79487371178211, 2.55270530204625), c(0, 0, 0, 0.0412188277837779, 0.218851219710947, 0.281178109847399, 0.318187061211362, 0.346336916208562, 0.368500427783778, 0.387753955899259, 0.405439627783778, 0.4218461, 0.438238911502765, 0.455473161565916, 0.474946888792488, 0.497793222697627, 0.526600327783778, 0.565677321171112, 0.632773149305243, 0.891087255237454, 1.53723873883164, 2.07877430490449, - 2.80265665435411), quantile_levels = c(0.01, 0.025, 0.05, 0.1, - 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, 0.65, - 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, 0.99)), class = c("dist_quantiles", - "dist_default", "vctrs_rcrd", "vctrs_vctr")), structure(list( - values = c(0, 0, 0, 0, 0.11916637099981, 0.229217761668717, - 0.283591182792578, 0.32089403701397, 0.351025234947199, 0.376764238355684, - 0.399580647158371, 0.4218461, 0.44387311299288, 0.466809871716417, - 0.493008689720547, 0.523409488360383, 0.563157298622986, - 0.621505313473235, 0.756485815282202, 1.12190615310943, 1.76010655352564, - 2.36678033794496, 2.94420631979259), quantile_levels = c(0.01, - 0.025, 0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, - 0.5, 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, - 0.99)), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr")), structure(list(values = c(0, 0, 0, 0, 0.0166944520132201, - 0.165418069472795, 0.245206977511275, 0.294705591133411, 0.333122440419504, - 0.365628706470365, 0.393898304736197, 0.4218461, 0.449111464628896, - 0.478419567119571, 0.511583967360174, 0.551380591704217, 0.602914542469175, - 0.695207681738717, 0.912006796599716, 1.31516316514125, 1.94296465866439, - 2.56528565211139, 3.07364144272118), quantile_levels = c(0.01, - 0.025, 0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, - 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, 0.99 - )), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr")), structure(list(values = c(0, 0, 0, 0, 0, 0.095868346511765, - 0.20216012803078, 0.267545492825128, 0.314290150935209, 0.353895445422154, - 0.388115128404834, 0.4218461, 0.455823761272913, 0.49135719600286, - 0.53249009905049, 0.582341165610556, 0.654473427614026, 0.784511194125441, - 1.05644872659752, 1.47044175860169, 2.09183984013705, 2.69484857437112, - 3.1694157654766), quantile_levels = c(0.01, 0.025, 0.05, 0.1, - 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, 0.65, - 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, 0.99)), class = c("dist_quantiles", - "dist_default", "vctrs_rcrd", "vctrs_vctr")), structure(list( - values = c(0.189889609612846, 0.28831400446517, 0.378590156778518, - 0.474951757151471, 0.546550271666467, 0.599713541496415, - 0.636994072140471, 0.663814888730087, 0.6839305, 0.701811, - 0.71711131701917, 0.7319844, 0.746512343291783, 0.7621579, - 0.7800383, 0.800154, 0.826974702066021, 0.86472325100111, - 0.918612458720487, 0.988605006042461, 1.08324298909714, 1.1736324426019, - 1.27400190201593), quantile_levels = c(0.01, 0.025, 0.05, - 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, - 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, 0.99)), class = c("dist_quantiles", - "dist_default", "vctrs_rcrd", "vctrs_vctr")), structure(list( - values = c(0.0970521814156041, 0.21019273451422, 0.3073217, - 0.418096666577866, 0.489016664299943, 0.547102113575136, - 0.594490775323003, 0.63162246104581, 0.661579866583116, 0.687283, - 0.709633785855109, 0.7319844, 0.754030577281223, 0.776967707389074, - 0.802389, 0.832791429272493, 0.870576437517875, 0.917019363782438, - 0.973069487834329, 1.04481411391714, 1.15502640396814, 1.25613855529213, - 1.37419193312441), quantile_levels = c(0.01, 0.025, 0.05, - 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, - 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, 0.99)), class = c("dist_quantiles", - "dist_default", "vctrs_rcrd", "vctrs_vctr")), structure(list( - values = c(0.0121672025865257, 0.139873460696682, 0.245836896475015, - 0.366700877088971, 0.445024777793378, 0.506295707796278, - 0.557812941319663, 0.601634091201612, 0.639324955546405, - 0.673001603565436, 0.702827370737707, 0.7319844, 0.760387153293983, - 0.790515252114921, 0.823330663438584, 0.86065768198682, 0.904468070814958, - 0.954989716167962, 1.01626566701207, 1.09352836237872, 1.21548452077266, - 1.32239947141536, 1.46006378366371), quantile_levels = c(0.01, - 0.025, 0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, - 0.5, 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, - 0.99)), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr")), structure(list(values = c(0, 0.0755189873928237, - 0.192404624794198, 0.322282766861868, 0.409749729479745, 0.475729034228042, - 0.531171513462134, 0.579442333436034, 0.623023292701627, 0.662178609529395, - 0.697968947885378, 0.7319844, 0.766345465406154, 0.80256496503135, - 0.841452466611966, 0.884524366576965, 0.93218174000415, 0.988252217755677, - 1.05297410373014, 1.13838991320473, 1.27210128334768, 1.38822119412612, - 1.53603026586717), quantile_levels = c(0.01, 0.025, 0.05, 0.1, - 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, 0.65, - 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, 0.99)), class = c("dist_quantiles", - "dist_default", "vctrs_rcrd", "vctrs_vctr")), structure(list( - values = c(0, 0.0137515321313713, 0.140785106599616, 0.283710273212032, - 0.374321519596796, 0.446394180252102, 0.505830587319873, - 0.559570052916329, 0.606684360953109, 0.65111343293503, 0.692845474832798, - 0.7319844, 0.771333743893139, 0.812267094081241, 0.855930534362644, - 0.903545840608706, 0.955193592261423, 1.01560313647486, 1.08583632750787, - 1.17818451335943, 1.31856131315813, 1.44615719776698, 1.60468791291453 - ), quantile_levels = c(0.01, 0.025, 0.05, 0.1, 0.15, 0.2, - 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, 0.65, 0.7, 0.75, - 0.8, 0.85, 0.9, 0.95, 0.975, 0.99)), class = c("dist_quantiles", - "dist_default", "vctrs_rcrd", "vctrs_vctr")), structure(list( - values = c(0, 0, 0, 0.0124103998425985, 0.0518320161167612, - 0.0822283734557346, 0.106956582246572, 0.130236689538895, - 0.150852198845738, 0.168835673455735, 0.183678547429124, - 0.1975426, 0.211166273455735, 0.226249473455735, 0.243919155834858, - 0.265304527061771, 0.289781663064881, 0.315985067670677, - 0.347644682675627, 0.394981842425824, 0.491215248628636, - 0.584975102439074, 0.694697494489265), quantile_levels = c(0.01, - 0.025, 0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, - 0.5, 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, - 0.99)), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr")), structure(list(values = c(0, 0, 0, 0, 0.0106056685868359, + 2.80265665435411), c(0, 0, 0, 0, 0.11916637099981, 0.229217761668717, + 0.283591182792578, 0.32089403701397, 0.351025234947199, 0.376764238355684, + 0.399580647158371, 0.4218461, 0.44387311299288, 0.466809871716417, + 0.493008689720547, 0.523409488360383, 0.563157298622986, 0.621505313473235, + 0.756485815282202, 1.12190615310943, 1.76010655352564, 2.36678033794496, + 2.94420631979259), c(0, 0, 0, 0, 0.0166944520132201, 0.165418069472795, + 0.245206977511275, 0.294705591133411, 0.333122440419504, 0.365628706470365, + 0.393898304736197, 0.4218461, 0.449111464628896, 0.478419567119571, + 0.511583967360174, 0.551380591704217, 0.602914542469175, 0.695207681738717, + 0.912006796599716, 1.31516316514125, 1.94296465866439, 2.56528565211139, + 3.07364144272118), c(0, 0, 0, 0, 0, 0.095868346511765, 0.20216012803078, + 0.267545492825128, 0.314290150935209, 0.353895445422154, 0.388115128404834, + 0.4218461, 0.455823761272913, 0.49135719600286, 0.53249009905049, + 0.582341165610556, 0.654473427614026, 0.784511194125441, 1.05644872659752, + 1.47044175860169, 2.09183984013705, 2.69484857437112, 3.1694157654766 + ), c(0.189889609612846, 0.28831400446517, 0.378590156778518, + 0.474951757151471, 0.546550271666467, 0.599713541496415, 0.636994072140471, + 0.663814888730087, 0.6839305, 0.701811, 0.71711131701917, 0.7319844, + 0.746512343291783, 0.7621579, 0.7800383, 0.800154, 0.826974702066021, + 0.86472325100111, 0.918612458720487, 0.988605006042461, 1.08324298909714, + 1.1736324426019, 1.27400190201593), c(0.0970521814156041, 0.21019273451422, + 0.3073217, 0.418096666577866, 0.489016664299943, 0.547102113575136, + 0.594490775323003, 0.63162246104581, 0.661579866583116, 0.687283, + 0.709633785855109, 0.7319844, 0.754030577281223, 0.776967707389074, + 0.802389, 0.832791429272493, 0.870576437517875, 0.917019363782438, + 0.973069487834329, 1.04481411391714, 1.15502640396814, 1.25613855529213, + 1.37419193312441), c(0.0121672025865257, 0.139873460696682, 0.245836896475015, + 0.366700877088971, 0.445024777793378, 0.506295707796278, 0.557812941319663, + 0.601634091201612, 0.639324955546405, 0.673001603565436, 0.702827370737707, + 0.7319844, 0.760387153293983, 0.790515252114921, 0.823330663438584, + 0.86065768198682, 0.904468070814958, 0.954989716167962, 1.01626566701207, + 1.09352836237872, 1.21548452077266, 1.32239947141536, 1.46006378366371 + ), c(0, 0.0755189873928237, 0.192404624794198, 0.322282766861868, + 0.409749729479745, 0.475729034228042, 0.531171513462134, 0.579442333436034, + 0.623023292701627, 0.662178609529395, 0.697968947885378, 0.7319844, + 0.766345465406154, 0.80256496503135, 0.841452466611966, 0.884524366576965, + 0.93218174000415, 0.988252217755677, 1.05297410373014, 1.13838991320473, + 1.27210128334768, 1.38822119412612, 1.53603026586717), c(0, 0.0137515321313713, + 0.140785106599616, 0.283710273212032, 0.374321519596796, 0.446394180252102, + 0.505830587319873, 0.559570052916329, 0.606684360953109, 0.65111343293503, + 0.692845474832798, 0.7319844, 0.771333743893139, 0.812267094081241, + 0.855930534362644, 0.903545840608706, 0.955193592261423, 1.01560313647486, + 1.08583632750787, 1.17818451335943, 1.31856131315813, 1.44615719776698, + 1.60468791291453), c(0, 0, 0, 0.0124103998425985, 0.0518320161167612, + 0.0822283734557346, 0.106956582246572, 0.130236689538895, 0.150852198845738, + 0.168835673455735, 0.183678547429124, 0.1975426, 0.211166273455735, + 0.226249473455735, 0.243919155834858, 0.265304527061771, 0.289781663064881, + 0.315985067670677, 0.347644682675627, 0.394981842425824, 0.491215248628636, + 0.584975102439074, 0.694697494489265), c(0, 0, 0, 0, 0.0106056685868359, 0.0491424720812208, 0.0803975947094471, 0.108060576398464, 0.133638500841809, 0.155968088623186, 0.177107275224252, 0.1975426, 0.218180906543366, 0.239601831646016, 0.262811949904799, 0.28886838404664, 0.317235975224252, 0.350545157867879, 0.393998327257523, 0.454550976564066, 0.558555075803007, - 0.656859449317743, 0.763718974419534), quantile_levels = c(0.01, - 0.025, 0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, - 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, 0.99 - )), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr")), structure(list(values = c(0, 0, 0, 0, 0, 0.0185370189554894, + 0.656859449317743, 0.763718974419534), c(0, 0, 0, 0, 0, 0.0185370189554894, 0.0562218087603375, 0.0890356919950198, 0.118731362266373, 0.146216910144001, 0.172533896645116, 0.1975426, 0.223021121504065, 0.249412654553045, 0.277680444480195, 0.308522683806638, 0.342270845449704, 0.382702709814398, 0.433443929063141, 0.501610622734127, 0.61417580106326, 0.715138862353848, - 0.833535553075286), quantile_levels = c(0.01, 0.025, 0.05, 0.1, - 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, 0.65, - 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, 0.99)), class = c("dist_quantiles", - "dist_default", "vctrs_rcrd", "vctrs_vctr")), structure(list( - values = c(0, 0, 0, 0, 0, 0, 0.0346528073343234, 0.0723584880324803, - 0.106222897173122, 0.138467941096611, 0.167844669490445, - 0.1975426, 0.227591504589096, 0.258479799230192, 0.290862843650987, - 0.325718759418194, 0.364163081687565, 0.409581315443156, - 0.46531554698862, 0.54043504498905, 0.659111642885379, 0.761453612496025, - 0.889794566241181), quantile_levels = c(0.01, 0.025, 0.05, - 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, - 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, 0.99)), class = c("dist_quantiles", - "dist_default", "vctrs_rcrd", "vctrs_vctr")), structure(list( - values = c(0, 0, 0, 0, 0, 0, 0.0134397969692197, 0.0557212574100741, - 0.0941597345954959, 0.130401776157262, 0.164200585080601, - 0.1975426, 0.231566981332063, 0.265597088493385, 0.30192115798073, - 0.341652226704467, 0.384249568152932, 0.43541812199952, 0.495340659591346, - 0.575765691755518, 0.703032070294999, 0.815605113815338, - 0.955488202108743), quantile_levels = c(0.01, 0.025, 0.05, - 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, - 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, 0.99)), class = c("dist_quantiles", - "dist_default", "vctrs_rcrd", "vctrs_vctr"))), class = c("distribution", - "vctrs_vctr", "list")), forecast_date = structure(c(18992, 18992, + 0.833535553075286), c(0, 0, 0, 0, 0, 0, 0.0346528073343234, 0.0723584880324803, + 0.106222897173122, 0.138467941096611, 0.167844669490445, 0.1975426, + 0.227591504589096, 0.258479799230192, 0.290862843650987, 0.325718759418194, + 0.364163081687565, 0.409581315443156, 0.46531554698862, 0.54043504498905, + 0.659111642885379, 0.761453612496025, 0.889794566241181), c(0, + 0, 0, 0, 0, 0, 0.0134397969692197, 0.0557212574100741, 0.0941597345954959, + 0.130401776157262, 0.164200585080601, 0.1975426, 0.231566981332063, + 0.265597088493385, 0.30192115798073, 0.341652226704467, 0.384249568152932, + 0.43541812199952, 0.495340659591346, 0.575765691755518, 0.703032070294999, + 0.815605113815338, 0.955488202108743)), quantile_levels = c(0.01, + 0.025, 0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, + 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, 0.99 + ), class = c("quantile_pred", "vctrs_vctr", "list")), forecast_date = structure(c(18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, - 18992), class = "Date"), target_date = structure(c(19006, 19013, - 19020, 19027, 19034, 19006, 19013, 19020, 19027, 19034, 19006, + 18992, 18992), class = "Date"), target_date = structure(c(19006, 19013, 19020, 19027, 19034, 19006, 19013, 19020, 19027, 19034, 19006, 19013, 19020, 19027, 19034, 19006, 19013, 19020, 19027, - 19034), class = "Date")), row.names = c(NA, -30L), class = c("tbl_df", + 19034, 19006, 19013, 19020, 19027, 19034, 19006, 19013, 19020, + 19027, 19034), class = "Date")), row.names = c(NA, -30L), class = c("tbl_df", "tbl", "data.frame")) --- @@ -696,287 +402,180 @@ 0.7319844, 0.7319844, 0.7319844, 0.1975426, 0.1975426, 0.1975426, 0.1975426, 0.1975426), ahead = c(1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, - 4L, 5L, 1L, 2L, 3L, 4L, 5L), .pred_distn = structure(list(structure(list( - values = c(0, 0, 0.00812835000000001, 0.07297428, 0.0936219, - 0.10421786, 0.1121285, 0.1201118, 0.1273693, 0.1317238, 0.1360783, - 0.1393442, 0.1426101, 0.1469646, 0.1513191, 0.1585766, 0.1665599, - 0.17447054, 0.1850665, 0.20571412, 0.27056005, 0.313941744999999, - 0.384931126999997), quantile_levels = c(0.01, 0.025, 0.05, - 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, - 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, 0.99)), class = c("dist_quantiles", - "dist_default", "vctrs_rcrd", "vctrs_vctr")), structure(list( - values = c(0, 0, 0, 0.0250982954899548, 0.0576421230361804, - 0.0776985410529105, 0.0929731777892779, 0.104205115094451, - 0.114209292598776, 0.123365027741977, 0.131496226094211, - 0.1393442, 0.147007648291083, 0.154990950042, 0.16406284204392, - 0.173835548288583, 0.185472494222942, 0.200167568392984, - 0.221760005190952, 0.260313716029161, 0.318794320716957, - 0.376941794597195, 0.461705276864399), quantile_levels = c(0.01, - 0.025, 0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, - 0.5, 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, - 0.99)), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr")), structure(list(values = c(0, 0, 0, 0, 0.028693230499105, - 0.055453963203632, 0.0755679534410344, 0.0913921813275133, 0.104804902302573, - 0.117142722458225, 0.128444430213702, 0.1393442, 0.150479535783308, - 0.161776522458225, 0.173925041831968, 0.187540579925299, 0.204200618941439, - 0.225353161205212, 0.253695961466565, 0.294498109305393, 0.358245879234942, - 0.427563795224327, 0.501665748776186), quantile_levels = c(0.01, - 0.025, 0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, - 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, 0.99 - )), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr")), structure(list(values = c(0, 0, 0, 0, 0.00587171510650109, - 0.0364866623781238, 0.0602683002957529, 0.0794861096145961, 0.0963414561651617, - 0.111439230212802, 0.125394639614746, 0.1393442, 0.153216527502025, - 0.167801944181742, 0.183359587288923, 0.200880434888349, 0.221656465706657, - 0.24743726609676, 0.279449270180852, 0.322415149384594, 0.395367499639696, - 0.464904880713406, 0.539558052669137), quantile_levels = c(0.01, - 0.025, 0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, - 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, 0.99 - )), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr")), structure(list(values = c(0, 0, 0, 0, 0, 0.019055042091221, - 0.0457625510440105, 0.068309473710537, 0.087945102194822, 0.106033592330923, - 0.123045226382564, 0.1393442, 0.155351600131351, 0.172491058371384, - 0.19101350900654, 0.211425349928599, 0.234936300692507, 0.264303292652126, - 0.299599722715327, 0.346282638921389, 0.423857010226352, 0.494689091614341, - 0.577833814673327), quantile_levels = c(0.01, 0.025, 0.05, 0.1, - 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, 0.65, - 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, 0.99)), class = c("dist_quantiles", - "dist_default", "vctrs_rcrd", "vctrs_vctr")), structure(list( - values = c(0, 0, 0, 0.00138033000000002, 0.030893965, 0.0479842, - 0.059815975, 0.07118759, 0.0815075, 0.0926819, 0.0992551, - 0.103199, 0.1071429, 0.1137161, 0.1248905, 0.13521041, 0.146582025, - 0.1584138, 0.175504035, 0.20501767, 0.25694586, 0.335051815, - 0.436709474), quantile_levels = c(0.01, 0.025, 0.05, 0.1, - 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, 0.65, - 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, 0.99)), class = c("dist_quantiles", - "dist_default", "vctrs_rcrd", "vctrs_vctr")), structure(list( - values = c(0, 0, 0, 0, 0, 0.0179658025100251, 0.0356060154111541, + 4L, 5L, 1L, 2L, 3L, 4L, 5L), .pred_distn = structure(list(c(0, + 0, 0.00812835000000001, 0.07297428, 0.0936219, 0.10421786, 0.1121285, + 0.1201118, 0.1273693, 0.1317238, 0.1360783, 0.1393442, 0.1426101, + 0.1469646, 0.1513191, 0.1585766, 0.1665599, 0.17447054, 0.1850665, + 0.20571412, 0.27056005, 0.313941744999999, 0.384931126999997), + c(0, 0, 0, 0.0250982954899548, 0.0576421230361804, 0.0776985410529105, + 0.0929731777892779, 0.104205115094451, 0.114209292598776, + 0.123365027741977, 0.131496226094211, 0.1393442, 0.147007648291083, + 0.154990950042, 0.16406284204392, 0.173835548288583, 0.185472494222942, + 0.200167568392984, 0.221760005190952, 0.260313716029161, + 0.318794320716957, 0.376941794597195, 0.461705276864399), + c(0, 0, 0, 0, 0.028693230499105, 0.055453963203632, 0.0755679534410344, + 0.0913921813275133, 0.104804902302573, 0.117142722458225, + 0.128444430213702, 0.1393442, 0.150479535783308, 0.161776522458225, + 0.173925041831968, 0.187540579925299, 0.204200618941439, + 0.225353161205212, 0.253695961466565, 0.294498109305393, + 0.358245879234942, 0.427563795224327, 0.501665748776186), + c(0, 0, 0, 0, 0.00587171510650109, 0.0364866623781238, 0.0602683002957529, + 0.0794861096145961, 0.0963414561651617, 0.111439230212802, + 0.125394639614746, 0.1393442, 0.153216527502025, 0.167801944181742, + 0.183359587288923, 0.200880434888349, 0.221656465706657, + 0.24743726609676, 0.279449270180852, 0.322415149384594, 0.395367499639696, + 0.464904880713406, 0.539558052669137), c(0, 0, 0, 0, 0, 0.019055042091221, + 0.0457625510440105, 0.068309473710537, 0.087945102194822, + 0.106033592330923, 0.123045226382564, 0.1393442, 0.155351600131351, + 0.172491058371384, 0.19101350900654, 0.211425349928599, 0.234936300692507, + 0.264303292652126, 0.299599722715327, 0.346282638921389, + 0.423857010226352, 0.494689091614341, 0.577833814673327), + c(0, 0, 0, 0.00138033000000002, 0.030893965, 0.0479842, 0.059815975, + 0.07118759, 0.0815075, 0.0926819, 0.0992551, 0.103199, 0.1071429, + 0.1137161, 0.1248905, 0.13521041, 0.146582025, 0.1584138, + 0.175504035, 0.20501767, 0.25694586, 0.335051815, 0.436709474 + ), c(0, 0, 0, 0, 0, 0.0179658025100251, 0.0356060154111541, 0.050834301692017, 0.0650050989327893, 0.0784417069434695, 0.0916422518458685, 0.103199, 0.115251501692017, 0.128398001692017, 0.142201701692017, 0.157319973859039, 0.174980914065641, 0.196101805086251, 0.223989860848608, 0.266334685464555, 0.354050965519204, 0.437948459272293, 0.520203978940639), - quantile_levels = c(0.01, 0.025, 0.05, 0.1, 0.15, 0.2, 0.25, - 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, - 0.85, 0.9, 0.95, 0.975, 0.99)), class = c("dist_quantiles", - "dist_default", "vctrs_rcrd", "vctrs_vctr")), structure(list( - values = c(0, 0, 0, 0, 0, 0, 0.0134241653129031, 0.0338447112456125, + c(0, 0, 0, 0, 0, 0, 0.0134241653129031, 0.0338447112456125, 0.052643303388484, 0.0699345638167383, 0.0866373614747148, 0.103199, 0.119627111136411, 0.137401026927169, 0.156056395793358, 0.175781901322513, 0.198564535163602, 0.226934571881819, 0.263862501322513, 0.317121769745397, 0.412419996940619, - 0.491470213131306, 0.580892509639735), quantile_levels = c(0.01, - 0.025, 0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, - 0.5, 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, - 0.99)), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr")), structure(list(values = c(0, 0, 0, 0, 0, 0, 0, - 0.0170903, 0.0403385023363734, 0.0616387632732329, 0.0827585779094291, - 0.103199, 0.123094939420544, 0.14464638301663, 0.1669589, 0.191770645535455, - 0.220735117412174, 0.254231042750228, 0.296807527848978, 0.357153759489695, - 0.45347931404539, 0.538725322834228, 0.636530647411066), quantile_levels = c(0.01, - 0.025, 0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, - 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, 0.99 - )), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr")), structure(list(values = c(0, 0, 0, 0, 0, 0, 0, - 0.0026415954262542, 0.0297423239924899, 0.0555402340406406, 0.0792255827466275, - 0.103199, 0.127366925585556, 0.151700351432014, 0.177708522618176, - 0.206088123699737, 0.238712707453825, 0.277708313715037, 0.325132239647296, - 0.390468252727729, 0.490417296529864, 0.578557086846368, 0.688679948593326 - ), quantile_levels = c(0.01, 0.025, 0.05, 0.1, 0.15, 0.2, 0.25, - 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, - 0.9, 0.95, 0.975, 0.99)), class = c("dist_quantiles", "dist_default", - "vctrs_rcrd", "vctrs_vctr")), structure(list(values = c(0, 0.0320461375000001, - 0.129384955, 0.18940881, 0.2200878, 0.2427634, 0.2587698, 0.2734423, - 0.2841133, 0.296118, 0.3041212, 0.3121244, 0.3201276, 0.3281308, - 0.3401355, 0.3508065, 0.365479, 0.3814854, 0.404161, 0.43483999, - 0.494863845, 0.592202662499998, 0.737413847999994), quantile_levels = c(0.01, - 0.025, 0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, - 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, 0.99 - )), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr")), structure(list(values = c(0, 0, 0.0319186440152902, - 0.118606588418984, 0.166386434627046, 0.198884154069741, 0.224089313858389, - 0.245418255377554, 0.2641052, 0.281445422925429, 0.297451875378704, - 0.3121244, 0.327667648091081, 0.343487967727477, 0.360314881408664, - 0.379575527422374, 0.400991145952209, 0.426605204088841, 0.4588495, - 0.506128350755908, 0.604640728888889, 0.713520019350718, 0.848429920658984 - ), quantile_levels = c(0.01, 0.025, 0.05, 0.1, 0.15, 0.2, 0.25, - 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, - 0.9, 0.95, 0.975, 0.99)), class = c("dist_quantiles", "dist_default", - "vctrs_rcrd", "vctrs_vctr")), structure(list(values = c(0, 0, - 0, 0.0628145244703447, 0.119951261697167, 0.161800708429584, - 0.194481529786298, 0.221976473503235, 0.246382528361484, 0.268661795456855, - 0.29099237601426, 0.3121244, 0.332687273503235, 0.354487379145491, - 0.376704773503235, 0.401222379758598, 0.428725473503235, 0.462071908680987, - 0.503745448659536, 0.564825512591627, 0.677307126205362, 0.788889302835928, - 0.92389000979736), quantile_levels = c(0.01, 0.025, 0.05, 0.1, - 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, 0.65, - 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, 0.99)), class = c("dist_quantiles", - "dist_default", "vctrs_rcrd", "vctrs_vctr")), structure(list( - values = c(0, 0, 0, 0.0154147362739629, 0.0815589624901754, - 0.130419447103471, 0.16933591200637, 0.202296191455315, 0.23230661698317, - 0.260103744489245, 0.28583424396924, 0.3121244, 0.337226511153312, - 0.3628113, 0.3894886, 0.419049975899859, 0.453339140405904, - 0.492830630339104, 0.542883079890499, 0.613577832767128, - 0.73571689900399, 0.853844909059791, 0.988010467319443), - quantile_levels = c(0.01, 0.025, 0.05, 0.1, 0.15, 0.2, 0.25, - 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, - 0.85, 0.9, 0.95, 0.975, 0.99)), class = c("dist_quantiles", - "dist_default", "vctrs_rcrd", "vctrs_vctr")), structure(list( - values = c(0, 0, 0, 0, 0.0493531737111374, 0.104172112803728, - 0.147940700281253, 0.185518687303273, 0.220197034594646, - 0.2521005, 0.282477641919719, 0.3121244, 0.3414694, 0.371435390499905, - 0.402230766363414, 0.436173824348844, 0.474579164424894, - 0.519690345185252, 0.57667375206677, 0.655151246845668, 0.78520792902029, - 0.90968118047453, 1.05112182091783), quantile_levels = c(0.01, - 0.025, 0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, - 0.5, 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, - 0.99)), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr")), structure(list(values = c(0, 0, 0.28439515, 0.33688581, - 0.369872555, 0.3863845, 0.3945111, 0.40189893, 0.4078092, 0.4137194, - 0.4174134, 0.4218461, 0.4262788, 0.4299728, 0.435883, 0.44179327, - 0.4491811, 0.4573077, 0.473819645, 0.50680639, 0.55929705, 0.9841905175, - 1.556671116), quantile_levels = c(0.01, 0.025, 0.05, 0.1, 0.15, - 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, 0.65, 0.7, 0.75, - 0.8, 0.85, 0.9, 0.95, 0.975, 0.99)), class = c("dist_quantiles", - "dist_default", "vctrs_rcrd", "vctrs_vctr")), structure(list( - values = c(0, 0, 0.003694, 0.268840486221162, 0.320208490155752, + 0.491470213131306, 0.580892509639735), c(0, 0, 0, 0, 0, 0, + 0, 0.0170903, 0.0403385023363734, 0.0616387632732329, 0.0827585779094291, + 0.103199, 0.123094939420544, 0.14464638301663, 0.1669589, + 0.191770645535455, 0.220735117412174, 0.254231042750228, + 0.296807527848978, 0.357153759489695, 0.45347931404539, 0.538725322834228, + 0.636530647411066), c(0, 0, 0, 0, 0, 0, 0, 0.0026415954262542, + 0.0297423239924899, 0.0555402340406406, 0.0792255827466275, + 0.103199, 0.127366925585556, 0.151700351432014, 0.177708522618176, + 0.206088123699737, 0.238712707453825, 0.277708313715037, + 0.325132239647296, 0.390468252727729, 0.490417296529864, + 0.578557086846368, 0.688679948593326), c(0, 0.0320461375000001, + 0.129384955, 0.18940881, 0.2200878, 0.2427634, 0.2587698, + 0.2734423, 0.2841133, 0.296118, 0.3041212, 0.3121244, 0.3201276, + 0.3281308, 0.3401355, 0.3508065, 0.365479, 0.3814854, 0.404161, + 0.43483999, 0.494863845, 0.592202662499998, 0.737413847999994 + ), c(0, 0, 0.0319186440152902, 0.118606588418984, 0.166386434627046, + 0.198884154069741, 0.224089313858389, 0.245418255377554, + 0.2641052, 0.281445422925429, 0.297451875378704, 0.3121244, + 0.327667648091081, 0.343487967727477, 0.360314881408664, + 0.379575527422374, 0.400991145952209, 0.426605204088841, + 0.4588495, 0.506128350755908, 0.604640728888889, 0.713520019350718, + 0.848429920658984), c(0, 0, 0, 0.0628145244703447, 0.119951261697167, + 0.161800708429584, 0.194481529786298, 0.221976473503235, + 0.246382528361484, 0.268661795456855, 0.29099237601426, 0.3121244, + 0.332687273503235, 0.354487379145491, 0.376704773503235, + 0.401222379758598, 0.428725473503235, 0.462071908680987, + 0.503745448659536, 0.564825512591627, 0.677307126205362, + 0.788889302835928, 0.92389000979736), c(0, 0, 0, 0.0154147362739629, + 0.0815589624901754, 0.130419447103471, 0.16933591200637, + 0.202296191455315, 0.23230661698317, 0.260103744489245, 0.28583424396924, + 0.3121244, 0.337226511153312, 0.3628113, 0.3894886, 0.419049975899859, + 0.453339140405904, 0.492830630339104, 0.542883079890499, + 0.613577832767128, 0.73571689900399, 0.853844909059791, 0.988010467319443 + ), c(0, 0, 0, 0, 0.0493531737111374, 0.104172112803728, 0.147940700281253, + 0.185518687303273, 0.220197034594646, 0.2521005, 0.282477641919719, + 0.3121244, 0.3414694, 0.371435390499905, 0.402230766363414, + 0.436173824348844, 0.474579164424894, 0.519690345185252, + 0.57667375206677, 0.655151246845668, 0.78520792902029, 0.90968118047453, + 1.05112182091783), c(0, 0, 0.28439515, 0.33688581, 0.369872555, + 0.3863845, 0.3945111, 0.40189893, 0.4078092, 0.4137194, 0.4174134, + 0.4218461, 0.4262788, 0.4299728, 0.435883, 0.44179327, 0.4491811, + 0.4573077, 0.473819645, 0.50680639, 0.55929705, 0.9841905175, + 1.556671116), c(0, 0, 0.003694, 0.268840486221162, 0.320208490155752, 0.34804029700677, 0.368653615349654, 0.3834292, 0.3945111, 0.4041153, 0.413171785132151, 0.4218461, 0.430424661802068, 0.4395769, 0.4491812, 0.4610017, 0.47590450199302, 0.497193409669697, 0.525275921931869, 0.57616046396334, 0.97179808113241, 1.42880557869041, - 2.00265362857685), quantile_levels = c(0.01, 0.025, 0.05, - 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, - 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, 0.99)), class = c("dist_quantiles", - "dist_default", "vctrs_rcrd", "vctrs_vctr")), structure(list( - values = c(0, 0, 0, 0.0925362072632727, 0.270427502912579, + 2.00265362857685), c(0, 0, 0, 0.0925362072632727, 0.270427502912579, 0.315212102423624, 0.343335698090731, 0.364285966419164, 0.381412585636556, 0.3959887, 0.4092868, 0.4218461, 0.4344055, 0.447738051828318, 0.4632179, 0.480948870517105, 0.502553166907419, 0.531676966454865, 0.576804782629326, 0.776643061384413, - 1.21840177544959, 1.666716830807, 2.19163048441111), quantile_levels = c(0.01, - 0.025, 0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, - 0.5, 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, - 0.99)), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr")), structure(list(values = c(0, 0, 0, 0, 0.186887482630176, - 0.277238777881179, 0.317854348809488, 0.345779327332173, 0.367941987952029, - 0.38755201396574, 0.405055828677287, 0.4218461, 0.438666668060931, - 0.456611962704227, 0.476718028677287, 0.499751625882259, 0.528508989683397, - 0.569810205861059, 0.666081219804098, 0.934028445917159, 1.42658287124316, - 1.85311957889209, 2.30760254154095), quantile_levels = c(0.01, - 0.025, 0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, - 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, 0.99 - )), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr")), structure(list(values = c(0, 0, 0, 0, 0.0845659921302213, - 0.228553649752897, 0.289236861333113, 0.326073140839108, 0.354785333802038, - 0.379166830409904, 0.401230227456875, 0.4218461, 0.442801275729157, - 0.465572618600986, 0.490133389090691, 0.520052318734487, 0.558588500497255, - 0.62065225601836, 0.788392143304334, 1.05428294678997, 1.55684044507063, - 2.01374350966068, 2.37954449328776), quantile_levels = c(0.01, - 0.025, 0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, - 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, 0.99 - )), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr")), structure(list(values = c(0.33818795, 0.4386877525, - 0.528816855, 0.61252005, 0.6626973, 0.6816954, 0.697340875, 0.7085162, - 0.7152214, 0.7208091, 0.72745833, 0.7319844, 0.73651047, 0.7431597, - 0.7487474, 0.7554526, 0.766627925, 0.7822734, 0.8012715, 0.85144875, - 0.935151945, 1.0252810475, 1.12578085), quantile_levels = c(0.01, - 0.025, 0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, - 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, 0.99 - )), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr")), structure(list(values = c(0.276821846502455, - 0.354318476867519, 0.440270225449805, 0.533132934163242, 0.5900576, - 0.631102729748298, 0.660462274661497, 0.680831108876989, 0.696223359635746, - 0.7096337, 0.7219265, 0.7319844, 0.7431597, 0.7543351, 0.7677455, - 0.783391, 0.804046832839828, 0.833541896886769, 0.873735298798638, - 0.929106903073231, 1.02188617627186, 1.10971107833641, 1.18626816850867 - ), quantile_levels = c(0.01, 0.025, 0.05, 0.1, 0.15, 0.2, 0.25, - 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, - 0.9, 0.95, 0.975, 0.99)), class = c("dist_quantiles", "dist_default", - "vctrs_rcrd", "vctrs_vctr")), structure(list(values = c(0.202265200637946, - 0.298325094034965, 0.380907645938709, 0.481339524857949, 0.543219696138311, - 0.589507953775938, 0.6258186, 0.654874580912809, 0.6783427, 0.6984583, - 0.715655544727447, 0.7319844, 0.7487473, 0.7666278, 0.785715489951649, - 0.8090941, 0.83815, 0.873623567291473, 0.920206978680437, 0.98231174201862, - 1.08425930872329, 1.16639411427812, 1.25926838507547), quantile_levels = c(0.01, + 1.21840177544959, 1.666716830807, 2.19163048441111), c(0, + 0, 0, 0, 0.186887482630176, 0.277238777881179, 0.317854348809488, + 0.345779327332173, 0.367941987952029, 0.38755201396574, 0.405055828677287, + 0.4218461, 0.438666668060931, 0.456611962704227, 0.476718028677287, + 0.499751625882259, 0.528508989683397, 0.569810205861059, + 0.666081219804098, 0.934028445917159, 1.42658287124316, 1.85311957889209, + 2.30760254154095), c(0, 0, 0, 0, 0.0845659921302213, 0.228553649752897, + 0.289236861333113, 0.326073140839108, 0.354785333802038, + 0.379166830409904, 0.401230227456875, 0.4218461, 0.442801275729157, + 0.465572618600986, 0.490133389090691, 0.520052318734487, + 0.558588500497255, 0.62065225601836, 0.788392143304334, 1.05428294678997, + 1.55684044507063, 2.01374350966068, 2.37954449328776), c(0.33818795, + 0.4386877525, 0.528816855, 0.61252005, 0.6626973, 0.6816954, + 0.697340875, 0.7085162, 0.7152214, 0.7208091, 0.72745833, + 0.7319844, 0.73651047, 0.7431597, 0.7487474, 0.7554526, 0.766627925, + 0.7822734, 0.8012715, 0.85144875, 0.935151945, 1.0252810475, + 1.12578085), c(0.276821846502455, 0.354318476867519, 0.440270225449805, + 0.533132934163242, 0.5900576, 0.631102729748298, 0.660462274661497, + 0.680831108876989, 0.696223359635746, 0.7096337, 0.7219265, + 0.7319844, 0.7431597, 0.7543351, 0.7677455, 0.783391, 0.804046832839828, + 0.833541896886769, 0.873735298798638, 0.929106903073231, + 1.02188617627186, 1.10971107833641, 1.18626816850867), c(0.202265200637946, + 0.298325094034965, 0.380907645938709, 0.481339524857949, + 0.543219696138311, 0.589507953775938, 0.6258186, 0.654874580912809, + 0.6783427, 0.6984583, 0.715655544727447, 0.7319844, 0.7487473, + 0.7666278, 0.785715489951649, 0.8090941, 0.83815, 0.873623567291473, + 0.920206978680437, 0.98231174201862, 1.08425930872329, 1.16639411427812, + 1.25926838507547), c(0.129193504425124, 0.241744300793533, + 0.331949483165032, 0.43649858695157, 0.504472062268773, 0.556141464729147, + 0.597172505336053, 0.631406591640416, 0.660898437441874, + 0.686684727470375, 0.709633972330423, 0.7319844, 0.753217699696647, + 0.77608746100351, 0.8012715950276, 0.830327492252422, 0.86464477397774, + 0.906319686121761, 0.956815387818928, 1.02495125855129, 1.13129413647201, + 1.21644533535035, 1.32424172966634), c(0.0667682979050189, + 0.189580042212397, 0.290485041721667, 0.402951609190092, + 0.475328740486855, 0.530590906520765, 0.575504908587586, + 0.613421932920829, 0.647285177364573, 0.678099283398734, + 0.70593862799773, 0.7319844, 0.758701322488325, 0.786639532920829, + 0.816837200234752, 0.850627936753767, 0.888963924063491, + 0.933785069065791, 0.988913131611816, 1.06240172852619, 1.16959624730917, + 1.2662008825538, 1.38860505690239), c(0, 0, 0.0419413650000001, + 0.09882005, 0.1230992, 0.14226962, 0.1600776, 0.1722416, + 0.1800265, 0.1880061, 0.1936501, 0.1975426, 0.2014351, 0.2070791, + 0.2150587, 0.2228436, 0.2350076, 0.25281558, 0.271986, 0.29626515, + 0.353143835, 0.4353357125, 0.545314878), c(0, 0, 0, 0.0438463650372504, + 0.0808594787511875, 0.106995615813358, 0.127478232938079, + 0.145480846633466, 0.1610508, 0.17461199504795, 0.186668812203222, + 0.1975426, 0.208428571374764, 0.2204108, 0.233930283744537, + 0.249894552784127, 0.267362348440485, 0.288755575723157, + 0.316120297580926, 0.355450425419354, 0.443192503687136, + 0.536871211931719, 0.636344785545224), c(0, 0, 0, 0.00188932708477086, + 0.0470905919531195, 0.079226864399944, 0.105414109111591, + 0.127225815559956, 0.146699420891509, 0.164644114298843, + 0.18142942603581, 0.1975426, 0.213933119201142, 0.231001630488804, + 0.24941229702312, 0.269578845560456, 0.292362546530965, 0.319632071367214, + 0.354433951358713, 0.406915236639266, 0.506944745332152, + 0.596044605353528, 0.695533388807317), c(0, 0, 0, 0, 0.0156342454546545, + 0.0536811248488485, 0.084228833507335, 0.110407751354614, + 0.134410113872139, 0.156669167575476, 0.177701902429674, + 0.1975426, 0.217759024165492, 0.238897316673167, 0.261484572608426, + 0.286120039498095, 0.313065324705997, 0.345395334882349, + 0.386811116673167, 0.44780805303823, 0.550781846423163, 0.644984940689833, + 0.752937731654986), c(0, 0, 0, 0, 0, 0.0290260214229144, + 0.0653218111708617, 0.0966336637233373, 0.124670861123061, + 0.149775978614687, 0.174275935467055, 0.1975426, 0.221291415429954, + 0.246723385601356, 0.273144383515685, 0.30101566402084, 0.33204051788793, + 0.369730347126771, 0.416909038104281, 0.481925596660567, + 0.58989871202142, 0.688635568252056, 0.803906183401304)), quantile_levels = c(0.01, 0.025, 0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, 0.99 - )), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr")), structure(list(values = c(0.129193504425124, - 0.241744300793533, 0.331949483165032, 0.43649858695157, 0.504472062268773, - 0.556141464729147, 0.597172505336053, 0.631406591640416, 0.660898437441874, - 0.686684727470375, 0.709633972330423, 0.7319844, 0.753217699696647, - 0.77608746100351, 0.8012715950276, 0.830327492252422, 0.86464477397774, - 0.906319686121761, 0.956815387818928, 1.02495125855129, 1.13129413647201, - 1.21644533535035, 1.32424172966634), quantile_levels = c(0.01, - 0.025, 0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, - 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, 0.99 - )), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr")), structure(list(values = c(0.0667682979050189, - 0.189580042212397, 0.290485041721667, 0.402951609190092, 0.475328740486855, - 0.530590906520765, 0.575504908587586, 0.613421932920829, 0.647285177364573, - 0.678099283398734, 0.70593862799773, 0.7319844, 0.758701322488325, - 0.786639532920829, 0.816837200234752, 0.850627936753767, 0.888963924063491, - 0.933785069065791, 0.988913131611816, 1.06240172852619, 1.16959624730917, - 1.2662008825538, 1.38860505690239), quantile_levels = c(0.01, - 0.025, 0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, - 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, 0.99 - )), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr")), structure(list(values = c(0, 0, 0.0419413650000001, - 0.09882005, 0.1230992, 0.14226962, 0.1600776, 0.1722416, 0.1800265, - 0.1880061, 0.1936501, 0.1975426, 0.2014351, 0.2070791, 0.2150587, - 0.2228436, 0.2350076, 0.25281558, 0.271986, 0.29626515, 0.353143835, - 0.4353357125, 0.545314878), quantile_levels = c(0.01, 0.025, - 0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, - 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, 0.99)), class = c("dist_quantiles", - "dist_default", "vctrs_rcrd", "vctrs_vctr")), structure(list( - values = c(0, 0, 0, 0.0438463650372504, 0.0808594787511875, - 0.106995615813358, 0.127478232938079, 0.145480846633466, - 0.1610508, 0.17461199504795, 0.186668812203222, 0.1975426, - 0.208428571374764, 0.2204108, 0.233930283744537, 0.249894552784127, - 0.267362348440485, 0.288755575723157, 0.316120297580926, - 0.355450425419354, 0.443192503687136, 0.536871211931719, - 0.636344785545224), quantile_levels = c(0.01, 0.025, 0.05, - 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, - 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, 0.99)), class = c("dist_quantiles", - "dist_default", "vctrs_rcrd", "vctrs_vctr")), structure(list( - values = c(0, 0, 0, 0.00188932708477086, 0.0470905919531195, - 0.079226864399944, 0.105414109111591, 0.127225815559956, - 0.146699420891509, 0.164644114298843, 0.18142942603581, 0.1975426, - 0.213933119201142, 0.231001630488804, 0.24941229702312, 0.269578845560456, - 0.292362546530965, 0.319632071367214, 0.354433951358713, - 0.406915236639266, 0.506944745332152, 0.596044605353528, - 0.695533388807317), quantile_levels = c(0.01, 0.025, 0.05, - 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, - 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, 0.99)), class = c("dist_quantiles", - "dist_default", "vctrs_rcrd", "vctrs_vctr")), structure(list( - values = c(0, 0, 0, 0, 0.0156342454546545, 0.0536811248488485, - 0.084228833507335, 0.110407751354614, 0.134410113872139, - 0.156669167575476, 0.177701902429674, 0.1975426, 0.217759024165492, - 0.238897316673167, 0.261484572608426, 0.286120039498095, - 0.313065324705997, 0.345395334882349, 0.386811116673167, - 0.44780805303823, 0.550781846423163, 0.644984940689833, 0.752937731654986 - ), quantile_levels = c(0.01, 0.025, 0.05, 0.1, 0.15, 0.2, - 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, 0.65, 0.7, 0.75, - 0.8, 0.85, 0.9, 0.95, 0.975, 0.99)), class = c("dist_quantiles", - "dist_default", "vctrs_rcrd", "vctrs_vctr")), structure(list( - values = c(0, 0, 0, 0, 0, 0.0290260214229144, 0.0653218111708617, - 0.0966336637233373, 0.124670861123061, 0.149775978614687, - 0.174275935467055, 0.1975426, 0.221291415429954, 0.246723385601356, - 0.273144383515685, 0.30101566402084, 0.33204051788793, 0.369730347126771, - 0.416909038104281, 0.481925596660567, 0.58989871202142, 0.688635568252056, - 0.803906183401304), quantile_levels = c(0.01, 0.025, 0.05, - 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, - 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.975, 0.99)), class = c("dist_quantiles", - "dist_default", "vctrs_rcrd", "vctrs_vctr"))), class = c("distribution", - "vctrs_vctr", "list")), forecast_date = structure(c(18992, 18992, + ), class = c("quantile_pred", "vctrs_vctr", "list")), forecast_date = structure(c(18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, 18992, - 18992), class = "Date"), target_date = structure(c(18997, 19002, - 19007, 19012, 19017, 18997, 19002, 19007, 19012, 19017, 18997, + 18992, 18992), class = "Date"), target_date = structure(c(18997, 19002, 19007, 19012, 19017, 18997, 19002, 19007, 19012, 19017, 18997, 19002, 19007, 19012, 19017, 18997, 19002, 19007, 19012, - 19017), class = "Date")), row.names = c(NA, -30L), class = c("tbl_df", + 19017, 18997, 19002, 19007, 19012, 19017, 18997, 19002, 19007, + 19012, 19017), class = "Date")), row.names = c(NA, -30L), class = c("tbl_df", "tbl", "data.frame")) # arx_forecaster snapshots @@ -984,24 +583,13 @@ structure(list(geo_value = c("ca", "fl", "ga", "ny", "pa", "tx" ), .pred = c(0.353013358779435, 0.648525432444877, 0.667670289394328, 1.1418673907239, 0.830448695683587, 0.329799431948649), .pred_distn = structure(list( - structure(list(values = c(0.171022956902288, 0.535003760656582 - ), quantile_levels = c(0.05, 0.95)), class = c("dist_quantiles", - "dist_default", "vctrs_rcrd", "vctrs_vctr")), structure(list( - values = c(0.46653503056773, 0.830515834322024), quantile_levels = c(0.05, - 0.95)), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr")), structure(list(values = c(0.485679887517181, - 0.849660691271475), quantile_levels = c(0.05, 0.95)), class = c("dist_quantiles", - "dist_default", "vctrs_rcrd", "vctrs_vctr")), structure(list( - values = c(0.959876988846753, 1.32385779260105), quantile_levels = c(0.05, - 0.95)), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr")), structure(list(values = c(0.64845829380644, - 1.01243909756073), quantile_levels = c(0.05, 0.95)), class = c("dist_quantiles", - "dist_default", "vctrs_rcrd", "vctrs_vctr")), structure(list( - values = c(0.147809030071502, 0.511789833825796), quantile_levels = c(0.05, - 0.95)), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr"))), class = c("distribution", "vctrs_vctr", - "list")), forecast_date = structure(c(18992, 18992, 18992, 18992, - 18992, 18992), class = "Date"), target_date = structure(c(18999, + c(0.171022956902288, 0.535003760656582), c(0.46653503056773, + 0.830515834322024), c(0.485679887517181, 0.849660691271475 + ), c(0.959876988846753, 1.32385779260105), c(0.64845829380644, + 1.01243909756073), c(0.147809030071502, 0.511789833825796 + )), quantile_levels = c(0.05, 0.95), class = c("quantile_pred", + "vctrs_vctr", "list")), forecast_date = structure(c(18992, 18992, + 18992, 18992, 18992, 18992), class = "Date"), target_date = structure(c(18999, 18999, 18999, 18999, 18999, 18999), class = "Date")), row.names = c(NA, -6L), class = c("tbl_df", "tbl", "data.frame")) @@ -1010,24 +598,13 @@ structure(list(geo_value = c("ca", "fl", "ga", "ny", "pa", "tx" ), .pred = c(0.149303403634373, 0.139764664505948, 0.333186321066645, 0.470345577837144, 0.725986105412008, 0.212686665274007), .pred_distn = structure(list( - structure(list(values = c(0.0961118191398634, 0.202494988128882 - ), quantile_levels = c(0.05, 0.95)), class = c("dist_quantiles", - "dist_default", "vctrs_rcrd", "vctrs_vctr")), structure(list( - values = c(0.0865730800114383, 0.192956249000457), quantile_levels = c(0.05, - 0.95)), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr")), structure(list(values = c(0.279994736572136, - 0.386377905561154), quantile_levels = c(0.05, 0.95)), class = c("dist_quantiles", - "dist_default", "vctrs_rcrd", "vctrs_vctr")), structure(list( - values = c(0.417153993342634, 0.523537162331653), quantile_levels = c(0.05, - 0.95)), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr")), structure(list(values = c(0.672794520917498, - 0.779177689906517), quantile_levels = c(0.05, 0.95)), class = c("dist_quantiles", - "dist_default", "vctrs_rcrd", "vctrs_vctr")), structure(list( - values = c(0.159495080779498, 0.265878249768516), quantile_levels = c(0.05, - 0.95)), class = c("dist_quantiles", "dist_default", "vctrs_rcrd", - "vctrs_vctr"))), class = c("distribution", "vctrs_vctr", - "list")), forecast_date = structure(c(18992, 18992, 18992, 18992, - 18992, 18992), class = "Date"), target_date = structure(c(18993, + c(0.0961118191398634, 0.202494988128882), c(0.0865730800114383, + 0.192956249000457), c(0.279994736572136, 0.386377905561154 + ), c(0.417153993342634, 0.523537162331653), c(0.672794520917498, + 0.779177689906517), c(0.159495080779498, 0.265878249768516 + )), quantile_levels = c(0.05, 0.95), class = c("quantile_pred", + "vctrs_vctr", "list")), forecast_date = structure(c(18992, 18992, + 18992, 18992, 18992, 18992), class = "Date"), target_date = structure(c(18993, 18993, 18993, 18993, 18993, 18993), class = "Date")), row.names = c(NA, -6L), class = c("tbl_df", "tbl", "data.frame")) diff --git a/tests/testthat/_snaps/step_epi_naomit.md b/tests/testthat/_snaps/step_epi_naomit.md new file mode 100644 index 000000000..653e84d0e --- /dev/null +++ b/tests/testthat/_snaps/step_epi_naomit.md @@ -0,0 +1,8 @@ +# Argument must be a recipe + + Code + step_epi_naomit(x) + Condition + Error in `step_epi_naomit()`: + ! inherits(recipe, "recipe") is not TRUE + diff --git a/tests/testthat/_snaps/step_epi_shift.md b/tests/testthat/_snaps/step_epi_shift.md new file mode 100644 index 000000000..1c14bd68e --- /dev/null +++ b/tests/testthat/_snaps/step_epi_shift.md @@ -0,0 +1,37 @@ +# Values for ahead and lag must be integer values + + Code + r1 <- recipe(x) %>% step_epi_ahead(death_rate, ahead = 3.6) %>% step_epi_lag( + death_rate, lag = 1.9) + Condition + Error in `step_epi_ahead()`: + ! `ahead` must be a non-negative integer. + +# A negative lag value should should throw an error + + Code + r2 <- recipe(x) %>% step_epi_ahead(death_rate, ahead = 7) %>% step_epi_lag( + death_rate, lag = -7) + Condition + Error in `step_epi_lag()`: + ! `lag` must be a non-negative integer. + +# A nonpositive ahead value should throw an error + + Code + r3 <- recipe(x) %>% step_epi_ahead(death_rate, ahead = -7) %>% step_epi_lag( + death_rate, lag = 7) + Condition + Error in `step_epi_ahead()`: + ! `ahead` must be a non-negative integer. + +# Values for ahead and lag cannot be duplicates + + Code + slm_fit(r4) + Condition + Error in `step_epi_lag()`: + Caused by error in `bake()`: + ! Name collision occured in + The following variable name already exists: "lag_7_death_rate". + diff --git a/tests/testthat/_snaps/step_epi_slide.md b/tests/testthat/_snaps/step_epi_slide.md new file mode 100644 index 000000000..e1fbd6bc6 --- /dev/null +++ b/tests/testthat/_snaps/step_epi_slide.md @@ -0,0 +1,154 @@ +# epi_slide errors when needed + + Code + recipe(edf) %>% step_epi_slide(value, .f = mean, .window_size = 7L) + Message + + -- Epi Recipe ------------------------------------------------------------------ + + -- Inputs + Number of variables by role + geo_value: 1 + time_value: 1 + undeclared role: 1 + + -- Operations + 1. Calculating epi_slide for: value with .f + +--- + + Code + r %>% step_epi_slide(value, .f = mean, .window_size = c(3L, 6L)) + Condition + Error in `epiprocess:::validate_slide_window_arg()`: + ! Slide function expected `.window_size` to be a non-null, scalar integer >= 1. + +--- + + Code + r %>% step_epi_slide(value, .f = mean, .align = c("right", "left")) + Condition + Error in `step_epi_slide()`: + ! step_epi_slide: `.window_size` must be specified. + +--- + + Code + r %>% step_epi_slide(value, .f = mean, .window_size = 1L, skip = c(TRUE, FALSE)) + Condition + Error in `step_epi_slide()`: + ! `skip` must be a scalar of type . + +--- + + Code + r %>% step_epi_slide(value, .f = mean, .window_size = 1L, role = letters[1:2]) + Condition + Error in `step_epi_slide()`: + ! `role` must be a scalar of type . + +--- + + Code + r %>% step_epi_slide(value, .f = mean, .window_size = 1L, prefix = letters[1:2]) + Condition + Error in `step_epi_slide()`: + ! `prefix` must be a scalar of type . + +--- + + Code + r %>% step_epi_slide(value, .f = mean, .window_size = 1L, id = letters[1:2]) + Condition + Error in `step_epi_slide()`: + ! `id` must be a scalar of type . + +--- + + Code + r %>% step_epi_slide(value, .f = mean, .window_size = 1.5) + Condition + Error in `epiprocess:::validate_slide_window_arg()`: + ! Slide function expected `.window_size` to be a difftime with units in days or non-negative integer or Inf. + +--- + + Code + r %>% step_epi_slide(value, .f = mean, .window_size = 1L, .align = 1.5) + Condition + Error in `step_epi_slide()`: + ! `.align` must be a character vector, not the number 1.5. + +--- + + Code + r %>% step_epi_slide(value, .f = mean, .window_size = 1L, skip = "a") + Condition + Error in `step_epi_slide()`: + ! `skip` must be a scalar of type . + +--- + + Code + r %>% step_epi_slide(value, .f = mean, .window_size = 1L, role = 1) + Condition + Error in `step_epi_slide()`: + ! `role` must be a scalar of type . + +--- + + Code + r %>% step_epi_slide(value, .f = mean, .window_size = 1L, prefix = 1) + Condition + Error in `step_epi_slide()`: + ! `prefix` must be a scalar of type . + +--- + + Code + r %>% step_epi_slide(value, .f = mean, .window_size = 1L, id = 1) + Condition + Error in `step_epi_slide()`: + ! `id` must be a scalar of type . + +--- + + Code + r %>% step_epi_slide(value) + Condition + Error in `step_epi_slide()`: + ! argument ".f" is missing, with no default + +--- + + Code + r %>% step_epi_slide(value, .f = 1) + Condition + Error in `validate_slide_fun()`: + ! In, `step_epi_slide()`, `.f` must be a function. + +--- + + Code + r %>% step_epi_slide(value) + Condition + Error in `step_epi_slide()`: + ! argument ".f" is missing, with no default + +--- + + Code + r %>% step_epi_slide(value, .f = 1) + Condition + Error in `validate_slide_fun()`: + ! In, `step_epi_slide()`, `.f` must be a function. + +# epi_slide handles different function specs + + Code + lfun <- r %>% step_epi_slide(value, .f = ~ mean(.x, na.rm = TRUE), + .window_size = 4L) + Condition + Error in `validate_slide_fun()`: + ! In, `step_epi_slide()`, `.f` cannot be a formula. + diff --git a/tests/testthat/_snaps/step_growth_rate.md b/tests/testthat/_snaps/step_growth_rate.md new file mode 100644 index 000000000..5a3ac6f44 --- /dev/null +++ b/tests/testthat/_snaps/step_growth_rate.md @@ -0,0 +1,121 @@ +# step_growth_rate validates arguments + + Code + step_growth_rate(r) + Condition + Error in `step_growth_rate()`: + ! This recipe step can only operate on an . + +--- + + Code + step_growth_rate(r, value, role = 1) + Condition + Error in `step_growth_rate()`: + ! `role` must be of type . + +--- + + Code + step_growth_rate(r, value, method = "abc") + Condition + Error in `step_growth_rate()`: + ! `method` must be one of "rel_change" or "linear_reg", not "abc". + +--- + + Code + step_growth_rate(r, value, horizon = 0) + Condition + Error in `step_growth_rate()`: + ! `horizon` must be a positive integer. + +--- + + Code + step_growth_rate(r, value, horizon = c(1, 2)) + Condition + Error in `step_growth_rate()`: + ! `horizon` must be a scalar. + +--- + + Code + step_growth_rate(r, value, prefix = letters[1:2]) + Condition + Error in `step_growth_rate()`: + ! `prefix` must be a scalar of type . + +--- + + Code + step_growth_rate(r, value, id = letters[1:2]) + Condition + Error in `step_growth_rate()`: + ! `id` must be a scalar of type . + +--- + + Code + step_growth_rate(r, value, prefix = letters[1:2]) + Condition + Error in `step_growth_rate()`: + ! `prefix` must be a scalar of type . + +--- + + Code + step_growth_rate(r, value, prefix = 1) + Condition + Error in `step_growth_rate()`: + ! `prefix` must be a scalar of type . + +--- + + Code + step_growth_rate(r, value, id = 1) + Condition + Error in `step_growth_rate()`: + ! `id` must be a scalar of type . + +--- + + Code + step_growth_rate(r, value, log_scale = 1) + Condition + Error in `step_growth_rate()`: + ! `log_scale` must be a scalar of type . + +--- + + Code + step_growth_rate(r, value, skip = 1) + Condition + Error in `step_growth_rate()`: + ! `skip` must be a scalar of type . + +--- + + Code + step_growth_rate(r, value, additional_gr_args_list = 1:5) + Condition + Error in `step_growth_rate()`: + ! `additional_gr_args_list` must be a . + i See `?epiprocess::growth_rate` for available options. + +--- + + Code + step_growth_rate(r, value, replace_Inf = "c") + Condition + Error in `step_growth_rate()`: + ! `replace_Inf` must be of type . + +--- + + Code + step_growth_rate(r, value, replace_Inf = c(1, 2)) + Condition + Error in `step_growth_rate()`: + ! replace_Inf must be a scalar. + diff --git a/tests/testthat/_snaps/step_lag_difference.md b/tests/testthat/_snaps/step_lag_difference.md new file mode 100644 index 000000000..4edc9c287 --- /dev/null +++ b/tests/testthat/_snaps/step_lag_difference.md @@ -0,0 +1,72 @@ +# step_lag_difference validates arguments + + Code + step_lag_difference(r) + Condition + Error in `step_lag_difference()`: + ! This recipe step can only operate on an . + +--- + + Code + step_lag_difference(r, value, role = 1) + Condition + Error in `step_lag_difference()`: + ! `role` must be of type . + +--- + + Code + step_lag_difference(r, value, horizon = 0) + Condition + Error in `step_lag_difference()`: + ! `horizon` must be a positive integer. + +--- + + Code + step_lag_difference(r, value, prefix = letters[1:2]) + Condition + Error in `step_lag_difference()`: + ! `prefix` must be a scalar of type . + +--- + + Code + step_lag_difference(r, value, id = letters[1:2]) + Condition + Error in `step_lag_difference()`: + ! `id` must be a scalar of type . + +--- + + Code + step_lag_difference(r, value, prefix = letters[1:2]) + Condition + Error in `step_lag_difference()`: + ! `prefix` must be a scalar of type . + +--- + + Code + step_lag_difference(r, value, prefix = 1) + Condition + Error in `step_lag_difference()`: + ! `prefix` must be a scalar of type . + +--- + + Code + step_lag_difference(r, value, id = 1) + Condition + Error in `step_lag_difference()`: + ! `id` must be a scalar of type . + +--- + + Code + step_lag_difference(r, value, skip = 1) + Condition + Error in `step_lag_difference()`: + ! `skip` must be a scalar of type . + diff --git a/tests/testthat/_snaps/wis-quantile_pred.md b/tests/testthat/_snaps/wis-quantile_pred.md new file mode 100644 index 000000000..71f093607 --- /dev/null +++ b/tests/testthat/_snaps/wis-quantile_pred.md @@ -0,0 +1,16 @@ +# wis dispatches and produces the correct values + + Code + weighted_interval_score(1:10, 10) + Condition + Error in `weighted_interval_score()`: + ! Weighted interval score can only be calculated if `x` has class . + +--- + + Code + weighted_interval_score(quantile_pred(rbind(1:4, 8:11), 1:4 / 5), 1:3) + Condition + Error in `weighted_interval_score.quantile_pred()`: + ! Assertion on 'actual' failed: Must have length 2, but has length 3. + diff --git a/tests/testthat/test-arg_is_.R b/tests/testthat/test-arg_is_.R index 52a4a16db..b4d5f1a4c 100644 --- a/tests/testthat/test-arg_is_.R +++ b/tests/testthat/test-arg_is_.R @@ -15,15 +15,16 @@ dd <- Sys.Date() - 5 v <- 1:5 l <- TRUE ll <- c(TRUE, FALSE) +z <- character(0) test_that("logical", { expect_silent(arg_is_lgl(l)) expect_silent(arg_is_lgl(ll)) expect_silent(arg_is_lgl(l, ll)) - expect_error(arg_is_lgl(l, ll, n)) - expect_error(arg_is_lgl(x)) + expect_snapshot(error = TRUE, arg_is_lgl(l, ll, n)) + expect_snapshot(error = TRUE, arg_is_lgl(x)) expect_silent(arg_is_lgl(l, ll, n, allow_null = TRUE)) - expect_error(arg_is_lgl(l, ll, nn)) + expect_snapshot(error = TRUE, arg_is_lgl(l, ll, nn)) expect_silent(arg_is_lgl(l, ll, nn, allow_na = TRUE)) }) @@ -31,115 +32,123 @@ test_that("scalar", { expect_silent(arg_is_scalar(x)) expect_silent(arg_is_scalar(dd)) expect_silent(arg_is_scalar(x, y, dd)) - expect_error(arg_is_scalar(x, y, n)) + expect_snapshot(error = TRUE, arg_is_scalar(x, y, n)) expect_silent(arg_is_scalar(x, y, n, allow_null = TRUE)) - expect_error(arg_is_scalar(x, y, nn)) + expect_snapshot(error = TRUE, arg_is_scalar(x, y, nn)) expect_silent(arg_is_scalar(x, y, nn, allow_na = TRUE)) - expect_error(arg_is_scalar(v, nn)) - expect_error(arg_is_scalar(v, nn, allow_na = TRUE)) - expect_error(arg_is_scalar(v, n, allow_null = TRUE)) - expect_error(arg_is_scalar(nnn, allow_na = TRUE)) + expect_snapshot(error = TRUE, arg_is_scalar(v, nn)) + expect_snapshot(error = TRUE, arg_is_scalar(v, nn, allow_na = TRUE)) + expect_snapshot(error = TRUE, arg_is_scalar(v, n, allow_null = TRUE)) + expect_snapshot(error = TRUE, arg_is_scalar(nnn, allow_na = TRUE)) }) test_that("numeric", { expect_silent(arg_is_numeric(i, j, x, y)) - expect_error(arg_is_numeric(a)) + expect_snapshot(error = TRUE, arg_is_numeric(a)) expect_silent(arg_is_numeric(d)) expect_silent(arg_is_numeric(c(i, j))) expect_silent(arg_is_numeric(i, k)) expect_silent(arg_is_numeric(i, j, n, allow_null = TRUE)) - expect_error(arg_is_numeric(i, j, n)) - expect_error(arg_is_numeric(i, nn)) + expect_snapshot(error = TRUE, arg_is_numeric(i, j, n)) + expect_snapshot(error = TRUE, arg_is_numeric(i, nn)) expect_silent(arg_is_numeric(a = -10:10)) }) test_that("positive", { expect_silent(arg_is_pos(i, j, x, y)) - expect_error(arg_is_pos(a)) + expect_snapshot(error = TRUE, arg_is_pos(a)) expect_silent(arg_is_pos(d)) expect_silent(arg_is_pos(c(i, j))) - expect_error(arg_is_pos(i, k)) + expect_snapshot(error = TRUE, arg_is_pos(i, k)) expect_silent(arg_is_pos(i, j, n, allow_null = TRUE)) - expect_error(arg_is_pos(i, j, n)) - expect_error(arg_is_pos(i, nn)) - expect_error(arg_is_pos(a = 0:10)) + expect_snapshot(error = TRUE, arg_is_pos(i, j, n)) + expect_snapshot(error = TRUE, arg_is_pos(i, nn)) + expect_snapshot(error = TRUE, arg_is_pos(a = 0:10)) }) test_that("nonneg", { expect_silent(arg_is_nonneg(i, j, x, y)) - expect_error(arg_is_nonneg(a)) + expect_snapshot(error = TRUE, arg_is_nonneg(a)) expect_silent(arg_is_nonneg(d)) expect_silent(arg_is_nonneg(c(i, j))) - expect_error(arg_is_nonneg(i, k)) + expect_snapshot(error = TRUE, arg_is_nonneg(i, k)) expect_silent(arg_is_nonneg(i, j, n, allow_null = TRUE)) - expect_error(arg_is_nonneg(i, j, n)) - expect_error(arg_is_nonneg(i, nn)) + expect_snapshot(error = TRUE, arg_is_nonneg(i, j, n)) + expect_snapshot(error = TRUE, arg_is_nonneg(i, nn)) expect_silent(arg_is_nonneg(a = 0:10)) }) test_that("nonneg-int", { - expect_error(arg_is_nonneg_int(a)) - expect_error(arg_is_nonneg_int(d)) + expect_snapshot(error = TRUE, arg_is_nonneg_int(a)) + expect_snapshot(error = TRUE, arg_is_nonneg_int(d)) expect_silent(arg_is_nonneg_int(i, j)) expect_silent(arg_is_nonneg_int(c(i, j))) - expect_error(arg_is_nonneg_int(i, k)) + expect_snapshot(error = TRUE, arg_is_nonneg_int(i, k)) expect_silent(arg_is_nonneg_int(i, j, n, allow_null = TRUE)) - expect_error(arg_is_nonneg_int(i, j, n)) - expect_error(arg_is_nonneg_int(i, nn)) + expect_snapshot(error = TRUE, arg_is_nonneg_int(i, j, n)) + expect_snapshot(error = TRUE, arg_is_nonneg_int(i, nn)) expect_silent(arg_is_nonneg_int(a = 0:10)) }) test_that("date", { expect_silent(arg_is_date(d, dd)) expect_silent(arg_is_date(c(d, dd))) - expect_error(arg_is_date(d, dd, n)) - expect_error(arg_is_date(d, dd, nn)) + expect_snapshot(error = TRUE, arg_is_date(d, dd, n)) + expect_snapshot(error = TRUE, arg_is_date(d, dd, nn)) expect_silent(arg_is_date(d, dd, n, allow_null = TRUE)) # Upstream issue, see: https://github.com/mllg/checkmate/issues/256 # expect_silent(arg_is_date(d, dd, nn, allow_na = TRUE)) - expect_error(arg_is_date(a)) - expect_error(arg_is_date(v)) - expect_error(arg_is_date(ll)) + expect_snapshot(error = TRUE, arg_is_date(a)) + expect_snapshot(error = TRUE, arg_is_date(v)) + expect_snapshot(error = TRUE, arg_is_date(ll)) }) test_that("probabilities", { expect_silent(arg_is_probabilities(i, x)) - expect_error(arg_is_probabilities(a)) - expect_error(arg_is_probabilities(d)) + expect_snapshot(error = TRUE, arg_is_probabilities(a)) + expect_snapshot(error = TRUE, arg_is_probabilities(d)) expect_silent(arg_is_probabilities(c(.4, .7))) - expect_error(arg_is_probabilities(i, 1.1)) + expect_snapshot(error = TRUE, arg_is_probabilities(i, 1.1)) expect_silent(arg_is_probabilities(c(.4, .8), n, allow_null = TRUE)) - expect_error(arg_is_probabilities(c(.4, .8), n)) - expect_error(arg_is_probabilities(c(.4, .8), nn)) + expect_snapshot(error = TRUE, arg_is_probabilities(c(.4, .8), n)) + expect_snapshot(error = TRUE, arg_is_probabilities(c(.4, .8), nn)) }) test_that("chr", { expect_silent(arg_is_chr(a, b)) expect_silent(arg_is_chr(c(a, b))) - expect_error(arg_is_chr(a, b, n)) - expect_error(arg_is_chr(a, b, nn)) + expect_snapshot(error = TRUE, arg_is_chr(a, b, n)) + expect_snapshot(error = TRUE, arg_is_chr(a, b, nn)) expect_silent(arg_is_chr(a, b, n, allow_null = TRUE)) expect_silent(arg_is_chr(a, b, nn, allow_na = TRUE)) - expect_error(arg_is_chr(d)) - expect_error(arg_is_chr(v)) - expect_error(arg_is_chr(ll)) - expect_error(arg_is_chr(z = character(0))) - expect_silent(arg_is_chr(z = character(0), allow_empty = TRUE)) + expect_snapshot(error = TRUE, arg_is_chr(d)) + expect_snapshot(error = TRUE, arg_is_chr(v)) + expect_snapshot(error = TRUE, arg_is_chr(ll)) + expect_snapshot(error = TRUE, arg_is_chr(z)) + expect_silent(arg_is_chr(z, allow_empty = TRUE)) }) test_that("function", { expect_silent(arg_is_function(f, g, parsnip::linear_reg)) - expect_error(arg_is_function(c(a, b))) - expect_error(arg_is_function(c(f, g))) - expect_error(arg_is_function(f = NULL)) - expect_silent(arg_is_function(g, f = NULL, allow_null = TRUE)) + expect_snapshot(error = TRUE, arg_is_function(c(a, b))) + expect_snapshot(error = TRUE, arg_is_function(c(f, g))) + f <- NULL + expect_snapshot(error = TRUE, arg_is_function(f)) + expect_silent(arg_is_function(g, f, allow_null = TRUE)) }) test_that("coerce scalar to date", { - expect_error(arg_to_date("12345")) + expect_snapshot(error = TRUE, arg_to_date("12345")) expect_s3_class(arg_to_date(12345), "Date") expect_s3_class(arg_to_date("2020-01-01"), "Date") - expect_error(arg_to_date(c("12345", "12345"))) + expect_snapshot(error = TRUE, arg_to_date(c("12345", "12345"))) +}) + +test_that("simple surface step test", { + expect_snapshot( + error = TRUE, + recipe(jhu_csse_daily_subset) %>% step_epi_lag(death_rate, lag = "hello") + ) }) diff --git a/tests/testthat/test-arx_args_list.R b/tests/testthat/test-arx_args_list.R index 9d81be024..03cbc0025 100644 --- a/tests/testthat/test-arx_args_list.R +++ b/tests/testthat/test-arx_args_list.R @@ -1,30 +1,30 @@ test_that("arx_args checks inputs", { expect_s3_class(arx_args_list(), c("arx_fcast", "alist")) - expect_error(arx_args_list(ahead = c(0, 4))) - expect_error(arx_args_list(n_training = c(28, 65))) + expect_snapshot(error = TRUE, arx_args_list(ahead = c(0, 4))) + expect_snapshot(error = TRUE, arx_args_list(n_training = c(28, 65))) - expect_error(arx_args_list(ahead = -1)) - expect_error(arx_args_list(ahead = 1.5)) - expect_error(arx_args_list(n_training = -1)) - expect_error(arx_args_list(n_training = 1.5)) - expect_error(arx_args_list(lags = c(-1, 0))) - expect_error(arx_args_list(lags = list(c(1:5, 6.5), 2:8))) + expect_snapshot(error = TRUE, arx_args_list(ahead = -1)) + expect_snapshot(error = TRUE, arx_args_list(ahead = 1.5)) + expect_snapshot(error = TRUE, arx_args_list(n_training = -1)) + expect_snapshot(error = TRUE, arx_args_list(n_training = 1.5)) + expect_snapshot(error = TRUE, arx_args_list(lags = c(-1, 0))) + expect_snapshot(error = TRUE, arx_args_list(lags = list(c(1:5, 6.5), 2:8))) - expect_error(arx_args_list(symmetrize = 4)) - expect_error(arx_args_list(nonneg = 4)) + expect_snapshot(error = TRUE, arx_args_list(symmetrize = 4)) + expect_snapshot(error = TRUE, arx_args_list(nonneg = 4)) - expect_error(arx_args_list(quantile_levels = -.1)) - expect_error(arx_args_list(quantile_levels = 1.1)) + expect_snapshot(error = TRUE, arx_args_list(quantile_levels = -.1)) + expect_snapshot(error = TRUE, arx_args_list(quantile_levels = 1.1)) expect_type(arx_args_list(quantile_levels = NULL), "list") - expect_error(arx_args_list(target_date = "2022-01-01")) + expect_snapshot(error = TRUE, arx_args_list(target_date = "2022-01-01")) expect_identical( arx_args_list(target_date = as.Date("2022-01-01"))$target_date, as.Date("2022-01-01") ) - expect_error(arx_args_list(n_training_min = "de")) - expect_error(arx_args_list(epi_keys = 1)) + expect_snapshot(error = TRUE, arx_args_list(n_training_min = "de")) + expect_snapshot(error = TRUE, arx_args_list(epi_keys = 1)) expect_warning(arx_args_list( forecast_date = as.Date("2022-01-01"), @@ -58,7 +58,7 @@ test_that("arx forecaster disambiguates quantiles", { sort(unique(tlist)) ) alist <- c(.1, .3, .5, .7, .9) # neither default, and different, - expect_error(compare_quantile_args(alist, tlist)) + expect_snapshot(error = TRUE, compare_quantile_args(alist, tlist)) }) test_that("arx_lags_validator handles named & unnamed lists as expected", { @@ -94,7 +94,7 @@ test_that("arx_lags_validator handles named & unnamed lists as expected", { ) # More lags than predictors - Error - expect_error(arx_lags_validator(pred_vec, lags_finit_fn_switch2)) + expect_snapshot(error = TRUE, arx_lags_validator(pred_vec, lags_finit_fn_switch2)) # Unnamed list of lags lags_init_un <- list(c(0, 7, 14), c(0, 1, 2, 3, 7, 14)) @@ -115,5 +115,5 @@ test_that("arx_lags_validator handles named & unnamed lists as expected", { # Try use a name not in predictors - Error lags_init_other_name <- list(death_rate = c(0, 7, 14), test_var = c(0, 1, 2, 3, 7, 14)) - expect_error(arx_lags_validator(pred_vec, lags_init_other_name)) + expect_snapshot(error = TRUE, arx_lags_validator(pred_vec, lags_init_other_name)) }) diff --git a/tests/testthat/test-arx_cargs_list.R b/tests/testthat/test-arx_cargs_list.R index d225cf62a..12087e45f 100644 --- a/tests/testthat/test-arx_cargs_list.R +++ b/tests/testthat/test-arx_cargs_list.R @@ -1,24 +1,24 @@ test_that("arx_class_args checks inputs", { expect_s3_class(arx_class_args_list(), c("arx_class", "alist")) - expect_error(arx_class_args_list(ahead = c(0, 4))) - expect_error(arx_class_args_list(n_training = c(28, 65))) + expect_snapshot(error = TRUE, arx_class_args_list(ahead = c(0, 4))) + expect_snapshot(error = TRUE, arx_class_args_list(n_training = c(28, 65))) - expect_error(arx_class_args_list(ahead = -1)) - expect_error(arx_class_args_list(ahead = 1.5)) - expect_error(arx_class_args_list(n_training = -1)) - expect_error(arx_class_args_list(n_training = 1.5)) - expect_error(arx_class_args_list(lags = c(-1, 0))) - expect_error(arx_class_args_list(lags = list(c(1:5, 6.5), 2:8))) + expect_snapshot(error = TRUE, arx_class_args_list(ahead = -1)) + expect_snapshot(error = TRUE, arx_class_args_list(ahead = 1.5)) + expect_snapshot(error = TRUE, arx_class_args_list(n_training = -1)) + expect_snapshot(error = TRUE, arx_class_args_list(n_training = 1.5)) + expect_snapshot(error = TRUE, arx_class_args_list(lags = c(-1, 0))) + expect_snapshot(error = TRUE, arx_class_args_list(lags = list(c(1:5, 6.5), 2:8))) - expect_error(arx_class_args_list(target_date = "2022-01-01")) + expect_snapshot(error = TRUE, arx_class_args_list(target_date = "2022-01-01")) expect_identical( arx_class_args_list(target_date = as.Date("2022-01-01"))$target_date, as.Date("2022-01-01") ) - expect_error(arx_class_args_list(n_training_min = "de")) - expect_error(arx_class_args_list(epi_keys = 1)) + expect_snapshot(error = TRUE, arx_class_args_list(n_training_min = "de")) + expect_snapshot(error = TRUE, arx_class_args_list(epi_keys = 1)) expect_warning(arx_class_args_list( forecast_date = as.Date("2022-01-01"), diff --git a/tests/testthat/test-bake-method.R b/tests/testthat/test-bake-method.R index e1dd232e6..f942f5d77 100644 --- a/tests/testthat/test-bake-method.R +++ b/tests/testthat/test-bake-method.R @@ -25,5 +25,5 @@ test_that("bake method works in all cases", { expect_s3_class(bake(prep(r, edf), NULL, composition = "tibble"), "tbl_df") expect_s3_class(bake(prep(r, edf), NULL, composition = "data.frame"), "data.frame") # can't be a matrix because time_value/geo_value aren't numeric - expect_error(bake(prep(r, edf), NULL, composition = "matrix")) + expect_snapshot(error = TRUE, bake(prep(r, edf), NULL, composition = "matrix")) }) diff --git a/tests/testthat/test-check-training-set.R b/tests/testthat/test-check-training-set.R index 0f9246282..64d4d6945 100644 --- a/tests/testthat/test-check-training-set.R +++ b/tests/testthat/test-check-training-set.R @@ -7,7 +7,7 @@ test_that("training set validation works", { expect_silent(validate_meta_match(template, template, "time_type", "blah")) attr(t1, "metadata")$geo_type <- "county" expect_warning(validate_meta_match(t1, template, "geo_type"), "county") - expect_error(validate_meta_match(t1, template, "geo_type", "abort"), "county") + expect_snapshot(error = TRUE, validate_meta_match(t1, template, "geo_type", "abort")) expect_identical(template, epi_check_training_set(template, rec)) @@ -25,5 +25,5 @@ test_that("training set validation works", { expect_warning(t4 <- epi_check_training_set(t3, rec)) expect_identical(rec$template, t4) attr(rec$template, "metadata")$other_keys <- "missing_col" - expect_error(epi_check_training_set(t4, rec), "missing_col") + expect_snapshot(error = TRUE, epi_check_training_set(t4, rec)) }) diff --git a/tests/testthat/test-check_enough_train_data.R b/tests/testthat/test-check_enough_train_data.R index f5b3173f2..446dc321e 100644 --- a/tests/testthat/test-check_enough_train_data.R +++ b/tests/testthat/test-check_enough_train_data.R @@ -23,15 +23,16 @@ test_that("check_enough_train_data works on pooled data", { bake(new_data = NULL) ) # Check both column don't have enough data - expect_error( + expect_snapshot( + error = TRUE, recipe(toy_epi_df) %>% check_enough_train_data(x, y, n = 2 * n + 1, drop_na = FALSE) %>% prep(toy_epi_df) %>% - bake(new_data = NULL), - regexp = "The following columns don't have enough data" + bake(new_data = NULL) ) # Check drop_na works - expect_error( + expect_snapshot( + error = TRUE, recipe(toy_epi_df) %>% check_enough_train_data(x, y, n = 2 * n - 1, drop_na = TRUE) %>% prep(toy_epi_df) %>% @@ -48,15 +49,16 @@ test_that("check_enough_train_data works on unpooled data", { bake(new_data = NULL) ) # Check one column don't have enough data - expect_error( + expect_snapshot( + error = TRUE, recipe(toy_epi_df) %>% check_enough_train_data(x, y, n = n + 1, epi_keys = "geo_value", drop_na = FALSE) %>% prep(toy_epi_df) %>% - bake(new_data = NULL), - regexp = "The following columns don't have enough data" + bake(new_data = NULL) ) # Check drop_na works - expect_error( + expect_snapshot( + error = TRUE, recipe(toy_epi_df) %>% check_enough_train_data(x, y, n = 2 * n - 3, epi_keys = "geo_value", drop_na = TRUE) %>% prep(toy_epi_df) %>% @@ -114,7 +116,8 @@ test_that("check_enough_train_data works with all_predictors() downstream of con prep(toy_epi_df) %>% bake(new_data = NULL) ) - expect_error( + expect_snapshot( + error = TRUE, recipe(toy_epi_df) %>% step_epi_lag(x, lag = c(1, 2)) %>% check_enough_train_data(all_predictors(), y, n = 2 * n - 5) %>% diff --git a/tests/testthat/test-dist_quantiles.R b/tests/testthat/test-dist_quantiles.R deleted file mode 100644 index 66456ef80..000000000 --- a/tests/testthat/test-dist_quantiles.R +++ /dev/null @@ -1,111 +0,0 @@ -library(distributional) - -test_that("constructor returns reasonable quantiles", { - expect_error(new_quantiles(rnorm(5), rnorm(5))) - expect_silent(new_quantiles(sort(rnorm(5)), sort(runif(5)))) - expect_error(new_quantiles(sort(rnorm(5)), sort(runif(2)))) - expect_silent(new_quantiles(1:5, 1:5 / 10)) - expect_error(new_quantiles(c(2, 1, 3, 4, 5), c(.1, .1, .2, .5, .8))) - expect_error(new_quantiles(c(2, 1, 3, 4, 5), c(.1, .15, .2, .5, .8))) - expect_error(new_quantiles(c(1, 2, 3), c(.1, .2, 3))) -}) - - -test_that("single dist_quantiles works, quantiles are accessible", { - z <- new_quantiles(values = 1:5, quantile_levels = c(.2, .4, .5, .6, .8)) - expect_s3_class(z, "dist_quantiles") - expect_equal(median(z), 3) - expect_equal(quantile(z, c(.2, .4, .5, .6, .8)), 1:5) - expect_equal(quantile(z, c(.3, .7), middle = "linear"), c(1.5, 4.5)) - - Q <- stats::splinefun(c(.2, .4, .5, .6, .8), 1:5, method = "hyman") - expect_equal(quantile(z, c(.3, .7), middle = "cubic"), Q(c(.3, .7))) - expect_identical( - extrapolate_quantiles(z, c(.3, .7), middle = "linear"), - new_quantiles(values = c(1, 1.5, 2, 3, 4, 4.5, 5), quantile_levels = 2:8 / 10) - ) - # empty values slot results in a length zero distribution - # see issue #361 - expect_length(dist_quantiles(list(), c(.1, .9)), 0L) - expect_identical( - dist_quantiles(list(), c(.1, .9)), - distributional::dist_degenerate(double()) - ) -}) - - -test_that("quantile extrapolator works", { - dstn <- dist_normal(c(10, 2), c(5, 10)) - qq <- extrapolate_quantiles(dstn, probs = c(.25, 0.5, .75)) - expect_s3_class(qq, "distribution") - expect_s3_class(vctrs::vec_data(qq[1])[[1]], "dist_quantiles") - expect_length(parameters(qq[1])$quantile_levels[[1]], 3L) - - dstn <- dist_quantiles(list(1:4, 8:11), list(c(.2, .4, .6, .8))) - qq <- extrapolate_quantiles(dstn, probs = c(.25, 0.5, .75)) - expect_s3_class(qq, "distribution") - expect_s3_class(vctrs::vec_data(qq[1])[[1]], "dist_quantiles") - expect_length(parameters(qq[1])$quantile_levels[[1]], 7L) - - dstn <- dist_quantiles(1:4, 1:4 / 5) - qq <- extrapolate_quantiles(dstn, 1:9 / 10) - dstn_na <- dist_quantiles(c(1, 2, NA, 4), 1:4 / 5) - qq2 <- extrapolate_quantiles(dstn_na, 1:9 / 10) - expect_equal(qq, qq2) - qq3 <- extrapolate_quantiles(dstn_na, 1:9 / 10, replace_na = FALSE) - qq2_vals <- field(vec_data(qq2)[[1]], "values") - qq3_vals <- field(vec_data(qq3)[[1]], "values") - qq2_vals[6] <- NA - expect_equal(qq2_vals, qq3_vals) -}) - -test_that("small deviations of quantile requests work", { - l <- c(.05, .1, .25, .75, .9, .95) - v <- c(0.0890306, 0.1424997, 0.1971793, 0.2850978, 0.3832912, 0.4240479) - badl <- l - badl[1] <- badl[1] - 1e-14 - distn <- dist_quantiles(list(v), list(l)) - - # was broken before, now works - expect_equal(quantile(distn, l), quantile(distn, badl)) - - # The tail extrapolation was still poor. It needs to _always_ use - # the smallest (largest) values or we could end up unsorted - l <- 1:9 / 10 - v <- 1:9 - distn <- dist_quantiles(list(v), list(l)) - expect_equal(quantile(distn, c(.25, .75)), list(c(2.5, 7.5))) - expect_equal(quantile(distn, c(.1, .9)), list(c(1, 9))) - qv <- data.frame(q = l, v = v) - expect_equal( - unlist(quantile(distn, c(.01, .05))), - tail_extrapolate(c(.01, .05), head(qv, 2)) - ) - expect_equal( - unlist(quantile(distn, c(.99, .95))), - tail_extrapolate(c(.95, .99), tail(qv, 2)) - ) -}) - -test_that("unary math works on quantiles", { - dstn <- dist_quantiles(list(1:4, 8:11), list(c(.2, .4, .6, .8))) - dstn2 <- dist_quantiles(list(log(1:4), log(8:11)), list(c(.2, .4, .6, .8))) - expect_identical(log(dstn), dstn2) - - dstn2 <- dist_quantiles(list(cumsum(1:4), cumsum(8:11)), list(c(.2, .4, .6, .8))) - expect_identical(cumsum(dstn), dstn2) -}) - -test_that("arithmetic works on quantiles", { - dstn <- dist_quantiles(list(1:4, 8:11), list(c(.2, .4, .6, .8))) - dstn2 <- dist_quantiles(list(1:4 + 1, 8:11 + 1), list(c(.2, .4, .6, .8))) - expect_identical(dstn + 1, dstn2) - expect_identical(1 + dstn, dstn2) - - dstn2 <- dist_quantiles(list(1:4 / 4, 8:11 / 4), list(c(.2, .4, .6, .8))) - expect_identical(dstn / 4, dstn2) - expect_identical((1 / 4) * dstn, dstn2) - - expect_error(sum(dstn)) - expect_error(suppressWarnings(dstn + distributional::dist_normal())) -}) diff --git a/tests/testthat/test-enframer.R b/tests/testthat/test-enframer.R index c555ea9b2..0926c587b 100644 --- a/tests/testthat/test-enframer.R +++ b/tests/testthat/test-enframer.R @@ -1,11 +1,11 @@ test_that("enframer errors/works as needed", { template1 <- data.frame(aa = 1:5, a = NA, b = NA, c = NA) template2 <- data.frame(aa = 1:5, a = 2:6, b = 2:6, c = 2:6) - expect_error(enframer(1:5, letters[1])) - expect_error(enframer(data.frame(a = 1:5), 1:3)) - expect_error(enframer(data.frame(a = 1:5), letters[1:3])) + expect_snapshot(error = TRUE, enframer(1:5, letters[1])) + expect_snapshot(error = TRUE, enframer(data.frame(a = 1:5), 1:3)) + expect_snapshot(error = TRUE, enframer(data.frame(a = 1:5), letters[1:3])) expect_identical(enframer(data.frame(aa = 1:5), letters[1:3]), template1) - expect_error(enframer(data.frame(aa = 1:5), letters[1:2], fill = 1:4)) + expect_snapshot(error = TRUE, enframer(data.frame(aa = 1:5), letters[1:2], fill = 1:4)) expect_identical( enframer(data.frame(aa = 1:5), letters[1:3], fill = 2:6), template2 diff --git a/tests/testthat/test-epi_recipe.R b/tests/testthat/test-epi_recipe.R index 20d30a158..ba01e5e64 100644 --- a/tests/testthat/test-epi_recipe.R +++ b/tests/testthat/test-epi_recipe.R @@ -53,7 +53,7 @@ test_that("recipe formula works", { time_value = seq(as.Date("2020-01-01"), by = 1, length.out = 5), geo_value = "ca", z = "dummy_key" - ) %>% epiprocess::as_epi_df(additional_metadata = list(other_keys = "z")) + ) %>% epiprocess::as_epi_df(other_keys = "z") # with an additional key r <- recipe(y ~ x + geo_value, tib) @@ -165,6 +165,6 @@ test_that("add/update/adjust/remove epi_recipe works as intended", { wf <- remove_epi_recipe(wf) - expect_error(workflows::extract_preprocessor(wf)$steps) + expect_snapshot(error = TRUE, workflows::extract_preprocessor(wf)$steps) expect_equal(wf$pre$actions$recipe$recipe, NULL) }) diff --git a/tests/testthat/test-epi_workflow.R b/tests/testthat/test-epi_workflow.R index 94799faa1..9a87745ed 100644 --- a/tests/testthat/test-epi_workflow.R +++ b/tests/testthat/test-epi_workflow.R @@ -59,7 +59,7 @@ test_that("model can be added/updated/removed from epi_workflow", { expect_equal(class(model_spec2), c("linear_reg", "model_spec")) wf <- remove_model(wf) - expect_error(extract_spec_parsnip(wf)) + expect_snapshot(error = TRUE, extract_spec_parsnip(wf)) expect_equal(wf$fit$actions$model$spec, NULL) }) @@ -103,5 +103,41 @@ test_that("forecast method errors when workflow not fit", { step_epi_naomit() wf <- epi_workflow(r, parsnip::linear_reg()) - expect_error(forecast(wf)) + expect_snapshot(error = TRUE, forecast(wf)) +}) + +test_that("fit method does not silently drop the class", { + # This is issue #363 + + library(recipes) + tbl <- tibble::tibble( + geo_value = 1, + time_value = 1:100, + x = 1:100, + y = x + rnorm(100L) + ) + edf <- as_epi_df(tbl) + + rec_tbl <- recipe(y ~ x, data = tbl) + rec_edf <- recipe(y ~ x, data = edf) + erec_edf <- recipe(y ~ x, data = edf) + + ewf_rec_tbl <- epi_workflow(rec_tbl, linear_reg()) + ewf_rec_edf <- epi_workflow(rec_edf, linear_reg()) + ewf_erec_edf <- epi_workflow(erec_edf, linear_reg()) + + # above are all epi_workflows: + + expect_s3_class(ewf_rec_tbl, "epi_workflow") + expect_s3_class(ewf_rec_edf, "epi_workflow") + expect_s3_class(ewf_erec_edf, "epi_workflow") + + # but fitting drops the class or generates errors in many cases: + + expect_s3_class(ewf_rec_tbl %>% fit(tbl), "epi_workflow") + expect_s3_class(ewf_rec_tbl %>% fit(edf), "epi_workflow") + expect_warning(ewf_rec_edf %>% fit(tbl)) + expect_s3_class(ewf_rec_edf %>% fit(edf), "epi_workflow") + expect_warning(ewf_erec_edf %>% fit(tbl)) + expect_s3_class(ewf_erec_edf %>% fit(edf), "epi_workflow") }) diff --git a/tests/testthat/test-extract_argument.R b/tests/testthat/test-extract_argument.R index bbccaad78..2fb2cb9b5 100644 --- a/tests/testthat/test-extract_argument.R +++ b/tests/testthat/test-extract_argument.R @@ -4,27 +4,27 @@ test_that("layer argument extractor works", { layer_residual_quantiles(quantile_levels = c(0.0275, 0.975), symmetrize = FALSE) %>% layer_naomit(.pred) - expect_error(extract_argument(f$layers[[1]], "uhoh", "bubble")) - expect_error(extract_argument(f$layers[[1]], "layer_predict", "bubble")) + expect_snapshot(error = TRUE, extract_argument(f$layers[[1]], "uhoh", "bubble")) + expect_snapshot(error = TRUE, extract_argument(f$layers[[1]], "layer_predict", "bubble")) expect_identical( extract_argument(f$layers[[2]], "layer_residual_quantiles", "quantile_levels"), c(0.0275, 0.9750) ) - expect_error(extract_argument(f, "layer_thresh", "quantile_levels")) + expect_snapshot(error = TRUE, extract_argument(f, "layer_thresh", "quantile_levels")) expect_identical( extract_argument(f, "layer_residual_quantiles", "quantile_levels"), c(0.0275, 0.9750) ) wf <- epi_workflow(postprocessor = f) - expect_error(extract_argument(epi_workflow(), "layer_residual_quantiles", "quantile_levels")) + expect_snapshot(error = TRUE, extract_argument(epi_workflow(), "layer_residual_quantiles", "quantile_levels")) expect_identical( extract_argument(wf, "layer_residual_quantiles", "quantile_levels"), c(0.0275, 0.9750) ) - expect_error(extract_argument(wf, "layer_predict", c("type", "opts"))) + expect_snapshot(error = TRUE, extract_argument(wf, "layer_predict", c("type", "opts"))) }) test_that("recipe argument extractor works", { @@ -41,19 +41,19 @@ test_that("recipe argument extractor works", { step_naomit(all_outcomes(), skip = TRUE) - expect_error(extract_argument(r$steps[[1]], "uhoh", "bubble")) - expect_error(extract_argument(r$steps[[1]], "step_epi_lag", "bubble")) + expect_snapshot(error = TRUE, extract_argument(r$steps[[1]], "uhoh", "bubble")) + expect_snapshot(error = TRUE, extract_argument(r$steps[[1]], "step_epi_lag", "bubble")) expect_identical(extract_argument(r$steps[[2]], "step_epi_ahead", "ahead"), 7L) - expect_error(extract_argument(r, "step_lightly", "quantile_levels")) + expect_snapshot(error = TRUE, extract_argument(r, "step_lightly", "quantile_levels")) expect_identical( extract_argument(r, "step_epi_lag", "lag"), list(c(0L, 7L, 14L), c(0L, 7L, 14L)) ) wf <- epi_workflow(preprocessor = r) - expect_error(extract_argument(epi_workflow(), "step_epi_lag", "lag")) + expect_snapshot(error = TRUE, extract_argument(epi_workflow(), "step_epi_lag", "lag")) expect_identical( extract_argument(wf, "step_epi_lag", "lag"), list(c(0L, 7L, 14L), c(0L, 7L, 14L)) diff --git a/tests/testthat/test-flatline_args_list.R b/tests/testthat/test-flatline_args_list.R index 86f42a208..6359afc27 100644 --- a/tests/testthat/test-flatline_args_list.R +++ b/tests/testthat/test-flatline_args_list.R @@ -1,30 +1,30 @@ test_that("flatline_args_list checks inputs", { expect_s3_class(flatline_args_list(), c("flat_fcast", "alist")) - expect_error(flatline_args_list(ahead = c(0, 4))) - expect_error(flatline_args_list(n_training = c(28, 65))) + expect_snapshot(error = TRUE, flatline_args_list(ahead = c(0, 4))) + expect_snapshot(error = TRUE, flatline_args_list(n_training = c(28, 65))) - expect_error(flatline_args_list(ahead = -1)) - expect_error(flatline_args_list(ahead = 1.5)) - expect_error(flatline_args_list(n_training = -1)) - expect_error(flatline_args_list(n_training = 1.5)) - expect_error(flatline_args_list(lags = c(-1, 0))) - expect_error(flatline_args_list(lags = list(c(1:5, 6.5), 2:8))) + expect_snapshot(error = TRUE, flatline_args_list(ahead = -1)) + expect_snapshot(error = TRUE, flatline_args_list(ahead = 1.5)) + expect_snapshot(error = TRUE, flatline_args_list(n_training = -1)) + expect_snapshot(error = TRUE, flatline_args_list(n_training = 1.5)) + expect_snapshot(error = TRUE, flatline_args_list(lags = c(-1, 0))) + expect_snapshot(error = TRUE, flatline_args_list(lags = list(c(1:5, 6.5), 2:8))) - expect_error(flatline_args_list(symmetrize = 4)) - expect_error(flatline_args_list(nonneg = 4)) + expect_snapshot(error = TRUE, flatline_args_list(symmetrize = 4)) + expect_snapshot(error = TRUE, flatline_args_list(nonneg = 4)) - expect_error(flatline_args_list(quantile_levels = -.1)) - expect_error(flatline_args_list(quantile_levels = 1.1)) + expect_snapshot(error = TRUE, flatline_args_list(quantile_levels = -.1)) + expect_snapshot(error = TRUE, flatline_args_list(quantile_levels = 1.1)) expect_type(flatline_args_list(quantile_levels = NULL), "list") - expect_error(flatline_args_list(target_date = "2022-01-01")) + expect_snapshot(error = TRUE, flatline_args_list(target_date = "2022-01-01")) expect_identical( flatline_args_list(target_date = as.Date("2022-01-01"))$target_date, as.Date("2022-01-01") ) - expect_error(flatline_args_list(n_training_min = "de")) - expect_error(flatline_args_list(epi_keys = 1)) + expect_snapshot(error = TRUE, flatline_args_list(n_training_min = "de")) + expect_snapshot(error = TRUE, flatline_args_list(epi_keys = 1)) # Detect mismatched ahead and target_date - forecast_date difference expect_warning(flatline_args_list( diff --git a/tests/testthat/test-frosting.R b/tests/testthat/test-frosting.R index 9c00e210d..74f4cfcd2 100644 --- a/tests/testthat/test-frosting.R +++ b/tests/testthat/test-frosting.R @@ -7,7 +7,7 @@ test_that("frosting validators / constructors work", { expect_false(has_postprocessor_frosting(wf)) expect_silent(wf %>% add_frosting(new_frosting())) expect_silent(wf %>% add_postprocessor(new_frosting())) - expect_error(wf %>% add_postprocessor(list())) + expect_snapshot(error = TRUE, wf %>% add_postprocessor(list())) wf <- wf %>% add_frosting(new_frosting()) expect_true(has_postprocessor(wf)) @@ -16,7 +16,7 @@ test_that("frosting validators / constructors work", { test_that("frosting can be created/added/updated/adjusted/removed", { f <- frosting() - expect_error(frosting(layers = 1:5)) + expect_snapshot(error = TRUE, frosting(layers = 1:5)) wf <- epi_workflow() %>% add_frosting(f) expect_true(has_postprocessor_frosting(wf)) wf1 <- update_frosting(wf, frosting() %>% layer_predict() %>% layer_threshold(.pred)) diff --git a/tests/testthat/test-get_test_data.R b/tests/testthat/test-get_test_data.R index c0f32bc42..740b9099f 100644 --- a/tests/testthat/test-get_test_data.R +++ b/tests/testthat/test-get_test_data.R @@ -25,7 +25,7 @@ test_that("expect insufficient training data error", { step_naomit(all_predictors()) %>% step_naomit(all_outcomes(), skip = TRUE) - expect_error(get_test_data(recipe = r, x = case_death_rate_subset)) + expect_snapshot(error = TRUE, get_test_data(recipe = r, x = case_death_rate_subset)) }) @@ -39,7 +39,7 @@ test_that("expect error that geo_value or time_value does not exist", { wrong_epi_df <- case_death_rate_subset %>% dplyr::select(-geo_value) - expect_error(get_test_data(recipe = r, x = wrong_epi_df)) + expect_snapshot(error = TRUE, get_test_data(recipe = r, x = wrong_epi_df)) }) @@ -60,15 +60,15 @@ test_that("NA fill behaves as desired", { expect_silent(tt <- get_test_data(r, df)) expect_s3_class(tt, "epi_df") - expect_error(get_test_data(r, df, "A")) - expect_error(get_test_data(r, df, TRUE, -3)) + expect_snapshot(error = TRUE, get_test_data(r, df, "A")) + expect_snapshot(error = TRUE, get_test_data(r, df, TRUE, -3)) df2 <- df df2$x1[df2$geo_value == "ca"] <- NA td <- get_test_data(r, df2) expect_true(any(is.na(td))) - expect_error(get_test_data(r, df2, TRUE)) + expect_snapshot(error = TRUE, get_test_data(r, df2, TRUE)) df1 <- df2 df1$x1[1:4] <- 1:4 @@ -93,9 +93,9 @@ test_that("forecast date behaves", { step_epi_ahead(x1, ahead = 3) %>% step_epi_lag(x1, x2, lag = c(1, 3)) - expect_error(get_test_data(r, df, TRUE, forecast_date = 9)) # class error - expect_error(get_test_data(r, df, TRUE, forecast_date = 9L)) # fd too early - expect_error(get_test_data(r, df, forecast_date = 9L)) # fd too early + expect_snapshot(error = TRUE, get_test_data(r, df, TRUE, forecast_date = 9)) # class error + expect_snapshot(error = TRUE, get_test_data(r, df, TRUE, forecast_date = 9L)) # fd too early + expect_snapshot(error = TRUE, get_test_data(r, df, forecast_date = 9L)) # fd too early ndf <- get_test_data(r, df, TRUE, forecast_date = 12L) expect_equal(max(ndf$time_value), 11L) # max lag was 1 diff --git a/tests/testthat/test-key_colnames.R b/tests/testthat/test-key_colnames.R index fdda59ad5..cbf8e3a75 100644 --- a/tests/testthat/test-key_colnames.R +++ b/tests/testthat/test-key_colnames.R @@ -38,24 +38,23 @@ test_that("key_colnames extracts additional keys when they are present", { value = 1:length(geo_value) + 0.01 * rnorm(length(geo_value)) ) %>% as_epi_df( - additional_metadata = list(other_keys = c("state", "pol")) + other_keys = c("state", "pol") ) + expect_identical( + key_colnames(my_data), + c("geo_value", "state", "pol", "time_value") + ) + my_recipe <- recipe(my_data) %>% step_epi_ahead(value, ahead = 7) %>% step_epi_naomit() # order of the additional keys may be different - expect_setequal( - key_colnames(my_recipe), - c("geo_value", "time_value", "state", "pol") - ) + expect_equal(key_colnames(my_recipe), c("geo_value", "state", "pol", "time_value")) my_workflow <- epi_workflow(my_recipe, linear_reg()) %>% fit(my_data) # order of the additional keys may be different - expect_setequal( - key_colnames(my_workflow), - c("geo_value", "time_value", "state", "pol") - ) + expect_equal(key_colnames(my_workflow), c("geo_value", "state", "pol", "time_value")) }) diff --git a/tests/testthat/test-layer_add_forecast_date.R b/tests/testthat/test-layer_add_forecast_date.R index 6b81a9cd6..b78a49bf6 100644 --- a/tests/testthat/test-layer_add_forecast_date.R +++ b/tests/testthat/test-layer_add_forecast_date.R @@ -11,9 +11,9 @@ latest <- jhu %>% test_that("layer validation works", { f <- frosting() - expect_error(layer_add_forecast_date(f, c("2022-05-31", "2022-05-31"))) # multiple forecast_dates - expect_error(layer_add_forecast_date(f, "2022-05-31", id = 2)) # id is not a character - expect_error(layer_add_forecast_date(f, "2022-05-31", id = c("a", "b"))) # multiple ids + expect_snapshot(error = TRUE, layer_add_forecast_date(f, c("2022-05-31", "2022-05-31"))) # multiple forecast_dates + expect_snapshot(error = TRUE, layer_add_forecast_date(f, "2022-05-31", id = 2)) # id is not a character + expect_snapshot(error = TRUE, layer_add_forecast_date(f, "2022-05-31", id = c("a", "b"))) # multiple ids expect_silent(layer_add_forecast_date(f, "2022-05-31")) expect_silent(layer_add_forecast_date(f)) expect_silent(layer_add_forecast_date(f, as.Date("2022-05-31"))) @@ -93,8 +93,10 @@ test_that("forecast date works for daily", { unclass() %>% as.data.frame() %>% mutate(time_value = as.POSIXlt(time_value)$year + 1900L) %>% + group_by(geo_value, time_value) %>% + summarize(case_rate = mean(case_rate), death_rate = mean(death_rate), .groups = "drop") %>% as_epi_df() - expect_error(predict(wf1, latest_yearly)) + expect_snapshot(error = TRUE, predict(wf1, latest_yearly)) # forecast_date is a string, gets correctly converted to date wf2 <- add_frosting( @@ -108,5 +110,5 @@ test_that("forecast date works for daily", { wf, adjust_frosting(f, "layer_add_forecast_date", forecast_date = 2022L) ) - expect_error(predict(wf3, latest)) + expect_snapshot(error = TRUE, predict(wf3, latest)) }) diff --git a/tests/testthat/test-layer_add_target_date.R b/tests/testthat/test-layer_add_target_date.R index 3fcae9cad..07ec4e28f 100644 --- a/tests/testthat/test-layer_add_target_date.R +++ b/tests/testthat/test-layer_add_target_date.R @@ -104,8 +104,10 @@ test_that("target date works for daily and yearly", { unclass() %>% as.data.frame() %>% mutate(time_value = as.POSIXlt(time_value)$year + 1900L) %>% + group_by(geo_value, time_value) %>% + summarize(case_rate = mean(case_rate), death_rate = mean(death_rate), .groups = "drop") %>% as_epi_df() - expect_error(predict(wf1, latest_bad)) + expect_snapshot(error = TRUE, predict(wf1, latest_bad)) # target_date is a string (gets correctly converted to Date) wf1 <- add_frosting( diff --git a/tests/testthat/test-layer_residual_quantiles.R b/tests/testthat/test-layer_residual_quantiles.R index c2b9aa198..9321c1a85 100644 --- a/tests/testthat/test-layer_residual_quantiles.R +++ b/tests/testthat/test-layer_residual_quantiles.R @@ -23,11 +23,10 @@ test_that("Returns expected number or rows and columns", { expect_equal(nrow(p), 3L) expect_named(p, c("geo_value", "time_value", ".pred", ".pred_distn")) - nested <- p %>% dplyr::mutate(.quantiles = nested_quantiles(.pred_distn)) - unnested <- nested %>% tidyr::unnest(.quantiles) + unnested <- p %>% pivot_quantiles_longer(.pred_distn) expect_equal(nrow(unnested), 9L) - expect_equal(unique(unnested$quantile_levels), c(.0275, .8, .95)) + expect_equal(unique(unnested$.pred_distn_quantile_level), c(.0275, .8, .95)) }) @@ -46,7 +45,7 @@ test_that("Errors when used with a classifier", { layer_predict() %>% layer_residual_quantiles() wf <- wf %>% add_frosting(f) - expect_error(forecast(wf)) + expect_snapshot(error = TRUE, forecast(wf)) }) @@ -99,8 +98,8 @@ test_that("Canned forecasters work with / without", { }) test_that("flatline_forecaster correctly errors when n_training < ahead", { - expect_error( - flatline_forecaster(jhu, "death_rate", args_list = flatline_args_list(ahead = 10, n_training = 9)), - "This may be due to `n_train` < `ahead`" + expect_snapshot( + error = TRUE, + flatline_forecaster(jhu, "death_rate", args_list = flatline_args_list(ahead = 10, n_training = 9)) ) }) diff --git a/tests/testthat/test-layer_threshold_preds.R b/tests/testthat/test-layer_threshold_preds.R index f051913f9..6d0f177a9 100644 --- a/tests/testthat/test-layer_threshold_preds.R +++ b/tests/testthat/test-layer_threshold_preds.R @@ -56,8 +56,7 @@ test_that("thresholds additional columns", { expect_equal(round(p$.pred, digits = 3), c(0.180, 0.180, 0.310)) expect_named(p, c("geo_value", "time_value", ".pred", ".pred_distn")) p <- p %>% - dplyr::mutate(.quantiles = nested_quantiles(.pred_distn)) %>% - tidyr::unnest(.quantiles) - expect_equal(round(p$values, digits = 3), c(0.180, 0.31, 0.180, .18, 0.310, .31)) - expect_equal(p$quantile_levels, rep(c(.1, .9), times = 3)) + pivot_quantiles_longer(.pred_distn) + expect_equal(round(p$.pred_distn_value, digits = 3), c(0.180, 0.31, 0.180, .18, 0.310, .31)) + expect_equal(p$.pred_distn_quantile_level, rep(c(.1, .9), times = 3)) }) diff --git a/tests/testthat/test-layers.R b/tests/testthat/test-layers.R index 13f859ac3..6e2d80111 100644 --- a/tests/testthat/test-layers.R +++ b/tests/testthat/test-layers.R @@ -11,7 +11,7 @@ test_that("A layer can be updated in frosting", { expect_equal(length(f$layers), 2) expect_equal(f$layers[[1]], fold$layers[[1]]) expect_equal(f$layers[[2]]$lower, 100) - expect_error(update(f$layers[[1]], lower = 100)) - expect_error(update(f$layers[[3]], lower = 100)) - expect_error(update(f$layers[[2]], bad_param = 100)) + expect_snapshot(error = TRUE, update(f$layers[[1]], lower = 100)) + expect_snapshot(error = TRUE, update(f$layers[[3]], lower = 100)) + expect_snapshot(error = TRUE, update(f$layers[[2]], bad_param = 100)) }) diff --git a/tests/testthat/test-pad_to_end.R b/tests/testthat/test-pad_to_end.R index 0ea6244b0..6949f06ac 100644 --- a/tests/testthat/test-pad_to_end.R +++ b/tests/testthat/test-pad_to_end.R @@ -32,6 +32,6 @@ test_that("test set padding works", { # make sure it maintains the epi_df dat <- dat %>% dplyr::rename(geo_value = gr1) %>% - as_epi_df() + as_epi_df(other_keys = "gr2") expect_s3_class(pad_to_end(dat, "geo_value", 2), "epi_df") }) diff --git a/tests/testthat/test-parse_period.R b/tests/testthat/test-parse_period.R index 0adbcec3d..10dd5692d 100644 --- a/tests/testthat/test-parse_period.R +++ b/tests/testthat/test-parse_period.R @@ -1,8 +1,8 @@ test_that("parse_period works", { - expect_error(parse_period(c(1, 2))) - expect_error(parse_period(c(1.3))) - expect_error(parse_period("1 year")) - expect_error(parse_period("2 weeks later")) + expect_snapshot(error = TRUE, parse_period(c(1, 2))) + expect_snapshot(error = TRUE, parse_period(c(1.3))) + expect_snapshot(error = TRUE, parse_period("1 year")) + expect_snapshot(error = TRUE, parse_period("2 weeks later")) expect_identical(parse_period(1), 1L) expect_identical(parse_period("1 day"), 1L) expect_identical(parse_period("1 days"), 1L) diff --git a/tests/testthat/test-parsnip_model_validation.R b/tests/testthat/test-parsnip_model_validation.R index 02ed94fe0..605fad817 100644 --- a/tests/testthat/test-parsnip_model_validation.R +++ b/tests/testthat/test-parsnip_model_validation.R @@ -4,12 +4,12 @@ test_that("forecaster can validate parsnip model", { trainer2 <- parsnip::logistic_reg() trainer3 <- parsnip::rand_forest() - expect_error(get_parsnip_mode(l)) + expect_snapshot(error = TRUE, get_parsnip_mode(l)) expect_equal(get_parsnip_mode(trainer1), "regression") expect_equal(get_parsnip_mode(trainer2), "classification") expect_equal(get_parsnip_mode(trainer3), "unknown") - expect_error(is_classification(l)) + expect_snapshot(error = TRUE, is_classification(l)) expect_true(is_regression(trainer1)) expect_false(is_classification(trainer1)) expect_true(is_classification(trainer2)) diff --git a/tests/testthat/test-pivot_quantiles.R b/tests/testthat/test-pivot_quantiles.R index d1f092c0e..a4362cffb 100644 --- a/tests/testthat/test-pivot_quantiles.R +++ b/tests/testthat/test-pivot_quantiles.R @@ -1,76 +1,44 @@ test_that("quantile pivotting wider behaves", { tib <- tibble::tibble(a = 1:5, b = 6:10) - expect_error(pivot_quantiles_wider(tib, a)) - tib$c <- rep(dist_normal(), 5) - expect_error(pivot_quantiles_wider(tib, c)) + expect_snapshot(error = TRUE, pivot_quantiles_wider(tib, a)) - d1 <- c(dist_quantiles(1:3, 1:3 / 4), dist_quantiles(2:5, 1:4 / 5)) - # different quantiles - tib <- tib[1:2, ] - tib$d1 <- d1 - expect_error(pivot_quantiles_wider(tib, d1)) - - d1 <- c(dist_quantiles(1:3, 1:3 / 4), dist_quantiles(2:4, 2:4 / 4)) - tib$d1 <- d1 - # would want to error (mismatched quantiles), but hard to check efficiently - expect_silent(pivot_quantiles_wider(tib, d1)) + d1 <- quantile_pred(rbind(1:3, 2:4), 1:3 / 4) + d2 <- quantile_pred(rbind(2:4, 3:5), 2:4 / 5) + tib <- tibble(g = c("a", "b"), d1 = d1, d2 = d2) - d1 <- c(dist_quantiles(1:3, 1:3 / 4), dist_quantiles(2:4, 1:3 / 4)) - d2 <- c(dist_quantiles(2:4, 2:4 / 5), dist_quantiles(3:5, 2:4 / 5)) - tib <- tibble::tibble(g = c("a", "b"), d1 = d1, d2 = d2) + # too many columns + expect_snapshot(error = TRUE, pivot_quantiles_wider(tib, d1, d2)) + expect_snapshot(error = TRUE, pivot_quantiles_longer(tib, d1, d2)) - expect_length(pivot_quantiles_wider(tib, c("d1", "d2")), 7L) - expect_length(pivot_quantiles_wider(tib, tidyselect::starts_with("d")), 7L) - expect_length(pivot_quantiles_wider(tib, d2), 5L) + expect_length(pivot_quantiles_wider(tib, d1), 5L) + expect_length(pivot_quantiles_wider(tib, tidyselect::ends_with("1")), 5L) + expect_equal(vctrs::vec_size(pivot_quantiles_longer(tib, d2)), 6L) }) test_that("pivotting wider still works if there are duplicates", { # previously this would produce a warning if pivotted because the # two rows of the result are identical - tb <- tibble(.pred = dist_quantiles(list(1:3, 1:3), list(c(.1, .5, .9)))) + tb <- tibble(.pred = quantile_pred(rbind(1:3, 1:3), c(.1, .5, .9))) res <- tibble(`0.1` = c(1, 1), `0.5` = c(2, 2), `0.9` = c(3, 3)) - expect_identical(tb %>% pivot_quantiles_wider(.pred), res) + expect_equal(tb %>% pivot_quantiles_wider(.pred), res) }) test_that("quantile pivotting longer behaves", { tib <- tibble::tibble(a = 1:5, b = 6:10) - expect_error(pivot_quantiles_longer(tib, a)) - tib$c <- rep(dist_normal(), 5) - expect_error(pivot_quantiles_longer(tib, c)) - - d1 <- c(dist_quantiles(1:3, 1:3 / 4), dist_quantiles(2:5, 1:4 / 5)) - # different quantiles - tib <- tib[1:2, ] - tib$d1 <- d1 - expect_length(pivot_quantiles_longer(tib, d1), 5L) - expect_identical(nrow(pivot_quantiles_longer(tib, d1)), 7L) - expect_identical(pivot_quantiles_longer(tib, d1)$values, as.double(c(1:3, 2:5))) - - d1 <- c(dist_quantiles(1:3, 1:3 / 4), dist_quantiles(2:4, 2:4 / 4)) - tib$d1 <- d1 - expect_silent(pivot_quantiles_longer(tib, d1)) + expect_snapshot(error = TRUE, pivot_quantiles_longer(tib, a)) - d1 <- c(dist_quantiles(1:3, 1:3 / 4), dist_quantiles(2:4, 1:3 / 4)) - d2 <- c(dist_quantiles(2:4, 2:4 / 5), dist_quantiles(3:5, 2:4 / 5)) - tib <- tibble::tibble(g = c("a", "b"), d1 = d1, d2 = d2) + d1 <- quantile_pred(rbind(1:3, 2:4), 1:3 / 4) + d2 <- quantile_pred(rbind(2:4, 3:5), 2:4 / 5) + tib <- tibble(g = c("a", "b"), d1 = d1, d2 = d2) + # too many columns + expect_snapshot(error = TRUE, pivot_quantiles_longer(tib, d1, d2)) - expect_length(pivot_quantiles_longer(tib, c("d1", "d2")), 5L) - expect_identical(nrow(pivot_quantiles_longer(tib, c("d1", "d2"))), 6L) - expect_silent(pivot_quantiles_longer(tib, tidyselect::starts_with("d"))) - expect_length(pivot_quantiles_longer(tib, d2), 4L) + # different quantiles + 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)) - tib$d3 <- c(dist_quantiles(2:5, 2:5 / 6), dist_quantiles(3:6, 2:5 / 6)) - # now the cols have different numbers of quantiles - expect_error(pivot_quantiles_longer(tib, d1, d3)) - expect_length( - pivot_quantiles_longer(tib, d1, d3, .ignore_length_check = TRUE), - 6L - ) - expect_identical( - pivot_quantiles_longer(tib, d1, d3, .ignore_length_check = TRUE)$d1_values, - as.double(rep(c(1:3, 2:4), each = 4)) - ) }) diff --git a/tests/testthat/test-population_scaling.R b/tests/testthat/test-population_scaling.R index 1118ceb2d..b2b7c1bd6 100644 --- a/tests/testthat/test-population_scaling.R +++ b/tests/testthat/test-population_scaling.R @@ -51,7 +51,7 @@ test_that("Number of columns and column names returned correctly, Upper and lowe case = 1:10, death = 1:10 ) %>% - epiprocess::as_epi_df(additional_metadata = list(other_keys = "county")) + epiprocess::as_epi_df(other_keys = "county") r <- recipe(newdata) %>% step_population_scaling(c("case", "death"), @@ -276,7 +276,8 @@ test_that("expect error if `by` selector does not match", { df_pop_col = "values" ) - expect_error( + expect_snapshot( + error = TRUE, wf <- epi_workflow(r, parsnip::linear_reg()) %>% fit(jhu) %>% add_frosting(f) @@ -308,7 +309,7 @@ test_that("expect error if `by` selector does not match", { fit(jhu) %>% add_frosting(f) - expect_error(forecast(wf)) + expect_snapshot(error = TRUE, forecast(wf)) }) diff --git a/tests/testthat/test-quantile_pred.R b/tests/testthat/test-quantile_pred.R new file mode 100644 index 000000000..d7c7cc4cb --- /dev/null +++ b/tests/testthat/test-quantile_pred.R @@ -0,0 +1,105 @@ + +test_that("single quantile_pred works, quantiles are accessible", { + z <- hardhat::quantile_pred( + values = matrix(1:5, nrow = 1), + quantile_levels = c(.2, .4, .5, .6, .8) + ) + expect_equal(median(z), 3) + expect_equal(quantile(z, c(.2, .4, .5, .6, .8)), matrix(1:5, nrow = 1)) + expect_equal( + quantile(z, c(.3, .7), middle = "linear"), + matrix(c(1.5, 4.5), nrow = 1) + ) + + Q <- stats::splinefun(c(.2, .4, .5, .6, .8), 1:5, method = "hyman") + expect_equal(quantile(z, c(.3, .7)), matrix(Q(c(.3, .7)), nrow = 1)) + expect_identical( + extrapolate_quantiles(z, c(.3, .7), middle = "linear"), + hardhat::quantile_pred(matrix(c(1, 1.5, 2, 3, 4, 4.5, 5), nrow = 1), 2:8 / 10) + ) +}) + + +test_that("quantile extrapolator works", { + dstn <- hardhat::quantile_pred( + matrix(c(1:4, 8:11), nrow = 2, byrow = TRUE), + c(.2, .4, .6, .8) + ) + qq <- extrapolate_quantiles(dstn, probs = c(.25, 0.5, .75)) + expect_s3_class(qq, c("quantile_pred", "vctrs_vctr", "list")) + expect_length(qq %@% "quantile_levels", 7L) + + dstn <- hardhat::quantile_pred(matrix(1:4, nrow = 1), 1:4 / 5) + qq <- extrapolate_quantiles(dstn, 1:9 / 10) + dstn_na <- hardhat::quantile_pred(matrix(c(1, 2, NA, 4), nrow = 1), 1:4 / 5) + qq2 <- extrapolate_quantiles(dstn_na, 1:9 / 10) + expect_equal(qq, qq2) + qq3 <- extrapolate_quantiles(dstn_na, 1:9 / 10, replace_na = FALSE) + qq2_vals <- unlist(qq2) + qq3_vals <- unlist(qq3) + qq2_vals[6] <- NA + expect_equal(qq2_vals, qq3_vals) +}) + +test_that("small deviations of quantile requests work", { + l <- c(.05, .1, .25, .75, .9, .95) + v <- c(0.0890306, 0.1424997, 0.1971793, 0.2850978, 0.3832912, 0.4240479) + badl <- l + badl[1] <- badl[1] - 1e-14 + distn <- hardhat::quantile_pred(matrix(v, nrow = 1), l) + + # was broken before, now works + expect_equal(quantile(distn, l), quantile(distn, badl)) + + # The tail extrapolation was still poor. It needs to _always_ use + # the smallest (largest) values or we could end up unsorted + l <- 1:9 / 10 + v <- 1:9 + distn <- hardhat::quantile_pred(matrix(v, nrow = 1), l) + expect_equal(quantile(distn, c(.25, .75)), matrix(c(2.5, 7.5), nrow = 1)) + expect_equal(quantile(distn, c(.1, .9)), matrix(c(1, 9), nrow = 1)) + qv <- data.frame(q = l, v = v) + expect_equal( + drop(quantile(distn, c(.01, .05))), + tail_extrapolate(c(.01, .05), head(qv, 2)) + ) + expect_equal( + drop(quantile(distn, c(.99, .95))), + tail_extrapolate(c(.95, .99), tail(qv, 2)) + ) +}) + +test_that("unary math works on quantiles", { + dstn <- hardhat::quantile_pred( + matrix(c(1:4, 8:11), nrow = 2, byrow = TRUE), + 1:4 / 5 + ) + dstn2 <- hardhat::quantile_pred( + log(matrix(c(1:4, 8:11), nrow = 2, byrow = TRUE)), + 1:4 / 5 + ) + expect_identical(log(dstn), dstn2) + +}) + +test_that("arithmetic works on quantiles", { + dstn <- hardhat::quantile_pred( + matrix(c(1:4, 8:11), nrow = 2, byrow = TRUE), + 1:4 / 5 + ) + dstn2 <- hardhat::quantile_pred( + matrix(c(1:4, 8:11), nrow = 2, byrow = TRUE) + 1, + 1:4 / 5 + ) + expect_identical(dstn + 1, dstn2) + expect_identical(1 + dstn, dstn2) + + dstn2 <- hardhat::quantile_pred( + matrix(c(1:4, 8:11), nrow = 2, byrow = TRUE) / 4, + 1:4 / 5 + ) + expect_identical(dstn / 4, dstn2) + expect_identical((1 / 4) * dstn, dstn2) + + expect_snapshot(error = TRUE, sum(dstn)) +}) diff --git a/tests/testthat/test-shuffle.R b/tests/testthat/test-shuffle.R index 94bc1aa3b..f05e8be3d 100644 --- a/tests/testthat/test-shuffle.R +++ b/tests/testthat/test-shuffle.R @@ -1,5 +1,5 @@ test_that("shuffle works", { - expect_error(shuffle(matrix(NA, 2, 2))) + expect_snapshot(error = TRUE, shuffle(matrix(NA, 2, 2))) expect_length(shuffle(1:10), 10L) expect_identical(sort(shuffle(1:10)), 1:10) }) diff --git a/tests/testthat/test-step_epi_naomit.R b/tests/testthat/test-step_epi_naomit.R index 7e84f5d75..651536df9 100644 --- a/tests/testthat/test-step_epi_naomit.R +++ b/tests/testthat/test-step_epi_naomit.R @@ -17,7 +17,7 @@ r <- recipe(x) %>% step_epi_lag(death_rate, lag = c(0, 7, 14)) test_that("Argument must be a recipe", { - expect_error(step_epi_naomit(x)) + expect_snapshot(error = TRUE, step_epi_naomit(x)) }) z1 <- step_epi_naomit(r) diff --git a/tests/testthat/test-step_epi_shift.R b/tests/testthat/test-step_epi_shift.R index f6d523417..1da61a402 100644 --- a/tests/testthat/test-step_epi_shift.R +++ b/tests/testthat/test-step_epi_shift.R @@ -20,7 +20,8 @@ slm_fit <- function(recipe, data = x) { } test_that("Values for ahead and lag must be integer values", { - expect_error( + expect_snapshot( + error = TRUE, r1 <- recipe(x) %>% step_epi_ahead(death_rate, ahead = 3.6) %>% step_epi_lag(death_rate, lag = 1.9) @@ -28,7 +29,8 @@ test_that("Values for ahead and lag must be integer values", { }) test_that("A negative lag value should should throw an error", { - expect_error( + expect_snapshot( + error = TRUE, r2 <- recipe(x) %>% step_epi_ahead(death_rate, ahead = 7) %>% step_epi_lag(death_rate, lag = -7) @@ -36,7 +38,8 @@ test_that("A negative lag value should should throw an error", { }) test_that("A nonpositive ahead value should throw an error", { - expect_error( + expect_snapshot( + error = TRUE, r3 <- recipe(x) %>% step_epi_ahead(death_rate, ahead = -7) %>% step_epi_lag(death_rate, lag = 7) @@ -48,9 +51,7 @@ test_that("Values for ahead and lag cannot be duplicates", { step_epi_ahead(death_rate, ahead = 7) %>% step_epi_lag(death_rate, lag = 7) %>% step_epi_lag(death_rate, lag = 7) - expect_error( - slm_fit(r4) - ) + expect_snapshot(error = TRUE, slm_fit(r4)) }) test_that("Check that epi_lag shifts applies the shift", { diff --git a/tests/testthat/test-step_epi_slide.R b/tests/testthat/test-step_epi_slide.R index dd42c646c..5bbafc93e 100644 --- a/tests/testthat/test-step_epi_slide.R +++ b/tests/testthat/test-step_epi_slide.R @@ -7,69 +7,71 @@ edf <- data.frame( value = c(2:21, 3:22) ) %>% as_epi_df() - r <- recipe(edf) -rolled_before <- edf %>% - group_by(geo_value) %>% - epi_slide(value = mean(value), before = 3L) %>% - pull(value) -rolled_after <- edf %>% - group_by(geo_value) %>% - epi_slide(value = mean(value), after = 3L) %>% - pull(value) test_that("epi_slide errors when needed", { # not an epi_recipe - expect_error(recipe(as_tibble(edf)) %>% step_epi_slide(value, .f = mean, before = 6L)) + expect_snapshot(recipe(edf) %>% step_epi_slide(value, .f = mean, .window_size = 7L)) # non-scalar args - expect_error(r %>% step_epi_slide(value, .f = mean, before = c(3L, 6L))) - expect_error(r %>% step_epi_slide(value, .f = mean, after = c(3L, 6L))) - expect_error(r %>% step_epi_slide(value, .f = mean, skip = c(TRUE, FALSE))) - expect_error(r %>% step_epi_slide(value, .f = mean, role = letters[1:2])) - expect_error(r %>% step_epi_slide(value, .f = mean, prefix = letters[1:2])) - expect_error(r %>% step_epi_slide(value, .f = mean, id = letters[1:2])) + expect_snapshot(error = TRUE, r %>% step_epi_slide(value, .f = mean, .window_size = c(3L, 6L))) + expect_snapshot(error = TRUE, r %>% step_epi_slide(value, .f = mean, .align = c("right", "left"))) + expect_snapshot(error = TRUE, r %>% step_epi_slide(value, .f = mean, .window_size = 1L, skip = c(TRUE, FALSE))) + expect_snapshot(error = TRUE, r %>% step_epi_slide(value, .f = mean, .window_size = 1L, role = letters[1:2])) + expect_snapshot(error = TRUE, r %>% step_epi_slide(value, .f = mean, .window_size = 1L, prefix = letters[1:2])) + expect_snapshot(error = TRUE, r %>% step_epi_slide(value, .f = mean, .window_size = 1L, id = letters[1:2])) # wrong types - expect_error(r %>% step_epi_slide(value, .f = mean, before = 1.5)) - expect_error(r %>% step_epi_slide(value, .f = mean, after = 1.5)) - expect_error(r %>% step_epi_slide(value, .f = mean, skip = "a")) - expect_error(r %>% step_epi_slide(value, .f = mean, role = 1)) - expect_error(r %>% step_epi_slide(value, .f = mean, prefix = 1)) - expect_error(r %>% step_epi_slide(value, .f = mean, id = 1)) + expect_snapshot(error = TRUE, r %>% step_epi_slide(value, .f = mean, .window_size = 1.5)) + expect_snapshot(error = TRUE, r %>% step_epi_slide(value, .f = mean, .window_size = 1L, .align = 1.5)) + expect_snapshot(error = TRUE, r %>% step_epi_slide(value, .f = mean, .window_size = 1L, skip = "a")) + expect_snapshot(error = TRUE, r %>% step_epi_slide(value, .f = mean, .window_size = 1L, role = 1)) + expect_snapshot(error = TRUE, r %>% step_epi_slide(value, .f = mean, .window_size = 1L, prefix = 1)) + expect_snapshot(error = TRUE, r %>% step_epi_slide(value, .f = mean, .window_size = 1L, id = 1)) # function problems - expect_error(r %>% step_epi_slide(value)) - expect_error(r %>% step_epi_slide(value, .f = 1)) + expect_snapshot(error = TRUE, r %>% step_epi_slide(value)) + expect_snapshot(error = TRUE, r %>% step_epi_slide(value, .f = 1)) + expect_snapshot(error = TRUE, r %>% step_epi_slide(value)) + expect_snapshot(error = TRUE, r %>% step_epi_slide(value, .f = 1)) }) test_that("epi_slide handles different function specs", { cfun <- r %>% - step_epi_slide(value, .f = "mean", before = 3L) %>% + step_epi_slide(value, .f = "mean", .window_size = 4L) %>% prep(edf) %>% bake(new_data = NULL) + expected_out <- edf %>% + group_by(geo_value) %>% + epi_slide(~ mean(.x$value), .window_size = 4L) %>% + ungroup() %>% + rename(epi_slide__.f_value = slide_value) + expect_equal(cfun, expected_out) ffun <- r %>% - step_epi_slide(value, .f = mean, before = 3L) %>% + step_epi_slide(value, .f = mean, .window_size = 4L) %>% prep(edf) %>% bake(new_data = NULL) + expect_equal(ffun, expected_out) # formula NOT currently supported - expect_error( + expect_snapshot( + error = TRUE, lfun <- r %>% - step_epi_slide(value, .f = ~ mean(.x, na.rm = TRUE), before = 3L), - regexp = "cannot be a formula." + step_epi_slide(value, .f = ~ mean(.x, na.rm = TRUE), .window_size = 4L) ) + # expect_equal(lfun, rolled_before) blfun <- r %>% - step_epi_slide(value, .f = function(x) mean(x, na.rm = TRUE), before = 3L) %>% + step_epi_slide(value, .f = function(x) mean(x, na.rm = TRUE), .window_size = 4L) %>% prep(edf) %>% bake(new_data = NULL) + expected_out <- edf %>% + group_by(geo_value) %>% + epi_slide(~ mean(.x$value, na.rm = TRUE), .window_size = 4L) %>% + ungroup() %>% + rename(epi_slide__.f_value = slide_value) + expect_equal(blfun, expected_out) nblfun <- r %>% - step_epi_slide(value, .f = \(x) mean(x, na.rm = TRUE), before = 3L) %>% + step_epi_slide(value, .f = \(x) mean(x, na.rm = TRUE), .window_size = 4L) %>% prep(edf) %>% bake(new_data = NULL) - - expect_equal(cfun[[4]], rolled_before) - expect_equal(ffun[[4]], rolled_before) - # expect_equal(lfun[[4]], rolled_before) - expect_equal(blfun[[4]], rolled_before) - expect_equal(nblfun[[4]], rolled_before) + expect_equal(nblfun, expected_out) }) diff --git a/tests/testthat/test-step_growth_rate.R b/tests/testthat/test-step_growth_rate.R index 4c0c78642..8ddd40976 100644 --- a/tests/testthat/test-step_growth_rate.R +++ b/tests/testthat/test-step_growth_rate.R @@ -1,25 +1,25 @@ test_that("step_growth_rate validates arguments", { df <- data.frame(time_value = 1:5, geo_value = rep("a", 5), value = 6:10) r <- recipes::recipe(df) - expect_error(step_growth_rate(r)) + expect_snapshot(error = TRUE, step_growth_rate(r)) edf <- as_epi_df(df) r <- recipe(edf) - expect_error(step_growth_rate(r, value, role = 1)) - expect_error(step_growth_rate(r, value, method = "abc")) - expect_error(step_growth_rate(r, value, horizon = 0)) - expect_error(step_growth_rate(r, value, horizon = c(1, 2))) - expect_error(step_growth_rate(r, value, prefix = letters[1:2])) - expect_error(step_growth_rate(r, value, id = letters[1:2])) - expect_error(step_growth_rate(r, value, prefix = letters[1:2])) - expect_error(step_growth_rate(r, value, prefix = 1)) - expect_error(step_growth_rate(r, value, id = 1)) - expect_error(step_growth_rate(r, value, log_scale = 1)) - expect_error(step_growth_rate(r, value, skip = 1)) - expect_error(step_growth_rate(r, value, additional_gr_args_list = 1:5)) - expect_error(step_growth_rate(r, value, replace_Inf = "c")) - expect_error(step_growth_rate(r, value, replace_Inf = c(1, 2))) + expect_snapshot(error = TRUE, step_growth_rate(r, value, role = 1)) + expect_snapshot(error = TRUE, step_growth_rate(r, value, method = "abc")) + expect_snapshot(error = TRUE, step_growth_rate(r, value, horizon = 0)) + expect_snapshot(error = TRUE, step_growth_rate(r, value, horizon = c(1, 2))) + expect_snapshot(error = TRUE, step_growth_rate(r, value, prefix = letters[1:2])) + expect_snapshot(error = TRUE, step_growth_rate(r, value, id = letters[1:2])) + expect_snapshot(error = TRUE, step_growth_rate(r, value, prefix = letters[1:2])) + expect_snapshot(error = TRUE, step_growth_rate(r, value, prefix = 1)) + expect_snapshot(error = TRUE, step_growth_rate(r, value, id = 1)) + expect_snapshot(error = TRUE, step_growth_rate(r, value, log_scale = 1)) + expect_snapshot(error = TRUE, step_growth_rate(r, value, skip = 1)) + expect_snapshot(error = TRUE, step_growth_rate(r, value, additional_gr_args_list = 1:5)) + expect_snapshot(error = TRUE, step_growth_rate(r, value, replace_Inf = "c")) + expect_snapshot(error = TRUE, step_growth_rate(r, value, replace_Inf = c(1, 2))) expect_silent(step_growth_rate(r, value, replace_Inf = NULL)) expect_silent(step_growth_rate(r, value, replace_Inf = NA)) }) diff --git a/tests/testthat/test-step_lag_difference.R b/tests/testthat/test-step_lag_difference.R index 27eadf304..a25c5e636 100644 --- a/tests/testthat/test-step_lag_difference.R +++ b/tests/testthat/test-step_lag_difference.R @@ -1,20 +1,20 @@ test_that("step_lag_difference validates arguments", { df <- data.frame(time_value = 1:5, geo_value = rep("a", 5), value = 6:10) r <- recipes::recipe(df) - expect_error(step_lag_difference(r)) + expect_snapshot(error = TRUE, step_lag_difference(r)) edf <- as_epi_df(df) r <- recipe(edf) - expect_error(step_lag_difference(r, value, role = 1)) - expect_error(step_lag_difference(r, value, horizon = 0)) + expect_snapshot(error = TRUE, step_lag_difference(r, value, role = 1)) + expect_snapshot(error = TRUE, step_lag_difference(r, value, horizon = 0)) expect_silent(step_lag_difference(r, value, horizon = c(1, 2))) - expect_error(step_lag_difference(r, value, prefix = letters[1:2])) - expect_error(step_lag_difference(r, value, id = letters[1:2])) - expect_error(step_lag_difference(r, value, prefix = letters[1:2])) - expect_error(step_lag_difference(r, value, prefix = 1)) - expect_error(step_lag_difference(r, value, id = 1)) - expect_error(step_lag_difference(r, value, skip = 1)) + expect_snapshot(error = TRUE, step_lag_difference(r, value, prefix = letters[1:2])) + expect_snapshot(error = TRUE, step_lag_difference(r, value, id = letters[1:2])) + expect_snapshot(error = TRUE, step_lag_difference(r, value, prefix = letters[1:2])) + expect_snapshot(error = TRUE, step_lag_difference(r, value, prefix = 1)) + expect_snapshot(error = TRUE, step_lag_difference(r, value, id = 1)) + expect_snapshot(error = TRUE, step_lag_difference(r, value, skip = 1)) }) diff --git a/tests/testthat/test-step_training_window.R b/tests/testthat/test-step_training_window.R index cefdb79ce..d8675fdc5 100644 --- a/tests/testthat/test-step_training_window.R +++ b/tests/testthat/test-step_training_window.R @@ -73,7 +73,7 @@ test_that("step_training_window works with multiple keys", { geo_value = rep(c("ca", "hi"), each = 100), additional_key = as.factor(rep(1:4, each = 50)), ) %>% - epiprocess::as_epi_df(additional_metadata = list(other_keys = "additional_key")) + epiprocess::as_epi_df(other_keys = "additional_key") p4 <- recipe(y ~ x, data = toy_epi_df2) %>% step_training_window(n_recent = 3) %>% @@ -83,7 +83,7 @@ test_that("step_training_window works with multiple keys", { expect_equal(nrow(p4), 12L) expect_equal(ncol(p4), 5L) expect_s3_class(p4, "epi_df") - expect_named(p4, c("geo_value", "time_value", "x", "y", "additional_key")) + expect_named(p4, c("geo_value", "additional_key", "time_value", "x", "y")) expect_equal( p4$time_value, rep(c( diff --git a/tests/testthat/test-wis-dist-quantiles.R b/tests/testthat/test-wis-quantile_pred.R similarity index 60% rename from tests/testthat/test-wis-dist-quantiles.R rename to tests/testthat/test-wis-quantile_pred.R index 93f7c50eb..187344af9 100644 --- a/tests/testthat/test-wis-dist-quantiles.R +++ b/tests/testthat/test-wis-quantile_pred.R @@ -8,45 +8,38 @@ test_that("wis dispatches and produces the correct values", { actual <- 5 expected <- c(wis_one_pred(q1, tau, actual), wis_one_pred(q2, tau, actual)) - dstn <- dist_quantiles(list(q1, q2), tau) + dstn <- quantile_pred(rbind(q1, q2), tau) expect_equal(weighted_interval_score(dstn, actual), expected) # works with a single dstn q <- sort(10 * rexp(23)) tau0 <- c(.01, .025, 1:19 / 20, .975, .99) - dst <- dist_quantiles(q, tau0) + dst <- quantile_pred(rbind(q), tau0) expect_equal(weighted_interval_score(dst, 10), wis_one_pred(q, tau0, 10)) # returns NA when expected - dst <- dist_quantiles(rep(NA, 3), c(.2, .5, .95)) + dst <- quantile_pred(rbind(rep(NA, 3)), c(.2, .5, .95)) expect_true(is.na(weighted_interval_score(dst, 10))) expect_equal( weighted_interval_score(dstn, c(NA, actual)), c(NA, wis_one_pred(q2, tau, actual)) ) - # errors for non distributions - expect_error(weighted_interval_score(1:10, 10)) - expect_warning(w <- weighted_interval_score(dist_normal(1), 10)) - expect_true(all(is.na(w))) - expect_warning(w <- weighted_interval_score( - c(dist_normal(), dist_quantiles(1:5, 1:5 / 6)), - 10 - )) - expect_equal(w, c(NA, wis_one_pred(1:5, 1:5 / 6, 10))) + # errors for non quantile_pred + expect_snapshot(error = TRUE, weighted_interval_score(1:10, 10)) # errors if sizes don't match - expect_error(weighted_interval_score( - dist_quantiles(list(1:4, 8:11), 1:4 / 5), # length 2 + expect_snapshot(error = TRUE, weighted_interval_score( + quantile_pred(rbind(1:4, 8:11), 1:4 / 5), # length 2 1:3 )) #' # Missing value behaviours - dstn <- dist_quantiles(c(1, 2, NA, 4), 1:4 / 5) + dstn <- quantile_pred(rbind(c(1, 2, NA, 4)), 1:4 / 5) expect_equal(weighted_interval_score(dstn, 2.5), 0.5) expect_equal(weighted_interval_score(dstn, 2.5, c(2, 4, 5, 6, 8) / 10), 0.4) expect_equal( - weighted_interval_score(dist_quantiles(c(1, 2, NA, 4), 1:4 / 5), 3, na_handling = "drop"), + weighted_interval_score(dstn, 3, na_handling = "drop"), 2 / 3 ) expect_equal( @@ -56,5 +49,9 @@ test_that("wis dispatches and produces the correct values", { expect_true(is.na( weighted_interval_score(dstn, 2.5, na_handling = "propagate") )) - weighted_interval_score(dist_quantiles(1:4, 1:4 / 5), 2.5, 1:9 / 10, na_handling = "fail") + expect_true(is.na( + weighted_interval_score( + quantile_pred(rbind(1:4), 1:4 / 5), 2.5, 1:9 / 10, na_handling = "fail" + ) + )) }) diff --git a/vignettes/articles/sliding.Rmd b/vignettes/articles/sliding.Rmd index ec6f67359..1556c4a72 100644 --- a/vignettes/articles/sliding.Rmd +++ b/vignettes/articles/sliding.Rmd @@ -25,27 +25,21 @@ library(purrr) # Demonstrations of sliding AR and ARX forecasters -A key function from the epiprocess package is `epi_slide()`, which allows the -user to apply a function or formula-based computation over variables in an -`epi_df` over a running window of `n` time steps (see the following `epiprocess` -vignette to go over the basics of the function: ["Slide a computation over -signal values"](https://cmu-delphi.github.io/epiprocess/articles/slide.html)). -The equivalent sliding method for an `epi_archive` object can be called by using -the wrapper function `epix_slide()` (refer to the following vignette for the -basics of the function: ["Work with archive objects and data -revisions"](https://cmu-delphi.github.io/epiprocess/articles/archive.html)). The -key difference from `epi_slide()` is that it performs version-aware -computations. That is, the function only uses data that would have been -available as of time t for that reference time. - -In this vignette, we use `epi_slide()` and `epix_slide()` for backtesting our -`arx_forecaster` on historical COVID-19 case data from the US and from Canada. -More precisely, we first demonstrate using `epi_slide()` to slide ARX -forecasters over an `epi_df` object and compare the results obtained from using -different forecasting engines. We then compare the results from version-aware -and unaware forecasting, where the former is obtained from applying -`epix_slide()` to the `epi_archive` object, while the latter is obtained from -applying `epi_slide()` to the latest snapshot of the data. +A key function from the epiprocess package is `epix_slide()` (refer to the +following vignette for the basics of the function: ["Work with archive objects +and data +revisions"](https://cmu-delphi.github.io/epiprocess/articles/archive.html)) +which allows performing version-aware computations. That is, the function only +uses data that would have been available as of time t for that reference time. + +In this vignette, we use `epix_slide()` for backtesting our `arx_forecaster` on +historical COVID-19 case data from the US and from Canada. We first examine the +results from a version-unaware forecaster, comparing two different fitting +engines and then we contrast this with version-aware forecasting. The former +will proceed by constructing an `epi_archive` that erases its version +information and then use `epix_slide()` to forecast the future. The latter will +keep the versioned data and proceed similarly by using `epix_slide()` to +forecast the future. ## Comparing different forecasting engines @@ -54,23 +48,22 @@ applying `epi_slide()` to the latest snapshot of the data. First, we download the version history (ie. archive) of the percentage of doctor's visits with CLI (COVID-like illness) computed from medical insurance claims and the number of new confirmed COVID-19 cases per 100,000 population -(daily) for all 50 states from the COVIDcast API. +(daily) for all 50 states from the COVIDcast API.
Load a data archive -We process as before, with the -modification that we use `sync = locf` in `epix_merge()` so that the last -version of each observation can be carried forward to extrapolate unavailable -versions for the less up-to-date input archive. +We process as before, with the modification that we use `sync = locf` in +`epix_merge()` so that the last version of each observation can be carried +forward to extrapolate unavailable versions for the less up-to-date input +archive. ```{r grab-epi-data} theme_set(theme_bw()) -y <- readRDS("all_states_covidcast_signals.rds") - -y <- purrr::map(y, ~ select(.x, geo_value, time_value, version = issue, value)) +y <- readRDS("all_states_covidcast_signals.rds") %>% + purrr::map(~ select(.x, geo_value, time_value, version = issue, value)) x <- epix_merge( y[[1]] %>% rename(percent_cli = value) %>% as_epi_archive(compactify = FALSE), @@ -83,17 +76,15 @@ rm(y)
-After obtaining the latest snapshot of the data, we produce forecasts on that -data using the default engine of simple linear regression and compare to a -random forest. - -Note that all of the warnings about the forecast date being less than the most -recent update date of the data have been suppressed to avoid cluttering the -output. +We then obtaining the latest snapshot of the data and proceed to fake the +version information by setting `version = time_value`. This has the effect of +obtaining data that arrives exactly at the day of the time_value. ```{r arx-kweek-preliminaries, warning = FALSE} # Latest snapshot of data, and forecast dates -x_latest <- epix_as_of(x, max_version = max(x$versions_end)) +x_latest <- epix_as_of(x, version = max(x$versions_end)) %>% + mutate(version = time_value) %>% + as_epi_archive() fc_time_values <- seq( from = as.Date("2020-08-01"), to = as.Date("2021-11-01"), @@ -101,42 +92,41 @@ fc_time_values <- seq( ) aheads <- c(7, 14, 21, 28) -k_week_ahead <- function(epi_df, outcome, predictors, ahead = 7, engine) { - epi_slide( - epi_df, - ~ arx_forecaster( - .x, outcome, predictors, engine, - args_list = arx_args_list(ahead = ahead) - )$predictions %>% - select(-geo_value), - before = 120 - 1, - ref_time_values = fc_time_values, - new_col_name = "fc" - ) %>% - select(geo_value, time_value, starts_with("fc")) %>% - mutate(engine_type = engine$engine) +forecast_k_week_ahead <- function(epi_archive, outcome, predictors, ahead = 7, engine) { + epi_archive %>% + epix_slide( + .f = function(x, gk, rtv) { + arx_forecaster( + x, outcome, predictors, engine, + args_list = arx_args_list(ahead = ahead) + )$predictions %>% + mutate(engine_type = engine$engine) %>% + pivot_quantiles_wider(.pred_distn) + }, + .before = 120, + .versions = fc_time_values + ) } ``` ```{r make-arx-kweek} # Generate the forecasts and bind them together fc <- bind_rows( - map( - aheads, - ~ k_week_ahead( - x_latest, "case_rate", c("case_rate", "percent_cli"), .x, - engine = linear_reg() - ) - ) %>% list_rbind(), - map( - aheads, - ~ k_week_ahead( - x_latest, "case_rate", c("case_rate", "percent_cli"), .x, - engine = rand_forest(mode = "regression") - ) - ) %>% list_rbind() -) %>% - pivot_quantiles_wider(fc_.pred_distn) + map(aheads, ~ forecast_k_week_ahead( + x_latest, + outcome = "case_rate", + predictors = c("case_rate", "percent_cli"), + ahead = .x, + engine = linear_reg() + )), + map(aheads, ~ forecast_k_week_ahead( + x_latest, + outcome = "case_rate", + predictors = c("case_rate", "percent_cli"), + ahead = .x, + engine = rand_forest(mode = "regression") + )) +) ``` Here, `arx_forecaster()` does all the heavy lifting. It creates leads of the @@ -153,18 +143,22 @@ sense of the model performance while keeping the graphic simple. Code for plotting ```{r plot-arx, message = FALSE, warning = FALSE} -fc_cafl <- fc %>% filter(geo_value %in% c("ca", "fl")) -x_latest_cafl <- x_latest %>% filter(geo_value %in% c("ca", "fl")) - -p1 <- ggplot(fc_cafl, aes(fc_target_date, group = time_value, fill = engine_type)) + +fc_cafl <- fc %>% + tibble() %>% + filter(geo_value %in% c("ca", "fl")) +x_latest_cafl <- x_latest$DT %>% + tibble() %>% + filter(geo_value %in% c("ca", "fl")) + +p1 <- ggplot(fc_cafl, aes(target_date, group = forecast_date, fill = engine_type)) + geom_line( data = x_latest_cafl, aes(x = time_value, y = case_rate), inherit.aes = FALSE, color = "gray50" ) + geom_ribbon(aes(ymin = `0.05`, ymax = `0.95`), alpha = 0.4) + - geom_line(aes(y = fc_.pred)) + - geom_point(aes(y = fc_.pred), size = 0.5) + - geom_vline(aes(xintercept = time_value), linetype = 2, alpha = 0.5) + + geom_line(aes(y = .pred)) + + geom_point(aes(y = .pred), size = 0.5) + + geom_vline(aes(xintercept = forecast_date), linetype = 2, alpha = 0.5) + facet_grid(vars(geo_value), vars(engine_type), scales = "free") + scale_x_date(minor_breaks = "month", date_labels = "%b %y") + scale_fill_brewer(palette = "Set1") + @@ -221,31 +215,30 @@ linear regression with those from using boosted regression trees. can <- readRDS(system.file( "extdata", "can_prov_cases.rds", package = "epipredict", mustWork = TRUE -)) - -can <- can %>% +)) %>% group_by(version, geo_value) %>% arrange(time_value) %>% mutate(cr_7dav = RcppRoll::roll_meanr(case_rate, n = 7L)) %>% as_epi_archive(compactify = TRUE) -can_latest <- epix_as_of(can, max_version = max(can$DT$version)) +can_latest <- epix_as_of(can, version = max(can$DT$version)) %>% + mutate(version = time_value) %>% + as_epi_archive() # Generate the forecasts, and bind them together can_fc <- bind_rows( map( aheads, - ~ k_week_ahead(can_latest, "cr_7dav", "cr_7dav", .x, linear_reg()) - ) %>% list_rbind(), + ~ forecast_k_week_ahead(can_latest, "cr_7dav", "cr_7dav", .x, linear_reg()) + ), map( aheads, - ~ k_week_ahead( + ~ forecast_k_week_ahead( can_latest, "cr_7dav", "cr_7dav", .x, boost_tree(mode = "regression", trees = 20) ) - ) %>% list_rbind() -) %>% - pivot_quantiles_wider(fc_.pred_distn) + ) +) ``` The figures below shows the results for all of the provinces. @@ -253,19 +246,19 @@ The figures below shows the results for all of the provinces. ```{r plot-can-fc-lr, message = FALSE, warning = FALSE, fig.width = 9, fig.height = 12} ggplot( can_fc %>% filter(engine_type == "lm"), - aes(x = fc_target_date, group = time_value) + aes(x = target_date, group = forecast_date) ) + coord_cartesian(xlim = lubridate::ymd(c("2020-12-01", NA))) + geom_line( - data = can_latest, aes(x = time_value, y = cr_7dav), + data = can_latest$DT %>% tibble(), aes(x = time_value, y = cr_7dav), inherit.aes = FALSE, color = "gray50" ) + geom_ribbon(aes(ymin = `0.05`, ymax = `0.95`, fill = geo_value), alpha = 0.4 ) + - geom_line(aes(y = fc_.pred)) + - geom_point(aes(y = fc_.pred), size = 0.5) + - geom_vline(aes(xintercept = time_value), linetype = 2, alpha = 0.5) + + geom_line(aes(y = .pred)) + + geom_point(aes(y = .pred), size = 0.5) + + geom_vline(aes(xintercept = forecast_date), linetype = 2, alpha = 0.5) + facet_wrap(~geo_value, scales = "free_y", ncol = 3) + scale_x_date(minor_breaks = "month", date_labels = "%b %y") + labs( @@ -278,19 +271,19 @@ ggplot( ```{r plot-can-fc-boost, message = FALSE, warning = FALSE, fig.width = 9, fig.height = 12} ggplot( can_fc %>% filter(engine_type == "xgboost"), - aes(x = fc_target_date, group = time_value) + aes(x = target_date, group = forecast_date) ) + coord_cartesian(xlim = lubridate::ymd(c("2020-12-01", NA))) + geom_line( - data = can_latest, aes(x = time_value, y = cr_7dav), + data = can_latest$DT %>% tibble(), aes(x = time_value, y = cr_7dav), inherit.aes = FALSE, color = "gray50" ) + geom_ribbon(aes(ymin = `0.05`, ymax = `0.95`, fill = geo_value), alpha = 0.4 ) + - geom_line(aes(y = fc_.pred)) + - geom_point(aes(y = fc_.pred), size = 0.5) + - geom_vline(aes(xintercept = time_value), linetype = 2, alpha = 0.5) + + geom_line(aes(y = .pred)) + + geom_point(aes(y = .pred), size = 0.5) + + geom_vline(aes(xintercept = forecast_date), linetype = 2, alpha = 0.5) + facet_wrap(~geo_value, scales = "free_y", ncol = 3) + scale_x_date(minor_breaks = "month", date_labels = "%b %y") + labs( @@ -318,9 +311,7 @@ have been available in real-time) to forecast the 7 day average of future COVID-19 case rates from current and past COVID-19 case rates and death rates for all states. That is, we can make forecasts on the archive, `x`, and compare those to forecasts on the latest data, `x_latest` using the same general set-up -as above. For version-aware forecasting, note that `x` is fed into -`epix_slide()`, while for version-unaware forecasting, `x_latest` is fed into -`epi_slide()`. Note that in this example, we use a geo-pooled approach (using +as above. Note that in this example, we use a geo-pooled approach (using combined data from all US states and territories) to train our model.
@@ -357,21 +348,19 @@ deaths_incidence_prop <- pub_covidcast( as_epi_archive(compactify = FALSE) -x <- epix_merge(confirmed_incidence_prop, deaths_incidence_prop, - sync = "locf" -) +x <- epix_merge(confirmed_incidence_prop, deaths_incidence_prop, sync = "locf") x <- x %>% epix_slide( - before = 365000L, ref_time_values = fc_time_values, + .versions = fc_time_values, function(x, gk, rtv) { x %>% group_by(geo_value) %>% - epi_slide_mean(case_rate, before = 6L) %>% + epi_slide_mean(case_rate, .window_size = 7L) %>% rename(case_rate_7d_av = slide_value_case_rate) %>% - epi_slide_mean(death_rate, before = 6L) %>% - ungroup() %>% - rename(death_rate_7d_av = slide_value_death_rate) + epi_slide_mean(death_rate, ..window_size = 7L) %>% + rename(death_rate_7d_av = slide_value_death_rate) %>% + ungroup() } ) %>% rename(version = time_value) %>% @@ -424,14 +413,14 @@ epi archive and store it as `x_latest`. ```{r running-arx-forecaster} arx_preds <- x %>% - epix_slide(~ forecaster(.x), - before = 120, ref_time_values = fc_time_values, - names_sep = NULL + epix_slide( + ~ forecaster(.x), + .before = 120, .versions = fc_time_values ) %>% mutate(engine_type = quantile_reg()$engine) %>% mutate(ahead_val = target_date - forecast_date) -x_latest <- epix_as_of(x, max_version = max(x$versions_end)) +x_latest <- epix_as_of(x, version = max(x$versions_end)) ``` Now we plot both the actual and predicted 7 day average of the death rate for @@ -448,7 +437,7 @@ fc_states <- arx_preds %>% x_latest_states <- x_latest %>% filter(geo_value %in% states_to_show) -p2 <- ggplot(fc_states, aes(target_date, group = time_value)) + +p2 <- ggplot(fc_states, aes(target_date, group = forecast_date)) + geom_ribbon(aes(ymin = `0.05`, ymax = `0.95`, fill = geo_value), alpha = 0.4) + geom_line( data = x_latest_states, aes(x = time_value, y = death_rate_7d_av), @@ -456,7 +445,7 @@ p2 <- ggplot(fc_states, aes(target_date, group = time_value)) + ) + geom_line(aes(y = .pred, color = geo_value)) + geom_point(aes(y = .pred, color = geo_value), size = 0.5) + - geom_vline(aes(xintercept = time_value), linetype = 2, alpha = 0.5) + + geom_vline(aes(xintercept = forecast_date), linetype = 2, alpha = 0.5) + facet_wrap(~geo_value, scales = "free_y", ncol = 1L) + scale_x_date(minor_breaks = "month", date_labels = "%b %y") + scale_fill_brewer(palette = "Set1") + diff --git a/vignettes/articles/smooth-qr.Rmd b/vignettes/articles/smooth-qr.Rmd index 3b5d1e3ad..e03837404 100644 --- a/vignettes/articles/smooth-qr.Rmd +++ b/vignettes/articles/smooth-qr.Rmd @@ -25,8 +25,8 @@ Whereas other time-series forecasting examples in this package have used epidemiological applications where decisions are based on the trend of a signal. The idea underlying smooth quantile regression is that set forecast targets can -be approximated by a smooth curve. This novel approach from -[Tuzhilina et al., 2022](https://arxiv.org/abs/2202.09723) +be approximated by a smooth curve. This novel approach from +[Tuzhilina et al., 2022](https://arxiv.org/abs/2202.09723) enforces smoothness across the horizons and can be applied to point estimation by regression or interval prediction by quantile regression. Our focus in this vignette is the latter. @@ -62,9 +62,9 @@ The `degree` parameter indicates the degree of the polynomials used for smoothing of the response. It should be no more than the number of aheads. If the degree is precisely equal to the number of aheads, then there is no smoothing. To better understand this parameter and how it works, we should look -to its origins and how it is used in the model. +to its origins and how it is used in the model. -# Model form +# Model form Smooth quantile regression is linear auto-regressive, with the key feature being a transformation that forces the coefficients to satisfy a smoothing constraint. @@ -77,8 +77,8 @@ be no greater than the number of responses. This is a tuning parameter, and so it can be chosen by performing a grid search with cross-validation. Intuitively, $d = 1$ corresponds to the constant model, $d = 2$ gives straight line forecasts, while $d = 3$ gives quadratic forecasts. Since a degree of 3 was -found to work well in the tested applications (see Section 9 of -[Tuzhilina et al., 2022](https://arxiv.org/abs/2202.09723)), +found to work well in the tested applications (see Section 9 of +[Tuzhilina et al., 2022](https://arxiv.org/abs/2202.09723)), it is the default value. # Demonstration of smooth quantile regression @@ -169,7 +169,7 @@ regression, which has three main arguments - the quantiles, aheads, and degree. After creating our `epi_workflow` with these components, we get our test data based on longest lag period and make the predictions. -We input our forecaster into a function for ease of use. +We input our forecaster into a function for ease of use. ```{r} smooth_fc <- function(x, aheads = 1:28, degree = 3L, quantiles = 0.5, fd) { @@ -337,7 +337,8 @@ naturally related over time by a smooth curve. To get the basic quantile regression results we can utilize the forecaster that we've already built. We can simply set the degree to be the number of ahead -values to re-run the code without smoothing. +values to re-run the code without smoothing. + ```{r, warning = FALSE} baseline_preds <- smooth_fc( edf, @@ -397,15 +398,15 @@ that the smooth quantile regression model and baseline models perform very similarly overall, with the smooth quantile regression model only slightly beating the baseline model in terms of overall average MAE. -One other commonly used metric is the Weighted Interval Score -(WIS, [Bracher et al., 2021](https://arxiv.org/pdf/2005.12881.pdf)), +One other commonly used metric is the Weighted Interval Score +(WIS, [Bracher et al., 2021](https://arxiv.org/pdf/2005.12881.pdf)), which a scoring rule that is based on the population quantiles. The point is to score the interval, whereas MAE only evaluates the accuracy of the point forecast. Let $F$ be a forecast composed of predicted quantiles $q_{\tau}$ for the set of quantile levels $\tau$. Then, in terms of the predicted quantiles, the WIS for -target variable $Y$ is represented as follows +target variable $Y$ is represented as follows ([McDonald etal., 2021](https://www.pnas.org/doi/full/10.1073/pnas.2111453118)): $$ @@ -515,5 +516,5 @@ smooth curve. # Attribution -The information presented on smooth quantile regression is from -[Tuzhilina et al., 2022](https://arxiv.org/abs/2202.09723). +The information presented on smooth quantile regression is from +[Tuzhilina et al., 2022](https://arxiv.org/abs/2202.09723). diff --git a/vignettes/articles/symptom-surveys.Rmd b/vignettes/articles/symptom-surveys.Rmd index e8d4a8228..f480db575 100644 --- a/vignettes/articles/symptom-surveys.Rmd +++ b/vignettes/articles/symptom-surveys.Rmd @@ -48,7 +48,7 @@ most recent versions of the datasets). Now, we will delve into the forecasting problem set-up and code followed by a discussion of the results. -## Problem Setup +## Problem Setup Our goal is to predict county-level COVID-19 case incidence rates for 1 and 2 weeks ahead. For this, we restrict our attention to the 442 counties that had at @@ -437,7 +437,7 @@ knitr::kable( format = "html", table.attr = "style='width:70%;'" ) ``` -$$\\[0.01in]$$ +$$\\[0.01in]$$ Are these differences in median scaled errors significant? Some basic hypothesis testing suggests that some probably are: Below we conduct a sign test for whether the difference in the "Cases" model’s scaled error and each other @@ -662,7 +662,7 @@ knitr::kable( format = "html", table.attr = "style='width:70%;'", digits = 3 ) ``` -$$\\[0.01in]$$ +$$\\[0.01in]$$ Thanks to the extended length of the test period, we can also plot the trajectories of the median scaled errors over time, as we do below, with the @@ -731,7 +731,7 @@ knitr::kable( format = "html", table.attr = "style='width:50%;'" ) ``` -$$\\[0.01in]$$ +$$\\[0.01in]$$ If we stratify and recompute p-values by forecast date, the bulk of p-values are quite small. @@ -788,7 +788,7 @@ res <- case_fb_mods(dates, leads) We obtain and plot the median scaled errors for the "Cases" and "Cases + Facebook" models for different number of days ahead for the forecast target. This is done over May 20 through August 27 for the forecast dates that are -common to the two models. +common to the two models. ```{r} err_by_lead <- res %>% @@ -884,4 +884,4 @@ gets pulled "as of" the forecast date (this requires specifying the parameter Hopefully these preliminary findings have gotten you excited about the possible uses of this symptom survey data. For further practice, try your hand at implementing the suggested improvements or develop your own novel analytic -approach to extract insights from this data. +approach to extract insights from this data. diff --git a/vignettes/arx-classifier.Rmd b/vignettes/arx-classifier.Rmd index ae1641cce..b2a2bbf8e 100644 --- a/vignettes/arx-classifier.Rmd +++ b/vignettes/arx-classifier.Rmd @@ -50,10 +50,7 @@ jhu <- case_death_rate_subset %>% geo_value %in% c("ca", "fl", "tx", "ny", "nj") ) -out <- arx_classifier(jhu, - outcome = "case_rate", - predictors = "case_rate" -) +out <- arx_classifier(jhu, outcome = "case_rate", predictors = "case_rate") out$predictions ``` @@ -93,7 +90,8 @@ relying on the default of 0.25. We can do this by passing 0.5 to the `breaks` argument in `arx_class_args_list()` as follows: ```{r} -out_break_0.5 <- arx_classifier(jhu, +out_break_0.5 <- arx_classifier( + jhu, outcome = "case_rate", predictors = "case_rate", args_list = arx_class_args_list( @@ -142,8 +140,8 @@ the present? To answer this question, we can create a predictive model for upswings and downswings of case rates rather than the raw case rates themselves. For this situation, our target is to predict whether there is an increase in case rates -or not. Following -[McDonald, Bien, Green, Hu, et al.(2021)](https://www.pnas.org/doi/full/10.1073/pnas.2111453118), +or not. Following +[McDonald, Bien, Green, Hu, et al.(2021)](https://www.pnas.org/doi/full/10.1073/pnas.2111453118), we look at the relative change between $Y_{l,t}$ and $Y_{l, t+a}$, where the former is the case rate at location $l$ at time $t$ and the latter is the rate for that location at @@ -152,7 +150,7 @@ with two classes $$\begin{align} Z_{l,t} = \left\{\begin{matrix} -\text{up,} & \text{if } Y_{l,t}^\Delta > 0.25\\ +\text{up,} & \text{if } Y_{l,t}^\Delta > 0.25\\ \text{not up,} & \text{otherwise} \end{matrix}\right. \end{align}$$ @@ -166,7 +164,7 @@ $$\begin{align} \pi_{\text{up}}(x) &= Pr(Z_{l, t} = \text{up}|x) = \frac{e^{g_{\text{up}}(x)}}{1 + e^{g_{\text{up}}(x)}}, \\ \pi_{\text{not up}}(x)&= Pr(Z_{l, t} = \text{not up}|x) = 1 - Pr(Z_{l, t} = \text{up}|x) = \frac{1}{1 + e^{g_{\text{up}}(x)}} \end{align}$$ -where +where $$ g_{\text{up}}(x) = \log\left ( \frac{\Pr(Z_{l, t} = \text{up} \vert x)}{\Pr(Z_{l, t} = \text{not up} \vert x)} \right ) = \beta_{10} + \beta_{11}Y_{l,t}^\Delta + \beta_{12}Y_{l,t-7}^\Delta + \beta_{13}Y_{l,t-14}^\Delta. @@ -223,7 +221,7 @@ require access to the training data. The other optional arguments for controlling the growth rate calculation (that can be inputted as `additional_gr_args`) can be found in the documentation for -`epiprocess::growth_rate()` and the related +`epiprocess::growth_rate()` and the related `vignette("growth_rate", package = "epiprocess")`. ### Visualizing the results @@ -280,4 +278,4 @@ to start with using the built-in classifier for ostensibly simple projects and begin to implement your own when the modelling project takes a complicated turn. To get some practice on coding up a classifier by hand, consider translating this binary classification model example to an `epi_workflow`, akin to that in -`vignette("preprocessing-and-models")`. +`vignette("preprocessing-and-models")`. diff --git a/vignettes/epipredict.Rmd b/vignettes/epipredict.Rmd index 7ce4e2601..8c6a02aef 100644 --- a/vignettes/epipredict.Rmd +++ b/vignettes/epipredict.Rmd @@ -110,8 +110,6 @@ the *same set* of `geo_value`'s and `time_value`'s could actually be different. For more details, see [`{epiprocess}`](https://cmu-delphi.github.io/epiprocess/articles/epiprocess.html). - - ## Why doesn't this package already exist? As described above: @@ -121,7 +119,7 @@ preprocessing, training, and prediction, bound together, through a package calle `{workflows}`. We built `{epipredict}` on top of that setup. In this way, you CAN use almost everything they provide. -* However, `{workflows}` doesn't do postprocessing. And nothing in the -verse +* However, `{workflows}` doesn't do postprocessing. And nothing in the -verse handles _panel data_. * The tidy-team doesn't have plans to do either of these things. (We checked). @@ -131,7 +129,7 @@ handles _panel data_. etc.[^2] Our group has not prioritized these sorts of models for epidemic forecasting, but one could also integrate these methods into our framework. -[^2]: These are [`{timetk}`](https://business-science.github.io/timetk/index.html) +[^2]: These are [`{timetk}`](https://business-science.github.io/timetk/index.html) and [`{modeltime}`](https://business-science.github.io/timetk/index.html). There are *lots* of useful methods there than can be used to do fairly complex machine learning methodology, though not directly for panel data and not for direct @@ -231,14 +229,13 @@ quantile, head(quantile(out_q$predictions$.pred_distn, p = .4)) ``` -or extract the entire distribution into a "long" `epi_df` with `quantile_levels` -being the probability and `values` being the value associated to that quantile. +or extract the entire distribution into a "long" `epi_df` with `quantile_level` +being the probability and `value` being the value associated to that quantile +(each prefixed with the original column name `.pred_distn`). ```{r q2} out_q$predictions %>% - # first create a "nested" list-column - mutate(.pred_distn = nested_quantiles(.pred_distn)) %>% - unnest(.pred_distn) # then unnest it + pivot_quantiles_longer(.pred_distn) ``` Additional simple adjustments to the basic forecaster can be made using the @@ -327,6 +324,7 @@ the `time_value`, `geo_value`, and any additional keys so that these are availab when necessary. The `epi_recipe` from `out_gb` can be extracted from the result: + ```{r} extract_recipe(out_gb$epi_workflow) ``` @@ -441,7 +439,7 @@ But ideally, a user could create their own forecasters by building up the components we provide. In other vignettes, we try to walk through some of these customizations. -To illustrate everything above, here is (roughly) the code for the +To illustrate everything above, here is (roughly) the code for the `flatline_forecaster()` applied to the `case_rate`. ```{r}