Merge pull request #10 from tidymodels/typo-plausible

fix typo in plausible config

.github/workflows/R-CMD-check.yaml

@@ -25,17 +25,13 @@ jobs:
           - {os: macos-latest,   r: 'release'}
 
           - {os: windows-latest, r: 'release'}
-          # Use 3.6 to trigger usage of RTools35
-          - {os: windows-latest, r: '3.6'}
+
           # use 4.1 to check with rtools40's older compiler
           - {os: windows-latest, r: '4.1'}
 
           - {os: ubuntu-latest,   r: 'devel', http-user-agent: 'release'}
           - {os: ubuntu-latest,   r: 'release'}
           - {os: ubuntu-latest,   r: 'oldrel-1'}
-          - {os: ubuntu-latest,   r: 'oldrel-2'}
-          - {os: ubuntu-latest,   r: 'oldrel-3'}
-          - {os: ubuntu-latest,   r: 'oldrel-4'}
 
     env:
       GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}

.github/workflows/lock.yaml

@@ -16,15 +16,15 @@ jobs:
 #          issue-lock-labels: 'outdated'
           issue-lock-comment: >
             This issue has been automatically locked. If you believe you have
-            found a related problem, please file a new issue (with a reprex:
+            found a related problem, please file a new issue (with a reprex
             <https://reprex.tidyverse.org>) and link to this issue.
           issue-lock-reason: ''
           pr-lock-inactive-days: '14'
 #          pr-exclude-labels: 'wip'
           pr-lock-labels: ''
           pr-lock-comment: >
             This pull request has been automatically locked. If you believe you
-            have found a related problem, please file a new issue (with a reprex:
+            have found a related problem, please file a new issue (with a reprex
             <https://reprex.tidyverse.org>) and link to this issue.
           pr-lock-reason: ''
 #          process-only: 'issues'

DESCRIPTION

@@ -13,7 +13,7 @@ Description: An developer focused, low dependency package in 'tidymodels' that
 License: MIT + file LICENSE
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.3
+RoxygenNote: 7.2.3.9000
 Imports: 
     glue,
     rlang,

R/check.R

@@ -9,7 +9,9 @@
 #' library(rlang)
 #' tmp <- catch_cnd(stop_incompatible_mode("partition"))
 #' @export
-stop_incompatible_mode <- function(spec_modes, eng = NULL, model = NULL) {
+stop_incompatible_mode <- function(spec_modes,
+                                   eng = NULL,
+                                   model = NULL) {
   if (is.null(eng) & is.null(model)) {
     msg <- "Available modes are: "
   }
@@ -32,7 +34,7 @@ stop_incompatible_mode <- function(spec_modes, eng = NULL, model = NULL) {
   rlang::abort(msg)
 }
 
-check_model_val <- function(model) {
+check_model_val <- function(model, call = rlang::caller_env()) {
   if (rlang::is_missing(model) || length(model) != 1 || !is.character(model)) {
     rlang::abort(
       "Please supply a character string for a model name (e.g. `'k_means'`)."
@@ -42,25 +44,30 @@ check_model_val <- function(model) {
   current <- get_model_env()
 
   if (!any(current$models == model)) {
-    rlang::abort(glue::glue("Model `{model}` has not been registered."))
+    rlang::abort(
+      glue::glue("Model `{model}` has not been registered."),
+      call = call
+    )
   }
 
   invisible(NULL)
 }
 
-check_mode_val <- function(mode) {
+check_mode_val <- function(mode, call = rlang::caller_env()) {
   if (rlang::is_missing(mode) || length(mode) != 1 || !is.character(mode)) {
     rlang::abort(
-      "Please supply a character string for a mode (e.g. `'partition'`)."
+      "Please supply a character string for a mode (e.g. `'partition'`).",
+      call = call
     )
   }
   invisible(NULL)
 }
 
-check_eng_val <- function(eng) {
+check_eng_val <- function(eng, call = rlang::caller_env()) {
   if (rlang::is_missing(eng) || length(eng) != 1 || !is.character(eng)) {
     rlang::abort(
-      "Please supply a character string for an engine name (e.g. `'stats'`)."
+      "Please supply a character string for an engine name (e.g. `'stats'`).",
+      call = call
     )
   }
   invisible(NULL)
@@ -74,16 +81,22 @@ check_eng_val <- function(eng) {
 #' @param mode Character of specific mode
 #' @param eng Character of specific engine
 #'
+#' @inheritParams rlang::args_error_context
+#'
 #' @return An error
 #' @examples
 #' library(rlang)
 #' tmp <- catch_cnd(check_spec_mode_engine_val("turtle", "partition", "vegan"))
 #' @export
-check_spec_mode_engine_val <- function(model, mode, eng) {
+check_spec_mode_engine_val <- function(model,
+                                       mode,
+                                       eng,
+                                       call = rlang::caller_env()) {
   all_modes <- get_from_env(paste0(model, "_modes"))
   if (!(mode %in% all_modes)) {
     rlang::abort(
-      glue::glue("'{mode}' is not a known mode for model `{model}()`.")
+      glue::glue("'{mode}' is not a known mode for model `{model}()`."),
+      call = call
     )
   }
 
@@ -99,7 +112,8 @@ check_spec_mode_engine_val <- function(model, mode, eng) {
       paste0(
         "Engine '", eng, "' is not supported for `", model, "()`. See ",
         "`show_engines('", model, "')`."
-      )
+      ),
+      call = call
     )
   }
 

R/set_dependency.R

@@ -113,9 +113,12 @@ get_dependency <- function(model) {
   rlang::env_get(get_model_env(), pkg_name)
 }
 
-check_pkg_val <- function(pkg) {
+check_pkg_val <- function(pkg, call = rlang::caller_env()) {
   if (rlang::is_missing(pkg) || length(pkg) != 1 || !is.character(pkg)) {
-    rlang::abort("Please supply a single character value for the package name.")
+    rlang::abort(
+      "Please supply a single character value for the package name.",
+      call = call
+    )
   }
   invisible(NULL)
 }

R/set_encoding.R

@@ -91,9 +91,9 @@ get_encoding <- function(model) {
   get_from_env(nm)
 }
 
-check_encodings <- function(x) {
+check_encodings <- function(x, call = rlang::caller_env()) {
   if (rlang::is_missing(x) || !is.list(x)) {
-    rlang::abort("`values` should be a list.")
+    rlang::abort("`values` should be a list.", call = call)
   }
   req_args <- list(
     predictor_indicators = rlang::na_chr,
@@ -108,7 +108,8 @@ check_encodings <- function(x) {
       glue::glue(
         "The values passed to `set_encoding()` are missing arguments: ",
         paste0("'", missing_args, "'", collapse = ", ")
-      )
+      ),
+      call = call
     )
   }
   extra_args <- setdiff(names(x), names(req_args))
@@ -117,14 +118,16 @@ check_encodings <- function(x) {
       glue::glue(
         "The values passed to `set_encoding()` had extra arguments: ",
         paste0("'", extra_args, "'", collapse = ", ")
-      )
+      ),
+      call = call
     )
   }
   invisible(x)
 }
 
 is_discordant_info <- function(model, mode, eng, candidate,
-                               pred_type = NULL, component = "fit") {
+                               pred_type = NULL, component = "fit",
+                               call = rlang::caller_env()) {
   current <- get_from_env(paste0(model, "_", component))
   if (is.null(current)) {
     return(TRUE)
@@ -153,7 +156,8 @@ is_discordant_info <- function(model, mode, eng, candidate,
         "The combination of engine '{eng}' and mode '{mode}' {p_type} already ",
         "has {component} data for model '{model}' and the new information ",
         "being registered is different."
-      )
+      ),
+      call = call
     )
   }
 

R/set_fit.R

@@ -95,9 +95,9 @@ get_fit <- function(model) {
   rlang::env_get(get_model_env(), fit_name)
 }
 
-check_fit_info <- function(fit_obj) {
+check_fit_info <- function(fit_obj, call = rlang::caller_env()) {
   if (rlang::is_missing(fit_obj) || is.null(fit_obj)) {
-    rlang::abort("The `fit` module cannot be NULL.")
+    rlang::abort("The `fit` module cannot be NULL.", call = call)
   }
 
   # check required data elements
@@ -109,7 +109,8 @@ check_fit_info <- function(fit_obj) {
       glue::glue(
         "The `fit` module should have elements: ",
         glue::glue_collapse(glue::glue("`{exp_nms}`"), sep = ", ")
-      )
+      ),
+      call = call
     )
   }
 
@@ -123,71 +124,75 @@ check_fit_info <- function(fit_obj) {
       glue::glue_collapse(glue::glue("`{opt_nms}`"), sep = ", ")
     )
 
-    rlang::abort(msg)
+    rlang::abort(msg, call = call)
   }
 
   if (any(other_nms == "data")) {
     data_nms <- names(fit_obj$data)
     if (length(data_nms) == 0 || any(data_nms == "")) {
-      rlang::abort("All elements of the `data` argument vector must be named.")
+      rlang::abort(
+        "All elements of the `data` argument vector must be named.",
+        call = call
+      )
     }
   }
 
-  check_interface_val(fit_obj$interface)
-  check_func_val(fit_obj$func)
+  check_interface_val(fit_obj$interface, call = call)
+  check_func_val(fit_obj$func, call = call)
 
   if (!is.list(fit_obj$defaults)) {
-    rlang::abort("The `defaults` element should be a list: ")
+    rlang::abort("The `defaults` element should be a list: ", call = call)
   }
 
   invisible(NULL)
 }
 
-check_interface_val <- function(x) {
+check_interface_val <- function(x, call = rlang::caller_env()) {
   exp_interf <- c("data.frame", "formula", "matrix")
   if (length(x) != 1 || !(x %in% exp_interf)) {
     rlang::abort(
       glue::glue(
         "The `interface` element should have a single value of: ",
         glue::glue_collapse(glue::glue("`{exp_interf}`"), sep = ", ")
-      )
+      ),
+      call = call
     )
   }
   invisible(NULL)
 }
 
-check_func_val <- function(func) {
+check_func_val <- function(func, call = rlang::caller_env()) {
   msg <-
     paste(
       "`func` should be a named vector with element 'fun' and the optional ",
       "elements 'pkg', 'range', 'trans', and 'values'.",
       "`func` and 'pkg' should both be single character strings."
     )
 
-  nms <- sort(names(func))
-
-  if (all(is.null(nms))) {
-    rlang::abort(msg)
+  if (rlang::is_missing(func) || all(is.null(sort(names(func))))) {
+    rlang::abort(msg, call = call)
   }
 
+  nms <- sort(names(func))
+
   if (length(func) == 1) {
     if (isTRUE(any(nms != "fun"))) {
-      rlang::abort(msg)
+      rlang::abort(msg, call = call)
     }
   } else {
     # check for extra names:
     allow_nms <- c("fun", "pkg", "range", "trans", "values")
     not_allowed <- nms[!(nms %in% allow_nms)]
     if (length(not_allowed) > 0) {
-      rlang::abort(msg)
+      rlang::abort(msg, call = call)
     }
   }
 
   if (!is.character(func[["fun"]])) {
-    rlang::abort(msg)
+    rlang::abort(msg, call = call)
   }
   if (any(nms == "pkg") && !is.character(func[["pkg"]])) {
-    rlang::abort(msg)
+    rlang::abort(msg, call = call)
   }
 
   invisible(NULL)

R/set_model_arg.R

@@ -76,16 +76,24 @@ get_model_arg <- function(model, eng) {
   args
 }
 
-check_arg_val <- function(arg) {
+check_arg_val <- function(arg, call = rlang::caller_env()) {
   if (rlang::is_missing(arg) || length(arg) != 1 || !is.character(arg)) {
-    rlang::abort("Please supply a character string for the argument.")
+    rlang::abort(
+      "Please supply a character string for the argument.",
+      call = call
+    )
   }
   invisible(NULL)
 }
 
-check_submodels_val <- function(has_submodel) {
-  if (!is.logical(has_submodel) || length(has_submodel) != 1) {
-    rlang::abort("The `submodels` argument should be a single logical.")
+check_submodels_val <- function(has_submodel, call = rlang::caller_env()) {
+  if (rlang::is_missing(has_submodel) ||
+      !is.logical(has_submodel) ||
+      length(has_submodel) != 1) {
+    rlang::abort(
+      "The `submodels` argument should be a single logical.",
+      call = call
+    )
   }
   invisible(NULL)
 }

R/set_model_engine.R

@@ -38,13 +38,15 @@ set_model_engine <- function(model, mode, eng) {
   invisible(NULL)
 }
 
-check_mode_for_new_engine <- function(model, eng, mode) {
+check_mode_for_new_engine <- function(model, eng, mode,
+                                      call = rlang::caller_env()) {
   all_modes <- get_from_env(paste0(model, "_modes"))
   if (!(mode %in% all_modes)) {
     rlang::abort(
       glue::glue(
         "'{mode}' is not a known mode for model `{model}()`."
-      )
+      ),
+      call = call
     )
   }
 
@@ -55,7 +57,8 @@ check_mode_for_new_engine <- function(model, eng, mode) {
     rlang::abort(
       glue::glue(
         "Engine '{eng}' already exists for `{model}()` with mode `{mode}`."
-      )
+      ),
+      call = call
     )
   }