2.1. Model sculpting and interpretation - compas

Published

2024-09-13

Note

The following scripts need to be run first before knitting the document corresponding to model_type specified below:

3_model_sculpt_compas.R
Sculpting - Main models chunk (need to manually run in the interactive mode, not run during knitting as it takes some time)

Setup and load

Show the code

library(dplyr)
library(stringr)
source(here::here("R/0_setup.R"))

theme_set(theme_bw(base_size = 12))

theme_facets <- theme(
  text = element_text(size = 16),
  legend.position = "inside",
  legend.position.inside = c(0.85, 0.27), 
  legend.background = element_rect(colour = "black"), 
  legend.title = element_blank()
)

theme_single <- theme(text = element_text(size = 16))

# Function to check if the model is trained
load_model_if_trained <- function(model_type) {
  model_path <- file.path(storage_folder, sname(paste0(model_type, "-fit_final.rds")))
  if(file.exists(model_path)) {
    load_results(sname(paste0(model_type, "-fit_final.rds")))
  } else {
    stop(paste0("Model ", model_type, " is not trained for compas, `",
                model_path, "` does not exist. ",
                "Please train it first with: ",
                "`Rscript R/2_train_models.R ", model_type, " compas FALSE`"))
  }
}

Show the code

# set dataset (any with discrete response)
dataset <- "compas"

# set model_type
model_type = "xgb_bayes"
# model_type = "xgb"

# set nr of features for a polished model
top_k <- 3

# util function for storage
sname <- function(x, prefix = dataset) {
  paste0(prefix, "-", x)
}

# logit functions
logit <- function(x) log(x / (1-x))
inv.logit <- function(x) 1 / (1 + exp(-x))


# load dataset
dd <- define_data(dataset)

# load xgb
xgb <- load_model_if_trained(model_type)
xgb_fo <- load_model_if_trained("xgb_1_order_bayes")

# get product marginals
pm <- sample_marginals(dd$data$train[dd$covariates$all], n = 1e4, seed = 1234)

xgb model

Sculpting

Main models

Sculpting on product marginals on logit scale.

Show the code

# # get rough model - on pm
# # Already generated in 3_model_sculpt_compas.R
# rs_pm <- sculpt_rough(
#   pm,
#   seed = 1234,
#   model_predict_fun = function(x) {
#     p <- predict(xgb, new_data = x, type = "prob")$.pred_1
#     logit(p)
#   }
# )


# # detailed model on pm
# Already generated in 3_model_sculpt_compas.R
# ds_pm <- sculpt_detailed_gam(rs_pm)

## Below we use custom smoother for even better fitting smoothings
gam_cgam_smoother <- function(x, y, is_discrete, column_name, na_ind = NULL) {
  use_cgam <- TRUE
  if (column_name == "age") {
    s.decr <- cgam::s.decr
    form <- y ~ s.decr(x, numknots = 3)
  } else if (column_name == "priors") {
    s.incr <- cgam::s.incr
    form <- y ~ s.incr(x, numknots = 3)
  } else if (column_name == "juvenile_crimes") {
    return(getPAVAest(outcome = y, score = x)) # from stats4phc
  } else {
    use_cgam <- FALSE
  }
  if (use_cgam) {
    tryCatch(
      cgam::cgam(form), 
      error = function(e) {
        s <- mgcv::s
        tryCatch(
          mgcv::gam(y ~ s(x, k = -1)),
          error = function(e) {
            mgcv::gam(y ~ x)
          }
        )
      }
    )
  } else {
    if (is_discrete) {
      s <- mgcv::s
      tryCatch(
        mgcv::gam(y ~ x),
        error = function(e) {
          lm(y ~ 0)
        }
      )
    } else {
      s <- mgcv::s
      tryCatch(
        mgcv::gam(y ~ s(x, k = -1)),
        error = function(e) {
          mgcv::gam(y ~ x)
        }
      )
    }
  }
}

