speed up get_model_spec() helper (#901)

* test `get_model_spec()` helper

* speed up `get_model_spec()` helper

* accommodate 0-length `libs`/`fit`

``` r
boop <- list(a = 1)

bench::mark(
    base = if (length(boop) > 0) {boop[[1]]} else {NULL},
    purrr = purrr::pluck(boop, 1),
    dplyr = dplyr::first(boop),
    iterations = 100
)
#> # A tibble: 3 × 6
#>   expression      min   median `itr/sec` mem_alloc `gc/sec`
#>   <bch:expr> <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl>
#> 1 base       122.94ns 163.91ns  3179808.        0B        0
#> 2 purrr        2.01µs   2.52µs   305755.   22.66KB        0
#> 3 dplyr        5.29µs   6.07µs   141894.    8.12MB        0
```

Author: simonpcouch

R/translate.R

@@ -106,25 +106,21 @@ get_model_spec <- function(model, mode, engine) {
   env_obj <- grep(model, env_obj, value = TRUE)
 
   res <- list()
-  res$libs <-
-    rlang::env_get(m_env, paste0(model, "_pkgs")) %>%
-    dplyr::filter(engine == !!engine) %>%
-    purrr::pluck("pkg") %>%
-    purrr::pluck(1)
-
-  res$fit <-
-    rlang::env_get(m_env, paste0(model, "_fit")) %>%
-    dplyr::filter(mode == !!mode & engine == !!engine) %>%
-    dplyr::pull(value) %>%
-    purrr::pluck(1)
-
-  pred_code <-
-    rlang::env_get(m_env, paste0(model, "_predict")) %>%
-    dplyr::filter(mode == !!mode & engine == !!engine) %>%
-    dplyr::select(-engine, -mode)
-
-  res$pred <- pred_code[["value"]]
-  names(res$pred) <- pred_code$type
+
+  libs <- rlang::env_get(m_env, paste0(model, "_pkgs"))
+  libs <- vctrs::vec_slice(libs$pkg, libs$engine == engine)
+  res$libs <- if (length(libs) > 0) {libs[[1]]} else {NULL}
+
+  fits <- rlang::env_get(m_env, paste0(model, "_fit"))
+  fits <- vctrs::vec_slice(fits$value, fits$mode == mode & fits$engine == engine)
+  res$fit <- if (length(fits) > 0) {fits[[1]]} else {NULL}
+
+  preds <- rlang::env_get(m_env, paste0(model, "_predict"))
+  where <- preds$mode == mode & preds$engine == engine
+  types <- vctrs::vec_slice(preds$type, where)
+  values <- vctrs::vec_slice(preds$value, where)
+  names(values) <- types
+  res$pred <- values
 
   res
 }

tests/testthat/test_translate.R

@@ -309,4 +309,38 @@ test_that("translate tuning paramter names", {
   expect_snapshot_error(.model_param_name_key(1))
 })
 
+# ------------------------------------------------------------------------------
+
+test_that("get_model_spec helper", {
+  mod1 <- get_model_spec("linear_reg", "regression", "lm")
+
+  expect_type(mod1, "list")
+
+  expect_type(mod1$libs, "character")
+  expect_length(mod1$libs, 1)
+  expect_equal(mod1$libs, "stats")
+
+  expect_type(mod1$fit, "list")
+  expect_length(mod1$fit, 4)
+  expect_equal(names(mod1$fit), c("interface", "protect", "func", "defaults"))
 
+  expect_type(mod1$pred, "list")
+  expect_length(mod1$pred, 4)
+  expect_equal(names(mod1$pred), c("numeric", "conf_int", "pred_int", "raw"))
+
+  expect_type(mod1$pred$numeric, "list")
+  expect_length(mod1$pred$numeric, 4)
+  expect_equal(names(mod1$pred$numeric), c("pre", "post", "func", "args"))
+
+  expect_type(mod1$pred$conf_int, "list")
+  expect_length(mod1$pred$conf_int, 4)
+  expect_equal(names(mod1$pred$conf_int), c("pre", "post", "func", "args"))
+
+  expect_type(mod1$pred$pred_int, "list")
+  expect_length(mod1$pred$pred_int, 4)
+  expect_equal(names(mod1$pred$pred_int), c("pre", "post", "func", "args"))
+
+  expect_type(mod1$pred$raw, "list")
+  expect_length(mod1$pred$raw, 4)
+  expect_equal(names(mod1$pred$raw), c("pre", "post", "func", "args"))
+})