fix/258-getcommonChunk code in C++

.ci/atime/tests.R

@@ -1,14 +1,34 @@
 test.list <- atime::atime_test_list(
-  ## Adapted from https://github.com/animint/animint2/issues/235#issuecomment-3342083861
-  "getCommonChunk improved in #238"=atime::atime_test(
+  ## Historical #238 Slow/Fast commits fail `R CMD INSTALL` on current CI:
+  ## old man/geom_dotplot.Rd still has build-stage \Sexpr that looks up
+  ## GeomDotplot, which errors with "No geom called GeomDotplot".
+  ## Keep only the #258 C++ comparison for PR
+  ## https://github.com/animint/animint2/pull/342
+  ##
+  ## Issue #258: column/group C++ scan vs pre-C++ master.
+  ## Slow = before first C++ commit on PR #342 (R by= loop).
+  ## Fast = inner-compare-only C++ (188cb342). After this commit, HEAD is
+  ## the full detect_common_value_dt_cpp scan; CI also times HEAD.
+  ## Workload must (1) put each group in both showSelected values and
+  ## (2) produce a non-NULL common chunk, or the bench never hits C++.
+  "getCommonChunk C++ #258"=atime::atime_test(
     expr=animint2:::getCommonChunk(built, "showSelected", list(group="group")),
     setup={
+      ## atime supplies N; keep row count divisible by 4 for this workload.
+      n <- 4L * as.integer(N / 4L)
+      if(n < 4L) n <- 4L
+      ng <- as.integer(n / 4L)
       built <- data.table(
-        x=1:N,
-        group=rep(seq(1,N/2), each=2),
-        showSelected=1:2)
+        x=rep(seq_len(ng), each=4L),
+        y=rep(seq_len(ng), each=4L),
+        fill=rep(c("a","a","b","b"), length.out=n),
+        group=rep(seq_len(ng), each=4L),
+        showSelected=rep(c(1L, 1L, 2L, 2L), length.out=n),
+        na_group=0L,
+        row_in_group=rep(1:4, length.out=n)
+      )
     },
-    seconds.limit=1,
-    Slow="352f7e10040cb9de6ddd16416d342e9746c14c7a", # Parent of the first commit (https://github.com/animint/animint2/commit/121a11399e7d6ca6c822cd22472886c6d4d8cf10) of the PR (https://github.com/animint/animint2/pull/238/commits).
-    Fast="30950779702e6c8aeecd24aeb737c9fa5ce898e0") # Last commit in the PR (https://github.com/animint/animint2/pull/238/commits).
+    seconds.limit=2,
+    Slow="9dce8611495357d4441793b9494bbce11fcc1a9f", # Parent of first C++ commit https://github.com/animint/animint2/commit/623545cb
+    Fast="188cb3422ee0c87d9a71c06ab42a67b9dccb4be0") # Inner-compare-only C++; HEAD after grouping-scan commit is the real Fast path
 )

.gitignore

@@ -11,4 +11,13 @@
 *pids.txt
 *~
 .vscode/settings.json
