Use vapply() instead of tapply()

MatsuuraKentaro · Dec 10, 2024 · 4d7935d · 4d7935d
1 parent f67196b
commit 4d7935d
Show file tree

Hide file tree

Showing 4 changed files with 12 additions and 9 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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"
     )