75 two columns of the same name in parametric test values

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,8 @@
 # graphicalMCP 0.1.0
 
 * First release
+
+# graphicalMCP 0.1.1
+
+* Added compilation of vignettes (#73)
+* De-duplicated test values column names (#75)

R/as_graph.R

@@ -45,10 +45,10 @@ as_initial_graph.igraph <- function(graph) {
   hypotheses <- igraph::vertex_attr(graph, "weight")
   names(hypotheses) <- igraph::vertex_attr(graph, "name")
 
-  transitions <- matrix(0, length(graph), length(graph))
-  dimnames(transitions) <- rep(list(igraph::vertex_attr(graph, "name")), 2)
+  transitions <- matrix(0, length(hypotheses), length(hypotheses))
+  dimnames(transitions) <- rep(list(names(hypotheses)), 2)
 
-  for (tail in seq_along(graph)) {
+  for (tail in seq_along(hypotheses)) {
     transitions[tail, ] <- graph[tail]
   }
 

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

@@ -309,12 +309,10 @@ graph_test_closure <- function(graph,
     df_test_values <- do.call(rbind, test_values_list)
     rownames(df_test_values) <- NULL
 
-
-
     # "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*")] <- NULL
     }
   }
 

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*")] <- NULL
 
       df_test_values <- rbind(df_test_values, test_values_step)
 
@@ -161,6 +161,7 @@ graph_test_shortcut <- function(graph,
         step_graph <- graph_after_rejections
       }
     }
+    rownames(df_test_values) <- NULL
   }
 
   # Build the report -----------------------------------------------------------

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.15, 0.5),
+#'   c(0.65, 0.5),
+#'   c(0, 0),
+#'   c(0.5, 0),
+#'   c(0.3, 0),
+#'   c(0.8, 0)
 #' )
 #'
 #' plot(g, layout = plot_layout, eps = epsilon, edge_curves = c(pairs = .5))

R/print.graph_report.R

@@ -186,9 +186,9 @@ print.graph_report <- function(x, ..., precision = 4, indent = 2, rows = 10) {
     section_break("Detailed test values ($test_values)")
 
     if (any(x$inputs$test_types == "parametric")) {
-      num_cols <- c("p", "c_value", "Weight", "Alpha")
+      num_cols <- c("p", "c_value*", "Weight*", "Alpha")
     } else {
-      num_cols <- c("p", "Weight", "Alpha")
+      num_cols <- c("p", "Weight*", "Alpha")
     }
 
     crit_res <- x$test_values$results
@@ -200,10 +200,10 @@ print.graph_report <- function(x, ..., precision = 4, indent = 2, rows = 10) {
       }
     )
     if (any(x$inputs$test_types == "parametric")) {
-      crit_res$c_value <- ifelse(
-        trimws(crit_res$c_value) == "NA",
+      crit_res$"c_value*" <- ifelse(
+        trimws(crit_res$"c_value*") == "NA",
         "",
-        crit_res$c_value
+        crit_res$"c_value*"
       )
     }
 

R/test_values.R

@@ -36,10 +36,8 @@ test_values_bonferroni <- function(p, hypotheses, alpha, intersection = NA) {
       Test = "bonferroni",
       p = p,
       "<=" = "<=",
-      c_value = "",
-      "*" = "",
-      Weight = hypotheses,
-      "*" = "*",
+      "c_value*" = "",
+      "Weight*" = hypotheses,
       Alpha = alpha,
       Inequality_holds = ifelse(
         p == 0 & hypotheses == 0,
@@ -68,10 +66,8 @@ test_values_parametric <- function(p,
       Test = "parametric",
       p = p,
       "<=" = "<=",
-      c_value = c_value,
-      "*" = "*",
-      Weight = hypotheses,
-      "*" = "*",
+      "c_value*" = c_value,
+      "Weight*" = hypotheses,
       Alpha = alpha,
       Inequality_holds = ifelse(
         p == 0 & hypotheses == 0,
@@ -102,10 +98,8 @@ test_values_simes <- function(p, hypotheses, alpha, intersection = NA) {
       Test = "simes",
       p = p,
       "<=" = "<=",
-      c_value = "",
-      "*" = "",
-      Weight = w_sum,
-      "*" = "*",
+      "c_value*" = "",
+      "Weight*" = w_sum,
       Alpha = alpha,
       Inequality_holds = ifelse(
         p == 0 & w_sum == 0,