align raw output

now we RIR_primary, RIR_supplemental, RIR_perc, fragility_primary, fragility_supplemental
konfound-project · Dec 8, 2023 · c70d30a · c70d30a
1 parent b144a9b
commit c70d30a
Show file tree

Hide file tree

Showing 4 changed files with 37 additions and 13 deletions.
diff --git a/R/helper_output_list.R b/R/helper_output_list.R
@@ -4,7 +4,9 @@ output_list <- function(obs_r, act_r,
                         delta_star, delta_star_restricted, delta_exact, delta_pctbias, 
                         cor_oster, cor_exact, 
                         beta_threshold, perc_bias_to_change, 
-                        RIR, RIR_perc, fragility, starting_table, final_table, 
+                        RIR_primary, RIR_supplemental, RIR_perc, 
+                        fragility_primary, fragility_supplemental,
+                        starting_table, final_table, 
                         user_SE, analysis_SE, 
                         Fig_ITCV, Fig_RIR) {
   result <- list(obs_r = obs_r,
@@ -27,9 +29,11 @@ output_list <- function(obs_r, act_r,
                  cor_exact = cor_exact, 
                  beta_threshold = beta_threshold, 
                  perc_bias_to_change = perc_bias_to_change, 
-                 RIR = RIR, 
+                 RIR_primary = RIR_primary, 
+                 RIR_supplemental = RIR_supplemental, 
                  RIR_perc = RIR_perc, 
-                 fragility = fragility, 
+                 fragility_primary = fragility_primary, 
+                 fragility_supplemental = fragility_supplemental, 
                  starting_table = starting_table, 
                  final_table = final_table, 
                  user_SE = user_SE,

diff --git a/R/test_sensitivity.R b/R/test_sensitivity.R
@@ -243,8 +243,8 @@ test_sensitivity <- function(est_eff,
                        cor_oster = NA, cor_exact = NA, 
                        beta_threshold = beta_threshold,
                        perc_bias_to_change = perc_to_change, 
-                       RIR = recase, RIR_perc = perc_to_change, 
-                       fragility = NA, 
+                       RIR_primary = recase, RIR_supplemental = NA, RIR_perc = perc_to_change, 
+                       fragility_primary = NA, fragility_supplemental = NA, 
                        starting_table = NA, final_table = NA,
                        user_SE = NA, analysis_SE = NA,  
                        Fig_ITCV = 

diff --git a/R/test_sensitivity_ln.R b/R/test_sensitivity_ln.R
@@ -150,24 +150,33 @@ test_sensitivity_ln <- function(est_eff,
     transferway <- "treatment success to treatment failure,"
     RIR <- ceiling(final/((a+c)/n_obs))*(replace=="entire") + ceiling(final/(a/(a+b)))*(1-(replace=="entire"))
     RIRway <- "treatment success"
+    RIR_pi <- RIR / d * 100
   }
   if (switch_trm && !dcroddsratio_ob) {
     transferway <- "treatment failure to treatment success,"
     RIR <- ceiling(final/((b+d)/n_obs))*(replace=="entire") + ceiling(final/(b/(a+b)))*(1-(replace=="entire"))
     RIRway <- "treatment failure"
+    RIR_pi <- RIR / c * 100
   }
   if (!switch_trm && dcroddsratio_ob) {
     transferway <- "control failure to control success,"
     RIR <- ceiling(final/((b+d)/n_obs))*(replace=="entire") + ceiling(final/(b/(a+b)))*(1-(replace=="entire"))
     RIRway <- "control failure"
+    RIR_pi <- RIR / a * 100
   }
   if (!switch_trm && !dcroddsratio_ob) {
     transferway <- "control success to control failure,"
     RIR <- ceiling(final/((a+c)/n_obs))*(replace=="entire") + ceiling(final/(a/(a+b)))*(1-(replace=="entire"))
     RIRway <- "control success"
+    RIR_pi <- RIR / b * 100
   }
 
+  RIR_extra <- final_extra <- NA
+
   if (final_solution$needtworows) {
+    # if need two rows, then do not report RIR_pi 
+    ## because denominator is tricky 
+    RIR_pi <- NA
     final_extra <- final_solution$final_extra
     if (switch_trm && dcroddsratio_ob) {
       transferway_extra <- "control failure to control success,"
@@ -296,9 +305,11 @@ test_sensitivity_ln <- function(est_eff,
                   cor_oster = NA, cor_exact = NA, 
                   beta_threshold = NA,
                   perc_bias_to_change = NA, 
-                  RIR = total_RIR, 
-                  RIR_perc = NA,  # need to discuss the denominator
-                  fragility = total_switch, 
+                  RIR_primary = RIR,
+                  RIR_supplemental = RIR_extra, 
+                  RIR_perc = RIR_pi,  # need to discuss the denominator
+                  fragility_primary = final,
+                  fragility_supplemental = final_extra,
                   starting_table = final_solution$table_start,
                   final_table = final_solution$table_final,
                   user_SE = user_std_err,

diff --git a/R/tkonfound.R b/R/tkonfound.R
@@ -63,7 +63,6 @@ tkonfound <- function(a, b, c, d,
   p_final <- solution$p_final
   taylor_pred <- solution$taylor_pred
   perc_bias_pred <- solution$perc_bias_pred
-  final_extra <- solution$final_extra
   total_switch <- solution$total_switch
 
   ### add column and row names to contingency tables
@@ -74,26 +73,34 @@ tkonfound <- function(a, b, c, d,
     transferway <- "treatment success to treatment failure"
     RIR <- ceiling(final/((a+c)/n_obs))*(replace=="entire") + ceiling(final/(a/(a+b)))*(1-(replace=="entire"))
     RIRway <- "treatment success"
+    RIR_pi <- RIR / d * 100
   }
   if (switch_trm && !dcroddsratio_ob) {
     transferway <- "treatment failure to treatment success"
     RIR <- ceiling(final/((b+d)/n_obs))*(replace=="entire") + ceiling(final/(b/(a+b)))*(1-(replace=="entire"))
     RIRway <- "treatment failure"
+    RIR_pi <- RIR / c * 100
   }
   if (!switch_trm && dcroddsratio_ob) {
     transferway <- "control failure to control success"
     RIR <- ceiling(final/((b+d)/n_obs))*(replace=="entire") + ceiling(final/(b/(a+b)))*(1-(replace=="entire"))
     RIRway <- "control failure"
+    RIR_pi <- RIR / a * 100
   }
   if (!switch_trm && !dcroddsratio_ob) {
     transferway <- "control success to control failure"
     RIR <- ceiling(final/((a+c)/n_obs))*(replace=="entire") + ceiling(final/(a/(a+b)))*(1-(replace=="entire"))
     RIRway <- "control success"
+    RIR_pi <- RIR / b * 100
   }
 
-  RIR_extra <- 0
+  RIR_extra <- final_extra <- NA
 
   if (allnotenough) {
+      # if need two rows, then do not report RIR_pi 
+      ## because denominator is tricky 
+      RIR_pi <- NA
+      final_extra <- solution$final_extra
     if (switch_trm && dcroddsratio_ob) {
       transferway_extra <- "control failure to control success"
       RIR_extra <- ceiling(final_extra/((b+d)/n_obs))*(replace=="entire") + 
@@ -207,9 +214,11 @@ tkonfound <- function(a, b, c, d,
                      cor_oster = NA, cor_exact = NA, 
                      beta_threshold = NA,
                      perc_bias_to_change = NA, 
-                     RIR = RIR + RIR_extra, 
-                     RIR_perc = NA,  # need to discuss the denominator
-                     fragility = total_switch, 
+                     RIR_primary = RIR,
+                     RIR_supplemental = RIR_extra, 
+                     RIR_perc = RIR_pi,  
+                     fragility_primary = final,
+                     fragility_supplemental = final_extra,
                      starting_table = table_start,
                      final_table = table_final,
                      user_SE = NA,