Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 2 additions & 1 deletion NEWS.md
Original file line number Diff line number Diff line change
@@ -1,7 +1,8 @@
# consort 1.2.3

- Allow user configuration of arrow graphical parameters and padding with `set_consort_defaults()`.
- Allow custom bullet characters
- Allow custom bullet characters.
- Allow simple markup for bold, italic and superscript.

Copilot AI Apr 3, 2026

Copy link

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

The NEWS entry says “Allow simple markup for bold, italic and superscript”, but this PR also adds subscript and underline (and a parse_markup option). Please update this bullet so it accurately reflects the supported markup and the new option name.

Suggested change
- Allow simple markup for bold, italic and superscript.
- Allow simple markup for bold, italic, superscript, subscript, and underline with `parse_markup`.

Copilot uses AI. Check for mistakes.
- Figure styles will also be applied to grViz plot.
- Improved documentation.
- Special thanks to @Ramsas88
Expand Down
36 changes: 14 additions & 22 deletions R/build_grid.R
Original file line number Diff line number Diff line change
Expand Up @@ -6,7 +6,7 @@
#' \code{\link{build_grviz}} or \code{plot(g, grViz = TRUE)} for
#' multiple split nodes instead.
#'
#' @param x A conosrt object.
#' @param x A consort object.
#'
#' @return A \code{gList} object
#' @export
Expand Down Expand Up @@ -54,13 +54,16 @@ build_grid <- function(x) {
nodes_coord$y <- (vp_height - nodes_coord$y)/vp_height

if(any(grepl("label", names(x)))){
label_coord <- calc_coords_label(label_plot,
nodes_coord$nd_y,
label_coord <- calc_coords_label(label_plot,
nodes_coord$nd_y,
max_h = nodes_coord$max_height)
vp_width <- sum(label_coord$width[1], vp_width)

nodes_coord$x <- (nodes_coord$x + label_coord$width[1])/vp_width


# Convert label x from char units to NPC so they scale with the viewport
label_coord$x <- label_coord$x / vp_width

}else{
nodes_coord$x <- (nodes_coord$x)/vp_width
}
Expand All @@ -72,22 +75,17 @@ build_grid <- function(x) {
y = unit(nodes_coord$y[i], "npc"))
r$name <- i

# Skep empty side box
# Skip empty side box
if(is_empty(consort_plot[[i]]$text))
return(NULL)

return(r)
}, simplify = FALSE)

grobs_list <- gList()
for (i in seq_along(nodes)) {
if(is.null(nodes[[i]]))
next

if (i == 1) {
grobs_list <- gList(gList(), nodes[[i]])
} else {
if(!is.null(nodes[[i]]))
grobs_list <- gList(grobs_list, nodes[[i]])
}
}

# Connections
Expand Down Expand Up @@ -115,28 +113,22 @@ build_grid <- function(x) {
for(i in seq_along(label_plot)){
nam <- names(label_plot)[i]
r <- move_box(label_plot[[nam]]$box,
x = unit(label_coord$x[nam], "char"),
x = unit(label_coord$x[nam], "npc"),
y = unit(label_coord$y[nam], "npc"))
r$name <- nam

if (i == 1) {
lab_grobs <- gList(gList(), r)
} else {
lab_grobs <- gList(lab_grobs, r)
}
lab_grobs <- if (i == 1) gList(r) else gList(lab_grobs, r)
}

grobs_list <- gList(grobs_list, lab_grobs)

}

grobTree(grobs_list,
grobTree(grobs_list,
name = "consort",
vp = viewport(width = unit(0.98, "npc"),
height = unit(0.98, "npc")))

# return(grobs_list)


}


Expand Down
18 changes: 15 additions & 3 deletions R/defaults.R
Original file line number Diff line number Diff line change
Expand Up @@ -11,7 +11,8 @@ consort_defaults_settings <- list(
arrow_length = 0.1,
arrow_type = "closed",
pad_u = 3,
bullet = "\u2022"
bullet = "\u2022",
parse_markup = FALSE
)

