fitted_wflw

[spsanderson]

Function:

# Safely make fitted workflow
internal_make_fitted_wflw <- function(.model_tbl, .splits_obj){
  
  # Tidyeval ----
  model_tbl <- .model_tbl
  splits_obj <- .splits_obj
  col_nms <- colnames(model_tbl)
  
  # Checks ----
  if (!inherits(model_tbl, "tidyaml_mod_spec_tbl")){
    rlang::abort(
      message = "'.model_tbl' must inherit a class of 'tidyaml_mod_spec_tbl",
      use_cli_format = TRUE
    )
  }
  
  if (!"wflw" %in% col_nms){
    rlang::abort(
      message = "Missing the column 'wflw'",
      use_cli_format = TRUE
    )
  }
  
  if (!".model_id" %in% col_nms){
    rlang::abort(
      message = "Missing the column '.model_id'",
      use_cli_format = TRUE
    )
  }
  
  # Manipulation
  # Make a group split object list
  models_list <- model_tbl %>%
    dplyr::group_split(.model_id)
  
  # Make the fitted workflow object using purrr imap
  fitted_wflw_list <- models_list %>%
    purrr::imap(
      .f = function(obj, id){
        
        # Pull the workflow column and then pluck it
        wflw <- obj %>% dplyr::pull(6) %>% pluck(1)
        
        # Create a safe parsnip::fit function
        safe_parsnip_fit <- purrr::safely(
          parsnip::fit,
          otherwise = "Error - Could not fit the workflow.",
          quiet = FALSE
        )
        
        # Return the fitted workflow
        ret <- safe_parsnip_fit(
          wflw, data = rsample::training(splits_obj$splits)
        )
        
        res <- ret %>% purrr::pluck("result")
        
        return(res)
      }
    )
    
  return(fitted_wflw_list)
  
}

Example:

> internal_make_fitted_wflw(mod_tbl, splits_obj)
[[1]]
══ Workflow [trained] ════════════════════════════════════════════════════════════════════
Preprocessor: Recipe
Model: linear_reg()

── Preprocessor ──────────────────────────────────────────────────────────────────────────
0 Recipe Steps

── Model ─────────────────────────────────────────────────────────────────────────────────

Call:
stats::lm(formula = ..y ~ ., data = data)

Coefficients:
(Intercept)          cyl         disp           hp         drat           wt  
  28.907650    -0.664742    -0.009334    -0.014871     0.197659    -0.188327  
       qsec           vs           am         gear         carb  
  -0.190551     0.132323     1.732139     1.372764    -1.184251  


[[2]]
══ Workflow [trained] ════════════════════════════════════════════════════════════════════
Preprocessor: Recipe
Model: linear_reg()

── Preprocessor ──────────────────────────────────────────────────────────────────────────
0 Recipe Steps

── Model ─────────────────────────────────────────────────────────────────────────────────

Call:  stats::glm(formula = ..y ~ ., family = stats::gaussian, data = data)

Coefficients:
(Intercept)          cyl         disp           hp         drat           wt  
  28.907650    -0.664742    -0.009334    -0.014871     0.197659    -0.188327  
       qsec           vs           am         gear         carb  
  -0.190551     0.132323     1.732139     1.372764    -1.184251  

Degrees of Freedom: 23 Total (i.e. Null);  13 Residual
Null Deviance:	    736.5 
Residual Deviance: 100.5 	AIC: 126.5