Update with new configurations

DESCRIPTION

@@ -21,7 +21,7 @@ Suggests:
     covr,
     stringi
 VignetteBuilder: knitr
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.3
 Config/testthat/edition: 3
 Depends: 
     R (>= 2.10)

NAMESPACE

@@ -5,6 +5,7 @@ S3method(makeContent,textbox)
 S3method(makeContext,textbox)
 S3method(plot,consort)
 S3method(print,consort)
+S3method(print,consort_defaults)
 S3method(widthDetails,textbox)
 S3method(xDetails,textbox)
 S3method(yDetails,textbox)
@@ -17,9 +18,12 @@ export(build_grviz)
 export(connect_box)
 export(consort_plot)
 export(gen_text)
+export(get_consort_defaults)
 export(get_coords)
 export(grid.textbox)
+export(init_consort_defaults)
 export(move_box)
+export(set_consort_defaults)
 export(textbox)
 import(grid)
 importFrom(stats,na.omit)

NEWS.md

@@ -1,3 +1,11 @@
+# consort 1.2.3
+
+-   Allow user configuration of arrow graphical parameters and padding with `set_consort_defaults()`.
+-   Allow custom bullet characters
+-   Figure styles will also be applied to grViz plot.
+-   Improved documentation. 
+-   Special thanks to @Ramsas88
+
 # consort 1.2.2
 
 -   Use comma separators for large number. 

R/add_label_box.R

@@ -10,7 +10,8 @@
 #' @param only_terminal If the txt is only for the terminal box, default. Otherwise, the side box will
 #' also be accounted for.
 #' @param just The justification for the text: center (default), left or right.
-#' @param ... Other parameters pass to \link{textbox},
+#' @param box_fn The function to create the box grob. Default is \code{\link[grid]{roundrectGrob}}.
+#' @param ... Other parameters pass to \link{textbox}. 
 #'
 #' @export
 #' @seealso \code{\link{add_side_box}} \code{\link{add_split}} \code{\link{textbox}} 
