fix/258-getcommonChunk code in C++

.ci/atime/tests.R

@@ -10,5 +10,21 @@ test.list <- atime::atime_test_list(
     },
     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).
+    Fast="30950779702e6c8aeecd24aeb737c9fa5ce898e0"), # Last commit in the PR (https://github.com/animint/animint2/pull/238/commits).
+  ## Post-#242 workload with NA groups and multiple common columns (#258)
+  "getCommonChunk post-#242 NA workload"=atime::atime_test(
+    expr=animint2:::getCommonChunk(built, "showSelected", list(group="group")),
+    setup={
+      N <- 2000
+      built <- data.table(
+        x=rep(1:5, length.out=N),
+        y=rnorm(N),
+        colour="foo",
+        group=rep(seq_len(N/4), each=4),
+        showSelected=rep(1:2, each=N/2),
+        na_group=rep(c(0,0,1,0), length.out=N),
+        row_in_group=rep(1:4, length.out=N)
+      )
+    },
+    seconds.limit=2)
 )

.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

@@ -89,7 +89,8 @@ Imports:
     stats,
     knitr (>= 1.5.33),
     data.table (>= 1.9.8),
-    methods
+    methods,
+    Rcpp
 Suggests:
     gert, gitcreds, gh,
     sp,
@@ -117,9 +118,11 @@ Suggests:
     chromote,
     magick
 License: GPL-3
+LinkingTo: Rcpp
 Encoding: UTF-8
 LazyData: true
 Collate:
+    'RcppExports.R'
     'gganimintproto.r'
     'aaa-.r'
     'aes-calculated.r'
@@ -229,6 +232,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

@@ -2,6 +2,13 @@
 
 - `geom(showSelected=character())` means to opt-out of interactive legends. Thanks @ANAMASGARD.
 
+# Changes in version TBD (issue #258)
+
+- `getCommonChunk()` uses `detect_common_value_dt()` with a C++ fast path and per-column R fallback instead of the old nested per-column scan.
+- `common_value_for_group_subset_cpp()` in C++ accelerates the inner compare in `getCommonChunk()`; R handles grouping; R fallback when 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.3.8 (PR#311)
 
 - `geom_dotplot()` has been removed. Use `geom_point()` instead for interactive visualizations. (Fixed #289)

R/RcppExports.R

@@ -0,0 +1,7 @@
+# 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)
+}
+

R/rcpp-dynlib.R

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

R/z_animintHelpers.R

@@ -761,6 +761,66 @@ 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.
+##' Grouping stays in R; inner compare may use C++ via
+##' 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()
+    ))
+  }
+  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.
@@ -771,7 +831,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)
@@ -797,37 +857,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,33 @@
+// 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
+}
+
+static const R_CallMethodDef CallEntries[] = {
+    {"_animint2_common_value_for_group_subset_cpp", (DL_FUNC) &_animint2_common_value_for_group_subset_cpp, 1},
+    {NULL, NULL, 0}
+};
+
+RcppExport void R_init_animint2(DllInfo *dll) {
+    R_registerRoutines(dll, NULL, CallEntries, NULL, NULL);
+    R_useDynamicSymbols(dll, FALSE);
+}