From 4d7935d441d7f8d2944b576a2df686e2a7f774c8 Mon Sep 17 00:00:00 2001 From: Kentaro Matsuura Date: Wed, 11 Dec 2024 08:25:59 +0900 Subject: [PATCH] Use vapply() instead of tapply() --- R/generate_setup_code.R | 5 +++-- R/simulate_one_trial.R | 8 +++++--- README.Rmd | 4 ++-- README.md | 4 ++-- 4 files changed, 12 insertions(+), 9 deletions(-) diff --git a/R/generate_setup_code.R b/R/generate_setup_code.R index 53faafe..ac91a25 100644 --- a/R/generate_setup_code.R +++ b/R/generate_setup_code.R @@ -64,8 +64,9 @@ generate_setup_code <- function( compute_reward <- function(true_model_name, sim_doses, sim_resps) { if (outcome_type == "binary") { - sim_Ns <- unname(tapply(sim_resps, sim_doses, length)) - sim_resp_rates <- unname(tapply(sim_resps, sim_doses, sum)) / sim_Ns + resps_per_dose <- split(sim_resps, sim_doses) + sim_Ns <- vapply(resps_per_dose, length, integer(1L), USE.NAMES = FALSE) + sim_resp_rates <- vapply(resps_per_dose, sum, numeric(1L), USE.NAMES = FALSE) / sim_Ns # fit logistic regression (without intercept) logfit <- glm(sim_resp_rates ~ factor(doses) + 0, family = binomial, weights = sim_Ns) mu_hat <- coef(logfit) diff --git a/R/simulate_one_trial.R b/R/simulate_one_trial.R index 99108ef..12f95c4 100644 --- a/R/simulate_one_trial.R +++ b/R/simulate_one_trial.R @@ -144,8 +144,9 @@ simulate_one_trial <- function( } if (outcome_type == "binary") { - sim_Ns <- unname(tapply(sim_resps, sim_doses, length)) - sim_resp_rates <- unname(tapply(sim_resps, sim_doses, sum)) / sim_Ns + resps_per_dose <- split(sim_resps, sim_doses) + sim_Ns <- vapply(resps_per_dose, length, integer(1L), USE.NAMES = FALSE) + sim_resp_rates <- vapply(resps_per_dose, sum, integer(1L), USE.NAMES = FALSE) / sim_Ns # fit logistic regression (without intercept) logfit <- glm(sim_resp_rates ~ factor(doses) + 0, family = binomial, weights = sim_Ns) mu_hat <- coef(logfit) @@ -182,7 +183,8 @@ simulate_one_trial <- function( p_values <- attr(result_mcpmod$MCTtest$tStat, "pVal") min_p_value <- min(p_values) - count_per_action <- tapply(sim_resps, sim_actions, length) + resps_per_action <- split(sim_resps, sim_actions) + count_per_action <- vapply(resps_per_action, length, integer(1L), USE.NAMES = FALSE) proportion_per_action <- count_per_action / N_total names(proportion_per_action) <- sprintf("n_of_%s", as.character(doses)) diff --git a/README.Rmd b/README.Rmd index e023af3..4683a12 100644 --- a/README.Rmd +++ b/README.Rmd @@ -149,9 +149,9 @@ for (true_model_name in names(true_response_list)) { true_response <- true_response_list[[true_model_name]] for (simID in seq_len(n_sim)) { sim_one <- simulate_one_trial( - allocation_rule, models, + allocation_rule, models, true_response = true_response, - N_total = 150, N_ini = rep(10, 5), N_block = 10, + N_total = 150, N_ini = rep(10, 5), N_block = 10, Delta = 1.3, outcome_type = "continuous", sd_normal = sqrt(4.5), alpha = adjusted_alpha, seed = simID, eval_type = "all" ) diff --git a/README.md b/README.md index d689542..9f0e09c 100644 --- a/README.md +++ b/README.md @@ -154,9 +154,9 @@ for (true_model_name in names(true_response_list)) { true_response <- true_response_list[[true_model_name]] for (simID in seq_len(n_sim)) { sim_one <- simulate_one_trial( - allocation_rule, models, + allocation_rule, models, true_response = true_response, - N_total = 150, N_ini = rep(10, 5), N_block = 10, + N_total = 150, N_ini = rep(10, 5), N_block = 10, Delta = 1.3, outcome_type = "continuous", sd_normal = sqrt(4.5), alpha = adjusted_alpha, seed = simID, eval_type = "all" )