Enrich the documentation : tuning / cal_estimate_

[vince-ar]

Hello everyone,

Thank you for developing the probably package. Would it be possible to expand the documentation to help users better integrate the functionalities of probably into their pipelines? This would be greatly appreciated.

For instance, I am working on a small dataset and using glmnet for multinomial classification. Below is the specific cross-validation loop I am currently implementing. After carefully reviewing the package documentation, I remain uncertain whether my approach to calibrating predictions is valid or fundamentally incorrect. Unfortunately, I am unable to share the dataset. Thus, is the parameters argument in the cal_estimate_multinomial() function being employed correctly in this instance?

# Initialize lists to store results for training and testing
resultats.training <- list()
resultats.testing <- list()

# Generate all possible combinations of 5 individuals from the 7 available individuals
# The combinations function from the gtools package is used to generate all possible training set combinations

combinaisons <- combinations(7, 5, levels(db$individual))

for (i in 1:nrow(combinaisons)) {
  
  set.seed(i)
  
  # Create training set by selecting 5 individuals from the current combination
  train.set <- db.glmnet %>%
    filter(individual %in% combinaisons[i, ]) %>%
    droplevels()
  
  # Create test set with the remaining 2 individuals not in the training set
  test.set <- db%>%
    anti_join(train.set, by = "individual") %>%
    droplevels()
  
  # Generate all possible combinations of 3 individuals out of the 5 selected for tuning

  combinaisons.tuning <- combinations(5, 3, combinaisons[i, ]) %>%
    split(1:nrow(.)) %>% 
    map(as.vector)
  
  # Create cross-validation folds for hyperparameter tuning
  # Create 6 instances for group-wise Monte Carlo cross-validation
  # This ensures that all instances from the same group (individual) are kept together in the same fold
  
  folds <- group_mc_cv(
    train.set,
    times = length(combinaisons.tuning),
    prop = 3 / 5,
    group = individual
  )
  
  # Modify each fold to include the row IDs of the selected individuals
  
  folds$splits <- imap(folds$splits, function(split, j) {
    selected_individuals <- combinaisons.tuning[[j]] 
    split$in_id <- train.set %>%
      rownames_to_column("row_id") %>%
      filter(individual %in% selected_individuals) %>% 
      pull(row_id) %>%
      as.integer()
    return(split)
  })
  
  formula <- as.formula(paste0("var ~ ", paste0(colnames(db.glmnet)[-c(1:2)], collapse = " + ")))
  
  preprocess <- recipe(
    formula,
    data = db
  ) %>%
    step_zv(all_predictors())
  
  lasso <-
    multinom_reg(
      penalty = tune(),
      mixture = 1
    ) %>%
    set_mode("classification") %>%
    set_engine(
      "glmnet")
  
  wf <-
    workflow() %>%
    add_recipe(preprocess) %>%
    add_model(lasso)
  
   grid <- grid_regular(
    penalty(range = c(-6, 0)),
    levels = 100
  )
  
  tuning <- wf %>%
    tune_grid(
      resamples = folds,
      grid = grid,
      control = control_grid(
        save_workflow = TRUE,
        save_pred = TRUE),
      metrics = metric_set(roc_auc)
    )
  
  final_penalty <- tuning %>%
      select_best(metric = "roc_auc")
    
  final_mod <-
    wf %>%
    finalize_workflow(final_penalty) %>%
    fit(data = train.set)
  
###### The problematic lines ?
  cal_model <- tuning %>%
    cal_estimate_multinomial(truth = var,
                             smooth = FALSE,
                             parameters = final_penalty)

  train.all <- train.set %>%
    bind_cols(
      predict(final_mod, new_data = train.set, type = "prob"),
      predict(final_mod, new_data = train.set, type = "class")
    ) %>%
    cal_apply(., cal_model, pred_class = .pred_class)
  
  test.all <- test.set %>%
    bind_cols(
      predict(final_mod, new_data = test.set, type = "prob"),
      predict(final_mod, new_data = test.set, type = "class")
    ) %>%
    cal_apply(., cal_model, pred_class = .pred_class)

  resultats.training[[i]] <- list(resultats = train.all,
                                  modele = final_mod,
                                  tuning = tuning)
  
  resultats.testing[[i]] <- list(resultats = test.all)
  
}

Rather than embedding calibration within the cross-validation loop, I am considering using the training set to calibrate the model and then applying this calibration to the test set. However, I am concerned this might introduce data leakage. I apologize if this question appears overly basic, but I have been unable to find relevant documentation to address this issue.

cal_models <- resultats.training %>%
  imap( ~ {
    train <- .x %>% pluck("resultats")
    hop <- cal_estimate_multinomial(
      train,
      truth = var,
      estimate = c(
        ".pred_Tickl_Fam",
        ".pred_Tickl_Unfam",
        ".pred_Touc_Fam",
        ".pred_Touc_Unfam"
      ),
      smooth = FALSE
    )
  })

new_test_pred <- resultats.testing %>%
  imap( ~ .x %>%
          pluck("resultats") %>%
          cal_apply(., cal_models[[.y]], pred_class = .pred_class)) %>%
  bind_rows(.id = "index")

Thank you very much for your time and your help

[vince-ar]

I am sorry to bother you once again but could you kindly provide clarification regarding the operational differences between the following two syntaxes for calibration model construction in the context of cross-validation?

First syntax:

cal_models <- resultats.training %>%
imap( ~ { train <- .x %>% pluck("resultats")
hop <- cal_estimate_multinomial( train, truth = var,
estimate = c( ".pred_Tickl_Fam", ".pred_Tickl_Unfam", ".pred_Touc_Fam", ".pred_Touc_Unfam" ),
smooth = FALSE ) })

new_test_pred <- resultats.testing %>%
imap( ~ .x %>% pluck("resultats") %>%
cal_apply(., cal_models[[.y]], pred_class = .pred_class)) %>%
bind_rows(.id = "index")

Second syntax:

cal_models <- resultats.training %>%
imap(~ .x %>% pluck("resultats")) %>%
bind_rows(.id = "index") %>%
cal_estimate_multinomial( ., truth = var, estimate = c( ".pred_Tickl_Fam", ".pred_Tickl_Unfam", ".pred_Touc_Fam", ".pred_Touc_Unfam"), smooth = FALSE, .by = index )

new_test_pred <- resultats.testing %>%
imap( ~ .x %>% pluck("resultats") %>%
cal_apply(., cal_models, pred_class = .pred_class)) %>%
bind_rows(.id = "index")

Specifically, despite both methods employing fold-specific calibration through the .by= parameter in the second syntax, empirical observations reveal divergent results. Clarification regarding whether the .by= parameter in cal_estimate_multinomial() indeed computes entirely separate calibration models for each fold, analogous to the first syntax, would be greatly appreciated. Thank you.