control: Evaluate expression over multiple values

View source: R/control.R

controlR Documentation

Evaluate expression over multiple values

Description

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))
)

# 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)
)

# 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
)

# 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
)

# 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)
    )
)

# 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)
    )
)

TerseTears/tyecon documentation built on July 7, 2022, 2:45 p.m.