Fix long lines, docs, correct variable from get_active_quarto_project

Improve errors.

R/case-if-any.R

@@ -6,7 +6,8 @@
 #' The function allows you to assign multiple values to a character value, which
 #' can be very handy for EDA.
 #' @inheritParams dplyr::case_when
-#' @param .sep, the separator between answers. (default is `;`), can't be a substring of any of the text
+#' @param .sep, the separator between answers. (default is `;`), can't be a
+#'   substring of any of the text
 #' @inherit dplyr::case_when return
 #' @param .drop_empty drop if no match is returned.
 #'   (Defaults to `TRUE` for legibility), but if `FALSE`,
@@ -50,7 +51,12 @@ case_if_any <- function(..., .default = "", .sep = ";", .drop_empty = TRUE) {
   result_raw1 <-
     dplyr::mutate(
       .data = dplyr::bind_cols(res),
-      dplyr::across(dplyr::everything(), function(x) ifelse(x, text_condition[dplyr::cur_column()], .default))
+      dplyr::across(
+        .cols = dplyr::everything(),
+        .fns = function(x) {
+          ifelse(x, text_condition[dplyr::cur_column()], .default)
+        }
+      )
     )
 
   result_raw2 <-
@@ -62,9 +68,13 @@ case_if_any <- function(..., .default = "", .sep = ";", .drop_empty = TRUE) {
   result <- result_raw2$text
 
   if (any(grepl(.sep, text_condition))) {
-    cli::cli_abort("`.sep` cannot be contained in the `condition`. Change the replacement text, or `sep`")
+    cli::cli_abort(c(
+      x = "{.arg .sep} cannot be contained in the condition.",
+      i = "Change either the replacement text, or {.arg .sep}"
+    ))
   }
 
+  # I ended up importing stringr...
   if (.drop_empty) {
     if (nzchar(.default)) {
       result <- gsub(pattern = paste0("(", .default, ")", .sep, "(", .default, ")?"), replacement = "", x = result)

R/dplyr-plus.R

@@ -174,12 +174,14 @@ slice_group_sample <- function(data, group_var = NULL, n_groups = 1) {
 }
 #' Keep rows that match one of the conditions
 #'
-#' The `filter_if_any()` function is used to subset a data frame, retaining all rows
-#' that satisfy **at least one of** your conditions.
-#' To be retained, the row must produce a value of `TRUE` for **one of the conditions**
-#' Note that when a condition evaluates to `NA` the row will be dropped, (hence this function) unlike base subsetting with `[`.
+#' The `filter_if_any()` function is used to subset a data frame, retaining all
+#' rows that satisfy **at least one of** your conditions.
+#' To be retained, the row must produce a value of `TRUE` for
+#' **one of the conditions**. Note that when a condition evaluates to `NA` the
+#' row will be dropped, (hence this function) unlike base subsetting with `[`.
 #'
 #' The reason to be of this function is to simplify a call like
+#'
 #' ```r
 #' # with dplyr::filter
 #' dat %>% dplyr::filter(vs == 1 | is.na(vs))
@@ -188,29 +190,33 @@ slice_group_sample <- function(data, group_var = NULL, n_groups = 1) {
 #'   dplyr::filter(dplyr::if_any(starts_with("cond")))
 #' dat %>% filter_if_any(vs == 1, is.na(vs))
 #' ```
-#' Basically, this is just a shortcut to `mutate(.data, new_lgl_vars)` + `filter(if_any(new_lgl_vars))` + `select(-new_lgl_vars)`
-#' It allows mutate_like syntax in `filter(if_any(...))`
 #'
-#' Caution: still doesn't work with [dplyr::across()], use the regular `filter(if_any())` syntax.
+#' Basically, this is just a shortcut to
+#' `mutate(.data, new_lgl_vars)` + `filter(if_any(new_lgl_vars))` + `select(-new_lgl_vars)`.
+#' It allows mutate_like syntax in `filter(if_any(...))`.
+#'
+#' Caution: still doesn't work with [dplyr::across()], use the regular
+#' `filter(if_any())` syntax.
+#'
 #' @param .data A data frame
 #' @param ... <[`data-masking`][rlang::args_data_masking]> Name-value pairs.
 #'   The name gives the name of the column in the output.
 #'
 #'   The value can be:
 #'
-#'   * A logical vector of length 1, which will be recycled to the correct length.
+#'   * A logical vector, which will be recycled to the correct length.
 #'   * A logical vector the same length as the current group (or the whole data frame
 #'     if ungrouped).
 #'
 #' @param ... <[`data-masking`][rlang::args_data_masking]> Expressions that
 #'   return a logical value, and are defined in terms of the variables in
 #'   `.data`. If multiple expressions are included, they are combined with the
-#'   `|` operator. Only rows for which **one of the conditions** evaluate to `TRUE` are
-#'   kept.
-#' @param .by Like in dplyr.
-#' @param .keep_new_var If `FALSE`,
-#' @returns
-#'   An object of the same type as `.data`. The output has the following properties:
+#'   `|` operator. Only rows for which **one of the conditions** evaluate to
+#'   `TRUE` are kept.
+#' @param .by See [dplyr::dplyr_by].
+#' @param .keep_new_var If `TRUE`, will remove newly created variables.
+#' @returns An object of the same type as `.data`.
+#'   The output has the following properties:
 #'
 #'  * Rows are a subset of the input, but appear in the same order.
 #'  * Columns are not modified (if `.keep_new_var = FALSE`.
@@ -238,16 +244,20 @@ filter_if_any <- function(.data, ..., .by = NULL, .keep_new_var = FALSE) {
     return(res)
   }
 
-  cli::cli_abort("You didn't provide logical expressions. See {.help dplyr::filter}")
+  cli::cli_abort(c(
+    x = "You must provide logical expressions to {.arg {cli::symbol$ellipsis}}",
+    i = "See {.help dplyr::filter} for more information on how it works."
+  ))
 }
 #' Elegant wrapper around filter and pull
 #'
-#' It can be very useful when trying to extract a value from somewhere,
-#' and you have one col that represents the unique id.
+#' It can be very useful when trying to extract a value from somewhere, and you
+#' have one col that represents the unique id.
 #'
 #' @param data A data.frame
 #' @param filter the filter
-#' @param name The variable for the name (by default, will look for `rownames`), can be quoted (safer).
+#' @param name The variable for the name (by default, will look for `rownames`),
+#'   can be quoted (safer).
 #' @inheritParams dplyr::pull
 #' @param length A fixed length to check for the output
 #' @param unique A logical. Should return unique values?

R/eda-identity.R

@@ -2,42 +2,52 @@
 #' Helpers that return the same value
 #'
 #' @description
-#' They all share the `*_identity` suffix, they are silent in non-interactive sessions
-#' They are very handy to create runnable hyperlinks that do not modify the current state of the analysis
+#' They all share the `*_identity` suffix, they are silent in non-interactive
+#' sessions. They are very handy to create clickable hyperlinks that do not
+#' modify the current state of the analysis.
 #'
-#' They are inspired by [pillar::glimpse], [tibble::view],
+#' They are inspired by [pillar::glimpse], [tibble::view].
 #'
 #' Look at the original functions for the other parameters.
+#'
 #' # Use cases / advantages
 #'
 #' * Like many other reuseme functions, they are most useful in interactive sessions
 #' * print the result in interactive sessions (quiet in non-interactive.)
-#' * Create runnable hyperlinks (In August 2023, RStudio forbids runnable hyperlinks of base functions, or non-package functions. (i.e. that don't have `::`))
+#' * Create runnable hyperlinks (In August 2023, RStudio forbids runnable
+#'   hyperlinks of base functions, or non-package functions. (i.e. that don't have `::`))
 #' * Use in pipelines to explore the data
 #' * Use [rlang::is_interactive()] over [base::interactive()] as it's easier to
 #' control and test with `options(rlang_interactive)`
 #' * Use the original functions for your final results.
 #' * `count_identity()` also prints percentages.
-#' * `slice_identity()` can be useful to resolve many-to-many warnings from dplyr join functions.
+#' * `slice_identity()` can be useful to resolve many-to-many warnings from
+#'   dplyr join functions.
+#'
 #' # Caution
 #'
 #' * Don't put those at the end of a pipeline
-#' * Don't name the first argument, to avoid conflicts in case a variable is named `x`.
+#' * Don't name the first argument, to avoid conflicts in case a column in the
+#'   data is named `x`.
 #' * Some functions have small tweaks
-#'   * `mutate_identity()` only prints the distinct values, and uses `.keep = "used"`, `.before = 0`,
-#'     unless specified to improve the display.
-#'   * `count_identity()` is a wrapper of `count_pct()` (wrapper of `dplyr::count()`),
-#'      may fail if there is already a variable named `n`.
+#'   * `mutate_identity()` only prints the distinct values, and uses
+#'     `.keep = "used"`, `.before = 0`, unless specified to improve the display.
+#'   * `count_identity()` is a wrapper of [count_pct()]
+#'     (itself a wrapper of `dplyr::count()`),
+#'   * `count_identity()` may fail if there is already a variable named `n`.
 #'   * `slice_min/max_identity()` relocates the target column at the beginning.
 #'   * `filter_identity()` prints a short message if no rows are returned.
 #'
-#' @param x The main object (a data.frame, but some functions accept a vector.) (aka `.data` in some `dplyr` functions, but naming it `x` throughout.)
-#' @param extra_msg A character vector of observations, notes taken related to the transformation.
+#' @param x The main object (a data.frame, but some functions accept a vector.)
+#'   (aka `.data` in some `dplyr` functions, but naming it `x` throughout.)
+#' @param extra_msg A character vector of observations that will print to
+#'   console, notes taken related to the transformation.
 #' @param nrows Number of rows to print.
 #' @param name,sort,.keep_all,.by,by,n_groups,group_var,...,n,prop,with_ties,order_by,.keep,.before,each,na_rm,weight_by,replace,.by_group,.keep_new_var,.preserve Check original functions.
 #'
-#' @returns `x` original `x` is (invisibly) returned. (allowing the `*_identity()`
-#'   functions to be used in a pipeline) will print `extra_msg` to the console in interactive sessions.
+#' @returns `x`, the original input is (invisibly) returned.
+#'   (allowing the `*_identity()` functions to be used in a pipeline) will print
+#'    `extra_msg` to the console in interactive sessions.
 #' @seealso
 #' * [dplyr::distinct()]
 #' * [dplyr::filter()]

R/named.R

@@ -34,7 +34,8 @@ min_named <- function(x, na.rm = FALSE, all_matches = FALSE) {
   }
 
   if (all_matches) {
-    # wouldn't make sense if there were duplicated names that return a different value
+    # wouldn't make sense if there were duplicated names
+    # that return a different value
     # min_named(c("x" = 1, "y" = 1, "ww" = 2, "y" = 2))
     cli::cli_abort("Still not done.")
   }
@@ -60,7 +61,7 @@ max_named <- function(x, na.rm = FALSE, all_matches = FALSE) {
 #' @export
 unique_named <- function(x) {
   # Duplicate names
-  # purrr::map vs list_c, SO question (this is in canadr, when querying possible geographies.)
+  # purrr::map vs list_c, SO question
   if (!rlang::is_named(x)) {
     return(unique(x))
   }

R/todo-utils.R

@@ -3,9 +3,11 @@
 #' Creates or edits a `TODO.R` file to store your TODOs.
 #' By default it will write in the current RStudio project.
 #'
-#' If you use `use_todo()` with a version-control repository, you may want to use
-#'  `usethis::use_git_ignore("TODO.R")` if you don't want your `TODO.R` file to be included.
-#' If using in a package directory, use `usethis::use_build_ignore("TODO.R")` to prevent a note in `R CMD CHECK`
+#' If you use `use_todo()` with a version-control repository, you may want to
+#' use `usethis::use_git_ignore("TODO.R")` if you don't want your `TODO.R` file
+#'
+#' to be included in git. If using in a package directory, use
+#' `usethis::use_build_ignore("TODO.R")` to prevent a note in `R CMD CHECK`
 #'
 #' @param todo A character vector of lines to add to the TODO file
 #' @param proj By default, the active project, an arbitrary directory, or a
@@ -34,7 +36,8 @@ use_todo <- function(todo, proj = proj_get(), code = FALSE) {
 
   if (!is.na(proj_in_todo)) {
     proj <- proj_in_todo
-    todo[1] <- stringr::str_remove(todo[1], paste0(proj_in_todo, "\\:\\:", "\\s?"))
+    regex_proj_in_todo <- paste0(proj_in_todo, "\\:\\:", "\\s?")
+    todo[1] <- stringr::str_remove(todo[1], regex_proj_in_todo)
   }
 
   is_active_proj <- identical(proj, proj_get2())
@@ -55,18 +58,22 @@ use_todo <- function(todo, proj = proj_get(), code = FALSE) {
     proj_path <- proj
   }
 
-  full_path_todo <- if (is_active_proj) path_todo else fs::path(proj_path, path_todo)
-
-  # TODO nice to have, but would need to extract duplicates (ideally changes in usethis)
+  full_path_todo <- if (is_active_proj) {
+    path_todo
+  } else {
+    fs::path(proj_path, path_todo)
+  }
+  # TODO nice to have, but would need to extract duplicates
+  # (ideally changes in usethis)
   # Change the default write_union message.
   write_union2(full_path_todo, lines = todo_lines, quiet = FALSE)
 }
 
 #' Remove a TODO/WORK/FIXME item from a file
 #'
 #' Function meant to be wrapped as `{.run}` hyperlinks with `file_outline()`.
-#' It basically removes a line from a file.
-#' Eventually, it may use regexp to look around and regexp could be used instead of line_id.
+#' It basically removes a line from a file. Eventually, it may use `regexp` to
+#' look around and regexp could be used instead of line_id.
 #'
 #' @param line_id The line number (a single integer)
 #' @param file Path to a file
@@ -75,7 +82,8 @@ use_todo <- function(todo, proj = proj_get(), code = FALSE) {
 #'   will remove only the tag (i.e. TODO, WORK, FIXME)
 #' @param regexp A regexp to assess that file content has not changed
 #'
-#' @return Writes a file with corrections, and returns the new line content invisibly.
+#' @return Writes a file with corrections, and returns the new line
+#'   content invisibly.
 #' @export
 #' @keywords internal
 mark_todo_as_complete <- function(line_id, file, regexp, rm_line = NULL) {
@@ -90,7 +98,7 @@ mark_todo_as_complete <- function(line_id, file, regexp, rm_line = NULL) {
       "Did not detect the following text as expected {regexp}",
       "This function expects regexp to be detected on line {line_id} in {file}",
       "Possibly the file content has changed since you ran this code",
-      "This function is still not robust to marking multiple items as done in a single call."
+      "You still cannot mark multiple items as done in a single call."
     ))
   }
 
@@ -105,8 +113,15 @@ mark_todo_as_complete <- function(line_id, file, regexp, rm_line = NULL) {
     file_content_new <- file_content[-line_id]
     line_content_new <- ""
   } else {
-    cli::cli_alert_success("Marking `{line_content}` as done! (Removing the {tag_type})")
-    line_content_new <- sub(pattern = paste0(tag_type, "\\s+"), replacement = "", line_content)
+    cli::cli_alert_success(
+      "Marking `{line_content}` as done! (Removing the {tag_type})"
+    )
+    line_content_new <- sub(
+      pattern = paste0(tag_type, "\\s+"),
+      replacement = "",
+      line_content
+    )
+
     file_content[line_id] <- line_content_new
     file_content_new <- file_content
   }

R/utils.R

@@ -69,7 +69,7 @@ is_quarto_blog <- function(base_path = proj_get()) {
 
 get_active_qmd_post <- function(base_path = proj_get(), dir = NULL, call = caller_env()) {
   # as long as rstudioapi is not consistent with fs on file paths, this may cause issues.
-  is_active_proj <- identical(proj, proj_get2())
+  is_active_proj <- identical(base_path, proj_get2())
   base_path <- fs::path(unname(base_path))
 
 
@@ -110,8 +110,8 @@ get_active_qmd_post <- function(base_path = proj_get(), dir = NULL, call = calle
   if (!fs::path_ext(relative_path) %in% c("qmd", "md", "Rmd", "Rmarkdown")) {
     cli::cli_abort(
       c(
-        x = "You must be calling the screenshot function when editing a Quarto document.",
-        i = "Open a document then retry. or set `dir` to manually override the location of the screenshot."
+        x = "{.fn screenshot} must be used when editing a qmd file.",
+        i = "Open a qmd file or set `dir` to override the location of the screenshot."
       ),
       call = call
     )

tests/testthat/_snaps/case-if-any.md

@@ -23,7 +23,8 @@
         "ooh lalal", .sep = " ")
     Condition
       Error in `case_if_any()`:
-      ! `.sep` cannot be contained in the `condition`. Change the replacement text, or `sep`
+      x `.sep` cannot be contained in the condition.
+      i Change either the replacement text, or `.sep`
     Code
       case_if_any(mtcars$vs == 1 ~ "Woww", mtcars$mpg > 15 ~ "QW", .sep = "")
     Condition

tests/testthat/_snaps/dplyr-plus.md

@@ -1,11 +1,12 @@
 # `filter_if_any()` doesn't work with `across()`
 
     Code
-      dplyr::starwars %>% filter_if_any(dplyr::across(ends_with("color"), function(x)
+      filter_if_any(dplyr::starwars, dplyr::across(ends_with("color"), function(x)
         stringr::str_detect(x, "brown")))
     Condition
       Error in `filter_if_any()`:
-      ! You didn't provide logical expressions. See `?dplyr::filter()`
+      x You must provide logical expressions to `...`
+      i See `?dplyr::filter()` for more information on how it works.
 
 # adds rows in front, but warns the user
 

tests/testthat/test-case-if-any.R

@@ -11,7 +11,12 @@ test_that("case_if_any basic work", {
 
 test_that("wrong cases error", {
   expect_snapshot(error = TRUE, {
-    case_if_any(mtcars$vs == 1 ~ "Woww", mtcars$mpg > 15 ~ "QW", mtcars$qsec > 18 ~ "ooh lalal", .sep = " ")
+    case_if_any(
+      mtcars$vs == 1 ~ "Woww",
+      mtcars$mpg > 15 ~ "QW",
+      mtcars$qsec > 18 ~ "ooh lalal",
+      .sep = " "
+    )
     case_if_any(mtcars$vs == 1 ~ "Woww", mtcars$mpg > 15 ~ "QW", .sep = "")
   })
 })
@@ -21,6 +26,9 @@ test_that("You can select a variable that was just created (#8)", {
   expect_snapshot({
     mtcars %>%
       group_by(vs) %>%
-      summarise(avg_mpg = mean(mpg), error = case_if_any(avg_mpg > 20 ~ "Youppi"))
+      summarise(
+        avg_mpg = mean(mpg),
+        error = case_if_any(avg_mpg > 20 ~ "Youppi")
+      )
   })
 })

tests/testthat/test-dplyr-plus.R

@@ -32,7 +32,7 @@ test_that("`filter_if_any()` works as expected", {
 })
 
 
-test_that("`filter_if_any()` gives the correct error when specifying by instead of .by", {
+test_that("filter_if_any() errors correctly when using `by` instead of `.by`", {
   skip("Not ready")
   expect_error(
     dplyr::starwars %>%
@@ -45,7 +45,13 @@ test_that("`filter_if_any()` doesn't work with `across()`", {
   # TODO improve this error
   expect_snapshot(
     error = TRUE,
-    dplyr::starwars %>% filter_if_any(dplyr::across(ends_with("color"), function(x) stringr::str_detect(x, "brown")))
+    filter_if_any(
+      dplyr::starwars,
+      dplyr::across(
+        ends_with("color"),
+        function(x) stringr::str_detect(x, "brown")
+      )
+    )
   )
 })