From 25f8f28541ce5be0c55fecee4cdd47a6c8603237 Mon Sep 17 00:00:00 2001
From: wojcieko <wojcie@mailbox.org>
Date: Thu, 14 Dec 2023 10:32:11 +0100
Subject: [PATCH] - fixed average success rate in assessDesign and added as
 attribute - added successRate attribute to BayesianMCP class objects - fixed
 a warning in print function of BayesianMCPMod that would occur if more than 1
 model shape of the same type was specified

---
 R/BMCPMod.R   | 14 ++++++++++----
 R/s3methods.R | 10 ++++++----
 2 files changed, 16 insertions(+), 8 deletions(-)

diff --git a/R/BMCPMod.R b/R/BMCPMod.R
index f3f3de6..866c1f8 100644
--- a/R/BMCPMod.R
+++ b/R/BMCPMod.R
@@ -85,12 +85,17 @@ assessDesign <- function (
     
   })
   
+  avg_success_rate <- mean(sapply(eval_design, function (bmcpmod) {
+    attr(bmcpmod$BayesianMCP, "successRate")
+  }))
+  
   names(eval_design) <- model_names
   
-  attr(eval_design, "placEff")    <- attr(mods, "placEff")
-  attr(eval_design, "maxEff")     <- attr(mods, "maxEff")
-  attr(eval_design, "sampleSize") <- n_patients
-  attr(eval_design, "priorESS")   <- getESS(prior_list)
+  attr(eval_design, "avgSuccessRate") <- avg_success_rate
+  attr(eval_design, "placEff")        <- attr(mods, "placEff")
+  attr(eval_design, "maxEff")         <- attr(mods, "maxEff")
+  attr(eval_design, "sampleSize")     <- n_patients
+  attr(eval_design, "priorESS")       <- getESS(prior_list)
   
   return (eval_design)
   
@@ -347,6 +352,7 @@ performBayesianMCP <- function(
   
   class(b_mcp)                 <- "BayesianMCP"
   attr(b_mcp, "crit_prob_adj") <- crit_prob_adj
+  attr(b_mcp, "successRate")   <- mean(b_mcp[, 1])
   attr(b_mcp, "ess_avg")       <- ifelse(
     test = is.na(attr(posterior_list[[1]], "ess")),
     yes  = numeric(0),
diff --git a/R/s3methods.R b/R/s3methods.R
index 98433fd..f4cc5f0 100644
--- a/R/s3methods.R
+++ b/R/s3methods.R
@@ -10,7 +10,9 @@ print.BayesianMCPMod <- function (
   
   model_names <- colnames(x$BayesianMCP)[
     grepl("post_probs.", colnames(x$BayesianMCP))] |>
-    sub(pattern = "post_probs.", replacement = "", x = _)
+    sub(pattern = "post_probs.", replacement = "", x = _) |>
+    gsub(pattern = "\\d", replacement = "", x = _) |>
+    unique(x = _)
   
   model_success <- colMeans(do.call(rbind, lapply(x$Mod, function (y) {
     
@@ -32,7 +34,7 @@ print.BayesianMCPMod <- function (
   print(x$BayesianMCP)
   cat("\n")
   cat("Model Significance Frequencies\n")
-  print(c(avg = mean(model_success), model_success), ...)
+  print(model_success, ...)
   
   if (!is.na(attr(x$BayesianMCP, "ess_avg"))) {
     
@@ -53,7 +55,6 @@ print.BayesianMCP <- function (
   
 ) {
   
-  power <- mean(x[, 1])
   n_sim <- nrow(x)
   
   cat("Bayesian Multiple Comparison Procedure\n")
@@ -61,13 +62,14 @@ print.BayesianMCP <- function (
   if (n_sim == 1L) {
     
     attr(x, "crit_prob_adj") <- NULL
+    attr(x, "success_rate")  <- NULL
     class(x) <- NULL
     
     print.default(x, ...)
     
   } else {
     
-    cat("  Estimated Success Rate: ", power, "\n")
+    cat("  Estimated Success Rate: ", attr(x, "successRate"), "\n")
     cat("  N Simulations:          ", n_sim)
     
   }