Evaluate expression over multiple values

control allows specifying multiple values for variables in an expression, returning all results in a tibble.

Usage

control(
  code,
  ...,
  .refiner = identity,
  .prober,
  .selector = identity,
  unnest_value = FALSE,
  unnest_summary = FALSE
)

Arguments

code

[expr] Expression to be evaluated.

...

[argument value pairs] Variables in code with the multiple values assigned to them.

.refiner

[function] Preprocessing the value tree over which evaluation of code is to be performed. Takes the tree tibble as input.

.prober

[function] Extracting extra information from the results of evaluating code. Takes the list of such values as input.

.selector

[function] Modifying the final tibble or extracting what's needed from it. Takes the refined, evaluated, probed tibble as input.

unnest_value

[boolean] Whether to unnest the results inside the tibble.

unnest_summary

[boolean] Whether to unnest the results from .prober inside the tibble.

Value

A tibble with information on the evaluation tree, and the columns .value, and .summary if probed and not unnested.

See also

Other result assemblers: %$>%(), %->%(), %<-%(), %to%(), conserve()

Examples

set.seed(123)
# Use control to apply multiple arguments to the same expression
control(
  {
    lm(Sepal.Length ~ ., data = rsample::analysis(fold$splits))
  },
  fold = purrr::transpose(rsample::vfold_cv(iris, 5))
)
#> # A tibble: 5 × 2
#>   fold             .value
#>   <list>           <list>
#> 1 <named list [2]> <lm>  
#> 2 <named list [2]> <lm>  
#> 3 <named list [2]> <lm>  
#> 4 <named list [2]> <lm>  
#> 5 <named list [2]> <lm>  

# Use .selector to alter output
control(
  {
    lm(Sepal.Length ~ ., data = rsample::analysis(fold$splits))
  },
  fold = purrr::transpose(rsample::vfold_cv(iris, 5)),
  .selector = ~ tidyr::unnest_wider(., fold, strict = TRUE)
)
#> # A tibble: 5 × 3
#>   splits           id    .value
#>   <list>           <chr> <list>
#> 1 <split [120/30]> Fold1 <lm>  
#> 2 <split [120/30]> Fold2 <lm>  
#> 3 <split [120/30]> Fold3 <lm>  
#> 4 <split [120/30]> Fold4 <lm>  
#> 5 <split [120/30]> Fold5 <lm>  

# Use .prober to extract information from results
control(
  {
    lm(Sepal.Length ~ ., data = rsample::analysis(fold$splits))
  },
  fold = purrr::transpose(rsample::vfold_cv(iris, 5)),
  .prober = ~ summary(.)$r.squared
)
#> # A tibble: 5 × 3
#>   fold             .value .summary
#>   <list>           <list>    <dbl>
#> 1 <named list [2]> <lm>      0.867
#> 2 <named list [2]> <lm>      0.869
#> 3 <named list [2]> <lm>      0.870
#> 4 <named list [2]> <lm>      0.886
#> 5 <named list [2]> <lm>      0.851

# Use list() and unnest_value to return multiple results
control(
  {
    model <- lm(Sepal.Length ~ ., data = rsample::analysis(fold$splits))
    holdout <- rsample::assessment(fold$splits)
    holdout$.fit <- predict(model, holdout)
    rmse_value <- yardstick::rmse(holdout, Sepal.Length, .fit)
    list(model = model, rmse = rmse_value)
  },
  fold = purrr::transpose(rsample::vfold_cv(iris, 5)),
  unnest_value = TRUE
)
#> # A tibble: 5 × 3
#>   fold             model  rmse$.metric $.estimator $.estimate
#>   <list>           <list> <chr>        <chr>            <dbl>
#> 1 <named list [2]> <lm>   rmse         standard         0.340
#> 2 <named list [2]> <lm>   rmse         standard         0.345
#> 3 <named list [2]> <lm>   rmse         standard         0.308
#> 4 <named list [2]> <lm>   rmse         standard         0.293
#> 5 <named list [2]> <lm>   rmse         standard         0.296

# Use multiple levels with the formula syntax
control(
  {
    model <- earth::earth(
      Sepal.Length ~ ., rsample::analysis(fold$splits), degree = degree)
    holdout <- rsample::assessment(fold$splits)
    holdout$.fit <- predict(model, holdout, "response")[, 1]
    rmse_value <- yardstick::rmse(holdout, Sepal.Length, .fit)
    list(model = model, rmse = rmse_value)
  },
  fold = purrr::transpose(rsample::vfold_cv(iris, 3)) ~ 1,
  degree = 1:5 ~ 2,
  unnest_value = TRUE,
  .selector = ~ dplyr::group_by(., degree) %>%
    dplyr::summarise(
      model = list(dplyr::first(model)),
      rmse = mean(rmse$.estimate)
    )
)
#> # A tibble: 5 × 3
#>   degree model    rmse
#>    <int> <list>  <dbl>
#> 1      1 <earth> 0.346
#> 2      2 <earth> 0.360
#> 3      3 <earth> 0.362
#> 4      4 <earth> 0.362
#> 5      5 <earth> 0.362

# Example with tuning a ridge model
control(
  {
    keepin <- rsample::analysis(fold$splits)
    model <- elasticnet::enet(
      Sepal.Length ~ .,
      x = model.matrix(Sepal.Length ~ . - 1, keepin),
      y = keepin[["Sepal.Length"]],
      lambda = lambda
    )
    holdout <- rsample::assessment(fold$splits)
    holdout$.fit <- predict(
      model,
      model.matrix(Sepal.Length ~ . - 1, holdout),
      s = 1, mode = "fraction"
    )$fit
    rmse_value <- yardstick::rmse(holdout, Sepal.Length, .fit)
    list(model = model, rmse = rmse_value)
  },
  fold = purrr::transpose(rsample::vfold_cv(iris, 5)) ~ 1,
  lambda = seq(0, 0.1, 0.01) ~ 2,
  unnest_value = TRUE,
  .selector = ~ dplyr::group_by(., lambda) %>%
    dplyr::summarise(
      model = list(dplyr::first(model)),
      rmse = mean(rmse$.estimate)
    )
)
#> # A tibble: 11 × 3
#>    lambda model   rmse
#>     <dbl> <list> <dbl>
#>  1   0    <enet> 0.305
#>  2   0.01 <enet> 0.310
#>  3   0.02 <enet> 0.319
#>  4   0.03 <enet> 0.327
#>  5   0.04 <enet> 0.334
#>  6   0.05 <enet> 0.340
#>  7   0.06 <enet> 0.345
#>  8   0.07 <enet> 0.349
#>  9   0.08 <enet> 0.353
#> 10   0.09 <enet> 0.356
#> 11   0.1  <enet> 0.359