From 0267c1346335b54031afbc203e2a160c0d6ff760 Mon Sep 17 00:00:00 2001 From: "Daniel J. McDonald" Date: Tue, 27 Dec 2022 10:11:52 -0800 Subject: [PATCH 1/4] remove flag argument from all layers --- R/create-layer.R | 10 ++++++---- R/layer_add_target_date.R | 2 ++ R/layer_naomit.R | 8 +++----- R/layer_point_from_distn.R | 3 +-- R/layer_population_scaling.R | 10 +++------- R/layer_predict.R | 19 +++++++++---------- R/layer_predictive_distn.R | 22 +++++++++------------- R/layer_quantile_distn.R | 3 +-- R/layer_residual_quantiles.R | 10 +++------- R/layer_threshold_preds.R | 11 +++++------ R/layers.R | 5 ++--- 11 files changed, 44 insertions(+), 59 deletions(-) diff --git a/R/create-layer.R b/R/create-layer.R index e9c3e1da7..d26402c18 100644 --- a/R/create-layer.R +++ b/R/create-layer.R @@ -25,10 +25,12 @@ create_layer <- function(name = NULL, open = rlang::is_interactive()) { name <- usethis:::slug(name, "R") usethis:::check_file_name(name) path <- fs::path("R", name) - if (! fs::file_exists(path)) { - usethis::use_template("layer.R", save_as = path, - data = list(name = layer_name), open = FALSE, - package = "epipredict") + if (!fs::file_exists(path)) { + usethis::use_template( + "layer.R", save_as = path, + data = list(name = layer_name), open = FALSE, + package = "epipredict" + ) } usethis::edit_file(usethis::proj_path(path), open = open) } diff --git a/R/layer_add_target_date.R b/R/layer_add_target_date.R index 330b56102..d11d947f5 100644 --- a/R/layer_add_target_date.R +++ b/R/layer_add_target_date.R @@ -45,6 +45,8 @@ #' p2 layer_add_target_date <- function(frosting, target_date = NULL, id = rand_id("add_target_date")) { + arg_is_chr_scalar(id) + arg_is_date(target_date) add_layer( frosting, layer_add_target_date_new( diff --git a/R/layer_naomit.R b/R/layer_naomit.R index b0066e504..eb33b43b3 100644 --- a/R/layer_naomit.R +++ b/R/layer_naomit.R @@ -6,8 +6,6 @@ #' were positions in the data frame, so expressions like `x:y` can #' be used to select a range of variables. Typical usage is `.pred` to remove #' any rows with `NA` predictions. -#' @param .flag a logical to determine if the layer is added. Passed on to -#' `add_layer()`. Default `TRUE`. #' @param id a random id string #' #' @return an updated `frosting` postprocessor @@ -35,14 +33,14 @@ #' #' p <- predict(wf1, latest) #' p -layer_naomit <- function(frosting, ..., .flag = TRUE, id = rand_id("naomit")) { +layer_naomit <- function(frosting, ..., id = rand_id("naomit")) { + arg_is_chr_scalar(id) add_layer( frosting, layer_naomit_new( terms = dplyr::enquos(...), id = id - ), - flag = .flag + ) ) } diff --git a/R/layer_point_from_distn.R b/R/layer_point_from_distn.R index b53b56255..de228af0a 100644 --- a/R/layer_point_from_distn.R +++ b/R/layer_point_from_distn.R @@ -64,8 +64,7 @@ layer_point_from_distn <- function(frosting, type = type, name = name, id = id - ), - flag = TRUE + ) ) } diff --git a/R/layer_population_scaling.R b/R/layer_population_scaling.R index b1e36cc41..57255911e 100644 --- a/R/layer_population_scaling.R +++ b/R/layer_population_scaling.R @@ -42,8 +42,6 @@ #' in the `epi_df`. #' @param suffix a character. The suffix added to the column name if #' `create_new = TRUE`. Default to "_original". -#' @param .flag a logical to determine if the layer is added. Passed on to -#' `add_layer()`. Default `TRUE`. #' @param id a random id string #' #' @return an updated `frosting` postprocessor @@ -94,11 +92,10 @@ layer_population_scaling <- function(frosting, rate_rescaling = 1, create_new = TRUE, suffix = "_scaled", - .flag = TRUE, id = rand_id("population_scaling")) { - arg_is_scalar(df_pop_col, rate_rescaling, create_new, suffix, .flag, id) - arg_is_lgl(create_new, .flag) + arg_is_scalar(df_pop_col, rate_rescaling, create_new, suffix, id) + arg_is_lgl(create_new) arg_is_chr(df_pop_col, suffix, id) arg_is_chr(by, allow_null = TRUE) if (rate_rescaling <= 0) @@ -115,8 +112,7 @@ layer_population_scaling <- function(frosting, create_new = create_new, suffix = suffix, id = id - ), - flag = .flag + ) ) } diff --git a/R/layer_predict.R b/R/layer_predict.R index c8a244181..63d876bea 100644 --- a/R/layer_predict.R +++ b/R/layer_predict.R @@ -9,10 +9,6 @@ #' #' @inheritParams parsnip::predict.model_fit #' @param frosting a frosting object -#' #' @param .flag a logical to determine if the layer is added. Passed on to -#' `add_layer()`. Default `TRUE`. -#' @param .flag a logical to determine if the layer is added. Passed on to -#' `add_layer()`. Default `TRUE`. #' @param id a string identifying the layer #' #' @@ -49,8 +45,9 @@ #' p2 layer_predict <- function(frosting, type = NULL, opts = list(), ..., - .flag = TRUE, id = rand_id("predict_default")) { + arg_is_chr_scalar(id) + arg_is_chr_scalar(type, allow_null = TRUE) add_layer( frosting, layer_predict_new( @@ -58,8 +55,7 @@ layer_predict <- opts = opts, dots_list = rlang::list2(...), # can't figure how to use this id = id - ), - flag = .flag + ) ) } @@ -71,8 +67,11 @@ layer_predict_new <- function(type, opts, dots_list, id) { #' @export slather.layer_predict <- function(object, components, the_fit, the_recipe, ...) { - components$predictions <- predict(the_fit, components$forged$predictors, - type = object$type, opts = object$opts) - components$predictions <- dplyr::bind_cols(components$keys, components$predictions) + components$predictions <- predict( + the_fit, + components$forged$predictors, + type = object$type, opts = object$opts) + components$predictions <- dplyr::bind_cols( + components$keys, components$predictions) components } diff --git a/R/layer_predictive_distn.R b/R/layer_predictive_distn.R index 6dc8b9d7f..2c8eff365 100644 --- a/R/layer_predictive_distn.R +++ b/R/layer_predictive_distn.R @@ -12,8 +12,6 @@ #' @param dist_type Gaussian or Student's t predictive intervals #' @param truncate Do we truncate the distribution to an interval #' @param name character. The name for the output column. -#' @param .flag a logical to determine if the layer is added. Passed on to -#' `add_layer()`. Default `TRUE`. #' @param id a random id string #' #' @return an updated `frosting` postprocessor with additional columns of the @@ -44,18 +42,17 @@ #' p <- predict(wf1, latest) #' p layer_predictive_distn <- function(frosting, - ..., - dist_type = c("gaussian", "student_t"), - truncate = c(-Inf, Inf), - name = ".pred_distn", - .flag = TRUE, # mandatory - id = rand_id("predictive_distn")) { + ..., + dist_type = c("gaussian", "student_t"), + truncate = c(-Inf, Inf), + name = ".pred_distn", + id = rand_id("predictive_distn")) { rlang::check_dots_empty() arg_is_chr_scalar(name, id) dist_type <- match.arg(dist_type) - stopifnot(length(truncate) == 2L, - is.numeric(truncate), - truncate[1] < truncate[2]) + stopifnot( + length(truncate) == 2L, is.numeric(truncate), truncate[1] < truncate[2] + ) add_layer( frosting, @@ -64,8 +61,7 @@ layer_predictive_distn <- function(frosting, truncate = truncate, name = name, id = id - ), - flag = .flag + ) ) } diff --git a/R/layer_quantile_distn.R b/R/layer_quantile_distn.R index 6cd5e348d..42c2669be 100644 --- a/R/layer_quantile_distn.R +++ b/R/layer_quantile_distn.R @@ -58,8 +58,7 @@ layer_quantile_distn <- function(frosting, truncate = truncate, name = name, id = id - ), - flag = TRUE + ) ) } diff --git a/R/layer_residual_quantiles.R b/R/layer_residual_quantiles.R index 01e973d9e..688eb3d27 100644 --- a/R/layer_residual_quantiles.R +++ b/R/layer_residual_quantiles.R @@ -8,8 +8,6 @@ #' @param by_key A character vector of keys to group the residuals by before #' calculating quantiles. The default, `c()` performs no grouping. #' @param name character. The name for the output column. -#' @param .flag a logical to determine if the layer is added. Passed on to -#' `add_layer()`. Default `TRUE`. #' @param id a random id string #' #' @return an updated `frosting` postprocessor with additional columns of the @@ -49,14 +47,13 @@ layer_residual_quantiles <- function(frosting, ..., symmetrize = TRUE, by_key = character(0L), name = ".pred_distn", - .flag = TRUE, id = rand_id("residual_quantiles")) { rlang::check_dots_empty() - arg_is_scalar(symmetrize, .flag) + arg_is_scalar(symmetrize) arg_is_chr_scalar(name, id) arg_is_chr(by_key, allow_null = TRUE) arg_is_probabilities(probs) - arg_is_lgl(symmetrize, .flag) + arg_is_lgl(symmetrize) add_layer( frosting, layer_residual_quantiles_new( @@ -65,8 +62,7 @@ layer_residual_quantiles <- function(frosting, ..., by_key = by_key, name = name, id = id - ), - flag = .flag + ) ) } diff --git a/R/layer_threshold_preds.R b/R/layer_threshold_preds.R index bcf47eaf7..f7ccc47b8 100644 --- a/R/layer_threshold_preds.R +++ b/R/layer_threshold_preds.R @@ -16,8 +16,6 @@ #' @param upper Upper threshold for the prediction values. That is, any #' predictions that are greater than this upper bound are set to it. #' Default value is `Inf`. -#' @param .flag a logical to determine if the layer is added. Passed on to -#' `add_layer()`. Default `TRUE`. #' @param id a random id string #' #' @@ -47,8 +45,10 @@ #' p <- predict(wf, latest) #' p layer_threshold <- - function(frosting, ..., lower = 0, upper = Inf, .flag = TRUE, - id = rand_id("threshold")) { + function(frosting, ..., lower = 0, upper = Inf, id = rand_id("threshold")) { + arg_is_scalar(lower, upper) + arg_is_chr_scalar(id) + stopifnot(is.numeric(lower), is.numeric(upper), lower < upper) add_layer( frosting, layer_threshold_new( @@ -56,8 +56,7 @@ layer_threshold <- lower = lower, upper = upper, id = id - ), - flag = .flag + ) ) } diff --git a/R/layers.R b/R/layers.R index 9aa7a0881..96c7d901f 100644 --- a/R/layers.R +++ b/R/layers.R @@ -2,15 +2,14 @@ #' #' @param frosting a `frosting` postprocessor #' @param object a `frosting` layer -#' @param flag logical to determine if the layer is added. Default `TRUE`. #' #' @return an updated `frosting` postprocessor #' @export -add_layer <- function(frosting, object, flag = TRUE) { +add_layer <- function(frosting, object) { validate_frosting(frosting) validate_layer(object) - if (flag) frosting$layers[[length(frosting$layers) + 1]] <- object + frosting$layers[[length(frosting$layers) + 1]] <- object frosting } From 4a51ceaa8d4d4c415918e7f2994734836fb563c1 Mon Sep 17 00:00:00 2001 From: "Daniel J. McDonald" Date: Tue, 27 Dec 2022 10:12:40 -0800 Subject: [PATCH 2/4] re-document --- man/add_layer.Rd | 4 +--- man/layer_naomit.Rd | 5 +---- man/layer_population_scaling.Rd | 4 ---- man/layer_predict.Rd | 8 +------- man/layer_predictive_distn.Rd | 4 ---- man/layer_residual_quantiles.Rd | 4 ---- man/layer_threshold.Rd | 4 ---- 7 files changed, 3 insertions(+), 30 deletions(-) diff --git a/man/add_layer.Rd b/man/add_layer.Rd index 9557193a0..536cc7202 100644 --- a/man/add_layer.Rd +++ b/man/add_layer.Rd @@ -4,14 +4,12 @@ \alias{add_layer} \title{Add layer to a frosting object} \usage{ -add_layer(frosting, object, flag = TRUE) +add_layer(frosting, object) } \arguments{ \item{frosting}{a \code{frosting} postprocessor} \item{object}{a \code{frosting} layer} - -\item{flag}{logical to determine if the layer is added. Default \code{TRUE}.} } \value{ an updated \code{frosting} postprocessor diff --git a/man/layer_naomit.Rd b/man/layer_naomit.Rd index 78c2f88fa..033181804 100644 --- a/man/layer_naomit.Rd +++ b/man/layer_naomit.Rd @@ -4,7 +4,7 @@ \alias{layer_naomit} \title{Omit \code{NA}s from predictions or other columns} \usage{ -layer_naomit(frosting, ..., .flag = TRUE, id = rand_id("naomit")) +layer_naomit(frosting, ..., id = rand_id("naomit")) } \arguments{ \item{frosting}{a \code{frosting} postprocessor} @@ -15,9 +15,6 @@ were positions in the data frame, so expressions like \code{x:y} can be used to select a range of variables. Typical usage is \code{.pred} to remove any rows with \code{NA} predictions.} -\item{.flag}{a logical to determine if the layer is added. Passed on to -\code{add_layer()}. Default \code{TRUE}.} - \item{id}{a random id string} } \value{ diff --git a/man/layer_population_scaling.Rd b/man/layer_population_scaling.Rd index 6537502cd..01abe0a0f 100644 --- a/man/layer_population_scaling.Rd +++ b/man/layer_population_scaling.Rd @@ -13,7 +13,6 @@ layer_population_scaling( rate_rescaling = 1, create_new = TRUE, suffix = "_scaled", - .flag = TRUE, id = rand_id("population_scaling") ) } @@ -57,9 +56,6 @@ in the \code{epi_df}.} \item{suffix}{a character. The suffix added to the column name if \code{create_new = TRUE}. Default to "_original".} -\item{.flag}{a logical to determine if the layer is added. Passed on to -\code{add_layer()}. Default \code{TRUE}.} - \item{id}{a random id string} } \value{ diff --git a/man/layer_predict.Rd b/man/layer_predict.Rd index 6f4422489..e13dcd9f6 100644 --- a/man/layer_predict.Rd +++ b/man/layer_predict.Rd @@ -9,14 +9,11 @@ layer_predict( type = NULL, opts = list(), ..., - .flag = TRUE, id = rand_id("predict_default") ) } \arguments{ -\item{frosting}{a frosting object -#' @param .flag a logical to determine if the layer is added. Passed on to -\code{add_layer()}. Default \code{TRUE}.} +\item{frosting}{a frosting object} \item{type}{A single character value or \code{NULL}. Possible values are "numeric", "class", "prob", "conf_int", "pred_int", "quantile", "time", @@ -48,9 +45,6 @@ and "pred_int". Default value is \code{FALSE}. \item \code{time}: the time(s) for hazard and survival probability estimates. }} -\item{.flag}{a logical to determine if the layer is added. Passed on to -\code{add_layer()}. Default \code{TRUE}.} - \item{id}{a string identifying the layer} } \value{ diff --git a/man/layer_predictive_distn.Rd b/man/layer_predictive_distn.Rd index 7be5b9217..f3a4c37c8 100644 --- a/man/layer_predictive_distn.Rd +++ b/man/layer_predictive_distn.Rd @@ -10,7 +10,6 @@ layer_predictive_distn( dist_type = c("gaussian", "student_t"), truncate = c(-Inf, Inf), name = ".pred_distn", - .flag = TRUE, id = rand_id("predictive_distn") ) } @@ -25,9 +24,6 @@ layer_predictive_distn( \item{name}{character. The name for the output column.} -\item{.flag}{a logical to determine if the layer is added. Passed on to -\code{add_layer()}. Default \code{TRUE}.} - \item{id}{a random id string} } \value{ diff --git a/man/layer_residual_quantiles.Rd b/man/layer_residual_quantiles.Rd index b960845cc..f41017120 100644 --- a/man/layer_residual_quantiles.Rd +++ b/man/layer_residual_quantiles.Rd @@ -11,7 +11,6 @@ layer_residual_quantiles( symmetrize = TRUE, by_key = character(0L), name = ".pred_distn", - .flag = TRUE, id = rand_id("residual_quantiles") ) } @@ -30,9 +29,6 @@ calculating quantiles. The default, \code{c()} performs no grouping.} \item{name}{character. The name for the output column.} -\item{.flag}{a logical to determine if the layer is added. Passed on to -\code{add_layer()}. Default \code{TRUE}.} - \item{id}{a random id string} } \value{ diff --git a/man/layer_threshold.Rd b/man/layer_threshold.Rd index cbd6d48e1..863ae2db7 100644 --- a/man/layer_threshold.Rd +++ b/man/layer_threshold.Rd @@ -9,7 +9,6 @@ layer_threshold( ..., lower = 0, upper = Inf, - .flag = TRUE, id = rand_id("threshold") ) } @@ -30,9 +29,6 @@ Default value is \code{0}.} predictions that are greater than this upper bound are set to it. Default value is \code{Inf}.} -\item{.flag}{a logical to determine if the layer is added. Passed on to -\code{add_layer()}. Default \code{TRUE}.} - \item{id}{a random id string} } \value{ From e592d984b2a9548cf250b793899c984779c34a1d Mon Sep 17 00:00:00 2001 From: "Daniel J. McDonald" Date: Tue, 27 Dec 2022 10:26:53 -0800 Subject: [PATCH 3/4] all tests pass, flag removed --- R/layer_add_forecast_date.R | 7 +------ R/layer_add_target_date.R | 2 +- R/utils_arg.R | 10 ++++++++++ 3 files changed, 12 insertions(+), 7 deletions(-) diff --git a/R/layer_add_forecast_date.R b/R/layer_add_forecast_date.R index 40b63ee9e..cfb795e92 100644 --- a/R/layer_add_forecast_date.R +++ b/R/layer_add_forecast_date.R @@ -69,13 +69,8 @@ layer_add_forecast_date <- } layer_add_forecast_date_new <- function(forecast_date, id) { - arg_is_scalar(forecast_date, allow_null = TRUE) - if (!is.null(forecast_date)) { - forecast_date <- tryCatch(as.Date(forecast_date), error = function(e) NA) - } - arg_is_date(forecast_date, allow_null = TRUE) + forecast_date <- arg_to_date(forecast_date, allow_null = TRUE) arg_is_chr_scalar(id) - layer("add_forecast_date", forecast_date = forecast_date, id = id) } diff --git a/R/layer_add_target_date.R b/R/layer_add_target_date.R index d11d947f5..f6d6fd155 100644 --- a/R/layer_add_target_date.R +++ b/R/layer_add_target_date.R @@ -45,8 +45,8 @@ #' p2 layer_add_target_date <- function(frosting, target_date = NULL, id = rand_id("add_target_date")) { + target_date <- arg_to_date(target_date, allow_null = TRUE) arg_is_chr_scalar(id) - arg_is_date(target_date) add_layer( frosting, layer_add_target_date_new( diff --git a/R/utils_arg.R b/R/utils_arg.R index c2b56fac9..b18a29898 100644 --- a/R/utils_arg.R +++ b/R/utils_arg.R @@ -158,3 +158,13 @@ arg_is_sorted = function(..., allow_null = FALSE) { }) } + + +arg_to_date <- function(x, allow_null = FALSE, allow_na = FALSE) { + arg_is_scalar(x, allow_null = allow_null, allow_na = allow_na) + if (allow_null && !is.null(x)) { + x <- tryCatch(as.Date(x), error = function(e) NA) + } + arg_is_date(x, allow_null = allow_null, allow_na = allow_na) + x +} From 20ee9c3f10f1b57f331aed25490e78b1c3480d84 Mon Sep 17 00:00:00 2001 From: "Daniel J. McDonald" Date: Tue, 27 Dec 2022 10:27:35 -0800 Subject: [PATCH 4/4] bump version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index e1a8b25d8..47d856675 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: epipredict Title: Basic epidemiology forecasting methods -Version: 0.0.3 +Version: 0.0.3.9999 Authors@R: c( person("Daniel", "McDonald", , "daniel@stat.ubc.ca", role = c("aut", "cre")), person("Ryan", "Tibshirani", , "ryantibs@cmu.edu", role = "aut"),