Add full argument to varying_args() (#138)

Also reexport generics::varying_args()

Author: DavisVaughan

NAMESPACE

@@ -122,9 +122,6 @@ export(svm_rbf)
 export(translate)
 export(varying)
 export(varying_args)
-export(varying_args.model_spec)
-export(varying_args.recipe)
-export(varying_args.step)
 export(xgb_train)
 import(rlang)
 importFrom(dplyr,arrange)
@@ -146,6 +143,7 @@ importFrom(dplyr,tally)
 importFrom(dplyr,vars)
 importFrom(generics,fit)
 importFrom(generics,fit_xy)
+importFrom(generics,varying_args)
 importFrom(glue,glue_collapse)
 importFrom(magrittr,"%>%")
 importFrom(purrr,as_vector)

NEWS.md

@@ -1,6 +1,16 @@
 # parsnip 0.0.1.9000
 
-## Bug fixes
+## Other Changes
+
+* `varying_args()` now has a `full` argument to control whether the full set
+of possible varying arguments is returned (as opposed to only the arguments
+that are actually varying).
+
+## Bug Fixes
+
+* `varying_args()` now uses the version from the `generics` package. This means
+that the first argument, `x`, has been renamed to `object` to align with 
+generics.
 
 * For the recipes step method of `varying_args()`, there is now error checking
 to catch if a user tries to specify an argument that _cannot_ be varying as 

R/varying.R

@@ -6,6 +6,10 @@ varying <- function() {
   quote(varying())
 }
 
+#' @importFrom generics varying_args
+#' @export
+generics::varying_args
+
 #' Determine varying arguments
 #'
 #' `varying_args()` takes a model specification or a recipe and returns a tibble
@@ -16,13 +20,16 @@ varying <- function() {
 #' or a `recipe` is used. For a `model_spec`, the first class is used. For
 #' a `recipe`, the unique step `id` is used.
 #'
-#' @param x A `model_spec` or a `recipe`.
+#' @param object A `model_spec` or a `recipe`.
+#' @param full A single logical. Should all possible varying parameters be
+#' returned? If `FALSE`, then only the parameters that
+#' are actually varying are returned.
 #'
 #' @param ... Not currently used.
 #'
 #' @return A tibble with columns for the parameter name (`name`), whether it
-#' contains _any_ varying value (`varying`), the `id` for the object, and the
-#' class that was used to call the method (`type`).
+#' contains _any_ varying value (`varying`), the `id` for the object (`id`),
+#' and the class that was used to call the method (`type`).
 #'
 #' @examples
 #'
@@ -37,6 +44,11 @@ varying <- function() {
 #'   set_engine("ranger", sample.fraction = varying()) %>%
 #'   varying_args()
 #'
+#' # List only the arguments that actually vary
+#' rand_forest() %>%
+#'   set_engine("ranger", sample.fraction = varying()) %>%
+#'   varying_args(full = FALSE)
+#'
 #' rand_forest() %>%
 #'   set_engine(
 #'     "randomForest",
@@ -45,37 +57,30 @@ varying <- function() {
 #'   ) %>%
 #'   varying_args()
 #'
-#' @export
-varying_args <- function (x, ...) {
-  UseMethod("varying_args")
-}
-
 #' @importFrom purrr map map_lgl
 #' @export
-#' @export varying_args.model_spec
-#' @rdname varying_args
-varying_args.model_spec <- function(x, ...) {
+varying_args.model_spec <- function(object, full = TRUE, ...) {
 
   # use the model_spec top level class as the id
-  id <- class(x)[1]
+  id <- class(object)[1]
 
-  if (length(x$args) == 0L & length(x$eng_args) == 0L) {
+  if (length(object$args) == 0L & length(object$eng_args) == 0L) {
     return(varying_tbl())
   }
 
   # Locate varying args in spec args and engine specific args
-  varying_args <- map_lgl(x$args, find_varying)
-  varying_eng_args <- map_lgl(x$eng_args, find_varying)
+  varying_args <- map_lgl(object$args, find_varying)
+  varying_eng_args <- map_lgl(object$eng_args, find_varying)
 
   res <- c(varying_args, varying_eng_args)
 
   varying_tbl(
     name = names(res),
     varying = unname(res),
     id = id,
-    type = "model_spec"
+    type = "model_spec",
+    full = full
   )
-
 }
 
 # Need to figure out a way to meld the results of varying_args with
@@ -89,66 +94,70 @@ varying_args.model_spec <- function(x, ...) {
 
 #' @importFrom purrr map2_dfr map_chr
 #' @export
-#' @export varying_args.recipe
-#' @rdname varying_args
-varying_args.recipe <- function(x, ...) {
+#' @rdname varying_args.model_spec
+varying_args.recipe <- function(object, full = TRUE, ...) {
 
-  steps <- x$steps
+  steps <- object$steps
 
   if (length(steps) == 0L) {
     return(varying_tbl())
   }
 
-  map_dfr(x$steps, varying_args)
+  map_dfr(object$steps, varying_args, full = full)
 }
 
 #' @importFrom purrr map map_lgl
 #' @export
-#' @export varying_args.step
-#' @rdname varying_args
-varying_args.step <- function(x, ...) {
+#' @rdname varying_args.model_spec
+varying_args.step <- function(object, full = TRUE, ...) {
 
   # Unique step id
-  id <- x$id
+  id <- object$id
 
   # Grab the step class before the subset, as that removes the class
-  step_type <- class(x)[1]
+  step_type <- class(object)[1]
 
   # Remove NULL argument steps. These are reserved
   # for deprecated args or those set at prep() time.
-  x <- x[!map_lgl(x, is.null)]
+  object <- object[!map_lgl(object, is.null)]
 
-  res <- map_lgl(x, find_varying)
+  res <- map_lgl(object, find_varying)
 
   # ensure the user didn't specify a non-varying argument as varying()
   validate_only_allowed_step_args(res, step_type)
 
   # remove the non-varying arguments as they are not important
-  res <- res[!(names(x) %in% non_varying_step_arguments)]
+  res <- res[!(names(object) %in% non_varying_step_arguments)]
 
   varying_tbl(
     name = names(res),
     varying = unname(res),
     id = id,
-    type = "step"
+    type = "step",
+    full = full
   )
-
 }
 
 # useful for standardization and for creating a 0 row varying tbl
 # (i.e. for when there are no steps in a recipe)
 varying_tbl <- function(name = character(),
                         varying = logical(),
                         id = character(),
-                        type = character()) {
+                        type = character(),
+                        full = FALSE) {
 
-  tibble(
+  vry_tbl <- tibble(
     name = name,
     varying = varying,
     id = id,
     type = type
   )
 
+  if (!full) {
+    vry_tbl <- vry_tbl[vry_tbl$varying,]
+  }
+
+  vry_tbl
 }
 
 validate_only_allowed_step_args <- function(x, step_type) {

man/reexports.Rd

@@ -175,3 +175,22 @@ test_that("recipe steps with non-varying args error if specified as varying()",
     "The following argument for a recipe step of type 'step_center' is not allowed to vary: 'skip'."
   )
 })
+
+test_that("`full = FALSE` returns only varying arguments", {
+
+  x_spec <- rand_forest(min_n = varying())  %>%
+    set_engine("ranger", sample.fraction = varying())
+
+  x_rec <- rec_1
+
+  expect_equal(
+    varying_args(x_spec, full = FALSE)$name,
+    c("min_n", "sample.fraction")
+  )
+
+  expect_equal(
+    varying_args(x_rec, full = FALSE)$name,
+    c("K", "num")
+  )
+
+})