De-duplicate test value column names

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: graphicalMCP
 Title: Graphical Multiple Comparison Procedures
-Version: 0.1.0
+Version: 0.1.1
 Authors@R: c(
     person("Dong", "Xi", , "[email protected]", role = c("aut", "cre")),
     person("Ethan", "Brockmann", , "[email protected]", role = "aut"),

NEWS.md

@@ -1,3 +1,7 @@
 # graphicalMCP 0.1.0
 
 * First release
+
+# graphicalMCP 0.1.1
+
+* De-duplicate test values column names (#75)

R/graph_rejection_orderings.R

@@ -44,7 +44,7 @@ graph_rejection_orderings <- function(shortcut_test_result) {
     rev(expand.grid(rep(list(rejected), length(rejected)))),
     1,
     function(row) {
-      if (length(unique(row)) == length(row)){
+      if (length(unique(row)) == length(row)) {
         structure(row, names = hyp_names[row])
       } else {
         NULL
@@ -61,7 +61,6 @@ graph_rejection_orderings <- function(shortcut_test_result) {
     intermediate_graph <- graph
 
     for (hyp_num in hyp_ordering) {
-
       if (p[[hyp_num]] <= intermediate_graph$hypotheses[[hyp_num]] * alpha) {
         intermediate_graph <-
           graph_update(intermediate_graph, hyp_num)$updated_graph

R/graph_test_closure.R

@@ -314,7 +314,8 @@ graph_test_closure <- function(graph,
     # "c" value is only used in parametric testing, so there's no need to
     # include this column when there are no parametric groups
     if (!any(test_types == "parametric")) {
-      df_test_values[c("c_value", "*")] <- NULL
+      df_test_values[c("c_value", "*_a")] <- NULL
+      names(df_test_values)[names(df_test_values) == "*_b"] <- "*"
     }
   }
 

R/graph_test_shortcut.R

@@ -146,7 +146,7 @@ graph_test_shortcut <- function(graph,
       # algorithm")
       names(test_values_step)[[1]] <- "Step"
       test_values_step$Step <- step_num
-      test_values_step[c("Test", "c_value", "*")] <- NULL
+      test_values_step[c("Test", "c_value", "*_a")] <- NULL
 
       df_test_values <- rbind(df_test_values, test_values_step)
 

R/plot.initial_graph.R

@@ -64,23 +64,23 @@
 #'
 #' epsilon <- 1e-5
 #' transitions <- rbind(
-#'   c(0,       0.5,     0.25,        0,    0.25, 0),
-#'   c(0.5,     0,       0,           0.25, 0,    0.25),
-#'   c(0,       0,       0,           0,    1,    0),
-#'   c(epsilon, 0,       0,           0,    0,    1 - epsilon),
-#'   c(0,       epsilon, 1 - epsilon, 0,    0,    0),
-#'   c(0,       0,       0,           1,    0,    0)
+#'   c(0, 0.5, 0.25, 0, 0.25, 0),
+#'   c(0.5, 0, 0, 0.25, 0, 0.25),
+#'   c(0, 0, 0, 0, 1, 0),
+#'   c(epsilon, 0, 0, 0, 0, 1 - epsilon),
+#'   c(0, epsilon, 1 - epsilon, 0, 0, 0),
+#'   c(0, 0, 0, 1, 0, 0)
 #' )
 #'
 #' g <- graph_create(hypotheses, transitions)
 #'
 #' plot_layout <- rbind(
 #'   c(.15, .5),
 #'   c(.65, .5),
-#'   c(  0,  0),
-#'   c( .5,  0),
-#'   c( .3,  0),
-#'   c( .8,  0)
+#'   c(0, 0),
+#'   c(.5, 0),
+#'   c(.3, 0),
+#'   c(.8, 0)
 #' )
 #'
 #' plot(g, layout = plot_layout, eps = epsilon, edge_curves = c(pairs = .5))

R/print.graph_report.R

@@ -199,6 +199,8 @@ print.graph_report <- function(x, ..., precision = 4, indent = 2, rows = 10) {
         format(as.numeric(num_col), digits = precision)
       }
     )
+
+    names(crit_res)[grep("\\*_", names(crit_res))] <- "*"
     if (any(x$inputs$test_types == "parametric")) {
       crit_res$c_value <- ifelse(
         trimws(crit_res$c_value) == "NA",

R/test_values.R

@@ -37,9 +37,9 @@ test_values_bonferroni <- function(p, hypotheses, alpha, intersection = NA) {
       p = p,
       "<=" = "<=",
       c_value = "",
-      "*" = "",
+      "*_a" = "",
       Weight = hypotheses,
-      "*" = "*",
+      "*_b" = "*",
       Alpha = alpha,
       Inequality_holds = ifelse(
         p == 0 & hypotheses == 0,
@@ -69,9 +69,9 @@ test_values_parametric <- function(p,
       p = p,
       "<=" = "<=",
       c_value = c_value,
-      "*" = "*",
+      "*_a" = "*",
       Weight = hypotheses,
-      "*" = "*",
+      "*_b" = "*",
       Alpha = alpha,
       Inequality_holds = ifelse(
         p == 0 & hypotheses == 0,
@@ -103,9 +103,9 @@ test_values_simes <- function(p, hypotheses, alpha, intersection = NA) {
       p = p,
       "<=" = "<=",
       c_value = "",
-      "*" = "",
+      "*_a" = "",
       Weight = w_sum,
-      "*" = "*",
+      "*_b" = "*",
       Alpha = alpha,
       Inequality_holds = ifelse(
         p == 0 & w_sum == 0,

tests/testthat/test-graph_test_closure.R

@@ -308,7 +308,6 @@ test_that("compare adjusted p-values to lrstat - Bonferroni & Simes", {
         ignore_attr = TRUE
       )
     }
-
   }
 })
 

vignettes/closed-testing.Rmd

@@ -80,12 +80,12 @@ Given a set of p-values for $H_1, \ldots, H_6$, the graphical multiple compariso
 ```{r graph-test-bonferroni}
 p_values <- c(0.015, 0.013, 0.01, 0.007, 0.1, 0.0124)
 test_results <- graph_test_closure(
-  g, 
-  p = p_values, 
-  alpha = 0.025, 
-  verbose = TRUE, 
+  g,
+  p = p_values,
+  alpha = 0.025,
+  verbose = TRUE,
   test_values = TRUE
-  )
+)
 
 test_results$outputs$adjusted_p
 
@@ -203,7 +203,7 @@ sample_size <- rep(200, 3)
 
 unpooled_variance <-
   prop[-1] * (1 - prop[-1]) / sample_size[-1] +
-  prop[1]  * (1 - prop[1])  / sample_size[1]
+  prop[1] * (1 - prop[1]) / sample_size[1]
 
 noncentrality_parameter_primary <-
   -(prop[-1] - prop[1]) / sqrt(unpooled_variance)
@@ -230,7 +230,7 @@ variance <- sd[-1]^2 / sample_size[-1] + sd[1]^2 / sample_size[1]
 
 noncentrality_parameter_se1 <-
   (mean_change_se1[-1] - mean_change_se1[1]) /
-  sqrt(variance)
+    sqrt(variance)
 
 marginal_power_se1 <- pnorm(
   qnorm(alpha, lower.tail = FALSE),
@@ -246,7 +246,7 @@ mean_change_se2 <- c(6, 8, 9)
 
 noncentrality_parameter_se2 <-
   (mean_change_se2[-1] - mean_change_se2[1]) /
-  sqrt(variance)
+    sqrt(variance)
 
 marginal_power_se2 <- pnorm(
   qnorm(alpha, lower.tail = FALSE),
@@ -309,20 +309,20 @@ These are the default outputs from the `graph_calculate_power` function. In addi
 success_fns <- list(
   # Probability to reject H1
   H1 = function(x) x[1],
-  
+
   # Expected number of rejections
   `Expected no. of rejections` =
     function(x) x[1] + x[2] + x[3] + x[4] + x[5] + x[6],
 
   # Probability to reject at least one hypothesis
   `AtLeast1` = function(x) x[1] | x[2] | x[3] | x[4] | x[5] | x[6],
-  
+
   # Probability to reject all hypotheses
   `All` = function(x) x[1] & x[2] & x[3] & x[4] & x[5] & x[6],
-  
+
   # Probability to reject both H1 and H2
   `H1andH2` = function(x) x[1] & x[2],
-  
+
   # Probability to reject all hypotheses for the low dose or the high dose
   `(H1andH3andH5)or(H2andH4andH6)` <-
     function(x) (x[1] & x[3] & x[5]) | (x[2] & x[4] & x[6])

vignettes/comparisons.Rmd

@@ -60,11 +60,11 @@ for (i in 1:1000) {
   graph <- random_graph(5)
   graphicalmcp_weights <- graphicalMCP::graph_generate_weights(graph)
   dimnames(graphicalmcp_weights) <- list(NULL, NULL)
-  gmcp_weights <- 
+  gmcp_weights <-
     gMCP::generateWeights(graph$transitions, graph$hypotheses)
   gmcp_weights <- gmcp_weights[nrow(gmcp_weights):1, ] # Reorder rows
   identical <- c(
-    identical, 
+    identical,
     all.equal(gmcp_weights, graphicalmcp_weights, tolerance = 1e-7)
   )
 }
@@ -83,12 +83,12 @@ identical <- NULL
 for (i in 1:10000) {
   graph <- random_graph(5)
   p <- runif(5, 0, alpha)
-  graphicalmcp_test_shortcut <- 
+  graphicalmcp_test_shortcut <-
     graph_test_shortcut(graph, p, alpha = alpha)$outputs$adjusted_p
-  gmcp_test_shortcut <- 
+  gmcp_test_shortcut <-
     gMCP(as_graphMCP(graph), p, alpha = alpha)@adjPValues
   identical <- c(
-    identical, 
+    identical,
     all.equal(graphicalmcp_test_shortcut, gmcp_test_shortcut, tolerance = 1e-7)
   )
 }
@@ -110,9 +110,9 @@ for (i in 1:1000) {
   graph <- random_graph(5)
   marginal_power <- runif(5, 0.5, 0.9)
   noncentrality_parameter <-
-  qnorm(1 - 0.025, lower.tail = TRUE) -
-  qnorm(1 - marginal_power, lower.tail = TRUE)
-  
+    qnorm(1 - 0.025, lower.tail = TRUE) -
+    qnorm(1 - marginal_power, lower.tail = TRUE)
+
   set.seed(1234 + i - 1)
   graphicalmcp_power <- rbind(
     graphicalmcp_power,
@@ -124,7 +124,7 @@ for (i in 1:1000) {
       sim_n = 2^17
     )$power$power_local
   )
-  
+
   set.seed(1234 + i - 1)
   gmcp_power <- rbind(
     gmcp_power,
@@ -143,7 +143,7 @@ diff <- data.frame(
   rbind(graphicalmcp_power, gmcp_power),
   procedure = rep(c("graphicalMCP", "gMCP"), each = nrow(graphicalmcp_power))
 )
-  
+
 write.csv(
   diff,
   here::here("vignettes/cache/comparisons_power_shortcut.csv"),
@@ -156,10 +156,10 @@ gmcp_power <- subset(diff, procedure == "gMCP")
 round(
   max(
     abs(
-      graphicalmcp_power[, - ncol(graphicalmcp_power)] - 
-        gmcp_power[, - ncol(gmcp_power)]
-      )
-    ),
+      graphicalmcp_power[, -ncol(graphicalmcp_power)] -
+        gmcp_power[, -ncol(gmcp_power)]
+    )
+  ),
   4
 ) # Maximum difference in local power among 1000 cases
 ```
@@ -191,8 +191,8 @@ test_corr <- rbind(
 for (i in 1:10000) {
   p <- runif(4, 0, alpha)
   graphicalmcp_test_parametric <- graph_test_closure(
-    graph, 
-    p, 
+    graph,
+    p,
     alpha = alpha,
     test_groups = list(1:2, 3:4),
     test_types = c("parametric", "bonferroni"),
@@ -205,7 +205,7 @@ for (i in 1:10000) {
     correlation = test_corr
   )@adjPValues
   identical <- c(
-    identical, 
+    identical,
     all.equal(graphicalmcp_test_parametric, gmcp_test_parametric, tolerance = 1e-7)
   )
 }
@@ -241,7 +241,7 @@ for (i in 1:100) {
   marginal_power <- runif(4, 0.5, 0.9)
   noncentrality_parameter <-
     qnorm(1 - 0.025, lower.tail = TRUE) -
-      qnorm(1 - marginal_power, lower.tail = TRUE)
+    qnorm(1 - marginal_power, lower.tail = TRUE)
 
   set.seed(1234 + i - 1)
   graphicalmcp_power_parametric <- rbind(
@@ -257,7 +257,7 @@ for (i in 1:100) {
       sim_n = 2^14
     )$power$power_local
   )
-  
+
   set.seed(1234 + i - 1)
   gmcp_power_parametric <- rbind(
     gmcp_power_parametric,
@@ -277,7 +277,7 @@ diff <- data.frame(
   rbind(graphicalmcp_power_parametric, gmcp_power_parametric),
   procedure = rep(c("graphicalMCP", "gMCP"), each = nrow(gmcp_power_parametric))
 )
-  
+
 write.csv(
   diff,
   here::here("vignettes/cache/comparisons_power_parametric.csv"),
@@ -290,10 +290,10 @@ gmcp_power <- subset(diff, procedure == "gMCP")
 round(
   max(
     abs(
-      graphicalmcp_power_parametric[, - ncol(graphicalmcp_power_parametric)] - 
-        gmcp_power_parametric[, - ncol(gmcp_power)]
-      )
-    ), 4
+      graphicalmcp_power_parametric[, -ncol(graphicalmcp_power_parametric)] -
+        gmcp_power_parametric[, -ncol(gmcp_power)]
+    )
+  ), 4
 ) # Maximum difference in local power among 100 cases
 ```
 
@@ -324,8 +324,8 @@ family <- rbind(
 for (i in 1:10000) {
   p <- runif(4, 0, alpha)
   graphicalmcp_test_simes <- graph_test_closure(
-    graph, 
-    p, 
+    graph,
+    p,
     alpha = alpha,
     test_groups = list(1:2, 3:4),
     test_types = c("simes", "bonferroni")
@@ -336,10 +336,10 @@ for (i in 1:10000) {
       fwgtmat(graph$hypotheses, graph$transitions),
       p,
       family
-  )
-  
+    )
+
   identical <- c(
-    identical, 
+    identical,
     all.equal(graphicalmcp_test_simes, lrstat_test_simes, tolerance = 1e-7)
   )
 }