Better number print with big marks #18

Author: adayim

CRAN-SUBMISSION

@@ -1,3 +1,8 @@
+# consort 1.2.1
+
+-   Better numeric format in `gen_text`
+-   Bug in connection with `build_grviz`
+
 # consort 1.2.0
 
 -   Able to have multiple split with `grViz`

NEWS.md

@@ -59,7 +59,9 @@ gen_text <- function(x, label = NULL, bullet = FALSE) {
           if(is.data.frame(val)){
             r <- box_data.frame(val)
             if(!is.null(label)){
-              lab_lst <- sprintf("%s (n=%i)", label[indx], sum(!is.na(val[[1]])))
+              lab_lst <- sprintf("%s (n=%s)", 
+                                 label[indx], 
+                                 pret_num(sum(!is.na(val[[1]]))))
               r <- paste(lab_lst, r, sep = "\n")
             }
 
@@ -85,7 +87,7 @@ box_data.frame <- function(x, label = NULL){
     stop("only two columns are supported")
 
   if(!is.null(label))
-    label <- sprintf("%s (n=%i)", label, sum(!is.na(x[[1]])))
+    label <- sprintf("%s (n=%s)", label, pret_num(sum(!is.na(x[[1]]))))
 
   r <- sapply(na.omit(unique(x[[1]])), function(i){
     box_label(x[[2]][x[[1]] == i], label = i, bullet = TRUE)
@@ -115,15 +117,37 @@ box_label <- function(x, label, bullet = TRUE) {
   }
 
   if (is.null(label)) {
-    return(paste0(names(table(x)), " (n=", table(x), ")"))
+    if(is.factor(x))
+      tab <- table(droplevels(x))
+    else
+      tab <- table(x)
+
+    tp <- paste0(names(tab), " (n=", pret_num(tab), ")")
+    if(!bullet){
+      return(tp)
+    }else{
+      return(paste0("\u2022 ", paste(tp, collapse = "\n\u2022 ")))
+    }
+
   }
 
-  tp <- paste0(label, " (n=", sum(!is.na(x)), ")")
+  tp <- paste0(label, " (n=", pret_num(sum(!is.na(x))), ")")
 
   if (bullet) {
-    txt_sub <- paste0("\u2022 ", names(table(x)), " (n=", table(x), ")")
+    if(is.factor(x))
+      tab <- table(droplevels(x))
+    else
+      tab <- table(x)
+    txt_sub <- paste0("\u2022 ", names(tab), " (n=", pret_num(tab), ")")
     tp <- paste0(tp, ":\n", paste(txt_sub, collapse = "\n"))
   }
 
   return(tp)
 }
+
+
+# Format numbers
+#' @keywords internal
+pret_num <- function(x){
+  prettyNum(x, big.mark = ",", preserve.width = "none", scientific = FALSE)
+}

R/gen_text.R

@@ -0,0 +1,66 @@
+digraph consort_diagram {
+  graph [layout = dot]
+
+
+
+
+
+# node definitions with substituted label text
+  node [shape = rectangle, fillcolor = Biege, style="", fillcolor = "", color = ""]
+
+node1 [label = "Cohort 1 (n=6)"]
+node2 [label = "Cohort 2 (n=6)"]
+node3 [label = "Cohort 3 (n=6)"]
+node4 [label = "Excluded (n=1)\l"]
+node5 [label = "Excluded (n=3)\l"]
+node7 [label = "Cohort 1 (n=5)"]
+node8 [label = "Cohort 2 (n=3)"]
+node10 [label = "Total (n=14)"]
+
+
+## Invisible point node for joints
+
+node [shape = point, width = 0]
+
+P1 P2 P3 P4 P5
+
+subgraph {
+  rank = same; rankdir = LR; node1; node2; node3;
+  }
+subgraph {
+  rank = same; rankdir = LR; P1; node4;
+  }
+subgraph {
+  rank = same; rankdir = LR; node7; node8; node9;
+  }
+subgraph {
+  rank = same; rankdir = LR; node4; node5; node6;
+  }
+subgraph {
+  rank = same; rankdir = LR; P2; node5;
+  }
+subgraph {
+  rank = same; rankdir = LR; node4; node5;
+  }
+subgraph {
+  rank = same; rankdir = LR; P3; P4; P5;
+  }
+
+edge[style=""];
+
+node1 -> P1 [arrowhead = none];
+P1 -> node4;
+P1 -> node7;
+node2 -> P2 [arrowhead = none];
+P2 -> node5;
+P2 -> node8;
+P4 -> node10;
+node7 -> P3 [arrowhead = none];
+node8 -> P4 [arrowhead = none];
+node9 -> P5 [arrowhead = none];
+P3 -> P4 -> P5 [arrowhead = none, minlen = 10];
+
+node3 -> node9 [arrowhead = none];
+
+
+}

tests/testthat/_snaps/build_grviz/empty-middle-grviz.gv

@@ -13,6 +13,13 @@ test_that("Generate text for the consort", {
     label = "Cars in the data",
     bullet = TRUE
   )
+  
+  tx7 <- gen_text(split(val$car, val$am),
+                  bullet = TRUE
+  )
+  
+  expect_equal(tx7, sub(".*?\\n", "", tx2))
+  
   tx3 <- gen_text(val$am)
   tx4 <- gen_text(rep("", 4), bullet = TRUE)
 
@@ -54,4 +61,5 @@ test_that("Generate text for the consort", {
            sum(tab6["V-shaped",]), "):")
   )
 
+  
 })