if (.if_run_ex_eval_mod()) { # Linear logistic regression ------------------------------------------------ set.seed(1234) data(d_sim_binom_cov_hgly2) d_split <- rsample::initial_split(d_sim_binom_cov_hgly2) d_train <- rsample::training(d_split) d_test <- rsample::testing(d_split) ermod_bin <- dev_ermod_bin( data = d_train |> head(100), var_resp = "AEFLAG", var_exposure = "AUCss_1000", var_cov = "BHBA1C_5", chains = 2, iter = 500 ) met_bin_training <- eval_ermod(ermod_bin, eval_type = "training") met_bin_test <- eval_ermod(ermod_bin, eval_type = "test", newdata = d_test) met_bin_kfold <- eval_ermod(ermod_bin, eval_type = "kfold", newdata = d_test, k = 3) |> suppressWarnings() # Emax logistic regression -------------------------------------------------- set.seed(1234) data_er_bin <- rstanemax::exposure.response.sample.binary ermod_bin_emax <- suppressWarnings(dev_ermod_bin_emax( data = data_er_bin, var_exposure = "conc", var_resp = "y_cov", l_var_cov = list(emax = "sex"), verbosity_level = 0, chains = 2, iter = 200, seed = 1 )) met_bin_emax_training <- eval_ermod(ermod_bin_emax, eval_type = "training") met_bin_emax_kfold <- eval_ermod(ermod_bin_emax, eval_type = "kfold", k = 3) |> suppressWarnings() # Linear regression --------------------------------------------------------- set.seed(1234) ermod_lin <- dev_ermod_lin( data = d_sim_lin, var_resp = "response", var_exposure = "AUCss", var_cov = c("SEX", "BAGE"), chains = 2, iter = 500 ) met_lin_training <- eval_ermod(ermod_lin, eval_type = "training") met_lin_kfold <- eval_ermod(ermod_lin, eval_type = "kfold", k = 3) |> suppressWarnings() # Emax model ---------------------------------------------------------------- set.seed(1234) data_er_cont_cov <- rstanemax::exposure.response.sample.with.cov ermod_emax <- suppressWarnings(dev_ermod_emax( data = data_er_cont_cov, var_exposure = "conc", var_resp = "resp", l_var_cov = list(emax = "cov2", ec50 = "cov3", e0 = "cov1"), verbosity_level = 0, chains = 2, iter = 200, seed = 1 )) met_emax_training <- eval_ermod(ermod_emax, eval_type = "training") met_emax_kfold <- eval_ermod(ermod_emax, eval_type = "kfold", k = 3) |> suppressWarnings() # Test ---------------------------------------------------------------------- test_that("Binary model", { # Training ersim_bin <- sim_er(ermod_bin, output_type = "median_qi") |> dplyr::mutate(AEFLAG = factor(AEFLAG, levels = c(1, 0))) estimates <- c( yardstick::roc_auc_vec(ersim_bin$AEFLAG, ersim_bin$.epred), yardstick::mn_log_loss_vec(ersim_bin$AEFLAG, ersim_bin$.epred) ) expect_equal(met_bin_training$.estimate, estimates) # Test ersim_bin_test <- sim_er(ermod_bin, newdata = d_test, output_type = "median_qi") |> dplyr::mutate(AEFLAG = factor(AEFLAG, levels = c(1, 0))) estimates_test <- c( yardstick::roc_auc_vec(ersim_bin_test$AEFLAG, ersim_bin_test$.epred), yardstick::mn_log_loss_vec(ersim_bin_test$AEFLAG, ersim_bin_test$.epred) ) expect_equal(met_bin_test$.estimate, estimates_test) # kfold expect_equal(dim(met_bin_kfold), c(6, 4)) # Binary emax expect_error( eval_ermod(ermod_bin_emax, eval_type = "test", newdata = d_test), 'conc" columns should be in data' ) expect_equal(dim(met_bin_emax_training), c(2, 3)) expect_equal(dim(met_bin_emax_kfold), c(6, 4)) }) test_that("Continuous model", { ersim_cont <- sim_er(ermod_lin, output_type = "median_qi") estimates <- c( yardstick::rmse_vec(ersim_cont$response, ersim_cont$.epred), yardstick::rsq_vec(ersim_cont$response, ersim_cont$.epred), yardstick::rsq_trad_vec(ersim_cont$response, ersim_cont$.epred) ) expect_equal(met_lin_training$.estimate, estimates) # Emax expect_equal(dim(met_emax_training), c(3, 3)) expect_equal(dim(met_emax_kfold), c(9, 4)) }) }