gam_cgam_predict <- function(smoother, new_x, is_discrete, column_name, na_ind = NULL) {
  if (inherits(smoother, "cgam")) {
    # cgam fails on extrapolation - need to do this manually
    if (min(new_x) < min(smoother$xmat0[, 1])) {
      new_x[new_x < min(smoother$xmat0[, 1])] <- min(smoother$xmat0[, 1])
    }
    if (max(new_x) > max(smoother$xmat0[, 1])) {
      new_x[new_x > max(smoother$xmat0[, 1])] <- max(smoother$xmat0[, 1])
    }
    newdata <- data.frame(x = new_x)
    predict(smoother, newData = newdata)$fit
  } else if (inherits(smoother, "gam")) {
    newdata <- data.frame(x = new_x)
    as.numeric(predict(smoother, newdata = newdata))
  } else if (is.data.frame(smoother)) {
    # specific for pava as there is no model returned, just a vector
    ifelse(
      new_x == 0, 
      smoother$estimate[smoother$score == 0][1],
      ifelse(
        new_x == 1, 
        smoother$estimate[smoother$score == 1][1],
        smoother$estimate[smoother$score == 2][1]
      )
    )
  }
}


polished_smoother <- function(x, y, is_discrete, column_name, na_ind = NULL) {
  if (column_name == "age") {
    s.decr <- cgam::s.decr
    form <- y ~ s.decr(x, numknots = 3)
  } else if (column_name == "priors") {
    s.incr <- cgam::s.incr
    form <- y ~ s.incr(x, numknots = 3)
  } else if (column_name == "juvenile_crimes") {
    return(getPAVAest(outcome = y, score = x)) # from stats4phc
  } else {
    out <- list()
    class(out) <- "constant"
    return(out)
  }
  tryCatch(
    cgam::cgam(form), 
    error = function(e) {
      s <- mgcv::s
      tryCatch(
        mgcv::gam(y ~ s(x, k = -1)),
        error = function(e) {
          mgcv::gam(y ~ x)
        }
      )
    }
  )
}

polished_smoother_predict <- function(smoother, new_x, is_discrete, column_name, na_ind = NULL) {
  if (inherits(smoother, "cgam")) {
    # cgam fails on extrapolation - need to do this manually
    if (min(new_x) < min(smoother$xmat0[, 1])) {
      new_x[new_x < min(smoother$xmat0[, 1])] <- min(smoother$xmat0[, 1])
    }
    if (max(new_x) > max(smoother$xmat0[, 1])) {
      new_x[new_x > max(smoother$xmat0[, 1])] <- max(smoother$xmat0[, 1])
    }
    newdata <- data.frame(x = new_x)
    predict(smoother, newData = newdata)$fit
  } else if (inherits(smoother, "constant")) { 
    0
  } else if (is.data.frame(smoother)) {
    # specific for pava as there is no model returned, just a vector
    ifelse(
      new_x == 0, 
      smoother$estimate[smoother$score == 0][1],
      ifelse(
        new_x == 1, 
        smoother$estimate[smoother$score == 1][1],
        smoother$estimate[smoother$score == 2][1]
      )
    )
  }
}

rs_pm <- load_results(paste0(dataset, "-", model_type, "-sculpt_rough_pm.rds"))

ds_pm_v2 <- sculpt_detailed_generic(
  rs = rs_pm,
  smoother_fit = gam_cgam_smoother, 
  smoother_predict = gam_cgam_predict
)

# Select variables for polished model
checkmate::assert_number(top_k, lower = 1)
vars <- levels(attr(rs_pm, "cumul_R2")$feature)[1:top_k]

rs_pm_top_k <- rs_pm[vars]
attr(rs_pm_top_k, "offset") <- attr(rs_pm, "offset")
class(rs_pm_top_k) <- class(rs_pm)

ps_pm_v2 <- sculpt_detailed_generic(
  rs = rs_pm_top_k,
  smoother_fit = polished_smoother, 
  smoother_predict = polished_smoother_predict
)

store_results(ds_pm_v2, paste0(dataset, "-", model_type, "-sculpt_detailed_pm_v2.rds"))
store_results(ps_pm_v2, paste0(dataset, "-", model_type, "-sculpt_polished_pm_v2.rds"))

Show the code