consort_global$defaults <- consort_defaults_settings
Expand All @@ -36,6 +37,10 @@ consort_opt <- function(name) {
#' @param arrow_type Character, arrow type: \code{"closed"} or \code{"open"}.
#' @param pad_u Numeric, padding between nodes.
#' @param bullet Character, bullet character for side box items.
#' @param parse_markup Logical, whether to parse lightweight markup syntax
#' (\code{**bold**}, \code{*italic*}, \code{^{superscript}},
#' \code{_{subscript}}, \code{__underline__}) in node labels.
#' Default is \code{FALSE}.
#'
#' @return Invisibly returns the previous defaults (a \code{consort_defaults} object).
#' @export
Expand Down Expand Up @@ -63,7 +68,8 @@ set_consort_defaults <- function(
arrow_length = NULL,
arrow_type = NULL,
pad_u = NULL,
bullet = NULL
bullet = NULL,
parse_markup = NULL
) {

old <- get_consort_defaults()
Expand All @@ -78,7 +84,8 @@ set_consort_defaults <- function(
arrow_length = arrow_length,
arrow_type = arrow_type,
pad_u = pad_u,
bullet = bullet
bullet = bullet,
parse_markup = parse_markup
)

# Keep only non-NULL arguments
Expand Down Expand Up @@ -117,6 +124,11 @@ set_consort_defaults <- function(
stop("`bullet` must be a single character string.")
}

if (!is.null(parse_markup)) {
if (!is.logical(parse_markup) || length(parse_markup) != 1 || is.na(parse_markup))
stop("`parse_markup` must be a single TRUE/FALSE value.")
}

# Update stored defaults
consort_global$defaults <- utils::modifyList(consort_global$defaults, args)

Expand Down
12 changes: 7 additions & 5 deletions R/grid_util.R
Original file line number Diff line number Diff line change
Expand Up @@ -14,7 +14,7 @@ calc_y_coords <- function(consort_plot, nodes_layout, pad_u) {
prev_bt <- max(heights)
} else {
# Extra padding when column count changes (split/merge transition)
extra_pad <- if (length(nd_y[[i]]) != length(nd_y[[i - 1]])) 2 * pad_u else pad_u
extra_pad <- if (length(heights) != length(nd_y[[i - 1]])) 2 * pad_u else pad_u
nd_y[[i]] <- prev_bt + extra_pad + heights / 2
prev_bt <- prev_bt + extra_pad + max(heights)
}
Expand Down Expand Up @@ -275,10 +275,12 @@ gp_consecutive <- function(x){
int <- 1
gp <- vector("character", length = length(x))
gp[1] <- letters[int]
for(i in 2:length(x)){
if(x[i] != x[i-1])
int <- int + 1
gp[i] <- letters[int]
if(length(x) > 1){
for(i in 2:length(x)){
if(x[i] != x[i-1])
int <- int + 1
gp[i] <- letters[int]
}
}
return(gp)
}
40 changes: 27 additions & 13 deletions R/grviz_util.R
Original file line number Diff line number Diff line change
Expand Up @@ -128,22 +128,36 @@ mk_invs_connect <- function(x){
# Make text alignment
#' @keywords internal
mk_text_align <- function(text, just, group = NULL, grviz_style = NULL){
# If empty
# if(is_empty(text))
# return("")

jst <- ifelse(just == "center", "",
ifelse(just == "left", "\\l", "\r"))

if(just %in% c("left", "right")){
text <- unlist(strsplit(text, "\n"))
text <- ifelse(just == "left",
paste(text, collapse = "\\l"),
paste(text, collapse = "\r"))

if (has_markup(text)) {
# Graphviz HTML-like label: <html> instead of "plain"
html <- markup_to_html(text)

if (just == "left") {
html <- gsub("<br/>", '<br align="left"/>', html, fixed = TRUE)
html <- paste0(html, '<br align="left"/>')
} else if (just == "right") {
html <- gsub("<br/>", '<br align="right"/>', html, fixed = TRUE)
html <- paste0(html, '<br align="right"/>')
}

attr_parts <- sprintf("label = <%s>", html)
} else {
# Original plain-text label
jst <- ifelse(just == "center", "",
ifelse(just == "left", "\\l", "\r"))

if(just %in% c("left", "right")){
text <- unlist(strsplit(text, "\n"))
text <- ifelse(just == "left",
paste(text, collapse = "\\l"),
paste(text, collapse = "\r"))
}

attr_parts <- sprintf('label = "%s%s"', text, jst)
}

# Build attributes
attr_parts <- sprintf('label = "%s%s"', text, jst)
if(!is.null(group)) attr_parts <- paste(attr_parts, sprintf("group=%s", group))
if(!is.null(grviz_style)) attr_parts <- paste(attr_parts, grviz_style)

Expand Down
Loading
Loading