updated npRCT functions with additional power computation for ANOVA a…

…nd chisquare tests. Included summary function

npRCT_functions.R

@@ -3,22 +3,21 @@
 # --------------------------------------------
 
 
-
+# --------------t.test eqivalent--------------
 npRCT.pwr.t.test <- function(d1 = 0.5, d2 = 0.5, 
                             sig.level1 = 0.05, sig.level2 = 0.05,
                             power1 = 0.8, power2 = 0.8, 
                             type1 = "two.sample", type2 = "two.sample", 
-                            alternative1 = "two.sided", alternative2 = "two.sided",
-                            suppressInfo = FALSE)    {
+                            alternative1 = "two.sided", alternative2 = "two.sided")    {
 
     # Load required package
     require("pwr")
 
-    # Run power calculation for first t-test (traditional part of RCST)
+    # Run power calculation for first t-test (traditional part of npRCT)
     t1 <- pwr.t.test(d = d1, sig.level = sig.level1, power = power1, type = type1, 
                      alternative = alternative1)
 
-    # Run power calculation for second t-test (stratified part of RCST)
+    # Run power calculation for second t-test (stratified part of npRCT)
     t2 <- pwr.t.test(d = d2, sig.level = sig.level2, power = power2, type = type2, 
                      alternative = alternative2)
 
@@ -27,18 +26,140 @@ npRCT.pwr.t.test <- function(d1 = 0.5, d2 = 0.5,
     n2 = t2$n
     n2_rct = ceiling(n2 / 2) # n still traditionally randomised in stratified part
 
-    n_strat = n1 - n2_rct
-    n_total = n_strat + n2
+    n_trad = n1 - n2_rct
+    n_total = n_trad + n2
 
     # Create output
-    output = data.frame(n_strat = n_strat,
-                        n_total = n_total)
+    output = structure(list(call = "npRCT t.test based Power Calculation",
+                            n1 = n1, n2 = n2, d1 = d1, d2 = d2, 
+                            sig.level1 = sig.level1, sig.level2 = sig.level2, 
+                            power1 = power1, 
+                            alternative1 = alternative1,
+                            alternative2 = alternative2,
+                            note = "Please note that sample sizes are provided for *each* group", 
+                            n_trad = n_trad,
+                            n_prec = ceiling(n2),
+                            n_total = n_total), 
+                       class = "npRCT.pwr.test")
 
-    # Information message for output
-    if(suppressInfo == FALSE) {
-        cat("Find here sample sizes per group for the time point\nof stratification (=n_strat) as well as for the complete\nRandomised Controlled Stratified Trial (=n_total)\n\n")
-    }
+    # End function by returning the output data.frame
+    return(output)
+}
+
+
+# --------------anova eqivalent---------------
+npRCT.pwr.anova.test <- function(f1 = 0.5, d2 = 0.5, k = 3,
+                             sig.level1 = 0.05, sig.level2 = 0.05,
+                             power1 = 0.8, power2 = 0.8, 
+                             type2 = "two.sample", alternative2 = "two.sided")    {
+
+    # Load required package
+    require("pwr")
+
+    # Run power calculation for first t-test (traditional part of npRCT)
+    anova1 <- pwr.anova.test(k = k, f = f1, sig.level = sig.level1, power = power1)
+
+    # Run power calculation for second t-test (stratified part of npRCT)
+    t2 <- pwr.t.test(d = d2, sig.level = sig.level2, power = power2, type = type2, 
+                     alternative = alternative2)
+
+    # Compute sample sizes (per group)
+    n1 = ceiling(anova1$n)
+    n2 = t2$n
+    n2_rct = ceiling(n2 / k) # n still traditionally randomised in stratified part
+
+    n_trad = n1 - n2_rct
+    n_total = n_trad + n2
+
+    # Create output
+    output = structure(list(call = "npRCT ANOVA based Power Calculation",
+                            n1 = n1, n2 = n2, f1 = f1, d2 = d2, 
+                            sig.level1 = sig.level1, sig.level2 = sig.level2, 
+                            power1 = power1, power2 = power2,
+                            alternative2 = alternative2,
+                            n_trad = n_trad,
+                            n_prec = ceiling(n2),
+                            n_total = n_total), 
+                       class = "npRCT.pwr.test")
 
     # End function by returning the output data.frame
     return(output)
 }
+
+
+
+
+# --------------quisquare eqivalent----------
+npRCT.pwr.chisq.test <- function(w1 = 0.5, w2 = 0.5, 
+                                 k = 2, # number of groups
+                                 ycat = 2, # number of outcome variable categories
+                             sig.level1 = 0.05, sig.level2 = 0.05,
+                             power1 = 0.8, power2 = 0.8, 
+                             suppressInfo = FALSE)    {
+
+    # Load required package
+    require("pwr")
+
+    # Run power calculation for first chisquare-test (traditional part of npRCT)
+    chisq1 <- pwr.chisq.test(w = w1, sig.level = sig.level1, 
+                             power = power1, df = (k-1)*(ycat-1))
+
+    # Run power calculation for second chisquare-test (stratified part of npRCT)
+    chisq2 <- pwr.chisq.test(w = w2, sig.level = sig.level2, 
+                             power = power2, df = (ycat-1))
+
+    # Compute sample sizes (per group)
+    n1 = ceiling(chisq1$N / k)
+    n2 = chisq2$N / 2
+    n2_rct = ceiling(n2 / k) # n still traditionally randomised in stratified part
+
+    n_trad = n1 - n2_rct
+    n_total = ceiling(n_trad + n2)
+
+    # Create output
+    output = structure(list(call = "npRCT chisq test based Power Calculation",
+                            n1 = n1, n2 = n2, w1 = w1, w2 = w2, 
+                            sig.level1 = sig.level1, sig.level2 = sig.level2, 
+                            power1 = power1, power2 = power2,
+                            k = k, ycat = ycat,
+                            n_trad = n_trad,
+                            n_prec = ceiling(n2),
+                            n_total = n_total), 
+                       class = "npRCT.pwr.test")
+
+
+    # End function by returning the output data.frame
+    return(output)
+
+
+}
+
+
+
+# ----------------Summary function----------------
+
+summary.npRCT.pwr.test <- function(x, ...) {
+
+    # General summary of sample sizes
+    cat("\nCall:\n")
+    cat(x$call)
+    cat("\n\n")
+    cat("Sample sizes of npRCT\n")
+    cat("Total n (*across* groups):\n")
+    cat(paste0(x$n_total * 2, "\n"))
+    cat("\nTraditional RCT n (*each* group):\n")
+    cat(paste0(x$n_trad, "\n"))
+    cat("\nPrecision RCT n (*each* group):\n")
+    cat(paste0(x$n_prec, "\n"))
+    cat("\n")
+    # Note/ warning if Traditional RCT n is too small
+    if(x$n_trad <= 0)   {
+        warning("You have obtained a negative sample size for the traditional RCT. This occurs, if the to-be-detected effect of the precision RCT is much smaller than for the traditional RCT (i.e., all participants required for testing the traditional research question (intervention A or B) are recruited as part of the precision RCT. If you want to use the npRCT, please adjust parameters accordingly and visit the Explanations tab for more insights on practical considerations.")
+    } else if(x$n_trad <= 20)  {
+        cat("Please note that the sample size (per group) of the traditional RCT is relatively small (i.e., smaller than 20). If you aim for online identification of a precision algorithm, you may need to adjust your parameters.")
+    }
+
+    invisible(x)
+}
+
+