# load sculpted models
rs_pm <- load_results(paste0(dataset, "-", model_type, "-sculpt_rough_pm.rds"))
ds_pm <- load_results(paste0(dataset, "-", model_type, "-sculpt_detailed_pm.rds"))
ps_pm <- load_results(paste0(dataset, "-", model_type, "-sculpt_polished_pm.rds"))
ds_pm_v2 <- load_results(paste0(dataset, "-", model_type, "-sculpt_detailed_pm_v2.rds"))
ps_pm_v2 <- load_results(paste0(dataset, "-", model_type, "-sculpt_polished_pm_v2.rds"))

Other sculpting models

Show the code

# get rough model - on train
rs_train <- sculpt_rough(
  dd$data$train[dd$covariates$all],
  seed = 1234,
  model_predict_fun = function(x) {
    p <- predict(xgb, new_data = x, type = "prob")$.pred_1
    logit(p)
  },
  data_as_marginals = TRUE
)

# rough model on pm on original scale
rs_pm_prob <- sculpt_rough(
  pm,
  seed = 1234,
  model_predict_fun = function(x) {
    predict(xgb, new_data = x, type = "prob")$.pred_1
  }
)

# rough model on train on original scale
rs_train_prob <- sculpt_rough(
  dd$data$train[dd$covariates$all],
  seed = 1234,
  model_predict_fun = function(x) {
    predict(xgb, new_data = x, type = "prob")$.pred_1
  },
  data_as_marginals = TRUE
)

# First order model
rs_pm_xgb_fo <- sculpt_rough(
  pm, 
  seed = 1234,
  model_predict_fun = function(x) {
    p <- predict(xgb_fo, new_data = x, type = "prob")$.pred_1
    logit(p)
  }
)

ICE plots

Show the code

scale_col_update <- 
  scale_color_manual(
    values = c("ICE Profiles" = "gray60", "Rough model (with SE)" = "blue"),
    labels = c("ICE Profiles", "Rough model"),
    name = ""
  )

ice_pm_ceteris <- g_ice(rs_pm, centered = F, show_PDP = F, 
                        facet_spec = facet_specification(ncol = 3))
ice_pm_ceteris_prob <- g_ice(rs_pm_prob, centered = F, show_PDP = F, 
                             facet_spec = facet_specification(ncol = 3))
ice_pm <- g_ice(rs_pm, centered = T, show_PDP = T, 
                facet_spec = facet_specification(ncol = 3))

Show the code

ice_pm_ceteris$continuous + theme_facets

Show the code

ice_pm_ceteris$discrete

Show the code

ice_pm_ceteris_prob$continuous + theme_facets

Show the code

ice_pm_ceteris_prob$discrete

Show the code

ice_pm$continuous + scale_col_update + theme_facets

Show the code

ice_pm$discrete + scale_col_update

Show the code

# comparison plot
comp_xgb_bayes <- g_comparison(
  sculptures = list(rs_pm, rs_pm_xgb_fo),
  descriptions = c("Rough Model", "Direct Additive XGB"), 
  facet_spec = facet_specification(ncol = 3)
)

comp_xgb_bayes$continuous + theme_facets

Show the code

comp_xgb_bayes$discrete

Show the code

# compare detailed and rough
comp_ds <- 
  g_comparison(
    sculptures = list(rs_pm, ds_pm_v2),
    descriptions = c("Rough Model", "Detailed Model"), 
    facet_spec = facet_specification(ncol = 3)
  )

comp_ds$continuous + theme_facets

Show the code

comp_ds$discrete

Show the code

# compare detailed and rough
## Select variables for polished model
checkmate::assert_number(top_k, lower = 1)
vars <- levels(attr(rs_pm, "cumul_R2")$feature)[1:top_k]

rs_pm_top_k <- rs_pm[vars]
attr(rs_pm_top_k, "offset") <- attr(rs_pm, "offset")
class(rs_pm_top_k) <- class(rs_pm)

comp_ps <- 
  g_comparison(
    sculptures = list(rs_pm_top_k, ps_pm_v2),
    descriptions = c("Rough Model", "Polished Model"), 
    facet_spec = facet_specification(ncol = 3)
  )

comp_ps$continuous + theme_facets

Data density

Show the code

g_density_plots_cont <- g_density_ice_plot_list(ps_pm_v2,
                                                dd$data$train,
                                                var_names = dd$covariates$continuous,
                                                var_labels = dd$covariates$labels,
                                                task = dd$task)