-/node_modules
+/node_modules
+*.o
+*.so
+*.dll
+src/*.o
+src/*.so
+src/*.dll
+vignettes/*.html
+vignettes/*.knit.md
+vignettes/*.utf8.md

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: animint2
 Title: Animated Interactive Grammar of Graphics
-Version: 2026.7.29
+Version: 2026.8.1
 URL: https://animint.github.io/animint2
 BugReports: https://github.com/animint/animint2/issues
 Authors@R: c(
@@ -92,7 +92,8 @@ Imports:
     stats,
     knitr (>= 1.5.33),
     data.table (>= 1.9.8),
-    methods
+    methods,
+    Rcpp
 Suggests:
     gert, gitcreds, gh,
     sp,
@@ -120,9 +121,11 @@ Suggests:
     chromote,
     magick
 License: GPL-3
+LinkingTo: Rcpp
 Encoding: UTF-8
 LazyData: true
 Collate:
+    'RcppExports.R'
     'gganimintproto.r'
     'aaa-.r'
     'aes-calculated.r'
@@ -232,6 +235,7 @@ Collate:
     'position-stack.r'
     'quick-plot.r'
     'range.r'
+    'rcpp-dynlib.R'
     'save.r'
     'scale-.r'
     'scale-alpha.r'

NAMESPACE

@@ -503,6 +503,7 @@ export(ylab)
 export(ylim)
 export(zeroGrob)
 import(RJSONIO)
+import(Rcpp)
 import(data.table)
 import(grid)
 import(gtable)
@@ -526,3 +527,4 @@ importFrom(utils,packageVersion)
 importFrom(utils,str)
 importFrom(utils,tail)
 importFrom(utils,write.table)
+useDynLib(animint2, .registration = TRUE)

NEWS.md

@@ -1,3 +1,10 @@
+# Changes in version 2026.8.1 (issue #258)
+
+- `getCommonChunk()` uses `detect_common_value_dt()` with a C++ column/group scan (`detect_common_value_dt_cpp`) and R data.table fallback (issue #258).
+- `common_value_for_group_subset_cpp()` remains available for the inner compare; R fallback when C++ is unavailable.
+- New unit tests in `test-compiler-getCommonChunk.R`.
+- New atime benchmark for post-#242 NA common-chunk workload. Thanks @nishita-shah1
+
 # Changes in version 2026.7.29 (PR#261)
 
 - Multi-line text support (issue #221): `\n` now works in plot titles, axis titles, legend titles, and `geom_text()` labels. R compiler converts newlines to `<br/>` via `R/z_multiline.R`; JavaScript renderer converts `<br/>` to SVG `<tspan>` elements.

R/RcppExports.R

@@ -0,0 +1,11 @@
+# Generated by using Rcpp::compileAttributes() -> do not edit by hand
+# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
+
+common_value_for_group_subset_cpp <- function(value_lists) {
+    .Call(`_animint2_common_value_for_group_subset_cpp`, value_lists)
+}
+
+detect_common_value_dt_cpp <- function(built, col_name_vec, chunk_vars) {
+    .Call(`_animint2_detect_common_value_dt_cpp`, built, col_name_vec, chunk_vars)
+}
+

R/rcpp-dynlib.R

@@ -0,0 +1,3 @@
+#' @useDynLib animint2, .registration = TRUE
+#' @import Rcpp
+NULL

R/z_animintHelpers.R

@@ -769,6 +769,84 @@ getTextSize <- function(element.name, theme){
   paste(input.size, "pt", sep="")
 }
 
+##' Common values for one (column, group) across chunk.vars subsets.
+##' @param value_lists list of atomic vectors, one per chunk.vars level.
+##' @return list with common (list of length 1) and is.common (logical).
+##' @keywords internal
+common_value_for_group_subset <- function(value_lists){
+  if(isTRUE(getOption("animint2.use.cpp", TRUE))){
+    cpp_out <- tryCatch(
+      common_value_for_group_subset_cpp(value_lists),
+      error=function(e) NULL
+    )
+    if(!is.null(cpp_out)) return(cpp_out)
+  }
+  lvec <- vapply(value_lists, length, integer(1))
+  value.vec <- unlist(value_lists, use.names=FALSE)
+  if(length(lvec) > 0 && all(lvec[1] == lvec)){
+    group.size <- lvec[1]
+    m <- matrix(value.vec, group.size)
+    min.na.vec <- apply(m, 1, function(x) x[!is.na(x)][1])
+    if(length(unique(min.na.vec)) == 1){
+      min.na.vec <- min.na.vec[1]
+    }
+    list(
+      common=list(min.na.vec),
+      is.common=all(m == min.na.vec, na.rm=TRUE)
+    )
+  }else if(length(unique(value.vec)) == 1){
+    list(common=list(value.vec[1]), is.common=TRUE)
+  }else{
+    list(common=list(), is.common=FALSE)
+  }
+}
+
+##' Detect common column values for each group.
+##' Prefer C++ column/group scan (issue #258); fall back to R
+##' data.table by= loop + common_value_for_group_subset().
+##' @param built data.table keyed by group and chunk.vars.
+##' @param col.name.vec candidate column names.
+##' @param chunk.vars chunk variable names.
+##' @return data.table with col.name, group, common, is.common.
+##' @keywords internal
+detect_common_value_dt <- function(built, col.name.vec, chunk.vars){
+  group <- col.name <- value <- common <- is.common <- NULL
+  if(length(col.name.vec) == 0){
+    return(data.table(
+      col.name=character(),
+      group=integer(),
+      common=list(),
+      is.common=logical()
+    ))
+  }
+  if(isTRUE(getOption("animint2.use.cpp", TRUE))){
+    cpp_out <- tryCatch(
+      detect_common_value_dt_cpp(built, col.name.vec, chunk.vars),
+      error=function(e) NULL
+    )
+    if(!is.null(cpp_out)){
+      dt <- as.data.table(cpp_out)
+      ## Match R data.table by= shape: list(value) unwraps to value so
+      ## sapply(common, length) is the vector length (needed for #255).
+      dt[, common := lapply(common, function(x) {
+        if(is.null(x)) list()
+        else if(!is.list(x)) x
+        else if(length(x) == 1L) x[[1]]
+        else x
+      })]
+      return(dt)
+    }
+  }
+  chunk.cols <- chunk.vars
+  rbindlist(lapply(col.name.vec, function(cn) {
+    built[, {
+      group_dt <- .SD[, list(value_list = list(get(cn))), by = chunk.cols]
+      cv <- common_value_for_group_subset(group_dt$value_list)
+      list(common = cv$common, is.common = cv$is.common)
+    }, by = group][, col.name := cn]
+  }))
+}
+
 ##' Save the common columns for each tsv to one chunk
 ##' @param built data.frame of built data.
 ##' @param chunk.vars which variables to chunk on.
@@ -779,7 +857,7 @@ getTextSize <- function(element.name, theme){
 ##' @importFrom stats na.omit
 ##' @import data.table
 getCommonChunk <- function(built, chunk.vars, aes.list){
-  group <- col.name <- group.size <- ok <- all.common <- size <- showSelected_values <- common <- NULL
+  group <- col.name <- group.size <- ok <- all.common <- size <- showSelected_values <- common <- is.common <- NULL
   ## Above to avoid CRAN NOTE.
   if(length(chunk.vars) == 0){
     return(NULL)
@@ -805,37 +883,15 @@ getCommonChunk <- function(built, chunk.vars, aes.list){
   g_chunk <- c("group", chunk.vars)
   setkeyv(built, g_chunk)
   group_size_dt <- built[, .(size=.N), by=c("group",chunk.vars)]
-  ## first_ss_dt <- built[, .SD[1], by=group, .SDcols=chunk.vars]
-  ## setkeyv(first_ss_dt, g_chunk)
   ss_count_dt <- group_size_dt[, .(
     showSelected_values=.N,
     min_size=min(size),
     max_size=max(size)
   ), by=group]
   groups_in_several_ss <- ss_count_dt[showSelected_values>1]
   if(nrow(groups_in_several_ss)==0)return(NULL)
-  common_value_dt <- data.table(col.name=col.name.vec)[, {
-    built[, {
-      group_dt <- .SD[, list(value_list=list(get(col.name))), by=chunk.vars]
-      lvec <- sapply(group_dt$value_list, length)
-      value.vec <- unlist(group_dt$value_list)
-      if(all(lvec[1]==lvec)){
-        group.size <- lvec[1]
-        m <- matrix(value.vec, group.size)
-        min.na.vec <- apply(m,1,function(x)x[!is.na(x)][1])
-        if(length(unique(min.na.vec))==1){
-          min.na.vec <- min.na.vec[1]
-        }
-        is.common <- all(m==min.na.vec,na.rm=TRUE)
-        ##if(anyNA(min.na.vec))is.common <- FALSE #TODO maybe could relax?
-        data.table(common=list(min.na.vec), is.common)
-      }else if(length(unique(value.vec))==1){
-        data.table(common=list(value.vec[1]), is.common=TRUE)
-      }else{
-        data.table(common=list(), is.common=FALSE)
-      }
-    }, by=group]
-  }, keyby=col.name]
+  common_value_dt <- detect_common_value_dt(built, col.name.vec, chunk.vars)
+  setkeyv(common_value_dt, "col.name")
   common_var_dt <- common_value_dt[, .(
     all.common=all(is.common)
   ), keyby=col.name]

build.sh

@@ -23,6 +23,7 @@ rm animint2-release/tests/testthat/helper-HTML.R
 rm animint2-release/tests/testthat/test-compiler-chunk-vars.R
 rm animint2-release/tests/testthat/test-compiler-ghpages.R
 rm animint2-release/vignettes/animint2.Rmd #to save disk space
+rm animint2-release/vignettes/get-common-chunk-cpp.Rmd # CRAN release has no VignetteBuilder
 cat <<EOF > animint2-release/tests/testthat.R 
 library(testthat)
 data.table::setDTthreads(1)

src/RcppExports.cpp

@@ -0,0 +1,47 @@
+// Generated by using Rcpp::compileAttributes() -> do not edit by hand
+// Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
+
+#include <Rcpp.h>
+
+using namespace Rcpp;
+
+#ifdef RCPP_USE_GLOBAL_ROSTREAM
+Rcpp::Rostream<true>&  Rcpp::Rcout = Rcpp::Rcpp_cout_get();
+Rcpp::Rostream<false>& Rcpp::Rcerr = Rcpp::Rcpp_cerr_get();
+#endif
+
+// common_value_for_group_subset_cpp
+List common_value_for_group_subset_cpp(List value_lists);
+RcppExport SEXP _animint2_common_value_for_group_subset_cpp(SEXP value_listsSEXP) {
+BEGIN_RCPP
+    Rcpp::RObject rcpp_result_gen;
+    Rcpp::RNGScope rcpp_rngScope_gen;
+    Rcpp::traits::input_parameter< List >::type value_lists(value_listsSEXP);
+    rcpp_result_gen = Rcpp::wrap(common_value_for_group_subset_cpp(value_lists));
+    return rcpp_result_gen;
+END_RCPP
+}
+// detect_common_value_dt_cpp
+List detect_common_value_dt_cpp(DataFrame built, CharacterVector col_name_vec, CharacterVector chunk_vars);
+RcppExport SEXP _animint2_detect_common_value_dt_cpp(SEXP builtSEXP, SEXP col_name_vecSEXP, SEXP chunk_varsSEXP) {
+BEGIN_RCPP
+    Rcpp::RObject rcpp_result_gen;
+    Rcpp::RNGScope rcpp_rngScope_gen;
+    Rcpp::traits::input_parameter< DataFrame >::type built(builtSEXP);
+    Rcpp::traits::input_parameter< CharacterVector >::type col_name_vec(col_name_vecSEXP);
+    Rcpp::traits::input_parameter< CharacterVector >::type chunk_vars(chunk_varsSEXP);
+    rcpp_result_gen = Rcpp::wrap(detect_common_value_dt_cpp(built, col_name_vec, chunk_vars));
+    return rcpp_result_gen;
+END_RCPP
+}
+
+static const R_CallMethodDef CallEntries[] = {
+    {"_animint2_common_value_for_group_subset_cpp", (DL_FUNC) &_animint2_common_value_for_group_subset_cpp, 1},
+    {"_animint2_detect_common_value_dt_cpp", (DL_FUNC) &_animint2_detect_common_value_dt_cpp, 3},
+    {NULL, NULL, 0}
+};
+
+RcppExport void R_init_animint2(DllInfo *dll) {
+    R_registerRoutines(dll, NULL, CallEntries, NULL, NULL);
+    R_useDynamicSymbols(dll, FALSE);
+}