diff --git a/R/slide.R b/R/slide.R index 77c7ae9c..688b6ce0 100644 --- a/R/slide.R +++ b/R/slide.R @@ -34,9 +34,8 @@ #' @param .new_col_name String indicating the name of the new column that will #' contain the derivative values. The default is "slide_value" unless your #' slide computations output data frames, in which case they will be unpacked -#' into the constituent columns and those names used. Note that setting -#' `.new_col_name` equal to an existing column name will overwrite this -#' column. +#' into the constituent columns and those names used. New columns should not +#' be given names that clash with the existing columns of `.x`; see details. #' #' @template basic-slide-details #' @@ -182,21 +181,12 @@ epi_slide <- function( assert_character(.new_col_name, null.ok = TRUE) if (!is.null(.new_col_name)) { - if (.new_col_name %in% group_vars(.x)) { - cli_abort(c("`.new_col_name` must not be one of the grouping column name(s); - `epi_slide()` uses these column name(s) to label what group - each slide computation came from.", - "i" = "{cli::qty(length(group_vars(.x)))} grouping column name{?s} - {?was/were} {format_chr_with_quotes(group_vars(.x))}", - "x" = "`.new_col_name` was {format_chr_with_quotes(.new_col_name)}" + if (.new_col_name %in% names(.x)) { + cli_abort(c("`.new_col_name` cannot overlap with existing column names", + "x" = "{sym(.new_col_name)} already exists in `.x`", + ">" = "Try using a different `.new_col_name` instead." )) } - if (any(.new_col_name %in% c("geo_value", "time_value"))) { - cli_abort( - "epi_slide: `.new_col_name` cannot be one of 'geo_value' or 'time_value'.", - class = "epiprocess__epi_slide_invalid_new_col_name" - ) - } } assert_logical(.all_rows, len = 1) @@ -406,18 +396,20 @@ epi_slide_one_group <- function( if (!identical(slide_values[[comp_i]], res[[comp_nms[[comp_i]]]])) { lines <- c( cli::format_error(c( - "conflict detected between existing columns and slide computation output:", - "i" = "pre-existing columns: {syms(names(res))}", - "x" = "slide computation output included a column {syms(comp_nms[[comp_i]])} that didn't match the - pre-existing value" + "New column and old column clash", + "x" = "slide computation output included a + {format_varname(comp_nms[[comp_i]])} column, but `.x` already had a + {format_varname(comp_nms[[comp_i]])} column with differing values", + "Here are examples of differing values, where the grouping variables were + {format_tibble_row(.group_key)}:" )), capture.output(print(waldo::compare( res[[comp_nms[[comp_i]]]], slide_values[[comp_i]], x_arg = "existing", y_arg = "comp output" ))), cli::format_message(c( - "You likely want to rename or remove this column from your slide computation's output, or - debug why it has a different value." + ">" = "You likely want to rename or remove this column from your slide + computation's output, or debug why it has a different value." )) ) rlang::abort(paste(collapse = "\n", lines), @@ -431,15 +423,16 @@ epi_slide_one_group <- function( res <- bind_cols(res, slide_values[!overlaps_existing_names]) } else { # Apply default name (to vector or packed data.frame-type column): + if ("slide_value" %in% names(res)) { + cli_abort(c("Cannot guess a good column name for your output", + "x" = "`slide_value` already exists in `.x`", + ">" = "Please provide a `.new_col_name`." + )) + } res[["slide_value"]] <- slide_values - # TODO check for bizarre conflicting `slide_value` existing col name. - # Either here or on entry to `epi_slide` (even if there we don't know - # whether vecs will be output). Or just turn this into a special case of - # the preceding branch and let the checking code there generate a - # complaint. } } else { - # vector or packed data.frame-type column (note: overlaps with existing + # Vector or packed data.frame-type column (note: overlaps with existing # column names should already be forbidden by earlier validation): res[[.new_col_name]] <- slide_values } diff --git a/R/utils.R b/R/utils.R index 87d32823..d627f0bb 100644 --- a/R/utils.R +++ b/R/utils.R @@ -22,7 +22,7 @@ #' `initial` is long or the printing width is very narrow. #' @return `chr`; to print, use [`base::writeLines`]. #' -#' @noRd +#' @keywords internal wrap_symbolics <- function(symbolics, initial = "", common_prefix = "", none_str = "", width = getOption("width", 80L)) { @@ -69,7 +69,7 @@ wrap_symbolics <- function(symbolics, #' @inheritParams wrap_symbolics #' @return `chr`; to print, use [`base::writeLines`]. #' -#' @noRd +#' @keywords internal wrap_varnames <- function(nms, initial = "", common_prefix = "", none_str = "", width = getOption("width", 80L)) { @@ -84,7 +84,7 @@ wrap_varnames <- function(nms, #' @param lines `chr` #' @return string #' -#' @noRd +#' @keywords internal paste_lines <- function(lines) { paste(paste0(lines, "\n"), collapse = "") } @@ -93,6 +93,7 @@ paste_lines <- function(lines) { #' #' @param class_vec `chr`; output of `class(object)` for some `object` #' @return string +#' @keywords internal format_class_vec <- function(class_vec) { paste(collapse = "", deparse(class_vec)) } @@ -102,6 +103,7 @@ format_class_vec <- function(class_vec) { #' @param x `chr`; e.g., `colnames` of some data frame #' @param empty string; what should be output if `x` is of length 0? #' @return string +#' @keywords internal format_chr_with_quotes <- function(x, empty = "*none*") { if (length(x) == 0L) { empty @@ -119,6 +121,58 @@ format_chr_with_quotes <- function(x, empty = "*none*") { } } +#' "Format" a character vector of column/variable names for cli interpolation +#' +#' Designed to give good output if interpolated with cli. Main purpose is to add +#' backticks around variable names when necessary, and something other than an +#' empty string if length 0. +#' +#' @param x `chr`; e.g., `colnames` of some data frame +#' @param empty string; what should be output if `x` is of length 0? +#' @return `chr` +#' @keywords internal +format_varnames <- function(x, empty = "*none*") { + if (length(x) == 0L) { + empty + } else { + as.character(syms(x)) + } +} + +#' "Format" column/variable name for cli interpolation +#' +#' Designed to give good output if interpolated with cli. Main purpose is to add +#' backticks around variable names when necessary. +#' +#' @param x string; e.g., a colname +#' @return string +#' @keywords internal +format_varname <- function(x) { + # `syms` provides backticks if necessary; `sym` does not + as.character(syms(x)) +} + +#' Format a tibble row as chr +#' +#' @param x a tibble with a single row +#' @return `chr` with one entry per column, of form " = " +#' @keywords internal +format_tibble_row <- function(x, empty = "*none*") { + if (length(x) == 0L) { + empty + } else { + formatted_names <- as.character(syms(names(bindings))) + # Deparse values (e.g., surround strings with quotes & escaping) so this + # can be more easily copy-paste-edited into a `dplyr::filter` for + # debugging. + formatted_values <- map_chr(bindings, function(binding_value) { + paste(collapse = " ", deparse(binding_value)) + }) + formatted_bindings <- paste(formatted_names, "=", formatted_values) + formatted_bindings + } +} + #' Assert that a sliding computation function takes enough args #' #' @param f Function; specifies a computation to slide over an `epi_df` or diff --git a/man/epi_slide.Rd b/man/epi_slide.Rd index 70918f18..323fdf4d 100644 --- a/man/epi_slide.Rd +++ b/man/epi_slide.Rd @@ -77,9 +77,8 @@ underlying data table, by default.} \item{.new_col_name}{String indicating the name of the new column that will contain the derivative values. The default is "slide_value" unless your slide computations output data frames, in which case they will be unpacked -into the constituent columns and those names used. Note that setting -\code{.new_col_name} equal to an existing column name will overwrite this -column.} +into the constituent columns and those names used. New columns should not +be given names that clash with the existing columns of \code{.x}; see details.} \item{.all_rows}{If \code{.all_rows = TRUE}, then all rows of \code{.x} will be kept in the output even with \code{.ref_time_values} provided, with some type of missing diff --git a/man/format_chr_with_quotes.Rd b/man/format_chr_with_quotes.Rd index b62b172e..49beffb0 100644 --- a/man/format_chr_with_quotes.Rd +++ b/man/format_chr_with_quotes.Rd @@ -17,3 +17,4 @@ string \description{ Format a character vector as a string via deparsing/quoting each } +\keyword{internal} diff --git a/man/format_class_vec.Rd b/man/format_class_vec.Rd index b2b96678..2c7ae4b7 100644 --- a/man/format_class_vec.Rd +++ b/man/format_class_vec.Rd @@ -15,3 +15,4 @@ string \description{ Format a class vector as a string via deparsing it } +\keyword{internal} diff --git a/man/format_tibble_row.Rd b/man/format_tibble_row.Rd new file mode 100644 index 00000000..c43bd4a9 --- /dev/null +++ b/man/format_tibble_row.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{format_tibble_row} +\alias{format_tibble_row} +\title{Format a tibble row as chr} +\usage{ +format_tibble_row(x, empty = "*none*") +} +\arguments{ +\item{x}{a tibble with a single row} +} +\value{ +\code{chr} with one entry per column, of form "\if{html}{\out{}} = \if{html}{\out{}}" +} +\description{ +Format a tibble row as chr +} +\keyword{internal} diff --git a/man/format_varname.Rd b/man/format_varname.Rd new file mode 100644 index 00000000..fa9d3583 --- /dev/null +++ b/man/format_varname.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{format_varname} +\alias{format_varname} +\title{"Format" column/variable name for cli interpolation} +\usage{ +format_varname(x) +} +\arguments{ +\item{x}{string; e.g., a colname} +} +\value{ +string +} +\description{ +Designed to give good output if interpolated with cli. Main purpose is to add +backticks around variable names when necessary. +} +\keyword{internal} diff --git a/man/format_varnames.Rd b/man/format_varnames.Rd new file mode 100644 index 00000000..d25eb713 --- /dev/null +++ b/man/format_varnames.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{format_varnames} +\alias{format_varnames} +\title{"Format" a character vector of column/variable names for cli interpolation} +\usage{ +format_varnames(x, empty = "*none*") +} +\arguments{ +\item{x}{\code{chr}; e.g., \code{colnames} of some data frame} + +\item{empty}{string; what should be output if \code{x} is of length 0?} +} +\value{ +\code{chr} +} +\description{ +Designed to give good output if interpolated with cli. Main purpose is to add +backticks around variable names when necessary, and something other than an +empty string if length 0. +} +\keyword{internal} diff --git a/man/paste_lines.Rd b/man/paste_lines.Rd new file mode 100644 index 00000000..bab1e90b --- /dev/null +++ b/man/paste_lines.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{paste_lines} +\alias{paste_lines} +\title{Paste \code{chr} entries (lines) together with \code{"\\n"} separators, trailing \code{"\\n"}} +\usage{ +paste_lines(lines) +} +\arguments{ +\item{lines}{\code{chr}} +} +\value{ +string +} +\description{ +Paste \code{chr} entries (lines) together with \code{"\\n"} separators, trailing \code{"\\n"} +} +\keyword{internal} diff --git a/man/wrap_symbolics.Rd b/man/wrap_symbolics.Rd new file mode 100644 index 00000000..cfee2dcf --- /dev/null +++ b/man/wrap_symbolics.Rd @@ -0,0 +1,42 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{wrap_symbolics} +\alias{wrap_symbolics} +\title{Line wrap list holding \link[rlang:is_expression]{symbolic}, with prefix&indent} +\usage{ +wrap_symbolics( + symbolics, + initial = "", + common_prefix = "", + none_str = "", + width = getOption("width", 80L) +) +} +\arguments{ +\item{symbolics}{List of \link[rlang:is_expression]{symbolic} objects: the variable +names (potentially empty)} + +\item{initial}{Optional; single string: a prefix for the initial line in the +result; e.g., "Variable names: ". Defaults to "". Any non-initial lines +will be indented with whitespace matching the (estimated) visual width of +\code{initial}.} + +\item{common_prefix}{Optional; single string: a prefix for every line (will +appear before \code{initial}); e.g., "# ". Defaults to "".} + +\item{none_str}{Optional; single string: what to display when given +\code{length}-0 input. Will be combined with \code{common_prefix} and \code{initial}.} + +\item{width}{Optional; single integer: desired maximum formatted line width. +The formatted output may not obey this setting if \code{common_prefix} plus +\code{initial} is long or the printing width is very narrow.} +} +\value{ +\code{chr}; to print, use \code{\link[base:writeLines]{base::writeLines}}. +} +\description{ +Helps pretty-print these objects. Adds backticks, commas, prefixes, and +indentation. Wraps lines, but won't insert line breaks in the middle of any +name while doing so. +} +\keyword{internal} diff --git a/man/wrap_varnames.Rd b/man/wrap_varnames.Rd new file mode 100644 index 00000000..8c3e1246 --- /dev/null +++ b/man/wrap_varnames.Rd @@ -0,0 +1,39 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{wrap_varnames} +\alias{wrap_varnames} +\title{Line wrap \code{chr} holding variable/column/other names, with prefix&indent} +\usage{ +wrap_varnames( + nms, + initial = "", + common_prefix = "", + none_str = "", + width = getOption("width", 80L) +) +} +\arguments{ +\item{nms}{Character vector: the variable names (potentially empty)} + +\item{initial}{Optional; single string: a prefix for the initial line in the +result; e.g., "Variable names: ". Defaults to "". Any non-initial lines +will be indented with whitespace matching the (estimated) visual width of +\code{initial}.} + +\item{common_prefix}{Optional; single string: a prefix for every line (will +appear before \code{initial}); e.g., "# ". Defaults to "".} + +\item{none_str}{Optional; single string: what to display when given +\code{length}-0 input. Will be combined with \code{common_prefix} and \code{initial}.} + +\item{width}{Optional; single integer: desired maximum formatted line width. +The formatted output may not obey this setting if \code{common_prefix} plus +\code{initial} is long or the printing width is very narrow.} +} +\value{ +\code{chr}; to print, use \code{\link[base:writeLines]{base::writeLines}}. +} +\description{ +Line wrap \code{chr} holding variable/column/other names, with prefix&indent +} +\keyword{internal}