# patchwork::wrap_plots(g_density_plots_cont[c("priors", "age", "juvenile_crimes")], ncol = 2)

Show the code

g_density_plots_cont[["priors"]]

Show the code

g_density_plots_cont[["age"]]

Show the code

g_density_plots_cont[["juvenile_crimes"]]

Additivity evaluation

Show the code

p1 <- predict(xgb, new_data = pm, type = "prob")$.pred_1
p2 <- predict(xgb, new_data = dd$data$train, type = "prob")$.pred_1
p3 <- predict(rs_pm, pm)
p4 <- predict(rs_train, dd$data$train)

g_additivity(
  sp = list(inv.logit(p3), inv.logit(p4)),
  lp = list(p1, p2),
  descriptions = c("Product Marginals", "Train Set")
) + 
    labs(x = "Rough Model Predictions", y = "Strong Learner Predictions") + 
    theme_single

Variable importance

Show the code

vi_pm <- g_var_imp(rs_pm, show_pdp_plot = FALSE, textsize = 16, var_imp_type = "ice", 
                   logodds_to_prob = F)
plot(vi_pm)

Show the code

vi_pm_prob <- g_var_imp(rs_pm, show_pdp_plot = FALSE, textsize = 16, var_imp_type = "ice", 
                        logodds_to_prob = T)
plot(vi_pm_prob)

Show the code

vi_train <- g_var_imp(rs_train, show_pdp_plot = FALSE, textsize = 16, var_imp_type = "ice", 
                      logodds_to_prob = F)
plot(vi_train)

Show the code

vi_train_prob <- g_var_imp(rs_train, show_pdp_plot = FALSE, textsize = 16, var_imp_type = "ice", 
                           logodds_to_prob = T)
plot(vi_train_prob)

Calibration

Show the code

preds_sculptures <- tibble(
  obs = as.numeric(as.character(dd$data$holdout[[dd$response]])),
  obs_fct = factor(dd$data$holdout[[dd$response]], levels = c("0", "1")),
  xgb_prob = predict(xgb, new_data = dd$data$holdout, type = "prob")$.pred_1,
  rm_log = predict(rs_pm, newdata = dd$data$holdout),
  pm_log = predict(ps_pm_v2, newdata = dd$data$holdout),
  dir_prob = predict(xgb_fo, new_data = dd$data$holdout, type = "prob")$.pred_1
) %>%
  mutate(
    rm_prob = inv.logit(rm_log),
    pm_prob = inv.logit(pm_log)
  ) %>%
  pivot_longer(
    cols = -c(obs, obs_fct),
    names_to = c("Model", "type"), names_sep = "_",
    values_to = "pred"
  ) %>%
  filter(type == "prob") %>% 
  mutate(
    Model = c(
      "xgb" = "XGBoost", "rm" = "Rough Model",
      "pm" = "Polished Model", "dir" = "Direct Additive XGBoost"
    )[Model],
    Model = factor(
      Model, 
      levels = c(
        "XGBoost", "Rough Model", "Polished Model", "Direct Additive XGBoost"
      )
    )
  )

calib_plot_sculptures <- ggplot(preds_sculptures) + 
  geom_smooth(aes(x = pred, y = obs, colour = Model), se = F, method = "gam", formula = y~x, 
              method.args = list(family = "binomial")) + 
  geom_abline(linetype = "dashed") + 
  labs(x = "Prediction", y = "Truth") + 
  theme_bw() + 
  theme(text = element_text(size = 18))

calib_plot_sculptures

Predictiveness curve

The plot was generated using the riskProfile function from the stats4phc package.

Show the code

rp <- riskProfile(
  outcome = as.numeric(as.character(dd$data$holdout[[dd$response]])),
  score = inv.logit(predict(ps_pm_v2, dd$data$holdout)),
  show.nonparam.pv = FALSE,
  show.best.pv = FALSE
)

dm_corel <- define_model("corel_publication", dd)
preds_corel <- predict(dm_corel$workflow, new_data = dd$data$holdout)$.pred_class
preds_corel_fct <- factor(preds_corel, levels = c("1", "0"))

