Skip to content

Commit 3bffc83

Browse files
EhrmannSclaude
EhrmannS
and
claude
committed
fix non-primitive functions in .find(fun=), add fun mode to schema_builder, widen right panel, fix _pkgdown.yml and CI actions
Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
1 parent 29e4167 commit 3bffc83

6 files changed

Lines changed: 153 additions & 61 deletions

File tree

‎.github/workflows/check-standard.yaml‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -29,7 +29,7 @@ jobs:
2929
R_KEEP_PKG_SOURCE: yes
3030

3131
steps:
32-
- uses: actions/checkout@v3
32+
- uses: actions/checkout@v4
3333

3434
- uses: r-lib/actions/setup-pandoc@v2
3535

‎.github/workflows/pkgdown.yaml‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -20,7 +20,7 @@ jobs:
2020
env:
2121
GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
2222
steps:
23-
- uses: actions/checkout@v3
23+
- uses: actions/checkout@v4
2424

2525
- uses: r-lib/actions/setup-pandoc@v2
2626

‎.github/workflows/test-coverage.yaml‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -15,7 +15,7 @@ jobs:
1515
GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
1616

1717
steps:
18-
- uses: actions/checkout@v3
18+
- uses: actions/checkout@v4
1919

2020
- uses: r-lib/actions/setup-r@v2
2121
with:
@@ -44,7 +44,7 @@ jobs:
4444

4545
- name: Upload test results
4646
if: failure()
47-
uses: actions/upload-artifact@v3
47+
uses: actions/upload-artifact@v4
4848
with:
4949
name: coverage-test-failures
5050
path: ${{ runner.temp }}/package

‎R/helpers.R‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -667,8 +667,9 @@
667667
subset <- subset %>%
668668
mutate(across(.cols = where(function(x) suppressWarnings(!anyNA(as.numeric(x[!is.na(x)]))) & !all(is.na(x))), .fns = as.numeric))
669669

