I have a function like so:
create_model_spec <- function(.parsnip_eng = list("lm"),
.mode = list("regression"),
.parsnip_fns = list("linear_reg"),
.return_tibble = TRUE) {
# Tidyeval ----
engine <- .parsnip_eng%>%
purrr::flatten_chr() %>%
as.list()
mode <- .mode %>%
purrr::flatten_chr() %>%
as.list()
call <- .parsnip_fns %>%
purrr::flatten_chr() %>%
as.list()
ret_tibble <- as.logical(.return_tibble)
# Make Model list for purrr call
model_spec_list <- list(
call,
engine,
mode
)
# Use purrr pmap to make mode specs
models <- purrr::pmap(
.l = model_spec_list,
.f = function(call, engine, mode) {
match.fun(call)(engine = engine, mode = mode)
}
)
# Return ----
models_list <- list(
.parsnip_engine = engine,
.parsnip_mode = mode,
.parsnip_fns = call,
.model_spec = models
)
ret_tbl <- dplyr::tibble(
.parsnip_engine = unlist(engine),
.parsnip_mode = unlist(mode),
.parsnip_fns = unlist(call),
.model_spec = models
)
ifelse(ret_tibble, return(ret_tbl), return(models_list))
}
I can make an object like so:
> tst <- create_model_spec(
+ .parsnip_eng = list("gee","lm"),
+ .mode = list("regression"),
+ .parsnip_fns = list("linear_reg")
+ )
>
> tst
# A tibble: 2 × 4
.parsnip_engine .parsnip_mode .parsnip_fns .model_spec
<chr> <chr> <chr> <list>
1 gee regression linear_reg <spec[+]>
2 lm regression linear_reg <spec[+]>
> str(tst)
tibble [2 × 4] (S3: tbl_df/tbl/data.frame)
$ .parsnip_engine: chr [1:2] "gee" "lm"
$ .parsnip_mode : chr [1:2] "regression" "regression"
$ .parsnip_fns : chr [1:2] "linear_reg" "linear_reg"
$ .model_spec :List of 2
..$ :List of 7
.. ..$ args :List of 2
.. .. ..$ penalty: language ~NULL
.. .. .. ..- attr(*, ".Environment")=<environment: R_EmptyEnv>
.. .. ..$ mixture: language ~NULL
.. .. .. ..- attr(*, ".Environment")=<environment: R_EmptyEnv>
.. ..$ eng_args : NULL
.. ..$ mode : chr "regression"
.. ..$ user_specified_mode : logi TRUE
.. ..$ method : NULL
.. ..$ engine : chr "gee"
.. ..$ user_specified_engine: logi TRUE
.. ..- attr(*, "class")= chr [1:2] "linear_reg" "model_spec"
..$ :List of 7
.. ..$ args :List of 2
.. .. ..$ penalty: language ~NULL
.. .. .. ..- attr(*, ".Environment")=<environment: R_EmptyEnv>
.. .. ..$ mixture: language ~NULL
.. .. .. ..- attr(*, ".Environment")=<environment: R_EmptyEnv>
.. ..$ eng_args : NULL
.. ..$ mode : chr "regression"
.. ..$ user_specified_mode : logi TRUE
.. ..$ method : NULL
.. ..$ engine : chr "lm"
.. ..$ user_specified_engine: logi TRUE
.. ..- attr(*, "class")= chr [1:2] "linear_reg" "model_spec"
Ok cool...but, when I try to make a column of workflows it fails out, when I'd like it to just error and move along. Here is the custom mapping function:
make_wflw_obj <- function(.model_recipe, .model_spec){
mr <- .model_recipe
ms <- .model_spec
res <- pmap(.l = list(mr, ms),.f = ~ workflows::workflow() %>%
workflows::add_recipe(..1) %>%
workflows::add_model(..2))
return(res)
}
possibly_make_wflw_obj <- possibly(.f = make_wflw_obj, otherwise = "Error")
The behavior is not expected, I expect the 'gee' model to fail because I don't have the extension package installed, but I expect the 'lm' model to pass.
> tst %>%
+ mutate(model_recipe = list(rec_obj)) %>%
+ mutate(
+ wflw_tst = list(
+ possibly_make_wflw_obj(model_recipe, model_spec)
+ )
+ ) %>%
+ mutate(error = unlist(wflw_tst))
# A tibble: 2 × 7
.parsnip_engine .parsnip_mode .parsnip_fns .model_spec model_recipe wflw_tst error
<chr> <chr> <chr> <list> <list> <list> <chr>
1 gee regression linear_reg <spec[+]> <recipe> <chr [1]> Error
2 lm regression linear_reg <spec[+]> <recipe> <chr [1]> Error
Solved my issue by using purrr::imap()
tst <- create_model_spec(
.parsnip_eng = list("gee","lm"),
.mode = list("regression"),
.parsnip_fns = list("linear_reg")
)
tst <- tst %>%
mutate(.model_id = row_number()) %>%
select(.model_id, everything()) %>%
mutate(.model_id = forcats::as_factor(.model_id)) %>%
mutate(rec_obj = list(rec_obj))
models_tbl <- tst %>%
group_split(.model_id)
wflw_list <- models_tbl %>%
purrr::imap(
.f = function(obj, id){
mod <- obj %>% dplyr::pull(5) %>% purrr::pluck(1)
rec_obj <- obj %>% dplyr::pull(6) %>% purrr::pluck(1)
safe_add_mod <- purrr::safely(workflows::add_model, otherwise = NULL, quiet = TRUE)
ret <- workflow() %>% add_recipe(rec_obj) %>% safe_add_mod(mod)
res <- ret %>% purrr::pluck("result")
return(res)
}
)
wflw_list_compacted <- purrr::compact(wflw_list)
wflw_list_compacted
[[1]]
══ Workflow ══════════════════════════════════════════════════════════════════════════════════════════
Preprocessor: Recipe
Model: linear_reg()
── Preprocessor ──────────────────────────────────────────────────────────────────────────────────────
0 Recipe Steps
── Model ─────────────────────────────────────────────────────────────────────────────────────────────
Linear Regression Model Specification (regression)
Computational engine: lm