dat_corel <- tibble(
  score_percentile = 1 - mean(preds_corel),
  PPV = ppv_vec(
    truth = dd$data$holdout[[dd$response]], 
    estimate = preds_corel_fct, 
    event_level = "first"
  ),
  `1-NPV` = 1 - npv_vec(
    truth = dd$data$holdout[[dd$response]], 
    estimate = preds_corel_fct, 
    event_level = "first"
  )
) %>% pivot_longer(cols = c(PPV, `1-NPV`))

# final Predictiveness curve with corel alg.
pc_plot <- 
  rp$plot + 
  geom_point(
    data = dat_corel,
    mapping = aes(x = score_percentile, y = value, colour = name),
    size = 3
  )


plot(pc_plot)

Show the code

# Below are to generate separate legends for slides
# plot(rp$plot + labs(color = "Predictive Quantity\n(Polished model)"))
# clrs <- stats4phc:::predictionColours(c("PC", "PPV", "1-NPV"), show.best = FALSE)
# p <- p + scale_colour_manual(values = clrs, breaks = names(clrs))
# ggplot(dat_corel, aes(x = score_percentile, y = value, colour = name)) + 
#   geom_point(size = 3) + 
#   scale_colour_manual(values = clrs, breaks = names(clrs)) + 
#   labs(color = "Predictive Quantity\n(CORELS)")

Compare with linear models

Load and sculpt

Show the code

elastic <- load_model_if_trained("log_elastic")
lasso <- load_model_if_trained("log_lasso")
ridge <- load_model_if_trained("log_ridge")

dm_linm <- define_model(type = "logistic", data_info = dd)
linm <- fit(dm_linm$workflow, data = dd$data$train)
tg_linm <- fit_resamples(dm_linm$workflow, dd$cv)

Show the code

# sculptures on pm from different models
rs_pm_elastic <- sculpt_rough(
  pm,
  seed = 1234,
  model_predict_fun = function(x) {
    p <- predict(elastic, new_data = x, type = "prob")$.pred_1
    logit(p)
  }
)
rs_pm_lasso <- sculpt_rough(
  pm,
  seed = 1234,
  model_predict_fun = function(x) {
    p <- predict(lasso, new_data = x, type = "prob")$.pred_1
    logit(p)
  }
)
rs_pm_ridge <- sculpt_rough(
  pm,
  seed = 1234,
  model_predict_fun = function(x) {
    p <- predict(ridge, new_data = x, type = "prob")$.pred_1
    logit(p)
  }
)
rs_pm_linm <- sculpt_rough(
  pm,
  seed = 1234,
  model_predict_fun = function(x) {
    p <- predict(linm, new_data = x, type = "prob")$.pred_1
    logit(p)
  }
)

ICE

Show the code

comp_models <- g_comparison(
  sculptures = list(rs_pm_elastic, rs_pm_lasso, rs_pm_ridge, rs_pm_linm, ps_pm_v2),
  descriptions = c("Elastic Net", "Lasso", "Ridge", "Logistic Regression", "Polished"),
  facet_spec = facet_specification(ncol = 3)
)

comp_models$continuous + theme_facets

Show the code

comp_models$discrete

Calibration

Show the code

preds_models <- tibble(
  obs = as.numeric(as.character(dd$data$holdout[[dd$response]])),
  obs_fct = factor(dd$data$holdout[[dd$response]], levels = c("0", "1")),
  xgbPol_log = predict(ps_pm_v2, newdata = dd$data$holdout),
  linm_log = predict(rs_pm_linm, newdata = dd$data$holdout),
  elastic_log = predict(rs_pm_elastic, newdata = dd$data$holdout),
  lasso_log = predict(rs_pm_lasso, newdata = dd$data$holdout),
  ridge_log = predict(rs_pm_ridge, newdata = dd$data$holdout)
) %>% 
  mutate(
    xgbPol_prob = inv.logit(xgbPol_log),
    linm_prob = inv.logit(linm_log),
    elastic_prob = inv.logit(elastic_log),
    lasso_prob = inv.logit(lasso_log),
    ridge_prob = inv.logit(ridge_log)
  ) %>%
  pivot_longer(
    cols = -c(obs, obs_fct),
    names_to = c("Model", "type"), names_sep = "_",
    values_to = "pred"
  ) %>%
  filter(type == "prob") %>% 
  mutate(
    Model = c(
      "xgbPol" = "Polished", 
      "linm" = "Logistic", "elastic" = "Elastic Net", "lasso" = "Lasso", "ridge" = "Ridge" 
    )[Model]
  )