670+
is_isna <- is_primitive(term) && prim_name(term) == "is.na"
670671
cols <- map_int(.x = 1:dim(input)[2], .f = function(ix){
671-
if(prim_name(term) != "is.na"){
672+
if(!is_isna){
672673
map(subset[,ix], term)[[1]] & !all(is.na(subset[,ix]))
673674
} else {
674675
map(subset[,ix], term)[[1]]

‎R/schema_builder.R‎

Lines changed: 145 additions & 54 deletions
Original file line numberDiff line numberDiff line change
@@ -247,8 +247,8 @@ schema_builder <- function(input = NULL) {
247247
/* two-column layout */
248248
#sb-outer { display: flex; gap: 16px; padding: 16px;
249249
max-width: 1200px; margin: auto; align-items: flex-start; }
250-
#sb-left { flex: 1 1 60%; min-width: 0; }
251-
#sb-right { flex: 0 0 360px; position: sticky; top: 16px;
250+
#sb-left { flex: 1 1 50%; min-width: 0; }
251+
#sb-right { flex: 1 1 50%; min-width: 0; position: sticky; top: 16px;
252252
display: flex; flex-direction: column; gap: 12px; }
253253
254254
/* panels */
@@ -299,9 +299,10 @@ schema_builder <- function(input = NULL) {
299299
border: 1px solid #ccc; flex-shrink: 0; }
300300
301301
/* grid */
302-
#sb_grid table { border-collapse: collapse; font-size: 12px; width: 100%; }
302+
#sb_grid { display: block; }
303+
#sb_grid table { border-collapse: collapse; font-size: 12px; }
303304
#sb_grid td, #sb_grid th { border: 1px solid #ccc; padding: 3px 6px;
304-
cursor: pointer; min-width: 36px; text-align: center; }
305+
cursor: pointer; min-width: 36px; text-align: center; white-space: nowrap; }
305306
#sb_grid th { background: #e9ecef; font-weight: normal;
306307
font-size: 11px; color: #666; }
307308
#sb_grid td:hover { outline: 2px solid #333; }
@@ -952,7 +953,9 @@ schema_builder <- function(input = NULL) {
952953
cols = integer(0),
953954
invert = FALSE,
954955
use_find = FALSE,
956+
find_mode = "pattern", # "pattern" or "fun"
955957
find_pattern = "",
958+
find_fun = "",
956959
find_search_in = "row", # which dimension to scan: "row" or "col"
957960
find_dim = "", # specific row/col number to scan (optional)
958961
find_select = "rows", # what setFilter receives: "rows" or "columns"
@@ -988,10 +991,18 @@ schema_builder <- function(input = NULL) {
988991
}
989992
}, ignoreNULL = TRUE, ignoreInit = TRUE)
990993
# finder fields
994+
shiny::observeEvent(input[[paste0("flt_find_mode_", n)]], {
995+
fl <- rv$filters
996+
if (n <= length(fl)) { fl[[n]]$find_mode <- input[[paste0("flt_find_mode_", n)]]; rv$filters <- fl }
997+
}, ignoreNULL = TRUE, ignoreInit = TRUE)
991998
shiny::observeEvent(input[[paste0("flt_pattern_", n)]], {
992999
fl <- rv$filters
9931000
if (n <= length(fl)) { fl[[n]]$find_pattern <- input[[paste0("flt_pattern_", n)]]; rv$filters <- fl }
9941001
}, ignoreNULL = FALSE, ignoreInit = TRUE)
1002+
shiny::observeEvent(input[[paste0("flt_fun_", n)]], {
1003+
fl <- rv$filters
1004+
if (n <= length(fl)) { fl[[n]]$find_fun <- input[[paste0("flt_fun_", n)]]; rv$filters <- fl }
1005+
}, ignoreNULL = FALSE, ignoreInit = TRUE)
9951006
shiny::observeEvent(input[[paste0("flt_in_", n)]], {
9961007
fl <- rv$filters
9971008
if (n <= length(fl)) { fl[[n]]$find_search_in <- input[[paste0("flt_in_", n)]]; rv$filters <- fl }
@@ -1440,45 +1451,101 @@ schema_builder <- function(input = NULL) {
14401451
if (length(flt$cols) > 0) paste(flt$cols, collapse=", ") else "none"))
14411452
)
14421453

1443-
find_err <- if (is_find && nchar(flt$find_pattern) > 0)
1444-
tryCatch({ grepl(flt$find_pattern, ""); NULL },
1445-
error = function(e) paste("Regex error:", conditionMessage(e)))
1446-
else NULL
1454+
find_mode <- flt$find_mode %||% "pattern"
1455+
find_err <- if (is_find) {
1456+
if (find_mode == "pattern" && nchar(flt$find_pattern) > 0)
1457+
tryCatch({ grepl(flt$find_pattern, ""); NULL },
1458+
error = function(e) paste("Regex error:", conditionMessage(e)))
1459+
else if (find_mode == "fun" && nchar(flt$find_fun) > 0)
1460+
tryCatch({
1461+
setTimeLimit(elapsed = 2, transient = TRUE)
1462+
on.exit(setTimeLimit(elapsed = Inf, transient = FALSE), add = TRUE)
1463+
f <- eval(parse(text = paste0("function(x) ", flt$find_fun)))
1464+
f(c(1L, "a", NA))
1465+
NULL
1466+
}, error = function(e) paste("Function error:", conditionMessage(e)))
1467+
else NULL
1468+
} else NULL
14471469

14481470
search_in <- flt$find_search_in %||% "row"
14491471
find_content <- shiny::tagList(
1450-
shiny::tags$div(style="display:flex;gap:8px;flex-wrap:wrap;align-items:flex-end;margin-bottom:6px;",
1451-
shiny::tags$div(
1452-
shiny::tags$label(style="font-size:12px;color:#555;display:block;margin-bottom:3px;",
1453-
"Regex pattern"),
1454-
shiny::textInput(paste0("flt_pattern_", i), NULL,
1455-
value = flt$find_pattern, placeholder = "e.g. ^NA$", width = "160px")
1456-
),
1457-
shiny::tags$div(
1458-
shiny::tags$label(style="font-size:12px;color:#555;display:block;margin-bottom:3px;",
1459-
"Search in"),
1460-
shiny::selectInput(paste0("flt_in_", i), NULL,
1461-
choices = c("Rows" = "row", "Columns" = "col"),
1462-
selected = search_in, width = "100px")
1463-
),
1464-
shiny::tags$div(
1465-
shiny::tags$label(style="font-size:12px;color:#555;display:block;margin-bottom:3px;",
1466-
paste0(if (search_in == "col") "Column" else "Row", " number (optional)")),
1467-
shiny::textInput(paste0("flt_dim_", i), NULL,
1468-
value = flt$find_dim, placeholder = "e.g. 1", width = "80px")
1469-
),
1470-
shiny::tags$div(
1471-
shiny::tags$label(style="font-size:12px;color:#555;display:block;margin-bottom:3px;",
1472-
"Select"),
1473-
shiny::selectInput(paste0("flt_select_", i), NULL,
1474-
choices = c("Rows" = "rows", "Columns" = "columns"),
1475-
selected = flt$find_select %||% "rows", width = "100px")
1476-
)
1472+
shiny::tags$div(style="margin-bottom:6px;",
1473+
shiny::radioButtons(paste0("flt_find_mode_", i), NULL,
1474+
choices = c("Regex pattern" = "pattern", "Function body" = "fun"),
1475+
selected = find_mode, inline = TRUE)
14771476
),
1477+
if (find_mode == "pattern")
1478+
shiny::tags$div(style="display:flex;gap:8px;flex-wrap:wrap;align-items:flex-end;margin-bottom:6px;",
1479+
shiny::tags$div(
1480+
shiny::tags$label(style="font-size:12px;color:#555;display:block;margin-bottom:3px;",
1481+
"Regex pattern"),
1482+
shiny::textInput(paste0("flt_pattern_", i), NULL,
1483+
value = flt$find_pattern, placeholder = "e.g. ^NA$", width = "160px")
1484+
),
1485+
shiny::tags$div(
1486+
shiny::tags$label(style="font-size:12px;color:#555;display:block;margin-bottom:3px;",
1487+
"Search in"),
1488+
shiny::selectInput(paste0("flt_in_", i), NULL,
1489+
choices = c("Rows" = "row", "Columns" = "col"),
1490+
selected = search_in, width = "100px")
1491+
),
1492+
shiny::tags$div(
1493+
shiny::tags$label(style="font-size:12px;color:#555;display:block;margin-bottom:3px;",
1494+
paste0(if (search_in == "col") "Column" else "Row", " number (optional)")),
1495+
shiny::textInput(paste0("flt_dim_", i), NULL,
1496+
value = flt$find_dim, placeholder = "e.g. 1", width = "80px")
1497+
),
1498+
shiny::tags$div(
1499+
shiny::tags$label(style="font-size:12px;color:#555;display:block;margin-bottom:3px;",
1500+
"Select"),
1501+
shiny::selectInput(paste0("flt_select_", i), NULL,
1502+
choices = c("Rows" = "rows", "Columns" = "columns"),
1503+
selected = flt$find_select %||% "rows", width = "100px")
1504+
)
1505+
)
1506+
else
1507+
shiny::tagList(
1508+
shiny::tags$div(style="margin-bottom:6px;",
1509+
shiny::tags$label(style="font-size:12px;color:#555;display:block;margin-bottom:3px;",
1510+
"Function body \u2014 receives one cell value x, must return TRUE/FALSE"),
1511+
shiny::tags$div(style="display:flex;gap:8px;align-items:flex-start;",
1512+
shiny::tags$div(style="font-size:12px;color:#888;padding-top:6px;white-space:nowrap;",
1513+
"function(x)"),
1514+
shiny::tags$div(style="flex:1;",
1515+
shiny::textAreaInput(paste0("flt_fun_", i), NULL,
1516+
value = flt$find_fun, placeholder = "e.g. !is.na(x) && as.numeric(x) > 100",
1517+
width = "100%", rows = 2))
1518+
)
1519+
),
1520+
shiny::tags$div(style="display:flex;gap:8px;flex-wrap:wrap;align-items:flex-end;margin-bottom:6px;",
1521+
shiny::tags$div(
1522+
shiny::tags$label(style="font-size:12px;color:#555;display:block;margin-bottom:3px;",
1523+
"Search in"),
1524+
shiny::selectInput(paste0("flt_in_", i), NULL,
1525+
choices = c("Rows" = "row", "Columns" = "col"),
1526+
selected = search_in, width = "100px")
1527+
),
1528+
shiny::tags$div(
1529+
shiny::tags$label(style="font-size:12px;color:#555;display:block;margin-bottom:3px;",
1530+
paste0(if (search_in == "col") "Column" else "Row", " number (optional)")),
1531+
shiny::textInput(paste0("flt_dim_", i), NULL,
1532+
value = flt$find_dim, placeholder = "e.g. 1", width = "80px")
1533+
),
1534+
shiny::tags$div(
1535+
shiny::tags$label(style="font-size:12px;color:#555;display:block;margin-bottom:3px;",
1536+
"Select"),
1537+
shiny::selectInput(paste0("flt_select_", i), NULL,
1538+
choices = c("Rows" = "rows", "Columns" = "columns"),
1539+
selected = flt$find_select %||% "rows", width = "100px")
1540+
)
1541+
)
1542+
),
14781543
if (!is.null(find_err))
14791544
shiny::tags$p(style="font-size:12px;color:#c0392b;", find_err)
1480-
else if (nchar(flt$find_pattern) > 0)
1545+
else if (find_mode == "pattern" && nchar(flt$find_pattern) > 0)
14811546
shiny::tags$p(style="font-size:12px;color:#2d6a16;", "\u2713 Valid regex \u2014 matching cells highlighted in table")
1547+
else if (find_mode == "fun" && nchar(flt$find_fun) > 0)
1548+
shiny::tags$p(style="font-size:12px;color:#2d6a16;", "\u2713 Valid function \u2014 matching cells highlighted in table")
14821549
)
14831550

14841551
shiny::tags$div(
@@ -1631,49 +1698,61 @@ schema_builder <- function(input = NULL) {
16311698
# invert is read from live input to avoid rv write -> re-render -> resize
16321699
inv <- isTRUE(input[[paste0("flt_invert_", fi)]])
16331700

1634-
# Finder mode -- evaluate regex against the table and highlight matches
1635-
if (isTRUE(flt$use_find) && nchar(flt$find_pattern) > 0) {
1636-
pat_ok <- tryCatch({ grepl(flt$find_pattern, ""); TRUE }, error = function(e) FALSE)
1637-
if (pat_ok) {
1701+
# Finder mode -- evaluate pattern/fun against the table and highlight matches
1702+
find_mode_hl <- flt$find_mode %||% "pattern"
1703+
has_find_input <- if (find_mode_hl == "fun") nchar(flt$find_fun) > 0
1704+
else nchar(flt$find_pattern) > 0
1705+
if (isTRUE(flt$use_find) && has_find_input) {
1706+
cell_match <- if (find_mode_hl == "fun") {
1707+
f_ok <- tryCatch({
1708+
setTimeLimit(elapsed = 2, transient = TRUE)
1709+
on.exit(setTimeLimit(elapsed = Inf, transient = FALSE), add = TRUE)
1710+
f <- eval(parse(text = paste0("function(x) ", flt$find_fun)))
1711+
f(c(1L, "a", NA))
1712+
f
1713+
}, error = function(e) NULL)
1714+
if (is.null(f_ok)) NULL else function(vals) {
1715+
vapply(vals, function(v) isTRUE(tryCatch(f_ok(v), error=function(e) FALSE)), logical(1))
1716+
}
1717+
} else {
1718+
pat_ok <- tryCatch({ grepl(flt$find_pattern, ""); TRUE }, error = function(e) FALSE)
1719+
if (!pat_ok) NULL else function(vals) grepl(flt$find_pattern, as.character(vals))
1720+
}
1721+
1722+
if (!is.null(cell_match)) {
16381723
dim_num <- suppressWarnings(as.integer(flt$find_dim))
16391724
search_in <- flt$find_search_in %||% "row"
16401725
sel <- flt$find_select %||% "rows"
16411726
tbl_chr <- as.data.frame(lapply(rv$tbl, as.character), stringsAsFactors = FALSE)
16421727
if (search_in == "row") {
1643-
# Pattern is matched against values within a specific row (or all rows)
16441728
search_rows <- if (!is.na(dim_num) && dim_num >= 1 && dim_num <= nr) dim_num else seq_len(nr)
1645-
# Find which COLUMNS have a match in those rows
16461729
matched_cols <- which(vapply(seq_len(nc), function(cl) {
1647-
any(grepl(flt$find_pattern, as.character(tbl_chr[search_rows, cl])))
1730+
any(cell_match(tbl_chr[search_rows, cl]))
16481731
}, logical(1)))
16491732
if (sel == "columns") {
16501733
tint_cols <- if (inv) setdiff(seq_len(nc), matched_cols) else matched_cols
16511734
if (length(tint_cols) > 0)
16521735
hl <- c(hl, list(list(row=seq_len(nr), col=tint_cols, color="#fff3cd")))
16531736
} else {
1654-
# select = "rows": highlight matched columns as a preview of what was found,
1655-
# but shade the rows that would be selected (all rows matching any pattern hit)
16561737
matched_rows <- which(vapply(seq_len(nr), function(r) {
1657-
any(grepl(flt$find_pattern, as.character(tbl_chr[r, seq_len(nc)])))
1738+
any(cell_match(unlist(tbl_chr[r, seq_len(nc)])))
16581739
}, logical(1)))
16591740
tint_rows <- if (inv) setdiff(seq_len(nr), matched_rows) else matched_rows
16601741
if (length(tint_rows) > 0)
16611742
hl <- c(hl, list(list(row=tint_rows, col=seq_len(nc), color="#fff3cd")))
16621743
}
16631744
} else {
1664-
# Pattern is matched against values within a specific column (or all columns)
16651745
search_cols <- if (!is.na(dim_num) && dim_num >= 1 && dim_num <= nc) dim_num else seq_len(nc)
16661746
matched_rows <- which(vapply(seq_len(nr), function(r) {
1667-
any(grepl(flt$find_pattern, as.character(tbl_chr[r, search_cols])))
1747+
any(cell_match(unlist(tbl_chr[r, search_cols])))
16681748
}, logical(1)))
16691749
if (sel == "rows") {
16701750
tint_rows <- if (inv) setdiff(seq_len(nr), matched_rows) else matched_rows
16711751
if (length(tint_rows) > 0)
16721752
hl <- c(hl, list(list(row=tint_rows, col=seq_len(nc), color="#fff3cd")))
16731753
} else {
1674-
# select = "columns": find which columns have a match
16751754
matched_cols <- which(vapply(seq_len(nc), function(cl) {
1676-
any(grepl(flt$find_pattern, as.character(tbl_chr[seq_len(nr), cl])))
1755+
any(cell_match(unlist(tbl_chr[seq_len(nr), cl])))
16771756
}, logical(1)))
16781757
tint_cols <- if (inv) setdiff(seq_len(nc), matched_cols) else matched_cols
16791758
if (length(tint_cols) > 0)
@@ -2902,12 +2981,24 @@ schema_builder <- function(input = NULL) {
29022981
if (isTRUE(flt$use_find)) {
29032982
# .find() based -- search_in determines the col/row arg to .find();
29042983
# find_select determines whether the result is rows = or columns =
2905-
pat <- flt$find_pattern
2906-
if (nchar(pat) > 0) {
2984+
find_mode_cg <- flt$find_mode %||% "pattern"
2985+
sel <- flt$find_select %||% "rows"
2986+
if (find_mode_cg == "fun" && nchar(flt$find_fun) > 0) {
2987+
search_in <- flt$find_search_in %||% "row"
2988+
dim_num <- suppressWarnings(as.integer(flt$find_dim))
2989+
find_args <- sprintf("fun = function(x) %s", flt$find_fun)
2990+
if (!is.na(dim_num)) {
2991+
if (search_in == "col")
2992+
find_args <- paste0(find_args, sprintf(", col = %d", dim_num))
2993+
else
2994+
find_args <- paste0(find_args, sprintf(", row = %d", dim_num))
2995+
}
2996+
if (inv) find_args <- paste0(find_args, ", invert = TRUE")
2997+
flt_args <- c(flt_args, sprintf("%s = .find(%s)", sel, find_args))
2998+
} else if (find_mode_cg == "pattern" && nchar(flt$find_pattern) > 0) {
29072999
search_in <- flt$find_search_in %||% "row"
2908-
sel <- flt$find_select %||% "rows"
29093000
dim_num <- suppressWarnings(as.integer(flt$find_dim))
2910-
find_args <- sprintf('pattern = "%s"', pat)
3001+
find_args <- sprintf('pattern = "%s"', flt$find_pattern)
29113002
if (!is.na(dim_num)) {
29123003
if (search_in == "col")
29133004
find_args <- paste0(find_args, sprintf(", col = %d", dim_num))

‎_pkgdown.yml‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -12,7 +12,7 @@ reference:
1212
- title: build a schema description
1313
contents:
1414
- schema
15-
- schema_default
15+
- schema_builder
1616
- setCluster
1717
- setFilter
1818
- setFormat
@@ -24,10 +24,10 @@ reference:
2424
- title: validate and debug the schema description
2525
contents:
2626
- getClusterVar
27-
- getData
2827
- getGroupVar
2928
- getIDVars
3029
- getObsVars
30+
- validateInput
3131
- validateSchema
3232
- title: reorganise tables
3333
contents:

0 commit comments

Comments
 (0)