Skip to content

Merge pattern regex adjustment #1964

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Draft
olivroy wants to merge 4 commits into
base: master
Choose a base branch
from
Draft

Merge pattern regex adjustment #1964

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
d782400
Code indenting
olivroy Mar 3, 2025
2101bb7
Fix regexp when spans are present
olivroy Mar 5, 2025
09e9f11
Refactor test for clarity (i.e. avoid confusion and keep objects clos…
olivroy Mar 5, 2025
505572c
Merge branch 'master' into merge-pattern
rich-iannone Jul 25, 2025
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
40 changes: 19 additions & 21 deletions R/utils.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1190,42 +1190,40 @@ markdown_to_xml <- function(text) {

if (inherits(x, "xml_nodeset")) {

results <- lapply(x, apply_rules)
results <- lapply(x, apply_rules)
do.call("paste0", c(results, collapse = "\n"))

} else {
} else {

output <- if (xml2::xml_type(x) == "element") {
rule <- cmark_rules_xml[[xml2::xml_name(x)]]

rule <- cmark_rules_xml[[xml2::xml_name(x)]]
if (is.null(rule)) {

if (is.null(rule)) {

rlang::warn(
paste0("Unknown commonmark element encountered: ", xml2::xml_name(x)),
.frequency = "once",
.frequency_id = "gt_commonmark_unknown_element"
)
cli::cli_warn(
"Unknown commonmark element encountered: {xml2::xml_name(x)}",
.frequency = "once",
.frequency_id = "gt_commonmark_unknown_element"
)

apply_rules(xml2::xml_children(x))
apply_rules(xml2::xml_children(x))

} else if (is.function(rule)) {
} else if (is.function(rule)) {

rule(x, apply_rules, ...)
rule(x, apply_rules, ...)

}
}
}

paste0(output, collapse = "")
}
}

res <- lapply(children, apply_rules)
res <- vapply(res, FUN = as.character, FUN.VALUE = character(1L))
res <- paste0(res, collapse = "")
paste0("<md_container>", res, "</md_container>")
}
)

res <- lapply(children, apply_rules)
res <- vapply(res, FUN = as.character, FUN.VALUE = character(1L))
res <- paste0(res, collapse = "")
paste0("<md_container>", res, "</md_container>")
})

}