# calibration plot on holdout based on pm sculptures of different linear models
calib_plot_models <- ggplot(preds_models) + 
  geom_smooth(aes(x = pred, y = obs, colour = Model), se = F, method = "gam", formula = y~x, 
              method.args = list(family = "binomial")) + 
  geom_abline(linetype = "dashed") + 
  labs(x = "Prediction", y = "Truth") + 
  theme_bw() + 
  theme(text = element_text(size = 18))

calib_plot_models

Session info

Show the code

devtools::session_info()

─ Session info ───────────────────────────────────────────────────────────────
 setting  value
 version  R version 4.3.3 (2024-02-29)
 os       Ubuntu 22.04.4 LTS
 system   x86_64, linux-gnu
 ui       X11
 language (EN)
 collate  en_US.UTF-8
 ctype    en_US.UTF-8
 tz       Etc/UTC
 date     2024-09-13
 pandoc   3.1.13 @ /opt/conda/bin/ (via rmarkdown)

─ Packages ───────────────────────────────────────────────────────────────────
 package      * version    date (UTC) lib source
 backports      1.4.1      2021-12-13 [2] RSPM (R 4.3.0)
 boot           1.3-30     2024-02-26 [4] RSPM (R 4.3.3)
 broom        * 1.0.5      2023-06-09 [2] RSPM (R 4.3.0)
 cachem         1.0.8      2023-05-01 [2] RSPM (R 4.3.0)
 cgam           1.21       2023-08-10 [1] RSPM (R 4.3.0)
 checkmate      2.3.1      2023-12-04 [2] RSPM (R 4.3.0)
 class          7.3-22     2023-05-03 [2] RSPM (R 4.3.0)
 cli            3.6.2      2023-12-11 [2] RSPM (R 4.3.0)
 codetools      0.2-20     2024-03-31 [4] RSPM (R 4.3.3)
 colorspace     2.1-0      2023-01-23 [2] RSPM (R 4.3.0)
 coneproj       1.17       2023-10-15 [1] RSPM (R 4.3.0)
 data.table     1.15.4     2024-03-30 [2] RSPM (R 4.3.0)
 devtools       2.4.5      2022-10-11 [1] RSPM (R 4.3.0)
 dials        * 1.2.1      2024-02-22 [1] RSPM (R 4.3.0)
 DiceDesign     1.10       2023-12-07 [1] RSPM (R 4.3.0)
 digest         0.6.35     2024-03-11 [2] RSPM (R 4.3.0)
 dplyr        * 1.1.4      2023-11-17 [2] RSPM (R 4.3.0)
 ellipsis       0.3.2      2021-04-29 [2] RSPM (R 4.3.0)
 evaluate       0.23       2023-11-01 [2] RSPM (R 4.3.0)
 fansi          1.0.6      2023-12-08 [2] RSPM (R 4.3.0)
 farver         2.1.1      2022-07-06 [2] RSPM (R 4.3.0)
 fastmap        1.1.1      2023-02-24 [2] RSPM (R 4.3.0)
 foreach        1.5.2      2022-02-02 [1] RSPM (R 4.3.0)
 fs             1.6.3      2023-07-20 [2] RSPM (R 4.3.0)
 furrr          0.3.1      2022-08-15 [1] RSPM (R 4.3.0)
 future         1.33.2     2024-03-26 [1] RSPM (R 4.3.0)
 future.apply   1.11.2     2024-03-28 [1] RSPM (R 4.3.0)
 generics       0.1.3      2022-07-05 [2] RSPM (R 4.3.0)
 ggplot2      * 3.5.0      2024-02-23 [2] RSPM (R 4.3.0)
 ggrepel        0.9.5      2024-01-10 [1] RSPM (R 4.3.0)
 glmnet         4.1-8      2023-08-22 [1] RSPM (R 4.3.0)
 globals        0.16.3     2024-03-08 [1] RSPM (R 4.3.0)
 glue           1.7.0      2024-01-09 [2] RSPM (R 4.3.0)
 gower          1.0.1      2022-12-22 [1] RSPM (R 4.3.0)
 GPfit          1.0-8      2019-02-08 [1] RSPM (R 4.3.0)
 gridExtra      2.3        2017-09-09 [2] RSPM (R 4.3.0)
 gtable         0.3.4      2023-08-21 [2] RSPM (R 4.3.0)
 hardhat        1.3.1      2024-02-02 [1] RSPM (R 4.3.0)
 here           1.0.1      2020-12-13 [1] RSPM (R 4.3.0)
 htmltools      0.5.8.1    2024-04-04 [2] RSPM (R 4.3.0)
 htmlwidgets    1.6.4      2023-12-06 [2] RSPM (R 4.3.0)
 httpuv         1.6.15     2024-03-26 [2] RSPM (R 4.3.0)
 infer        * 1.0.7      2024-03-25 [1] RSPM (R 4.3.0)
 ipred          0.9-14     2023-03-09 [1] RSPM (R 4.3.0)
 iterators      1.0.14     2022-02-05 [1] RSPM (R 4.3.0)
 jsonlite       1.8.8      2023-12-04 [2] RSPM (R 4.3.0)
 knitr          1.46       2024-04-06 [2] RSPM (R 4.3.0)
 labeling       0.4.3      2023-08-29 [2] RSPM (R 4.3.0)
 later          1.3.2      2023-12-06 [2] RSPM (R 4.3.0)
 lattice        0.22-6     2024-03-20 [4] RSPM (R 4.3.3)
 lava           1.8.0      2024-03-05 [1] RSPM (R 4.3.0)
 lhs            1.1.6      2022-12-17 [1] RSPM (R 4.3.0)
 lifecycle      1.0.4      2023-11-07 [2] RSPM (R 4.3.0)
 listenv        0.9.1      2024-01-29 [1] RSPM (R 4.3.0)
 lme4           1.1-35.2   2024-03-28 [2] RSPM (R 4.3.0)
 lubridate      1.9.3      2023-09-27 [2] RSPM (R 4.3.0)
 magrittr       2.0.3      2022-03-30 [2] RSPM (R 4.3.0)
 MASS           7.3-60.0.1 2024-01-13 [4] RSPM (R 4.3.3)
 Matrix         1.6-5      2024-01-11 [4] RSPM (R 4.3.3)
 memoise        2.0.1      2021-11-26 [2] RSPM (R 4.3.0)
 mgcv         * 1.9-1      2023-12-21 [4] RSPM (R 4.3.3)
 mime           0.12       2021-09-28 [2] RSPM (R 4.3.0)
 miniUI         0.1.1.1    2018-05-18 [2] RSPM (R 4.3.0)
 minqa          1.2.6      2023-09-11 [2] RSPM (R 4.3.0)
 modeldata    * 1.3.0      2024-01-21 [1] RSPM (R 4.3.0)
 modsculpt    * 0.1.1      2024-09-13 [1] Github (Genentech/modsculpt@426ffec)
 munsell        0.5.1      2024-04-01 [2] RSPM (R 4.3.0)
 nlme         * 3.1-164    2023-11-27 [4] RSPM (R 4.3.3)
 nloptr         2.0.3      2022-05-26 [2] RSPM (R 4.3.0)
 nnet           7.3-19     2023-05-03 [4] RSPM (R 4.3.3)
 parallelly     1.37.1     2024-02-29 [1] RSPM (R 4.3.0)
 parsnip      * 1.2.1      2024-03-22 [1] RSPM (R 4.3.0)
 pillar         1.9.0      2023-03-22 [2] RSPM (R 4.3.0)
 pkgbuild       1.4.4      2024-03-17 [2] RSPM (R 4.3.0)
 pkgconfig      2.0.3      2019-09-22 [2] RSPM (R 4.3.0)
 pkgload        1.3.4      2024-01-16 [2] RSPM (R 4.3.0)
 pracma         2.4.4      2023-11-10 [1] RSPM (R 4.3.0)
 prodlim        2023.08.28 2023-08-28 [1] RSPM (R 4.3.0)
 profvis        0.3.8      2023-05-02 [1] RSPM (R 4.3.0)
 promises       1.3.0      2024-04-05 [2] RSPM (R 4.3.0)
 purrr        * 1.0.2      2023-08-10 [2] RSPM (R 4.3.0)
 R6             2.5.1      2021-08-19 [2] RSPM (R 4.3.0)
 Rcpp           1.0.12     2024-01-09 [2] RSPM (R 4.3.0)
 recipes      * 1.0.10     2024-02-18 [1] RSPM (R 4.3.0)
 remotes        2.5.0      2024-03-17 [2] RSPM (R 4.3.0)
 rlang          1.1.3      2024-01-10 [2] RSPM (R 4.3.0)
 rmarkdown      2.26       2024-03-05 [2] RSPM (R 4.3.0)
 rpart          4.1.23     2023-12-05 [4] RSPM (R 4.3.3)
 rprojroot      2.0.4      2023-11-05 [2] RSPM (R 4.3.0)
 rsample      * 1.2.1      2024-03-25 [1] RSPM (R 4.3.0)
 rstudioapi     0.16.0     2024-03-24 [2] RSPM (R 4.3.0)
 scales       * 1.3.0      2023-11-28 [2] RSPM (R 4.3.0)
 sessioninfo    1.2.2      2021-12-06 [1] RSPM (R 4.3.0)
 shape          1.4.6.1    2024-02-23 [1] RSPM (R 4.3.0)
 shiny          1.8.1.1    2024-04-02 [2] RSPM (R 4.3.0)
 statmod        1.5.0      2023-01-06 [1] RSPM (R 4.3.0)
 stats4phc    * 0.1.1      2024-06-20 [1] Github (genentech/stats4phc@e868e23)
 stringi        1.8.3      2023-12-11 [2] RSPM (R 4.3.0)
 stringr      * 1.5.1      2023-11-14 [2] RSPM (R 4.3.0)
 survival       3.5-8      2024-02-14 [4] RSPM (R 4.3.3)
 svDialogs      1.1.0      2022-05-10 [1] RSPM (R 4.3.0)
 svGUI          1.0.1      2021-04-16 [1] RSPM (R 4.3.0)
 tibble       * 3.2.1      2023-03-20 [2] RSPM (R 4.3.0)
 tidymodels   * 1.2.0      2024-03-25 [1] RSPM (R 4.3.0)
 tidyr        * 1.3.1      2024-01-24 [2] RSPM (R 4.3.0)
 tidyselect     1.2.1      2024-03-11 [2] RSPM (R 4.3.0)
 timechange     0.3.0      2024-01-18 [2] RSPM (R 4.3.0)
 timeDate       4032.109   2023-12-14 [1] RSPM (R 4.3.0)
 tune         * 1.2.0      2024-03-20 [1] RSPM (R 4.3.0)
 urlchecker     1.0.1      2021-11-30 [1] RSPM (R 4.3.0)
 usethis        2.2.2      2023-07-06 [1] RSPM (R 4.3.0)
 utf8           1.2.4      2023-10-22 [2] RSPM (R 4.3.0)
 vctrs          0.6.5      2023-12-01 [2] RSPM (R 4.3.0)
 viridisLite    0.4.2      2023-05-02 [2] RSPM (R 4.3.0)
 withr          3.0.0      2024-01-16 [2] RSPM (R 4.3.0)
 workflows    * 1.1.4      2024-02-19 [1] RSPM (R 4.3.0)
 workflowsets * 1.1.0      2024-03-21 [1] RSPM (R 4.3.0)
 xfun           0.43       2024-03-25 [4] RSPM (R 4.3.3)
 xgboost        1.7.7.1    2024-01-25 [1] RSPM (R 4.3.0)
 xtable         1.8-4      2019-04-21 [2] RSPM (R 4.3.0)
 yaml           2.3.8      2023-12-11 [2] RSPM (R 4.3.0)
 yardstick    * 1.3.1      2024-03-21 [1] RSPM (R 4.3.0)

 [1] /home/yoshidk6/R/x86_64-pc-linux-gnu-library/4.3
 [2] /usr/local/lib/R/site-library
 [3] /usr/lib/R/site-library
 [4] /usr/lib/R/library

──────────────────────────────────────────────────────────────────────────────