@@ -24,6 +25,7 @@ add_label_box <- function(prev_box,
                           txt,
                           only_terminal = TRUE,
                           just = c("center", "left", "right"),
+                          box_fn = roundrectGrob,
                           ...) {
 
   just <- match.arg(just)
@@ -47,13 +49,20 @@ add_label_box <- function(prev_box,
     stop("prev_box must be consort object")
   }
 
-  cex <- ifelse("cex" %in% names(getOption("txt_gp")), getOption("txt_gp")$cex, 1)
+  if(!"txt_gp" %in% names(dots)){
+    dots$txt_gp <- consort_opt("label_txt_gp")
+  }
+
+  if(!"box_gp" %in% names(dots)){
+    dots$box_gp <- consort_opt("label_box_gp")
+  }
+
   # Set default values
   args_list <- list()
   # args_list$text <- txt
-  args_list$txt_gp <- gpar(col = "#4F81BD", cex = cex, fontface = "bold")
-  args_list$box_gp <- gpar(fill = "#A9C7FD")
-  args_list$box_fn <- roundrectGrob
+  # args_list$txt_gp <- label_txt_gp
+  # args_list$box_gp <- label_box_gp
+  # args_list$box_fn <- roundrectGrob
   args_list$name <- "label"
 
   args_list <- modifyList(args_list, dots)

R/build_grviz.R

@@ -41,19 +41,17 @@ build_grviz <- function(x) {
     label_plot <- x[grepl("label", names(x))]
 
     lab_txt <- lapply(names(label_plot), function(x){
-      txt_lab <- mk_text_align(label_plot[[x]]$text, label_plot[[x]]$just)
+      box <- label_plot[[x]]$box
+      grviz_style <- gpar_to_grviz_attrs(box$txt_gp, box$box_gp, box$box_fn)
+      txt_lab <- mk_text_align(label_plot[[x]]$text, label_plot[[x]]$just,
+                               grviz_style = grviz_style)
       c(nam = x,
         node = paste(x, txt_lab),
         pos = label_plot[[x]]$prev_node)
     })
     lab_txt <- do.call(rbind, lab_txt)
-
-    lab_gpar <- label_plot[[1]]$gpar
-
-    lab_nd <- sprintf("node [shape = rectangle, style = \"rounded,filled\", fillcolor = \"%s\" color = \"%s\"]\n%s\n",
-                      lab_gpar$box_gp$fill, 
-                      lab_gpar$txt_gp$col, 
-                      paste(lab_txt[,"node"], collapse = "\n"))
+
+    lab_nd <- paste(lab_txt[,"node"], collapse = "\n")
     lab_edge <- sprintf("edge[style=invis];\n%s;\n", 
                         paste(lab_txt[,"nam"], collapse = " -> "))
     lab_rnk <- nodes_layout[as.numeric(lab_txt[,"pos"])]
@@ -80,8 +78,11 @@ build_grviz <- function(x) {
   main_txt <- lapply(names(consort_plot), function(nd){
     text <- consort_plot[[nd]]$text
     just <- consort_plot[[nd]]$just
-    txt_lab <- mk_text_align(text, just)
-    c(nam = nd, text = text, just = just, node = paste(nd, txt_lab))
+    box <- consort_plot[[nd]]$box
+    grviz_style <- gpar_to_grviz_attrs(box$txt_gp, box$box_gp, box$box_fn)
+    style_str <- if(is.null(grviz_style)) "" else grviz_style
+    txt_lab <- mk_text_align(text, just, grviz_style = grviz_style)
+    c(nam = nd, text = text, just = just, grviz_style = style_str, node = paste(nd, txt_lab))
   })
   main_txt <- do.call(rbind, main_txt)
   # Remove empty label
@@ -282,21 +283,26 @@ build_grviz <- function(x) {
 
   # Build dot
 
+  # Edge attributes from arrow settings
+  edge_attrs <- arrow_to_grviz_attrs(consort_opt("arrow_gp"),
+                                     consort_opt("arrow_type"),
+                                     consort_opt("arrow_length"))
+  edge_stmt <- sprintf("edge[%s];", edge_attrs)
+
   grviz_txt <- paste("digraph consort_diagram {
   graph [layout = dot, splines=ortho]",
+  "node [shape = rectangle]",
   lab_nd,
   lab_edge,
-  "# node definitions with substituted label text
-  node [shape = rectangle, fillcolor = Biege, style=\"\", fillcolor = \"\", color = \"\"]",
-  paste(main_txt[,"node"], collapse = "\n"), # Node 
+  "# node definitions with substituted label text",
+  paste(main_txt[,"node"], collapse = "\n"), # Node
   "\n## Invisible point node for joints",
   "node [shape = point, width = 0, style=invis]",
-  paste(inv_nd, collapse = "\n"),             # Invisible node 
+  paste(inv_nd, collapse = "\n"),             # Invisible node
   paste(rnk_nd, collapse = "\n"),            # Ranks
-  "edge[style=\"\"];",
+  edge_stmt,
   paste(con_nd, collapse = "\n"),            # Connections
   "\n}\n",
-  # paste(main_txt[,"txt"], collapse = "\n"),  # Text 
   sep = "\n\n")
 
   return(grviz_txt)
@@ -308,15 +314,18 @@ build_grviz <- function(x) {
 #' @keywords internal
 
 update_node_label <- function(main_txt, node, group_name){
-  
+
   for(j in seq_along(node)){
     idx_row <- main_txt[,1] == node[j]
+    style <- main_txt[idx_row, "grviz_style"]
+    if(nchar(style) == 0) style <- NULL
     main_txt[idx_row, "node"] <- paste(node[j],
-                                       mk_text_align(main_txt[idx_row, "text"], 
+                                       mk_text_align(main_txt[idx_row, "text"],
                                                      main_txt[idx_row, "just"],
-                                                     group = group_name[j]))
+                                                     group = group_name[j],
+                                                     grviz_style = style))
   }
-  
+
   return(main_txt)
 }
 

R/connect_box.R

@@ -15,14 +15,12 @@
 #' will be started in the middle point.
 #' @param type Should be one the \code{"s"} (strait line), or \code{"p"} (polyline).
 #' @param name A character identifier of the line grob, passed to \code{\link[grid]{linesGrob}}.
-#' @param lwd Line width for the connector line. Defaults to 
-#'   \code{getOption("consort_line_lwd", default = 1)}.
-#' @param col Line and arrow fill color. Defaults to 
-#'   \code{getOption("consort_line_col", default = "black")}.
+#' @param arrow_gp Graphical parameters \code{\link[grid]{gpar}} object for the 
+#' connector line. Defaults to \code{grid::gpar(col = "black", lwd = 1)}.
 #' @param arrow_length Length of the arrowhead as a \code{\link[grid]{unit}} object. 
-#'   Defaults to \code{getOption("consort_arrow_length", default = unit(0.1, "inches"))}.
+#'   Defaults to \code{unit(0.1, "inches")}.
 #' @param arrow_type Arrow type, either \code{"closed"} or \code{"open"}. Defaults to 
-#'   \code{getOption("consort_arrow_type", default = "closed")}.
+#'   \code{"closed"}.
 #'
 #' @return A lines grob with arrow.
 #' @export
@@ -36,18 +34,17 @@
 #' connect_box(fg1, fg2, connect = "bl", type = "p")
 #'
 #' # Customize line width and color
-#' connect_box(fg1, fg2, connect = "bl", type = "p", lwd = 2, col = "red")
+#' connect_box(fg1, fg2, connect = "bl", type = "p", arrow_gp = grid::gpar(lwd = 2, col = "red"))
 #'
-#' # Or set globally via options
-#' options(consort_line_lwd = 2, consort_line_col = "blue")
+#' # Or set globally via set_consort_defaults
+#' set_consort_defaults(arrow_gp = grid::gpar(lwd = 2, col = "blue"))
 connect_box <- function(start, end,
                         connect,
                         type = c("s", "p"),
                         name = NULL,
-                        lwd = getOption("consort_line_lwd", default = 1),
-                        col = getOption("consort_line_col", default = "black"),
-                        arrow_length = getOption("consort_arrow_length", default = 0.1),
-                        arrow_type = getOption("consort_arrow_type", default = "closed")) {
+                        arrow_gp = consort_opt("arrow_gp"),
+                        arrow_length = consort_opt("arrow_length"),
+                        arrow_type = consort_opt("arrow_type")) {
 
   type <- match.arg(type)
 
@@ -146,11 +143,13 @@ connect_box <- function(start, end,
       y = unit.c(y_s, y_mid, y_e)
     )
   }
+
+  arrow_gp$fill <- arrow_gp$col
 
   linesGrob(
     x = line_coords$x,
     y = line_coords$y,
-    gp = gpar(fill = col, col = col, lwd = lwd),
+    gp = arrow_gp,
     arrow = arrow(
       length = arrow_length,
       ends = "last", type = arrow_type

R/consort.R

@@ -5,7 +5,14 @@
 #'   is done by creating a standardized disposition data, and using this data
 #'    as the source for the creation a standard CONSORT diagram. Human effort
 #'     by supplying text labels on the node can also be achieved.
-#'
-#' @name consort-package
+#'     
 #' @docType package
+#' @name consort
+#' @keywords internal
+"_PACKAGE"
+
+## usethis namespace: start
+#' @import grid
+#' @importFrom utils modifyList
+## usethis namespace: end
 NULL

R/consort_plot.R

@@ -22,7 +22,8 @@
 #' is defined.
 #' @param kickoff_sidebox remove (default) the side box observations from the 
 #' following counting.
-#' @param cex Multiplier applied to font size, Default is 0.8
+#' @param cex Multiplier applied to font size, default is 0.8. Prefer using
+#' \code{\link{set_consort_defaults}(txt_gp = gpar(cex = ...))} instead.
 #' @param text_width a positive integer giving the target column for wrapping
 #' lines in the output. String will not be wrapped if not defined (default).
 #' The \code{\link[stringi]{stri_wrap}} function will be used if \code{stringi}
@@ -40,7 +41,8 @@
 #' @export
 #'
 #' @seealso \code{\link{add_side_box}},\code{\link{add_split}},
-#' \code{\link{add_side_box}} \code{\link{textbox}}
+#' \code{\link{add_side_box}} \code{\link{textbox}} 
+#' \code{\link{set_consort_defaults}}
 #' @example inst/examples/consort-plot-example.R
 #' @import grid
 #' @importFrom stats na.omit
@@ -53,9 +55,13 @@ consort_plot <- function(data,
                          kickoff_sidebox = TRUE,
                          cex = 0.8,
                          text_width = NULL) {
-  options(txt_gp = gpar(cex = cex))
-  on.exit(options(txt_gp = gpar()))
-
+
+  if(!is.null(cex)){
+    message("Please define this via `set_consort_defaults(txt_gp = gpar(cex = ...))` instead.")
+    old <- set_consort_defaults(txt_gp = gpar(cex = cex))
+    on.exit(consort_global$defaults$txt_gp <- old$txt_gp, add = TRUE)
+  }
+
   data <- as.data.frame(data)
 
   if(!is.list(orders)){