Expand Down
13 changes: 12 additions & 1 deletion R/utils_render_common.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -359,13 +359,24 @@ resolve_secondary_pattern <- function(x) {

while (grepl("<<.*?>>", x)) {

m <- gregexpr("<<[^<]*?>>", x, perl = TRUE)
# stringr::str_extract_all(x, regexp)[1]
# (?<!<) means not preceded by <
# (?!>) means not followed by >
# Which means we take the outer match
# safeguarding about potential html elements within
# rstudio/gt#1880
m <- gregexpr("(?<!<)<<.*>>(?!>)", x, perl = TRUE)

matched <- unlist(regmatches(x, m))[1]

m_start <- as.integer(m[[1]])
m_length <- attr(m[[1]], "match.length")

if (m_start == -1) {
# Add safeguard instead of going in a very long loop
# rstudio/gt#1880
cli::cli_abort("Can't resolve pattern.", .internal = TRUE)
}
Comment on lines +375 to +379
Copy link
Collaborator Author

@olivroy olivroy Jul 10, 2025

Choose a reason for hiding this comment

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

This is probably the only part I am satisfied with in this PR. It prevents infinite loops from happening. The rest doesn't work as intended.

if (grepl(missing_val_token, matched)) {

# Remove `matched` text from `x`
Expand Down
2 changes: 1 addition & 1 deletion R/utils_render_xml.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2926,7 +2926,7 @@ parse_to_xml <- function(x, ...) {

## add namespace for later processing
parsed_xml_contents <-
suppressWarnings(read_xml(add_ns(x)))
suppressWarnings(xml2::read_xml(add_ns(x)))

xml_children(parsed_xml_contents)
}
Expand Down
159 changes: 127 additions & 32 deletions tests/testthat/test-cols_merge.R
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,30 +1,3 @@
# Create a table with four columns of values
tbl <-
dplyr::tribble(
~col_1, ~col_2, ~col_3, ~col_4,
767.6, 928.1, 382.0, 674.5,
403.3, 461.5, 15.1, 242.8,
686.4, 54.1, 282.7, 56.3,
662.6, 148.8, 984.6, 928.1,
198.5, 65.1, 127.4, 219.3,
132.1, 118.1, 91.2, 874.3,
349.7, 307.1, 566.7, 542.9,
63.7, 504.3, 152.0, 724.5,
105.4, 729.8, 962.4, 336.4,
924.2, 424.6, 740.8, 104.2
)

# Create a table with three columns, the last two having different
# combinations of NA values
tbl_na <-
dplyr::tibble(
a = 1:4,
b = c(1, NA, 3, NA),
c = c(1, 2, NA, NA),
d = c("1", "2", NA_character_, NA_character_),
e = c(TRUE, FALSE, NA, NA)
)

# Function to skip tests if Suggested packages not available on system
check_suggests <- function() {
skip_if_not_installed("rvest")
Expand Down Expand Up @@ -154,12 +127,10 @@ test_that("cols_merge() works correctly", {
expect_snapshot_html(gt_tbl_3)

# Ensure that `group` columns don't get the same treatment
expect_equal(
expect_equal_gt(
gt(tbl, groupname_col = "row"),
gt(tbl, groupname_col = "row") %>%
render_as_html(),
gt(tbl, groupname_col = "row") %>%
cols_merge(columns = c(row, a)) %>%
render_as_html()
cols_merge(columns = c(row, a))
)

# Use `cols_merge()` with a vector of `rows` which limits the rows
Expand All @@ -179,6 +150,17 @@ test_that("cols_merge() works correctly", {

test_that("The secondary pattern language works well in `cols_merge()`", {

# Create a table with three columns, the last two having different
# combinations of NA values
tbl_na <-
dplyr::tibble(
a = 1:4,
b = c(1, NA, 3, NA),
c = c(1, 2, NA, NA),
d = c("1", "2", NA_character_, NA_character_),
e = c(TRUE, FALSE, NA, NA)
)

# Create a `tbl_html` object with `gt()`
tbl_gt <- gt(tbl_na)

Expand Down Expand Up @@ -298,9 +280,44 @@ test_that("The secondary pattern language works well in `cols_merge()`", {
(tbl_gt_13 %>% render_formats_test("html"))[["a"]],
c("11TRUE", "2", "33X", "4")
)
#1880
base_tab <- gt(data.frame(
x = c("dice-one", "dice-two", "dice-three"),
y = c("dice-one", NA, "dice-three")
))

tbl_gt_14 <- base_tab %>% fmt_icon() %>%
cols_merge(
columns = everything(),
pattern = "({1}<< {2}>>)"
)

expect_equal(
(tbl_gt_14 %>% render_formats_test("html"))[["x"]],
c(
'(<span style="white-space:nowrap;"><svg aria-label="Dice One" role="img" viewBox="0 0 448 512" style="height:1em;width:0.88em;vertical-align:-0.125em;margin-left:auto;margin-right:auto;font-size:inherit;fill:currentColor;overflow:visible;position:relative;"><title>Dice One</title><path d="M64 32C28.7 32 0 60.7 0 96V416c0 35.3 28.7 64 64 64H384c35.3 0 64-28.7 64-64V96c0-35.3-28.7-64-64-64H64zM224 224a32 32 0 1 1 0 64 32 32 0 1 1 0-64z"/></svg></span> <span style="white-space:nowrap;"><svg aria-label="Dice One" role="img" viewBox="0 0 448 512" style="height:1em;width:0.88em;vertical-align:-0.125em;margin-left:auto;margin-right:auto;font-size:inherit;fill:currentColor;overflow:visible;position:relative;"><title>Dice One</title><path d="M64 32C28.7 32 0 60.7 0 96V416c0 35.3 28.7 64 64 64H384c35.3 0 64-28.7 64-64V96c0-35.3-28.7-64-64-64H64zM224 224a32 32 0 1 1 0 64 32 32 0 1 1 0-64z"/></svg></span>)',
'(<span style="white-space:nowrap;"><svg aria-label="Dice Two" role="img" viewBox="0 0 448 512" style="height:1em;width:0.88em;vertical-align:-0.125em;margin-left:auto;margin-right:auto;font-size:inherit;fill:currentColor;overflow:visible;position:relative;"><title>Dice Two</title><path d="M0 96C0 60.7 28.7 32 64 32H384c35.3 0 64 28.7 64 64V416c0 35.3-28.7 64-64 64H64c-35.3 0-64-28.7-64-64V96zM352 352a32 32 0 1 0 -64 0 32 32 0 1 0 64 0zM128 192a32 32 0 1 0 0-64 32 32 0 1 0 0 64z"/></svg></span>)',
'(<span style="white-space:nowrap;"><svg aria-label="Dice Three" role="img" viewBox="0 0 448 512" style="height:1em;width:0.88em;vertical-align:-0.125em;margin-left:auto;margin-right:auto;font-size:inherit;fill:currentColor;overflow:visible;position:relative;"><title>Dice Three</title><path d="M64 32C28.7 32 0 60.7 0 96V416c0 35.3 28.7 64 64 64H384c35.3 0 64-28.7 64-64V96c0-35.3-28.7-64-64-64H64zm64 96a32 32 0 1 1 0 64 32 32 0 1 1 0-64zm64 128a32 32 0 1 1 64 0 32 32 0 1 1 -64 0zm128 64a32 32 0 1 1 0 64 32 32 0 1 1 0-64z"/></svg></span> <span style="white-space:nowrap;"><svg aria-label="Dice Three" role="img" viewBox="0 0 448 512" style="height:1em;width:0.88em;vertical-align:-0.125em;margin-left:auto;margin-right:auto;font-size:inherit;fill:currentColor;overflow:visible;position:relative;"><title>Dice Three</title><path d="M64 32C28.7 32 0 60.7 0 96V416c0 35.3 28.7 64 64 64H384c35.3 0 64-28.7 64-64V96c0-35.3-28.7-64-64-64H64zm64 96a32 32 0 1 1 0 64 32 32 0 1 1 0-64zm64 128a32 32 0 1 1 64 0 32 32 0 1 1 -64 0zm128 64a32 32 0 1 1 0 64 32 32 0 1 1 0-64z"/></svg></span>)'
)
)
})

test_that("cols_merge_uncert() works correctly", {
# Create a table with four columns of values
tbl <-
dplyr::tribble(
~col_1, ~col_2, ~col_3, ~col_4,
767.6, 928.1, 382.0, 674.5,
403.3, 461.5, 15.1, 242.8,
686.4, 54.1, 282.7, 56.3,
662.6, 148.8, 984.6, 928.1,
198.5, 65.1, 127.4, 219.3,
132.1, 118.1, 91.2, 874.3,
349.7, 307.1, 566.7, 542.9,
63.7, 504.3, 152.0, 724.5,
105.4, 729.8, 962.4, 336.4,
924.2, 424.6, 740.8, 104.2
)

# Check that specific suggested packages are available
check_suggests()
Expand Down Expand Up @@ -509,6 +526,21 @@ test_that("cols_merge_uncert() works nicely with different error bounds", {
})

test_that("cols_merge_range() works correctly", {
# Create a table with four columns of values
tbl <-
dplyr::tribble(
~col_1, ~col_2, ~col_3, ~col_4,
767.6, 928.1, 382.0, 674.5,
403.3, 461.5, 15.1, 242.8,
686.4, 54.1, 282.7, 56.3,
662.6, 148.8, 984.6, 928.1,
198.5, 65.1, 127.4, 219.3,
132.1, 118.1, 91.2, 874.3,
349.7, 307.1, 566.7, 542.9,
63.7, 504.3, 152.0, 724.5,
105.4, 729.8, 962.4, 336.4,
924.2, 424.6, 740.8, 104.2
)

# Create a `tbl_html` object with `gt()`; merge two columns
# with `cols_merge_range()`
Expand All @@ -529,6 +561,21 @@ test_that("cols_merge_range() works correctly", {
})

test_that("cols_merge_range works 2", {
# Create a table with four columns of values
tbl <-
dplyr::tribble(
~col_1, ~col_2, ~col_3, ~col_4,
767.6, 928.1, 382.0, 674.5,
403.3, 461.5, 15.1, 242.8,
686.4, 54.1, 282.7, 56.3,
662.6, 148.8, 984.6, 928.1,
198.5, 65.1, 127.4, 219.3,
132.1, 118.1, 91.2, 874.3,
349.7, 307.1, 566.7, 542.9,
63.7, 504.3, 152.0, 724.5,
105.4, 729.8, 962.4, 336.4,
924.2, 424.6, 740.8, 104.2
)

# Create a `tbl_html` object with `gt()`; merge two columns
# with `cols_merge_range()`
Expand All @@ -549,6 +596,22 @@ test_that("cols_merge_range works 2", {
})

test_that("cols_merge_range() works with 2 statements", {
# Create a table with four columns of values
tbl <-
dplyr::tribble(
~col_1, ~col_2, ~col_3, ~col_4,
767.6, 928.1, 382.0, 674.5,
403.3, 461.5, 15.1, 242.8,
686.4, 54.1, 282.7, 56.3,
662.6, 148.8, 984.6, 928.1,
198.5, 65.1, 127.4, 219.3,
132.1, 118.1, 91.2, 874.3,
349.7, 307.1, 566.7, 542.9,
63.7, 504.3, 152.0, 724.5,
105.4, 729.8, 962.4, 336.4,
924.2, 424.6, 740.8, 104.2
)

# Create a `tbl_html` object with `gt()`; merge two columns, twice,
# with `cols_merge_range()`
tbl_html <-
Expand Down Expand Up @@ -594,6 +657,22 @@ test_that("cols_merge_range() respects locale for separators", {
})

test_that("cols_merge_range() works", {
# Create a table with four columns of values
tbl <-
dplyr::tribble(
~col_1, ~col_2, ~col_3, ~col_4,
767.6, 928.1, 382.0, 674.5,
403.3, 461.5, 15.1, 242.8,
686.4, 54.1, 282.7, 56.3,
662.6, 148.8, 984.6, 928.1,
198.5, 65.1, 127.4, 219.3,
132.1, 118.1, 91.2, 874.3,
349.7, 307.1, 566.7, 542.9,
63.7, 504.3, 152.0, 724.5,
105.4, 729.8, 962.4, 336.4,
924.2, 424.6, 740.8, 104.2
)

# Create a `tbl_html` object with `gt()`; merge two
# columns with `cols_merge_range()` but use the `I()`
# function to keep the `--` separator text as is
Expand Down Expand Up @@ -645,6 +724,22 @@ test_that("cols_merge_range() works", {
})

test_that("cols_merge_range() works well", {
# Create a table with four columns of values
tbl <-
dplyr::tribble(
~col_1, ~col_2, ~col_3, ~col_4,
767.6, 928.1, 382.0, 674.5,
403.3, 461.5, 15.1, 242.8,
686.4, 54.1, 282.7, 56.3,
662.6, 148.8, 984.6, 928.1,
198.5, 65.1, 127.4, 219.3,
132.1, 118.1, 91.2, 874.3,
349.7, 307.1, 566.7, 542.9,
63.7, 504.3, 152.0, 724.5,
105.4, 729.8, 962.4, 336.4,
924.2, 424.6, 740.8, 104.2
)

# Create two gt table objects; the first will be based
# on `tbl` while the second will use a different column name
# in `tbl` (`sep`) that collides with a pattern element name
Expand Down
Loading