fixed varying search

Author: topepo

R/varying.R

@@ -19,23 +19,23 @@ varying <- function()
 #' library(dplyr)
 #' library(rlang)
 #'
-#' #rand_forest() %>% varying_args(id = "plain")
+#' rand_forest() %>% varying_args(id = "plain")
 #'
-#' #rand_forest(mtry = varying()) %>% varying_args(id = "one arg")
+#' rand_forest(mtry = varying()) %>% varying_args(id = "one arg")
 #'
-#' #rand_forest(others = list(sample.fraction = varying())) %>%
-#' # varying_args(id = "only others")
+#' rand_forest(others = list(sample.fraction = varying())) %>%
+#'  varying_args(id = "only others")
 #'
-#' #rand_forest(
-#' #   others = list(
-#' #     strata = expr(Class),
-#' #     sampsize = c(varying(), varying())
-#' #   )
-#' #) %>%
-#' #   varying_args(id = "add an expr")
+#' rand_forest(
+#'    others = list(
+#'      strata = expr(Class),
+#'      sampsize = c(varying(), varying())
+#'    )
+#' ) %>%
+#'    varying_args(id = "add an expr")
 #'
-#' # rand_forest(others = list(classwt = c(class1 = 1, class2 = varying()))) %>%
-#' #   varying_args(id = "list of values")
+#'  rand_forest(others = list(classwt = c(class1 = 1, class2 = varying()))) %>%
+#'    varying_args(id = "list of values")
 #'
 #' @export
 varying_args <- function (x, id, ...)
@@ -113,6 +113,7 @@ varying_args.step <- function(x, id = NULL, ...) {
   x <- x[!(names(x) %in% exclude)]
   x <- x[!map_lgl(x, is.null)]
   res <- map(x, find_varying)
+
   res <- map_lgl(res, any)
   tibble(
     name = names(res),
@@ -138,16 +139,18 @@ is_varying <- function(x) {
 
 # Error: C stack usage  7970880 is too close to the limit (in some cases)
 find_varying <- function(x) {
-  if (is.atomic(x) | is.name(x)) {
+  if (is_quosure(x))
+    x <- quo_get_expr(x)
+  if (is_varying(x)) {
+    return(TRUE)
+  } else if (is.atomic(x) | is.name(x)) {
     FALSE
-  } else if (is.call(x)) {
-    if (is_varying(x)) {
-      TRUE
-    } else {
-      find_varying(x)
+  } else if (is.call(x) || is.pairlist(x)) {
+    for (i in seq_along(x)) {
+      if (is_varying(x[[i]]))
+        return(TRUE)
     }
-  } else if (is.pairlist(x)) {
-    find_varying(x)
+    FALSE
   } else if (is.vector(x) | is.list(x)) {
     map_lgl(x, find_varying)
   } else {

man/varying_args.Rd

@@ -8,7 +8,7 @@ context("varying parameters")
 load("recipes_examples.RData")
 
 test_that('main parsnip arguments', {
-  skip("Fixes are required")
+
   mod_1 <-
     rand_forest() %>%
     varying_args(id = "")
@@ -39,9 +39,9 @@ test_that('main parsnip arguments', {
 
 
 test_that('other parsnip arguments', {
-  skip("Fixes are required")
+
   other_1 <-
-    rand_forest(others = list(sample.fraction = varying())) %>%
+    rand_forest(sample.fraction = varying()) %>%
     varying_args(id = "only others")
   exp_1 <-
     tibble(
@@ -53,7 +53,7 @@ test_that('other parsnip arguments', {
   expect_equal(other_1, exp_1)
 
   other_2 <-
-    rand_forest(min_n = varying(), others = list(sample.fraction = varying())) %>%
+    rand_forest(min_n = varying(), sample.fraction = varying()) %>%
     varying_args(id = "only others")
   exp_2 <-
     tibble(
@@ -65,12 +65,7 @@ test_that('other parsnip arguments', {
   expect_equal(other_2, exp_2)
 
   other_3 <-
-    rand_forest(
-      others = list(
-        strata = expr(Class),
-        sampsize = c(varying(), varying())
-      )
-    ) %>%
+    rand_forest(strata = Class, sampsize = c(varying(), varying())) %>%
     varying_args(id = "add an expr")
   exp_3 <-
     tibble(
@@ -82,12 +77,7 @@ test_that('other parsnip arguments', {
   expect_equal(other_3, exp_3)
 
   other_4 <-
-    rand_forest(
-      others = list(
-        strata = expr(Class),
-        sampsize = c(12, varying())
-      )
-    ) %>%
+    rand_forest(strata = Class, sampsize = c(12, varying())) %>%
     varying_args(id = "num and varying in vec")
   exp_4 <-
     tibble(
@@ -101,7 +91,7 @@ test_that('other parsnip arguments', {
 
 
 test_that('recipe parameters', {
-  skip("Fixes are required")
+
   rec_res_1 <- varying_args(rec_1)
   exp_1 <-
     tibble(