pred_wflw

[spsanderson]

Function:

# Safely make predictions on fitted workflow
internal_make_wflw_predictions <- 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 (!"fitted_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
  model_factor_tbl <- model_tbl %>%
    dplyr::mutate(.model_id = forcats::as_factor(.model_id))
  
  models_list <- model_factor_tbl %>%
    dplyr::group_split(.model_id)
  
  # Make the predictions on the fitted workflow object using purrr imap
  wflw_preds_list <- models_list %>%
    purrr::imap(
      .f = function(obj, id){
        
        # Pull the fitted workflow column and then pluck it
        fitted_wflw = obj %>% dplyr::pull(7) %>% pluck(1)
        
        # Create a safe stats::predict
        safe_stats_predict <- purrr::safely(
          stats::predict,
          otherwise = "Error - Could not make predictions",
          quiet = FALSE
        )
        
        # Return the predictions
        ret <- safe_stats_predict(
          fitted_wflw, 
          new_data = rsample::training(splits_obj$splits)
        )
        
        res <- ret %>% purrr::pluck("result")
        
        return(res)
      }
    )
  
  return(wflw_preds_list)
}

Example:

> internal_make_wflw_predictions(mod_fitted_tbl, splits_obj)
Error: no applicable method for 'predict' applied to an object of class "character"
[[1]]
[[1]]$result
# A tibble: 24 × 1
   .pred
   <dbl>
 1  23.2
 2  18.9
 3  15.4
 4  17.7
 5  15.6
 6  16.8
 7  15.5
 8  19.7
 9  11.7
10  22.6
# … with 14 more rows
# ℹ Use `print(n = ...)` to see more rows

[[1]]$error
NULL


[[2]]
[[2]]$result
[1] "Error - Could not make predictions"

[[2]]$error
<simpleError in UseMethod("predict"): no applicable method for 'predict' applied to an object of class "character">


[[3]]
[[3]]$result
# A tibble: 24 × 1
   .pred
   <dbl>
 1  23.2
 2  18.9
 3  15.4
 4  17.7
 5  15.6
 6  16.8
 7  15.5
 8  19.7
 9  11.7
10  22.6
# … with 14 more rows
# ℹ Use `print(n = ...)` to see more rows

[[3]]$error
NULL
``