Better detection, messaging, docs on epi_slide output clashes

Also move some things to @Keywords internal to match some recent additions,
though it's still a mix.

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
   }

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 = "<none>",
                            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 = "<none>",
                           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 "<colname> = <deparsed col value>"
+#' @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