diff --git a/.ci/atime/tests.R b/.ci/atime/tests.R index ef0b910b9..8b90c3ee7 100644 --- a/.ci/atime/tests.R +++ b/.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 ) diff --git a/.gitignore b/.gitignore index 80b74d00b..d6b5367fb 100644 --- a/.gitignore +++ b/.gitignore @@ -11,4 +11,13 @@ *pids.txt *~ .vscode/settings.json -/node_modules \ No newline at end of file +/node_modules +*.o +*.so +*.dll +src/*.o +src/*.so +src/*.dll +vignettes/*.html +vignettes/*.knit.md +vignettes/*.utf8.md \ No newline at end of file diff --git a/DESCRIPTION b/DESCRIPTION index 206a37efa..a84d0d847 100644 --- a/DESCRIPTION +++ b/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' diff --git a/NAMESPACE b/NAMESPACE index 8f94a3988..166e5c13d 100644 --- a/NAMESPACE +++ b/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) diff --git a/NEWS.md b/NEWS.md index 418df8929..f4766c6e3 100644 --- a/NEWS.md +++ b/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 `
` via `R/z_multiline.R`; JavaScript renderer converts `
` to SVG `` elements. diff --git a/R/RcppExports.R b/R/RcppExports.R new file mode 100644 index 000000000..d353c325c --- /dev/null +++ b/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) +} + diff --git a/R/rcpp-dynlib.R b/R/rcpp-dynlib.R new file mode 100644 index 000000000..0e2c047d0 --- /dev/null +++ b/R/rcpp-dynlib.R @@ -0,0 +1,3 @@ +#' @useDynLib animint2, .registration = TRUE +#' @import Rcpp +NULL diff --git a/R/z_animintHelpers.R b/R/z_animintHelpers.R index dd72287c3..5d5e3eac8 100644 --- a/R/z_animintHelpers.R +++ b/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,8 +883,6 @@ 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), @@ -814,28 +890,8 @@ getCommonChunk <- function(built, chunk.vars, aes.list){ ), 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] diff --git a/build.sh b/build.sh index ce573b3cb..74faa89bc 100644 --- a/build.sh +++ b/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 < animint2-release/tests/testthat.R library(testthat) data.table::setDTthreads(1) diff --git a/man/checkSelectorNames.Rd b/man/checkSelectorNames.Rd new file mode 100644 index 000000000..c8ffe6875 --- /dev/null +++ b/man/checkSelectorNames.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/z_animintHelpers.R +\name{checkSelectorNames} +\alias{checkSelectorNames} +\title{Validate selector names for CSS compatibility} +\usage{ +checkSelectorNames(selectors) +} +\arguments{ +\item{selectors}{selectors to validate} +} +\value{ +\code{NULL}. Throws error if invalid characters found. +} +\description{ +Validate selector names for CSS compatibility +} diff --git a/man/common_value_for_group_subset.Rd b/man/common_value_for_group_subset.Rd new file mode 100644 index 000000000..87d9e3554 --- /dev/null +++ b/man/common_value_for_group_subset.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/z_animintHelpers.R +\name{common_value_for_group_subset} +\alias{common_value_for_group_subset} +\title{Common values for one (column, group) across chunk.vars subsets.} +\usage{ +common_value_for_group_subset(value_lists) +} +\arguments{ +\item{value_lists}{list of atomic vectors, one per chunk.vars level.} +} +\value{ +list with common (list of length 1) and is.common (logical). +} +\description{ +Common values for one (column, group) across chunk.vars subsets. +} +\keyword{internal} diff --git a/man/detect_common_value_dt.Rd b/man/detect_common_value_dt.Rd new file mode 100644 index 000000000..ff5ee04ee --- /dev/null +++ b/man/detect_common_value_dt.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/z_animintHelpers.R +\name{detect_common_value_dt} +\alias{detect_common_value_dt} +\title{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().} +\usage{ +detect_common_value_dt(built, col.name.vec, chunk.vars) +} +\arguments{ +\item{built}{data.table keyed by group and chunk.vars.} + +\item{col.name.vec}{candidate column names.} + +\item{chunk.vars}{chunk variable names.} +} +\value{ +data.table with col.name, group, common, is.common. +} +\description{ +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(). +} +\keyword{internal} diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp new file mode 100644 index 000000000..a9e2e9cec --- /dev/null +++ b/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 + +using namespace Rcpp; + +#ifdef RCPP_USE_GLOBAL_ROSTREAM +Rcpp::Rostream& Rcpp::Rcout = Rcpp::Rcpp_cout_get(); +Rcpp::Rostream& 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); +} diff --git a/src/get_common_chunk.cpp b/src/get_common_chunk.cpp new file mode 100644 index 000000000..12bbdc8e9 --- /dev/null +++ b/src/get_common_chunk.cpp @@ -0,0 +1,496 @@ +#include +#include +#include +#include +#include +#include + +using namespace Rcpp; + +namespace { + +struct CellRef { + int chunk; + int row; +}; + +bool is_na_at(SEXP v, int i) { + switch (TYPEOF(v)) { + case REALSXP: return ISNA(REAL(v)[i]); + case INTSXP: return INTEGER(v)[i] == NA_INTEGER; + case LGLSXP: return LOGICAL(v)[i] == NA_LOGICAL; + case STRSXP: return STRING_ELT(v, i) == NA_STRING; + default: return false; + } +} + +bool eq_at(SEXP a, int ia, SEXP b, int ib) { + if (TYPEOF(a) != TYPEOF(b)) return false; + switch (TYPEOF(a)) { + case REALSXP: { + double da = REAL(a)[ia], db = REAL(b)[ib]; + return (ISNA(da) && ISNA(db)) || da == db; + } + case INTSXP: { + int da = INTEGER(a)[ia], db = INTEGER(b)[ib]; + return (da == NA_INTEGER && db == NA_INTEGER) || da == db; + } + case LGLSXP: { + int da = LOGICAL(a)[ia], db = LOGICAL(b)[ib]; + return (da == NA_LOGICAL && db == NA_LOGICAL) || da == db; + } + case STRSXP: + return STRING_ELT(a, ia) == STRING_ELT(b, ib); + default: + return false; + } +} + +bool eq_refs(const std::vector& vecs, CellRef a, CellRef b) { + return eq_at(vecs[a.chunk], a.row, vecs[b.chunk], b.row); +} + +bool all_same_refs(const std::vector& vecs, const std::vector& refs) { + if (refs.empty()) return false; + for (size_t k = 1; k < refs.size(); ++k) { + if (!eq_refs(vecs, refs[0], refs[k])) return false; + } + return true; +} + +/* Build an atomic vector by reading cells from original chunk vectors. + No intermediate Rf_Scalar* SEXPs are stored, so nothing needs PROTECT + across allocations (Rcpp vectors protect themselves). */ +SEXP refs_to_vector(const std::vector& vecs, const std::vector& refs) { + if (refs.empty()) return R_NilValue; + const int n = static_cast(refs.size()); + SEXP first = vecs[refs[0].chunk]; + switch (TYPEOF(first)) { + case REALSXP: { + NumericVector out(n); + for (int i = 0; i < n; ++i) { + out[i] = REAL(vecs[refs[i].chunk])[refs[i].row]; + } + return out; + } + case INTSXP: { + IntegerVector out(n); + for (int i = 0; i < n; ++i) { + out[i] = INTEGER(vecs[refs[i].chunk])[refs[i].row]; + } + return out; + } + case LGLSXP: { + LogicalVector out(n); + for (int i = 0; i < n; ++i) { + out[i] = LOGICAL(vecs[refs[i].chunk])[refs[i].row]; + } + return out; + } + case STRSXP: { + CharacterVector out(n); + for (int i = 0; i < n; ++i) { + out[i] = STRING_ELT(vecs[refs[i].chunk], refs[i].row); + } + return out; + } + default: + return R_NilValue; + } +} + +/* Allocate one scalar and immediately wrap it in a List so Rcpp's + protection covers the SEXP before any further allocation. */ +List wrap_common_scalar(const std::vector& vecs, CellRef ref) { + SEXP v = vecs[ref.chunk]; + switch (TYPEOF(v)) { + case REALSXP: + return List::create(Rf_ScalarReal(REAL(v)[ref.row])); + case INTSXP: + return List::create(Rf_ScalarInteger(INTEGER(v)[ref.row])); + case LGLSXP: + return List::create(Rf_ScalarLogical(LOGICAL(v)[ref.row])); + case STRSXP: + return List::create(Rf_ScalarString(STRING_ELT(v, ref.row))); + default: + return List::create(R_NilValue); + } +} + +List wrap_common_vector(SEXP x) { + return List::create(x); +} + +/* Same algorithm as common_value_for_group_subset_cpp, but each chunk is a + set of absolute row indices into one column vector (no per-cell SEXPs). */ +List common_value_from_row_chunks(SEXP col, const std::vector >& chunk_rows) { + const int nchunks = static_cast(chunk_rows.size()); + if (nchunks == 0) { + return List::create(Named("common") = List(), Named("is.common") = false); + } + std::vector vecs(nchunks, col); + std::vector lvec(nchunks); + for (int c = 0; c < nchunks; ++c) { + lvec[c] = static_cast(chunk_rows[c].size()); + } + if (lvec[0] > 0 && std::equal(lvec.begin() + 1, lvec.end(), lvec.begin())) { + const int gs = lvec[0]; + std::vector min_na(gs); + for (int r = 0; r < gs; ++r) { + min_na[r].chunk = 0; + min_na[r].row = chunk_rows[0][r]; + for (int c = 0; c < nchunks; ++c) { + const int abs_row = chunk_rows[c][r]; + if (!is_na_at(col, abs_row)) { + min_na[r].chunk = c; + min_na[r].row = abs_row; + break; + } + } + } + const bool ref_scalar = all_same_refs(vecs, min_na); + const CellRef ref0 = min_na[0]; + bool is_common = true; + for (int c = 0; c < nchunks && is_common; ++c) { + for (int r = 0; r < gs; ++r) { + const int abs_row = chunk_rows[c][r]; + if (is_na_at(col, abs_row)) continue; + CellRef ref = ref_scalar ? ref0 : min_na[r]; + if (!eq_at(col, abs_row, col, ref.row)) { + is_common = false; + break; + } + } + } + if (ref_scalar) { + return List::create( + Named("common") = wrap_common_scalar(vecs, ref0), + Named("is.common") = is_common + ); + } + return List::create( + Named("common") = wrap_common_vector(refs_to_vector(vecs, min_na)), + Named("is.common") = is_common + ); + } + std::vector flat; + flat.reserve(static_cast(std::accumulate(lvec.begin(), lvec.end(), 0))); + for (int c = 0; c < nchunks; ++c) { + for (size_t r = 0; r < chunk_rows[c].size(); ++r) { + CellRef ref; + ref.chunk = c; + ref.row = chunk_rows[c][r]; + flat.push_back(ref); + } + } + if (!flat.empty() && all_same_refs(vecs, flat)) { + return List::create( + Named("common") = wrap_common_scalar(vecs, flat[0]), + Named("is.common") = true + ); + } + return List::create(Named("common") = List(), Named("is.common") = false); +} + +IntegerVector column_to_codes(SEXP x) { + const int n = Rf_length(x); + IntegerVector out(n); + if (TYPEOF(x) == INTSXP || TYPEOF(x) == LGLSXP) { + for (int i = 0; i < n; ++i) out[i] = INTEGER(x)[i]; + return out; + } + if (TYPEOF(x) == REALSXP) { + std::unordered_map levels; + int next_level = 1; + for (int i = 0; i < n; ++i) { + double v = REAL(x)[i]; + if (ISNA(v)) { + out[i] = NA_INTEGER; + continue; + } + std::unordered_map::iterator it = levels.find(v); + if (it == levels.end()) { + levels[v] = next_level; + out[i] = next_level; + ++next_level; + } else { + out[i] = it->second; + } + } + return out; + } + CharacterVector chr = as(x); + std::unordered_map levels; + int next_level = 1; + for (int i = 0; i < n; ++i) { + if (CharacterVector::is_na(chr[i])) { + out[i] = NA_INTEGER; + continue; + } + std::string key = as(chr[i]); + std::unordered_map::iterator it = levels.find(key); + if (it == levels.end()) { + levels[key] = next_level; + out[i] = next_level; + ++next_level; + } else { + out[i] = it->second; + } + } + return out; +} + +IntegerVector make_combo_key(DataFrame built, CharacterVector vars, int n) { + if (vars.size() == 1) { + return column_to_codes(built[as(vars[0])]); + } + std::vector codes; + codes.reserve(vars.size()); + for (int v = 0; v < vars.size(); ++v) { + codes.push_back(column_to_codes(built[as(vars[v])])); + } + IntegerVector out(n); + std::unordered_map levels; + int next_level = 1; + for (int i = 0; i < n; ++i) { + std::string key; + bool any_na = false; + for (size_t v = 0; v < codes.size(); ++v) { + if (v > 0) key.push_back('\1'); + int code = codes[v][i]; + if (code == NA_INTEGER) { + any_na = true; + break; + } + key += std::to_string(code); + } + if (any_na) { + out[i] = NA_INTEGER; + continue; + } + std::unordered_map::iterator it = levels.find(key); + if (it == levels.end()) { + levels[key] = next_level; + out[i] = next_level; + ++next_level; + } else { + out[i] = it->second; + } + } + return out; +} + +struct ChunkRows { + int first_row; + std::vector rows; +}; + +struct GroupBuckets { + int first_row; + std::unordered_map chunks; +}; + +SEXP build_group_column(SEXP group_col, const std::vector& first_rows) { + const int n = static_cast(first_rows.size()); + switch (TYPEOF(group_col)) { + case REALSXP: { + NumericVector out(n); + for (int i = 0; i < n; ++i) out[i] = REAL(group_col)[first_rows[i]]; + return out; + } + case INTSXP: { + IntegerVector out(n); + for (int i = 0; i < n; ++i) out[i] = INTEGER(group_col)[first_rows[i]]; + return out; + } + case LGLSXP: { + LogicalVector out(n); + for (int i = 0; i < n; ++i) out[i] = LOGICAL(group_col)[first_rows[i]]; + return out; + } + case STRSXP: { + CharacterVector out(n); + for (int i = 0; i < n; ++i) out[i] = STRING_ELT(group_col, first_rows[i]); + return out; + } + default: { + List out(n); + for (int i = 0; i < n; ++i) out[i] = R_NilValue; + return out; + } + } +} + +} // namespace + +// [[Rcpp::export]] +List common_value_for_group_subset_cpp(List value_lists) { + const int nchunks = value_lists.size(); + if (nchunks == 0) { + return List::create(Named("common") = List(), Named("is.common") = false); + } + std::vector vecs(nchunks); + std::vector lvec(nchunks); + for (int c = 0; c < nchunks; ++c) { + vecs[c] = value_lists[c]; + lvec[c] = Rf_length(vecs[c]); + } + if (lvec[0] > 0 && std::equal(lvec.begin() + 1, lvec.end(), lvec.begin())) { + const int gs = lvec[0]; + /* Store (chunk, row) indices into the original vectors instead of + allocating Rf_Scalar* SEXPs. Those SEXPs would need PROTECT because + later allocations can trigger GC. Index refs need no protection. */ + std::vector min_na(gs); + for (int r = 0; r < gs; ++r) { + min_na[r].chunk = 0; + min_na[r].row = r; + for (int c = 0; c < nchunks; ++c) { + if (!is_na_at(vecs[c], r)) { + min_na[r].chunk = c; + min_na[r].row = r; + break; + } + } + } + const bool ref_scalar = all_same_refs(vecs, min_na); + const CellRef ref0 = min_na[0]; + bool is_common = true; + for (int c = 0; c < nchunks && is_common; ++c) { + for (int r = 0; r < gs; ++r) { + if (is_na_at(vecs[c], r)) continue; + CellRef ref = ref_scalar ? ref0 : min_na[r]; + if (!eq_at(vecs[c], r, vecs[ref.chunk], ref.row)) { + is_common = false; + break; + } + } + } + if (ref_scalar) { + return List::create( + Named("common") = wrap_common_scalar(vecs, ref0), + Named("is.common") = is_common + ); + } + return List::create( + Named("common") = wrap_common_vector(refs_to_vector(vecs, min_na)), + Named("is.common") = is_common + ); + } + std::vector flat; + flat.reserve(static_cast(std::accumulate(lvec.begin(), lvec.end(), 0))); + for (int c = 0; c < nchunks; ++c) { + for (int r = 0; r < lvec[c]; ++r) { + CellRef ref; + ref.chunk = c; + ref.row = r; + flat.push_back(ref); + } + } + if (!flat.empty() && all_same_refs(vecs, flat)) { + return List::create( + Named("common") = wrap_common_scalar(vecs, flat[0]), + Named("is.common") = true + ); + } + return List::create(Named("common") = List(), Named("is.common") = false); +} + +/* Outer column/group scan for issue #258: avoid data.table by= allocations + by bucketing row indices once, then comparing inside each (col, group). */ +// [[Rcpp::export]] +List detect_common_value_dt_cpp(DataFrame built, + CharacterVector col_name_vec, + CharacterVector chunk_vars) { + const int n = built.nrows(); + const int ncol = col_name_vec.size(); + if (ncol == 0 || n == 0) { + return List::create( + Named("col.name") = CharacterVector(), + Named("group") = IntegerVector(), + Named("common") = List(), + Named("is.common") = LogicalVector() + ); + } + + SEXP group_col = built["group"]; + IntegerVector group_key = column_to_codes(group_col); + IntegerVector chunk_key = make_combo_key(built, chunk_vars, n); + + /* group_key -> buckets of chunk -> row indices (column-independent). */ + std::unordered_map groups; + std::vector group_order; + group_order.reserve(static_cast(n)); + for (int i = 0; i < n; ++i) { + const int gk = group_key[i]; + const int ck = chunk_key[i]; + std::unordered_map::iterator git = groups.find(gk); + if (git == groups.end()) { + GroupBuckets gb; + gb.first_row = i; + ChunkRows cr; + cr.first_row = i; + cr.rows.push_back(i); + gb.chunks[ck] = cr; + groups[gk] = gb; + group_order.push_back(gk); + } else { + std::unordered_map::iterator cit = git->second.chunks.find(ck); + if (cit == git->second.chunks.end()) { + ChunkRows cr; + cr.first_row = i; + cr.rows.push_back(i); + git->second.chunks[ck] = cr; + } else { + cit->second.rows.push_back(i); + } + } + } + + const int ngroup = static_cast(group_order.size()); + const int nout = ncol * ngroup; + + CharacterVector out_col(nout); + LogicalVector out_is_common(nout); + List out_common(nout); + std::vector group_first_rows(static_cast(nout)); + + /* Precompute ordered chunk row vectors per group (same for every column). */ + std::vector > > group_chunks(static_cast(ngroup)); + for (int g = 0; g < ngroup; ++g) { + GroupBuckets& gb = groups[group_order[g]]; + std::vector chunk_ids; + chunk_ids.reserve(gb.chunks.size()); + for (std::unordered_map::iterator cit = gb.chunks.begin(); + cit != gb.chunks.end(); ++cit) { + chunk_ids.push_back(cit->first); + } + std::sort(chunk_ids.begin(), chunk_ids.end(), [&](int a, int b) { + return gb.chunks.find(a)->second.first_row < gb.chunks.find(b)->second.first_row; + }); + group_chunks[g].reserve(chunk_ids.size()); + for (size_t c = 0; c < chunk_ids.size(); ++c) { + group_chunks[g].push_back(gb.chunks.find(chunk_ids[c])->second.rows); + } + } + + int out_i = 0; + for (int j = 0; j < ncol; ++j) { + const std::string col_name = as(col_name_vec[j]); + SEXP col = built[col_name]; + for (int g = 0; g < ngroup; ++g, ++out_i) { + out_col[out_i] = col_name; + group_first_rows[out_i] = groups[group_order[g]].first_row; + List one = common_value_from_row_chunks(col, group_chunks[g]); + out_is_common[out_i] = as(one["is.common"]); + /* clone so the nested common SEXP stays protected after `one` dies */ + out_common[out_i] = clone(as(one["common"])); + } + } + + return List::create( + Named("col.name") = out_col, + Named("group") = build_group_column(group_col, group_first_rows), + Named("common") = out_common, + Named("is.common") = out_is_common + ); +} diff --git a/tests/testthat/test-compiler-getCommonChunk.R b/tests/testthat/test-compiler-getCommonChunk.R new file mode 100644 index 000000000..0b023a0fc --- /dev/null +++ b/tests/testthat/test-compiler-getCommonChunk.R @@ -0,0 +1,160 @@ +context("getCommonChunk") +## Pure unit test: no tests_init(), servr (port 4848), or browser required. +library(data.table) + +expect_common_varied <- function(result, common_cols, varied_cols) { + expect_type(result, "list") + expect_named(result, c("common", "varied")) + expect_true(all(common_cols %in% names(result$common))) + expect_false(any(varied_cols %in% names(result$common))) +} + +test_that("NULL when chunk.vars empty", { + built <- data.table(x = 1:4, group = 1:4) + expect_null(animint2:::getCommonChunk(built, character(), list(group = "group"))) +}) + +test_that("NULL when only one chunk subset", { + built <- data.table( + x = 1:4, + y = 5:8, + group = 1:4, + showSelected = 1 + ) + expect_null(animint2:::getCommonChunk(built, "showSelected", list(group = "group"))) +}) + +test_that("NULL when no group appears in multiple subsets", { + built <- data.table( + x = 1:4, + y = 5:8, + group = 1:4, + showSelected = 1:4 + ) + expect_null(animint2:::getCommonChunk(built, "showSelected", list(group = "group"))) +}) + +test_that("polygon-like data splits x,y into common chunk", { + ## Each group appears in showSelected 1 and 2; x,y fixed per group; fill varies. + built <- data.table( + group = rep(1:2, each = 4), + showSelected = rep(c(1, 1, 2, 2), 2), + x = rep(c(10, 20), each = 4), + y = rep(c(1, 2), each = 4), + fill = c("a", "a", "b", "b", "c", "c", "d", "d") + ) + result <- animint2:::getCommonChunk(built, "showSelected", list(group = "group")) + expect_common_varied(result, c("x", "y", "group"), "fill") + expect_equal(nrow(result$common), 2) +}) + +test_that("colour common but xy varied", { + built <- data.table( + group = rep(c("left", "right"), each = 4), + showSelected = rep(c("A", "A", "B", "B"), 2), + x = 1:8, + y = c(6, 6, 7, 7, 8, 8, 9, 9), + colour = "foo", + constant = "bar" + ) + result <- animint2:::getCommonChunk(built, "showSelected", list(group = "group")) + expect_common_varied(result, c("colour", "constant", "group"), c("x", "y")) +}) + +test_that("xy common but colour varied", { + built <- data.table( + group = rep(c("left", "right"), each = 4), + showSelected = rep(c("A", "A", "B", "B"), 2), + x = rep(c(1, 2), each = 4), + y = rep(c(7, 8), each = 4), + colour = c("red", "red", "blue", "blue", "green", "gold", "green", "gold") + ) + result <- animint2:::getCommonChunk(built, "showSelected", list(group = "group")) + expect_common_varied(result, c("x", "y", "group"), "colour") +}) + +test_that("single common column with multi-row group is allowed (#255)", { + built <- data.table( + group = rep(1:2, each = 4), + showSelected = rep(c(1, 1, 2, 2), 2), + x = c(10, 20, 10, 20, 30, 40, 30, 40), + y = rnorm(8), + colour = rnorm(8) + ) + result <- animint2:::getCommonChunk(built, "showSelected", list(group = "group")) + expect_common_varied(result, c("x", "group"), c("y", "colour")) +}) + +test_that("single common column with one row per group returns NULL", { + built <- data.table( + x = 1:4, + y = rnorm(4), + group = 1:4, + colour = "red", + showSelected = rep(1:2, each = 2) + ) + expect_null(animint2:::getCommonChunk(built, "showSelected", list(group = "group"))) +}) + +test_that("NA paths keep na_group and row_in_group in varied data", { + built <- data.table( + group = rep(1:2, each = 4), + showSelected = rep(c(1, 1, 2, 2), 2), + x = c(NA, 2, NA, 2, NA, 5, NA, 5), + y = 1:8, + na_group = c(0, 0, 1, 0, 0, 0, 1, 0), + row_in_group = c(1, 2, 1, 2, 1, 2, 1, 2) + ) + result <- animint2:::getCommonChunk(built, "showSelected", list(group = "group")) + expect_type(result, "list") + chunk1 <- result$varied[["1"]] + expect_true(all(c("na_group", "row_in_group", "y") %in% names(chunk1))) + expect_false("x" %in% names(chunk1)) +}) + +test_that("factors are treated as character", { + built <- data.table( + group = rep(1:2, each = 4), + showSelected = factor(rep(c(1, 1, 2, 2), 2)), + x = rep(c(10, 20), each = 4), + y = rep(c(1, 2), each = 4), + fill = factor(c("a", "a", "b", "b", "c", "c", "d", "d")) + ) + result <- animint2:::getCommonChunk(built, "showSelected", list(group = "group")) + expect_common_varied(result, c("x", "y", "group"), "fill") +}) + +test_that("C++ and R detect_common_value_dt agree", { + built <- data.table( + group = rep(1:2, each = 4), + showSelected = rep(c(1, 1, 2, 2), 2), + x = rep(c(10, 20), each = 4), + y = rep(c(1, 2), each = 4), + colour = rep(c("r", "g"), each = 4), + na_group = 0, + row_in_group = 1:4 + ) + chunk.vars <- "showSelected" + col.name.vec <- c("x", "y", "colour") + setkeyv(built, c("group", chunk.vars)) + ## Do not use with(options(...), ...): options() sets globally and + ## with() does not restore. Capture/restore so R and C++ paths differ. + old.opt <- options(animint2.use.cpp = FALSE) + on.exit(options(old.opt), add = TRUE) + r_dt <- animint2:::detect_common_value_dt(built, col.name.vec, chunk.vars) + options(animint2.use.cpp = TRUE) + if(exists("detect_common_value_dt_cpp", where = asNamespace("animint2"), mode = "function")){ + cpp_dt <- animint2:::detect_common_value_dt(built, col.name.vec, chunk.vars) + setorder(r_dt, col.name, group) + setorder(cpp_dt, col.name, group) + expect_equal(nrow(r_dt), nrow(cpp_dt)) + expect_equal(r_dt$col.name, cpp_dt$col.name) + expect_equal(r_dt$group, cpp_dt$group) + expect_equal(r_dt$is.common, cpp_dt$is.common) + for(i in seq_len(nrow(r_dt))){ + expect_equal(r_dt$common[[i]], cpp_dt$common[[i]]) + } + } else { + skip("C++ not compiled") + } +}) diff --git a/vignettes/get-common-chunk-cpp.Rmd b/vignettes/get-common-chunk-cpp.Rmd new file mode 100644 index 000000000..375b49826 --- /dev/null +++ b/vignettes/get-common-chunk-cpp.Rmd @@ -0,0 +1,384 @@ +--- +title: "get_common_chunk.cpp: C++ common chunk detection" +author: "animint2 contributors" +date: "`r Sys.Date()`" +output: rmarkdown::html_vignette +vignette: > + %\VignetteIndexEntry{get_common_chunk.cpp: C++ common chunk detection} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r setup, include=FALSE} +knitr::opts_chunk$set(collapse = TRUE, comment = "#>") +``` + +Guide to the issue [#258](https://github.com/animint/animint2/issues/258) C++ work for +`getCommonChunk()`: what each file does, how the code fits together, and how to test it. + +## Problem + +Interactive plots split geom data into multiple chunk TSV files (one per selector value). +Often `x`, `y`, and `group` are identical across chunks; only `fill` (or similar) changes. + +``` +geom1_polygon_chunk_common.tsv -> x, y, group (written once) +geom1_polygon_chunk1.tsv -> fill, group +geom1_polygon_chunk2.tsv -> fill, group +``` + +`getCommonChunk()` detects shared columns at compile time and splits output into a +common TSV plus smaller varied TSVs. The browser merges them with `copy_chunk()` in +`inst/htmljs/animint.js`. + +## Architecture (current) + +C++ handles **inner compare only** (~154 lines). R handles grouping, assembly, and file I/O. + +``` +geom-.r + └─ getCommonChunk() [R/z_animintHelpers.R] + └─ detect_common_value_dt() + ├─ detect_common_value_dt_cpp() [src/get_common_chunk.cpp] + └─ R fallback: by= grouping + common_value_for_group_subset() + └─ common_value_for_group_subset_cpp() [inner compare] + └─ R fallback + └─ dcast, split_recursive, varied.chunk + └─ fwrite *_chunk_common.tsv [geom-.r] + └─ saveChunks() -> *_chunkN.tsv [R/z_animintHelpers.R] + +Browser: copy_chunk() in inst/htmljs/animint.js +``` + +## Files changed for issue #258 + +| File | Role | +|------|------| +| `src/get_common_chunk.cpp` | C++ column/group scan + inner compare | +| `src/RcppExports.cpp` | Auto-generated `.Call` registration | +| `R/RcppExports.R` | R wrapper calling C++ | +| `R/z_animintHelpers.R` | `common_value_for_group_subset()`, `detect_common_value_dt()`, `getCommonChunk()` | +| `R/geom-.r` | Calls `getCommonChunk()`; adds `na_group`, `row_in_group` (unchanged API) | +| `DESCRIPTION` | `Imports: Rcpp`, `LinkingTo: Rcpp` | +| `NAMESPACE` | `useDynLib(animint2, .registration = TRUE)` | +| `tests/testthat/test-compiler-getCommonChunk.R` | 11 unit tests | +| `.ci/atime/tests.R` | Performance benchmark for post-#242 NA workload | +| `NEWS.md` | Changelog entry | + + +--- + +## File: `src/get_common_chunk.cpp` + +**Exported function:** `common_value_for_group_subset_cpp(List value_lists)` + +**Input:** list of atomic vectors, one per chunk subset (e.g. each `showSelected` level) +for one `(column, group)`. + +**Output:** named list: + +```r +list(common = list(...), is.common = TRUE/FALSE) +``` + +Must match R shape: `common` is a list of length 1 whose element is an atomic vector +(or scalar). Use `wrap_common()` in C++ so data.table does not duplicate rows. + +### Internal helpers + +| Function | Lines (approx) | Role | +|----------|----------------|------| +| `is_na_at(v, i)` | 9-17 | NA test on vector element | +| `eq_at(a, ia, b, ib)` | 19-39 | Equal with NA = NA | +| `scalar_at(v, i)` | 41-49 | One cell as SEXP via `Rf_Scalar*` | +| `all_same(xs)` | 51-57 | All scalars equal | +| `scalars_to_vector(xs)` | 59-86 | Build atomic vector for R `common` | +| `wrap_common(x)` | 88-90 | `list(x)` wrapper | +| `common_value_for_group_subset_cpp` | 94-153 | Exported entry point | + +### Algorithm (mirrors R `common_value_for_group_subset()`) + +1. If all chunk vectors have equal length: build matrix, `min_na` per row, NA-tolerant + compare (PR #242). +2. Else if one unique value across all elements: scalar common. +3. Else: not common (`common = list()`, `is.common = FALSE`). + +### Design + +- R groups; C++ compares (small review surface). +- No file I/O in C++. +- `Rf_Scalar*` required on Windows / R 4.5+. +- SEXP types preserve mixed column types (numeric, character, etc.). + +--- + +## File: `R/z_animintHelpers.R` + +### `common_value_for_group_subset(value_lists)` + +~20 lines. Core R logic. Calls C++ when compiled: + +```r +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) +} +# R fallback: matrix + min.na.vec + all(..., na.rm = TRUE) +``` + +### `detect_common_value_dt(built, col.name.vec, chunk.vars)` + +Loops columns. For each column, groups by `group`, splits by `chunk.vars`, calls +`common_value_for_group_subset()` on each group's chunk vectors. + +Per-column loop (not `melt()`) keeps mixed column types correct. + +### `getCommonChunk(built, chunk.vars, aes.list)` + +Public entry used from `geom-.r`: + +1. Early exits (no chunk vars, one subset, no group in multiple subsets). +2. `detect_common_value_dt()` to find common columns. +3. If 2+ common columns (partial) or 1 common column with multi-row group (#255): + build `common` data.frame and `varied` nested list via `split_recursive()` / + `varied.chunk()`. +4. Return `list(common = ..., varied = ...)` or `NULL`. + +--- + +## File: `R/RcppExports.R` + +Auto-generated by `Rcpp::compileAttributes()`: + +```r +common_value_for_group_subset_cpp <- function(value_lists) { + .Call(`_animint2_common_value_for_group_subset_cpp`, value_lists) +} +``` + +--- + +## File: `R/geom-.r` + +Before `getCommonChunk()`: + +- Sets default `group = 1` when user omits `aes(group)` (#255). +- Adds `na_group` and `row_in_group` for NA path handling (#242). + +Then: + +```r +data.or.null <- getCommonChunk(g.data, chunk.cols, g$aes) +``` + +If non-NULL, writes `*_chunk_common.tsv` and passes `varied` to `saveChunks()`. + +--- + +## File: `inst/htmljs/animint.js` + +`copy_chunk(g_info, varied_chunk)` merges downloaded varied TSV rows with cached +common TSV rows. When NAs split paths, `row_in_group` picks the matching common row. + +--- + +## Why SEXP? + +**SEXP** = **S EXpression**, R's universal C type. Comparisons use R NA rules across +numeric, integer, logical, and character columns. + +| Name | Meaning | +|------|---------| +| `is_na_at(v, i)` | Is row `i` of vector `v` NA? | +| `eq_at(a, ia, b, ib)` | Equal with NA = NA? | +| `scalar_at(v, i)` | One cell as length-1 SEXP | + +--- + +## Worked example + +| row | group | showSelected | x | y | fill | +|-----|-------|--------------|---|---|------| +| 0 | 1 | 1 | 10 | 1 | a | +| 1 | 1 | 1 | 20 | 1 | a | +| 2 | 1 | 2 | 10 | 2 | b | +| 3 | 1 | 2 | 20 | 2 | b | +| 4 | 2 | 1 | 30 | 1 | c | +| 5 | 2 | 1 | 40 | 1 | c | +| 6 | 2 | 2 | 30 | 2 | d | +| 7 | 2 | 2 | 40 | 2 | d | + +For group 1, column `x`: chunks `[10, 20]` and `[10, 20]` -> common. +Column `fill`: `[a, a]` vs `[b, b]` -> not common. + +Result: common TSV has `x`, `y`, `group`; varied chunks have `fill` only. + +```{r quick-example, eval=FALSE} +library(animint2) +library(data.table) + +built <- data.table( + group = rep(1:2, each = 4), + showSelected = rep(c(1, 1, 2, 2), 2), + x = rep(c(10, 20), each = 4), + y = rep(c(1, 2), each = 4), + fill = c("a", "a", "b", "b", "c", "c", "d", "d") +) +setkeyv(built, c("group", "showSelected")) + +dt <- animint2:::detect_common_value_dt(built, c("x", "y", "fill"), "showSelected") +dt[, .(col.name, group, is.common)] + +result <- animint2:::getCommonChunk(built, "showSelected", list(group = "group")) +names(result$common) +result$varied +``` + +During development use `devtools::load_all()` instead of `library(animint2)`. + +## NA example (PR #242) + +| group | showSelected | x | +|-------|--------------|---| +| 1 | 1 | NA | +| 1 | 1 | 2 | +| 1 | 2 | NA | +| 1 | 2 | 2 | + +Chunks `[NA, 2]` vs `[NA, 2]`: row 1 NA skipped, row 2 matches -> `x` is common. + +--- + +## Tests + +**File:** `tests/testthat/test-compiler-getCommonChunk.R` + +Pure unit tests: no browser, no `tests_init()`, no port 4848 server. + +| Test | What it checks | +|------|----------------| +| `NULL when chunk.vars empty` | Early exit | +| `NULL when only one chunk subset` | Early exit | +| `NULL when no group appears in multiple subsets` | Early exit | +| `polygon-like data splits x,y into common chunk` | Typical map/polygon case | +| `colour common but xy varied` | Partial common (2+ common cols) | +| `xy common but colour varied` | Partial common | +| `single common column with multi-row group is allowed (#255)` | One common col OK | +| `single common column with one row per group returns NULL` | One common col rejected | +| `NA paths keep na_group and row_in_group in varied data` | PR #242 sparse cols | +| `factors are treated as character` | Factor coercion | +| `C++ and R detect_common_value_dt agree` | C++ vs R fallback match | + +### Run tests (fast) + +From package root: + +```{r run-tests, eval=FALSE} +library(devtools) +load_all() +library(testthat) +library(data.table) + +testthat::test_file("tests/testthat/test-compiler-getCommonChunk.R") +``` + +Expected: `[ FAIL 0 | WARN 0 | SKIP 0 | PASS 38 ]` (11 tests, 38 expectations). + +Skip `tests_init()` and `helper-HTML.R` for this file; they are only for renderer tests. + +### Compare C++ vs R manually + +```{r compare-cpp-r, eval=FALSE} +options(animint2.use.cpp = FALSE) # R inner compare only +r_result <- animint2:::getCommonChunk(built, "showSelected", list(group = "group")) + +options(animint2.use.cpp = TRUE) # C++ inner compare (default) +cpp_result <- animint2:::getCommonChunk(built, "showSelected", list(group = "group")) + +identical(r_result, cpp_result) +``` + +### Existing integration tests (should still pass) + +After changing `getCommonChunk()` code, also run: + +```{r integration-tests, eval=FALSE} +files <- c( + "test-compiler-save-separate-chunks.R", + "test-renderer1-chunk-vars.R", + "test-renderer3-chunk-NA-separate-lines.R", + "test-renderer1-chunk-WorldBank-NA.R", + "test-renderer2-VariantModels.R" +) +for (f in files) { + testthat::test_file(file.path("tests/testthat", f)) +} +``` + +Integration tests need `tests_init()` (browser + servr on port 4848). + +### Performance benchmark + +```{r atime, eval=FALSE} +install.packages("atime") +source(".ci/atime/tests.R") +atime::atime(test.list = test.list) +``` + +Benchmarks: `getCommonChunk improved in #238` and `getCommonChunk post-#242 NA workload`. + +### Windows setup + +C++ requires Rtools matching your R version. If `devtools::load_all()` fails: + +```powershell +winget install RProject.Rtools --accept-package-agreements --accept-source-agreements +$env:Path = "C:\rtools45\usr\bin;C:\rtools45\mingw64\bin;" + $env:Path +``` + +--- + +## Debug options + +```{r debug, eval=FALSE} +options(animint2.use.cpp = FALSE) # force R inner compare +options(animint2.use.cpp = TRUE) # restore default + +# verify C++ compiled +"common_value_for_group_subset_cpp" %in% ls(asNamespace("animint2"), all = TRUE) +``` + +--- + +## Issue history (brief) + +| PR | Change | +|----|--------| +| [#238](https://github.com/animint/animint2/pull/238) | Vectorized R; faster but incomplete | +| [#242](https://github.com/animint/animint2/pull/242) | NA matrix logic, `na_group`, `row_in_group` | +| [#255](https://github.com/animint/animint2/pull/255) | `group = 1` default, single common column, points | +| [#258](https://github.com/animint/animint2/issues/258) | C++ inner compare; R grouping unchanged | + +--- + +## C++ to R mapping + +| C++ | R (`R/z_animintHelpers.R`) | +|-----|----------------------------| +| `common_value_for_group_subset_cpp` | `common_value_for_group_subset()` | +| matrix + NA loop | `all(m == min.na.vec, na.rm = TRUE)` | +| `is_na_at` / `eq_at` | `is.na` / `==` with `na.rm` | +| (grouping) | `detect_common_value_dt()` per-column loop | + +--- + +## References + +- [Issue #258](https://github.com/animint/animint2/issues/258) +- [PR #238](https://github.com/animint/animint2/pull/238) +- [PR #242](https://github.com/animint/animint2/pull/242) +- [PR #255](https://github.com/animint/animint2/pull/255) +- `tests/testthat/test-compiler-getCommonChunk.R`