From 1ffa34322fb57edcddbb45ce02c8bff5069c9537 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franti=C5=A1ek=20Barto=C5=A1?= Date: Tue, 26 May 2026 10:50:15 +0200 Subject: [PATCH 01/11] Decode embedded column names in analysis results --- R/resultDecoding.R | 50 ++++++++++++++++++++++++++- tests/testthat/test-dataset-helpers.R | 12 +++++-- 2 files changed, 58 insertions(+), 4 deletions(-) diff --git a/R/resultDecoding.R b/R/resultDecoding.R index 9ac8623..2a9c6f6 100644 --- a/R/resultDecoding.R +++ b/R/resultDecoding.R @@ -141,10 +141,21 @@ decodeAnalysisResults <- function(results, requestedDataset = NULL, decoded <- unname(columnMapping[columnNames]) matched <- !is.na(decoded) columnNames[matched] <- decoded[matched] + columnNames[!matched] <- .replaceAnalysisResultColumnNameTokens( + columnNames[!matched], + columnMapping + ) return(columnNames) } - decodeColumnNames(columnNames, strict = FALSE) + decoded <- decodeColumnNames(columnNames, strict = FALSE) + tokens <- unique(unlist(.analysisResultColumnNameTokens(columnNames), use.names = FALSE)) + if (length(tokens) == 0L) { + return(decoded) + } + + tokenMapping <- stats::setNames(decodeColumnNames(tokens, strict = FALSE), tokens) + .replaceAnalysisResultColumnNameTokens(decoded, tokenMapping) } .encodedAnalysisResultColumnNames <- function(decodedColumnName, @@ -156,3 +167,40 @@ decodeAnalysisResults <- function(results, requestedDataset = NULL, names(columnMapping)[!is.na(columnMapping) & columnMapping == decodedColumnName] } + +.analysisResultColumnNameTokens <- function(columnNames) { + matches <- gregexpr(.analysisResultColumnNamePattern(), columnNames, perl = TRUE) + regmatches(columnNames, matches) +} + +.analysisResultColumnNamePattern <- function() { + "JaspColumn_[[:alnum:]_]+_Encoded|jaspColumn[0-9]+" +} + +.replaceAnalysisResultColumnNameTokens <- function(columnNames, columnMapping) { + if (!is.character(columnNames) || length(columnNames) == 0L || + length(columnMapping) == 0L) { + return(columnNames) + } + + tokenLists <- .analysisResultColumnNameTokens(columnNames) + if (!any(lengths(tokenLists) > 0L)) { + return(columnNames) + } + + for (i in seq_along(columnNames)) { + tokens <- unique(tokenLists[[i]]) + if (length(tokens) == 0L) { + next + } + + for (token in tokens) { + replacement <- unname(columnMapping[token]) + if (!is.na(replacement) && nzchar(replacement)) { + columnNames[[i]] <- gsub(token, replacement, columnNames[[i]], fixed = TRUE) + } + } + } + + columnNames +} diff --git a/tests/testthat/test-dataset-helpers.R b/tests/testthat/test-dataset-helpers.R index 062d62e..480e947 100644 --- a/tests/testthat/test-dataset-helpers.R +++ b/tests/testthat/test-dataset-helpers.R @@ -275,7 +275,10 @@ test_that("decodeAnalysisResults can use captured column mapping without native data = list( list( JaspColumn_1_Encoded = "2", - Variable = "JaspColumn_1_Encoded" + Variable = "JaspColumn_1_Encoded", + Interaction = "JaspColumn_1_Encoded:jaspColumn2", + Note = "The following variables are used: 'JaspColumn_1_Encoded', 'jaspColumn2'.", + Unmatched = "jaspColumn10" ) ) ) @@ -285,13 +288,16 @@ test_that("decodeAnalysisResults can use captured column mapping without native decoded <- jaspSyntax::decodeAnalysisResults( results, requestedDataset = requestedDataset, - columnMapping = c(JaspColumn_1_Encoded = "group") + columnMapping = c(JaspColumn_1_Encoded = "group", jaspColumn2 = "phase") ) firstRow <- decoded$results$table$data[[1L]] - expect_equal(names(firstRow), c("group", "Variable")) + expect_equal(names(firstRow), c("group", "Variable", "Interaction", "Note", "Unmatched")) expect_equal(firstRow$group, "treatment") expect_equal(firstRow$Variable, "group") + expect_equal(firstRow$Interaction, "group:phase") + expect_equal(firstRow$Note, "The following variables are used: 'group', 'phase'.") + expect_equal(firstRow$Unmatched, "jaspColumn10") }) test_that("decodeAnalysisResults maps factor values with decoded requested datasets", { From f7733ab0b18bc1ab23867a611d2484d899777455 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franti=C5=A1ek=20Barto=C5=A1?= Date: Wed, 27 May 2026 09:12:21 +0200 Subject: [PATCH 02/11] Expose SyntaxInterface verbose toggle --- man/nativeBridge.Rd | 4 ++++ src/syntaxfunctions.cpp | 5 +++++ 2 files changed, 9 insertions(+) diff --git a/man/nativeBridge.Rd b/man/nativeBridge.Rd index 71261cd..29c392a 100644 --- a/man/nativeBridge.Rd +++ b/man/nativeBridge.Rd @@ -74,6 +74,10 @@ package code should prefer the higher-level helpers such as \code{readRequestedDataset()}, \code{readAnalysisOptionsFromJaspFile()}, and \code{readDatasetFromJaspFile()}. +\code{setParameter("verbose", TRUE)} enables native SyntaxInterface logging for +debugging. Logging is disabled by default and can also be enabled before bridge +initialization with the \code{JASP_SYNTAX_VERBOSE=1} environment variable. + \code{cleanUp()} clears the native state and then runs the legacy cleanup hook. Use \code{\link{clearQmlForms}}, \code{\link{clearDatasetState}}, or \code{\link{clearNativeState}} when the intended lifecycle scope matters. diff --git a/src/syntaxfunctions.cpp b/src/syntaxfunctions.cpp index faa4d26..e293a12 100644 --- a/src/syntaxfunctions.cpp +++ b/src/syntaxfunctions.cpp @@ -120,6 +120,11 @@ bool setParameter(String name, SEXP value) global_param_orderLabelsByValue = Rcpp::as(value); return true; } + else if (nameStr == "verbose" && Rcpp::is(value)) + { + syntaxBridgeSetVerbose(Rcpp::as(value)); + return true; + } return false; } From 816c758c262da3acee55d02e016173d0c1b28c0a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franti=C5=A1ek=20Barto=C5=A1?= Date: Wed, 27 May 2026 09:42:42 +0200 Subject: [PATCH 03/11] Accept bridge verbosity levels --- man/nativeBridge.Rd | 6 +++-- src/syntaxfunctions.cpp | 53 ++++++++++++++++++++++++++++++++++++++--- 2 files changed, 54 insertions(+), 5 deletions(-) diff --git a/man/nativeBridge.Rd b/man/nativeBridge.Rd index 29c392a..bef8b39 100644 --- a/man/nativeBridge.Rd +++ b/man/nativeBridge.Rd @@ -74,8 +74,10 @@ package code should prefer the higher-level helpers such as \code{readRequestedDataset()}, \code{readAnalysisOptionsFromJaspFile()}, and \code{readDatasetFromJaspFile()}. -\code{setParameter("verbose", TRUE)} enables native SyntaxInterface logging for -debugging. Logging is disabled by default and can also be enabled before bridge +\code{setParameter("verbose", TRUE)} or \code{setParameter("verbose", "jasp")} +enables native SyntaxInterface logging for debugging. \code{"all"} also enables +native logging, while \code{"analysis"}, \code{"none"}, and \code{FALSE} disable +it. Native logging is disabled by default and can also be enabled before bridge initialization with the \code{JASP_SYNTAX_VERBOSE=1} environment variable. \code{cleanUp()} clears the native state and then runs the legacy cleanup hook. diff --git a/src/syntaxfunctions.cpp b/src/syntaxfunctions.cpp index e293a12..ed9d6e6 100644 --- a/src/syntaxfunctions.cpp +++ b/src/syntaxfunctions.cpp @@ -19,6 +19,9 @@ #include using namespace Rcpp; +#include +#include + #include "dataframeimporter.h" #include "syntaxbridge_interface.h" #include "json/json.h" @@ -57,6 +60,35 @@ Json::Value parseBridgeJsonOrStop(const char * rawJson, const char * functionNam return parsedJson; } +std::string normalizeParameterString(std::string value) +{ + auto isNotSpace = [](unsigned char c) { return !std::isspace(c); }; + value.erase(value.begin(), std::find_if(value.begin(), value.end(), isNotSpace)); + value.erase(std::find_if(value.rbegin(), value.rend(), isNotSpace).base(), value.end()); + std::transform(value.begin(), value.end(), value.begin(), [](unsigned char c) { return std::tolower(c); }); + return value; +} + +bool verboseValueShowsNativeOutput(const std::string & value, bool & verbose) +{ + const std::string normalizedValue = normalizeParameterString(value); + if (normalizedValue == "all" || normalizedValue == "jasp" || normalizedValue == "true" || + normalizedValue == "yes" || normalizedValue == "on" || normalizedValue == "1") + { + verbose = true; + return true; + } + + if (normalizedValue == "analysis" || normalizedValue == "none" || normalizedValue == "false" || + normalizedValue == "no" || normalizedValue == "off" || normalizedValue == "0") + { + verbose = false; + return true; + } + + return false; +} + // [[Rcpp::export]] void cleanUp() { @@ -120,10 +152,25 @@ bool setParameter(String name, SEXP value) global_param_orderLabelsByValue = Rcpp::as(value); return true; } - else if (nameStr == "verbose" && Rcpp::is(value)) + else if (nameStr == "verbose") { - syntaxBridgeSetVerbose(Rcpp::as(value)); - return true; + if (Rcpp::is(value)) + { + syntaxBridgeSetVerbose(Rcpp::as(value)); + return true; + } + + if (TYPEOF(value) == STRSXP && Rf_length(value) > 0) + { + bool verbose = false; + if (!verboseValueShowsNativeOutput(Rcpp::as(value), verbose)) + Rcpp::stop("Unsupported verbose value. Use 'all', 'analysis', 'jasp', 'none', TRUE, or FALSE."); + + syntaxBridgeSetVerbose(verbose); + return true; + } + + return false; } return false; From aa1c33023db4187c5d8cf94cb2ccc4645643bd6e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franti=C5=A1ek=20Barto=C5=A1?= Date: Thu, 28 May 2026 08:52:52 +0200 Subject: [PATCH 04/11] Let verbose parameter control syntax replay defaults --- R/RcppExports.R | 4 +-- R/parameters.R | 36 +++++++++++++++++++++ man/nativeBridge.Rd | 14 +++++--- src/RcppExports.cpp | 10 +++--- src/syntaxfunctions.cpp | 2 +- tests/testthat/test-desktop-jasp-contract.R | 22 +++++++++++++ 6 files changed, 76 insertions(+), 12 deletions(-) create mode 100644 R/parameters.R diff --git a/R/RcppExports.R b/R/RcppExports.R index 5ffd922..c8880ef 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -21,8 +21,8 @@ clearNativeStateNative <- function() { invisible(.Call(`_jaspSyntax_clearNativeStateNative`)) } -setParameter <- function(name, value) { - .Call(`_jaspSyntax_setParameter`, name, value) +setParameterNative <- function(name, value) { + .Call(`_jaspSyntax_setParameterNative`, name, value) } loadDataSet <- function(data) { diff --git a/R/parameters.R b/R/parameters.R new file mode 100644 index 0000000..6c76577 --- /dev/null +++ b/R/parameters.R @@ -0,0 +1,36 @@ +.normalizeVerboseParameter <- function(value) { + if (is.null(value) || length(value) == 0L || is.na(value[[1L]])) + stop("`verbose` must be one of 'all', 'analysis', 'jasp', 'none', TRUE, or FALSE.", call. = FALSE) + + value <- value[[1L]] + if (is.logical(value)) + return(if (isTRUE(value)) "all" else "analysis") + + if (is.character(value)) { + value <- tolower(trimws(value)) + if (value %in% c("true", "yes", "on", "1")) + return("all") + if (value %in% c("false", "no", "off", "0")) + return("analysis") + if (value %in% c("all", "analysis", "jasp", "none")) + return(value) + } + + stop("`verbose` must be one of 'all', 'analysis', 'jasp', 'none', TRUE, or FALSE.", call. = FALSE) +} + +.verboseParameterShowsNativeOutput <- function(verbose) { + verbose %in% c("all", "jasp") +} + +#' @export +setParameter <- function(name, value) { + if (identical(as.character(name), "verbose")) { + verbose <- .normalizeVerboseParameter(value) + result <- setParameterNative(name, .verboseParameterShowsNativeOutput(verbose)) + options(jaspSyntax.verbose = verbose) + return(result) + } + + setParameterNative(name, value) +} diff --git a/man/nativeBridge.Rd b/man/nativeBridge.Rd index bef8b39..d465a0d 100644 --- a/man/nativeBridge.Rd +++ b/man/nativeBridge.Rd @@ -75,10 +75,16 @@ package code should prefer the higher-level helpers such as \code{readDatasetFromJaspFile()}. \code{setParameter("verbose", TRUE)} or \code{setParameter("verbose", "jasp")} -enables native SyntaxInterface logging for debugging. \code{"all"} also enables -native logging, while \code{"analysis"}, \code{"none"}, and \code{FALSE} disable -it. Native logging is disabled by default and can also be enabled before bridge -initialization with the \code{JASP_SYNTAX_VERBOSE=1} environment variable. +enables native SyntaxInterface logging for debugging. For wrapped analyses, +\code{setParameter("verbose", value)} also sets the default verbosity honored by +\code{jaspBase} and \code{jaspTools}: \code{"all"} shows native and analysis +output, \code{"analysis"} shows analysis messages and warnings only, +\code{"jasp"} shows native output only, and \code{"none"} suppresses both. +For compatibility with the old native toggle, +\code{setParameter("verbose", FALSE)} disables native logging while keeping +analysis diagnostics visible. Native logging is disabled by default and can also +be enabled before bridge initialization with the \code{JASP_SYNTAX_VERBOSE=1} +environment variable. \code{cleanUp()} clears the native state and then runs the legacy cleanup hook. Use \code{\link{clearQmlForms}}, \code{\link{clearDatasetState}}, or diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp index f22fd56..dd577aa 100644 --- a/src/RcppExports.cpp +++ b/src/RcppExports.cpp @@ -55,15 +55,15 @@ BEGIN_RCPP return R_NilValue; END_RCPP } -// setParameter -bool setParameter(String name, SEXP value); -RcppExport SEXP _jaspSyntax_setParameter(SEXP nameSEXP, SEXP valueSEXP) { +// setParameterNative +bool setParameterNative(String name, SEXP value); +RcppExport SEXP _jaspSyntax_setParameterNative(SEXP nameSEXP, SEXP valueSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< String >::type name(nameSEXP); Rcpp::traits::input_parameter< SEXP >::type value(valueSEXP); - rcpp_result_gen = Rcpp::wrap(setParameter(name, value)); + rcpp_result_gen = Rcpp::wrap(setParameterNative(name, value)); return rcpp_result_gen; END_RCPP } @@ -166,7 +166,7 @@ static const R_CallMethodDef CallEntries[] = { {"_jaspSyntax_clearQmlFormsNative", (DL_FUNC) &_jaspSyntax_clearQmlFormsNative, 0}, {"_jaspSyntax_clearDatasetStateNative", (DL_FUNC) &_jaspSyntax_clearDatasetStateNative, 0}, {"_jaspSyntax_clearNativeStateNative", (DL_FUNC) &_jaspSyntax_clearNativeStateNative, 0}, - {"_jaspSyntax_setParameter", (DL_FUNC) &_jaspSyntax_setParameter, 2}, + {"_jaspSyntax_setParameterNative", (DL_FUNC) &_jaspSyntax_setParameterNative, 2}, {"_jaspSyntax_loadDataSet", (DL_FUNC) &_jaspSyntax_loadDataSet, 1}, {"_jaspSyntax_loadQmlAndParseOptions", (DL_FUNC) &_jaspSyntax_loadQmlAndParseOptions, 6}, {"_jaspSyntax_generateModuleWrappers", (DL_FUNC) &_jaspSyntax_generateModuleWrappers, 1}, diff --git a/src/syntaxfunctions.cpp b/src/syntaxfunctions.cpp index ed9d6e6..b3ceaf8 100644 --- a/src/syntaxfunctions.cpp +++ b/src/syntaxfunctions.cpp @@ -133,7 +133,7 @@ void clearNativeStateNative() } // [[Rcpp::export]] -bool setParameter(String name, SEXP value) +bool setParameterNative(String name, SEXP value) { std::string nameStr = name.get_cstring(); diff --git a/tests/testthat/test-desktop-jasp-contract.R b/tests/testthat/test-desktop-jasp-contract.R index b0aa2f9..acbfc5f 100644 --- a/tests/testthat/test-desktop-jasp-contract.R +++ b/tests/testthat/test-desktop-jasp-contract.R @@ -138,3 +138,25 @@ test_that("native and R bridge exports keep the expected consumer formals", { expect_true(formals(jaspSyntax::readAnalysisOptionsFromJaspFile)$includeTypeOptions) expect_true(formals(jaspSyntax::readAnalysisOptionsFromJaspFile)$isolated) }) + +test_that("verbose parameter sets the wrapped-analysis verbosity default", { + oldOptions <- options(jaspSyntax.verbose = NULL) + on.exit(do.call(options, oldOptions), add = TRUE) + + expect_true(jaspSyntax::setParameter("verbose", FALSE)) + expect_identical(getOption("jaspSyntax.verbose"), "analysis") + + expect_true(jaspSyntax::setParameter("verbose", TRUE)) + expect_identical(getOption("jaspSyntax.verbose"), "all") + + expect_true(jaspSyntax::setParameter("verbose", "jasp")) + expect_identical(getOption("jaspSyntax.verbose"), "jasp") + + expect_true(jaspSyntax::setParameter("verbose", "none")) + expect_identical(getOption("jaspSyntax.verbose"), "none") + + expect_error( + jaspSyntax::setParameter("verbose", "loud"), + "`verbose` must be one of" + ) +}) From 3ed55fab96d7d334ae44f30da7d9f6ba2dd070d5 Mon Sep 17 00:00:00 2001 From: boutinb Date: Thu, 28 May 2026 15:13:35 +0200 Subject: [PATCH 05/11] Propagate option-parsing errors from SyntaxInterface to R loadQmlAndParseOptions now calls syntaxBridgeLoadQmlAndParseOptionsStatus, which returns a JSON status object following the same pattern as other bridge functions. Errors from the QML form (e.g. unresolved formula terms) are surfaced via Rcpp::stop instead of being silently swallowed as an empty return value. Co-Authored-By: Claude Sonnet 4.6 --- R/options.R | 9 --------- src/syntaxfunctions.cpp | 18 +++++++++++++++--- 2 files changed, 15 insertions(+), 12 deletions(-) diff --git a/R/options.R b/R/options.R index 632c6a7..9653d6c 100644 --- a/R/options.R +++ b/R/options.R @@ -667,15 +667,6 @@ parseQmlOptions <- function(qmlFile, options = NULL, moduleName = "jaspModule", preloadData = preloadData ) - if (!is.character(rawOptions) || length(rawOptions) != 1L || !nzchar(rawOptions)) { - stop( - "jaspSyntax::loadQmlAndParseOptions() failed for QML file `", - qmlFile, - "`", - call. = FALSE - ) - } - if (identical(output, "json")) { return(rawOptions) } diff --git a/src/syntaxfunctions.cpp b/src/syntaxfunctions.cpp index b3ceaf8..76fd3fa 100644 --- a/src/syntaxfunctions.cpp +++ b/src/syntaxfunctions.cpp @@ -196,10 +196,22 @@ String loadQmlAndParseOptions(String moduleName, String analysisName, String qml analysisNameStr = analysisName.get_cstring(), moduleNameStr = moduleName.get_cstring(); + Json::Value status = parseBridgeJsonOrStop( + callBridgeOrStop("syntaxBridgeLoadQmlAndParseOptionsStatus", [&]() { + return syntaxBridgeLoadQmlAndParseOptionsStatus(moduleNameStr.c_str(), analysisNameStr.c_str(), qmlFileStr.c_str(), optionsStr.c_str(), versionStr.c_str(), preloadData); + }), + "syntaxBridgeLoadQmlAndParseOptionsStatus" + ); - return callBridgeOrStop("syntaxBridgeLoadQmlAndParseOptions", [&]() { - return syntaxBridgeLoadQmlAndParseOptions(moduleNameStr.c_str(), analysisNameStr.c_str(), qmlFileStr.c_str(), optionsStr.c_str(), versionStr.c_str(), preloadData); - }); + if (!status["ok"].asBool()) + { + std::string error = status.isMember("error") ? status["error"].asString() : "unknown error"; + Rcpp::stop("Error when parsing options: %s", error.c_str()); + } + + static std::string result; + result = status["options"].toStyledString(); + return result.c_str(); } // [[Rcpp::export]] From e147751f874dd2672d0abd4a35f6053699ded669 Mon Sep 17 00:00:00 2001 From: boutinb Date: Fri, 29 May 2026 18:13:52 +0200 Subject: [PATCH 06/11] Decode column names also for no preloadData anlayses --- R/readDatasetFromJaspFile.R | 19 ++++++++++++++++++- 1 file changed, 18 insertions(+), 1 deletion(-) diff --git a/R/readDatasetFromJaspFile.R b/R/readDatasetFromJaspFile.R index 4826c69..264635d 100644 --- a/R/readDatasetFromJaspFile.R +++ b/R/readDatasetFromJaspFile.R @@ -272,7 +272,24 @@ columnMapping <- function(encodedColumnNames = NULL, strict = FALSE) { strict <- .validateFlag(strict, "strict") if (is.null(encodedColumnNames)) { - encodedColumnNames <- readDatasetHeader(decode = FALSE)$encodedName + # getVariableNames() returns the decoded (user-facing) column names, not the + # JaspColumn_X_Encoded tokens the bridge uses during analysis execution. + # Encode each name via the bridge's .encodeColNamesStrict to get the actual + # analysis-time encoding tokens, then build the encoded → decoded mapping. + decodedNames <- readDatasetHeader(decode = FALSE)$encodedName + encodeFunc <- get0(".encodeColNamesStrict", envir = .GlobalEnv, inherits = FALSE) + if (is.function(encodeFunc) && length(decodedNames) > 0L) { + encoded <- tryCatch( + vapply(decodedNames, function(n) { + enc <- encodeFunc(n) + if (is.character(enc) && length(enc) == 1L && nzchar(enc)) enc else n + }, character(1L), USE.NAMES = FALSE), + error = function(e) decodedNames + ) + encodedColumnNames <- if (!identical(encoded, decodedNames)) encoded else decodedNames + } else { + encodedColumnNames <- decodedNames + } } if (!is.character(encodedColumnNames)) { From 1790279246f8fdbb68e6c6279760e374bd3ecfbc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franti=C5=A1ek=20Barto=C5=A1?= Date: Mon, 1 Jun 2026 10:48:47 +0200 Subject: [PATCH 07/11] Delegate result decoding to native column decoder Add serializable column decoder snapshots and decodeColumnText() so embedded JASP column tokens are replaced by SyntaxInterface's ColumnEncoder rules. Prefer the native decoder for dataset helpers and result decoding, while keeping a shallow mapping fallback for explicit snapshots/tests. Harden bridge subprocess result handoff and cover empty snapshots plus the public contract in focused tests. --- NAMESPACE | 2 + R/RcppExports.R | 8 + R/bridgeSubprocess.R | 28 +++- R/columnDecoder.R | 165 ++++++++++++++++++++ R/readDatasetFromJaspFile.R | 152 ++++++++++++------ R/resultDecoding.R | 114 ++++++-------- man/columnDecoderSnapshot.Rd | 28 ++++ src/RcppExports.cpp | 24 +++ src/syntaxfunctions.cpp | 53 +++++++ tests/testthat/test-dataset-helpers.R | 71 ++++++++- tests/testthat/test-desktop-jasp-contract.R | 2 + 11 files changed, 521 insertions(+), 126 deletions(-) create mode 100644 R/columnDecoder.R create mode 100644 man/columnDecoderSnapshot.Rd diff --git a/NAMESPACE b/NAMESPACE index 98bd8ab..686e0ac 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -9,6 +9,8 @@ export(cleanUp) export(columnMapping) export(decodeAnalysisResults) export(decodeColumnNames) +export(columnDecoderSnapshot) +export(decodeColumnText) export(generateAnalysisWrapper) export(generateModuleWrappers) export(getVariableNames) diff --git a/R/RcppExports.R b/R/RcppExports.R index c8880ef..0282da6 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -57,3 +57,11 @@ getVariableNames <- function() { .Call(`_jaspSyntax_getVariableNames`) } +columnDecoderSnapshotNative <- function() { + .Call(`_jaspSyntax_columnDecoderSnapshotNative`) +} + +decodeColumnTextNative <- function(values, decoderSnapshotJson) { + .Call(`_jaspSyntax_decodeColumnTextNative`, values, decoderSnapshotJson) +} + diff --git a/R/bridgeSubprocess.R b/R/bridgeSubprocess.R index ed5703b..7098946 100644 --- a/R/bridgeSubprocess.R +++ b/R/bridgeSubprocess.R @@ -181,13 +181,15 @@ .runBridgeSubprocess <- function(task, target, input, failureLabel) { stdoutPath <- tempfile(paste0("jaspSyntax_", task, "_"), fileext = ".out") stderrPath <- tempfile(paste0("jaspSyntax_", task, "_"), fileext = ".err") - on.exit(unlink(c(stdoutPath, stderrPath)), add = TRUE) + resultPath <- tempfile(paste0("jaspSyntax_", task, "_"), fileext = ".rds") + on.exit(unlink(c(stdoutPath, stderrPath, resultPath)), add = TRUE) packageSpec <- .bridgeSubprocessPackageSpec() + launchError <- NULL - result <- tryCatch( + tryCatch( callr::r( - func = function(target, input, packageSpec, loadPackage) { - tryCatch( + func = function(target, input, packageSpec, loadPackage, resultPath) { + result <- tryCatch( { loadPackage(packageSpec) do.call(getNamespace("jaspSyntax")[[target]], input) @@ -196,12 +198,15 @@ structure(list(message = conditionMessage(e)), class = "jaspSyntax_subprocess_error") } ) + saveRDS(result, resultPath) + invisible(NULL) }, args = list( target = target, input = input, packageSpec = packageSpec, - loadPackage = .bridgeSubprocessPackageLoader() + loadPackage = .bridgeSubprocessPackageLoader(), + resultPath = resultPath ), libpath = .libPaths(), stdout = stdoutPath, @@ -211,12 +216,23 @@ error = "error" ), error = function(e) { - structure(list(message = conditionMessage(e)), class = "jaspSyntax_subprocess_error") + launchError <<- e + NULL } ) output <- .readBridgeSubprocessOutput(stdoutPath, stderrPath) outputSuffix <- .bridgeSubprocessOutputSuffix(output) + result <- if (file.exists(resultPath)) { + readRDS(resultPath) + } else { + message <- if (!is.null(launchError)) { + conditionMessage(launchError) + } else { + "subprocess did not return a result" + } + structure(list(message = message), class = "jaspSyntax_subprocess_error") + } if (inherits(result, "jaspSyntax_subprocess_error")) { stop( diff --git a/R/columnDecoder.R b/R/columnDecoder.R new file mode 100644 index 0000000..8e0faf0 --- /dev/null +++ b/R/columnDecoder.R @@ -0,0 +1,165 @@ +#' Capture a Native Column Decoder +#' +#' Captures the current SyntaxInterface `ColumnEncoder` decode mapping in a +#' serializable object. The captured decoder can be reused after the active +#' native dataset changes. +#' +#' @param columnMapping Optional named character vector mapping encoded column +#' tokens to decoded user-facing names. This is mainly for tests and for +#' callers that already captured the mapping before native state changed. +#' +#' @return A serializable column decoder object. +#' +#' @export +columnDecoderSnapshot <- function(columnMapping = NULL) { + if (!is.null(columnMapping)) { + return(.columnDecoderSnapshotFromMapping(columnMapping)) + } + + rawSnapshot <- columnDecoderSnapshotNative() + .columnDecoderSnapshotFromJson(rawSnapshot) +} + +#' Decode Text With a Native Column Decoder +#' +#' Decodes embedded JASP column tokens using SyntaxInterface's native +#' `ColumnEncoder` replacement rules. +#' +#' @param text Character vector to decode. +#' @param decoderSnapshot Optional decoder returned by `columnDecoderSnapshot()`. +#' When omitted, the current native bridge decoder is used. +#' +#' @return A character vector with native column tokens decoded. +#' +#' @export +decodeColumnText <- function(text, decoderSnapshot = NULL) { + if (!is.character(text)) { + stop("`text` must be a character vector", call. = FALSE) + } + + snapshotJson <- .columnDecoderSnapshotJson(decoderSnapshot) + decoded <- tryCatch( + decodeColumnTextNative(text, snapshotJson), + error = function(e) { + if (.hasColumnDecoderFallback(decoderSnapshot)) { + return(.decodeColumnTextFallback(text, decoderSnapshot)) + } + stop(e) + } + ) + if (!is.character(decoded) || length(decoded) != length(text)) { + stop("Native column decoder returned an invalid result.", call. = FALSE) + } + + names(decoded) <- names(text) + decoded +} + +.columnDecoderSnapshotFromMapping <- function(columnMapping) { + columnMapping <- .validateAnalysisResultColumnMapping(columnMapping) + if (is.null(columnMapping)) { + columnMapping <- stats::setNames(character(), character()) + } + + columns <- unname(Map( + function(encoded, decoded) list(encoded = encoded, decoded = decoded), + names(columnMapping), + unname(columnMapping) + )) + + rawSnapshot <- as.character(jsonlite::toJSON( + list(version = 1L, columns = columns), + auto_unbox = TRUE, + null = "null" + )) + + .newColumnDecoderSnapshot(rawSnapshot, columnMapping) +} + +.columnDecoderSnapshotFromJson <- function(rawSnapshot) { + if (!is.character(rawSnapshot) || length(rawSnapshot) != 1L || is.na(rawSnapshot)) { + stop("Native column decoder snapshot must be a single JSON string.", call. = FALSE) + } + + parsed <- jsonlite::fromJSON(rawSnapshot, simplifyVector = FALSE) + columns <- parsed[["columns"]] + if (is.null(columns) || length(columns) == 0L) { + return(.newColumnDecoderSnapshot( + rawSnapshot, + stats::setNames(character(), character()) + )) + } + + encoded <- vapply(columns, `[[`, character(1L), "encoded", USE.NAMES = FALSE) + decoded <- vapply(columns, `[[`, character(1L), "decoded", USE.NAMES = FALSE) + mapping <- stats::setNames(decoded, encoded) + + .newColumnDecoderSnapshot(rawSnapshot, mapping) +} + +.newColumnDecoderSnapshot <- function(rawSnapshot, columnMapping) { + structure( + list( + version = 1L, + columns = .validateAnalysisResultColumnMapping(columnMapping), + native = rawSnapshot + ), + class = "jaspSyntaxColumnDecoder" + ) +} + +.columnDecoderSnapshotJson <- function(decoderSnapshot = NULL) { + if (is.null(decoderSnapshot)) { + return("") + } + + if (inherits(decoderSnapshot, "jaspSyntaxColumnDecoder")) { + return(decoderSnapshot[["native"]]) + } + + if (is.character(decoderSnapshot) && length(decoderSnapshot) == 1L && !is.na(decoderSnapshot)) { + return(decoderSnapshot) + } + + if (is.character(decoderSnapshot) && !is.null(names(decoderSnapshot))) { + return(.columnDecoderSnapshotFromMapping(decoderSnapshot)[["native"]]) + } + + stop("`decoderSnapshot` must be a native decoder snapshot or named column mapping.", call. = FALSE) +} + +.decodeColumnTextWithMapping <- function(text, columnMapping) { + decodeColumnText(text, .columnDecoderSnapshotFromMapping(columnMapping)) +} + +.decodeColumnTextFallback <- function(text, decoderSnapshot = NULL) { + mapping <- .columnDecoderSnapshotMapping(decoderSnapshot) + if (length(mapping) == 0L) { + return(text) + } + + tokens <- names(mapping) + tokens <- tokens[order(nchar(tokens), decreasing = TRUE)] + for (token in tokens) { + text <- gsub(token, unname(mapping[[token]]), text, fixed = TRUE) + } + + text +} + +.hasColumnDecoderFallback <- function(decoderSnapshot = NULL) { + inherits(decoderSnapshot, "jaspSyntaxColumnDecoder") || + (is.character(decoderSnapshot) && !is.null(names(decoderSnapshot))) +} + +.columnDecoderSnapshotMapping <- function(decoderSnapshot = NULL) { + if (inherits(decoderSnapshot, "jaspSyntaxColumnDecoder")) { + return(.validateAnalysisResultColumnMapping(decoderSnapshot[["columns"]])) + } + + if (is.character(decoderSnapshot) && !is.null(names(decoderSnapshot))) { + return(.validateAnalysisResultColumnMapping(decoderSnapshot)) + } + + stats::setNames(character(), character()) +} diff --git a/R/readDatasetFromJaspFile.R b/R/readDatasetFromJaspFile.R index 264635d..e6a4b52 100644 --- a/R/readDatasetFromJaspFile.R +++ b/R/readDatasetFromJaspFile.R @@ -219,42 +219,115 @@ decodeColumnNames <- function(columnNames, strict = FALSE) { return(columnNames) } - decodeName <- get0(".decodeColNamesStrict", envir = .GlobalEnv, inherits = FALSE) - if (!is.function(decodeName)) { - if (strict) { - stop( - "jaspSyntax bridge did not expose `.decodeColNamesStrict`", - call. = FALSE - ) + decodedNames <- columnNames + nativeError <- NULL + nativeDecoded <- tryCatch( + decodeColumnText(columnNames[encoded]), + error = function(e) { + nativeError <<- e + NULL + } + ) + + nativeLeftEncoded <- FALSE + if (is.character(nativeDecoded) && length(nativeDecoded) == sum(encoded)) { + decodedNames[encoded] <- nativeDecoded + nativeLeftEncoded <- any(.isEncodedBridgeColumnName(decodedNames[encoded])) + if (!strict || !any(.isEncodedBridgeColumnName(decodedNames[encoded]))) { + return(decodedNames) } - return(columnNames) } - decodedNames <- columnNames - decodedNames[encoded] <- vapply(columnNames[encoded], function(columnName) { - tryCatch( - { - decoded <- as.character(decodeName(columnName)) - if (length(decoded) != 1L || is.na(decoded)) { - stop("decoder returned an empty value") - } - decoded - }, - error = function(e) { - if (strict) { - stop( - "Could not decode column name `", columnName, "`: ", - conditionMessage(e), - call. = FALSE - ) + decodeName <- get0(".decodeColNamesStrict", envir = .GlobalEnv, inherits = FALSE) + useLegacyDecoder <- is.function(decodeName) && + (!is.null(nativeError) || (nativeLeftEncoded && !.currentColumnDecoderHasMappings())) + if (useLegacyDecoder) { + decodedNames[encoded] <- vapply(columnNames[encoded], function(columnName) { + tryCatch( + { + decoded <- as.character(decodeName(columnName)) + if (length(decoded) != 1L || is.na(decoded)) { + stop("decoder returned an empty value") + } + decoded + }, + error = function(e) { + if (strict) { + stop( + "Could not decode column name `", columnName, "`: ", + conditionMessage(e), + call. = FALSE + ) + } + columnName } - columnName - } + ) + }, character(1L), USE.NAMES = FALSE) + return(decodedNames) + } + + if (!is.null(nativeError) && strict) { + stop( + "jaspSyntax bridge could not decode native column names: ", + conditionMessage(nativeError), + call. = FALSE + ) + } + + if (strict && any(.isEncodedBridgeColumnName(decodedNames[encoded]))) { + failed <- columnNames[encoded][.isEncodedBridgeColumnName(decodedNames[encoded])][[1L]] + stop( + "Could not decode column name `", failed, "` with the native column decoder.", + call. = FALSE ) - }, character(1L), USE.NAMES = FALSE) + } + decodedNames } +.currentColumnDecoderHasMappings <- function() { + snapshot <- tryCatch(columnDecoderSnapshot(), error = function(e) NULL) + inherits(snapshot, "jaspSyntaxColumnDecoder") && length(snapshot[["columns"]]) > 0L +} + +.decodeColumnNamesWithMapping <- function(columnNames, columnMapping) { + if (!is.character(columnNames) || length(columnNames) == 0L) { + return(columnNames) + } + + tryCatch( + .decodeColumnTextWithMapping(columnNames, columnMapping), + error = function(e) { + decoded <- unname(columnMapping[columnNames]) + matched <- !is.na(decoded) + out <- columnNames + out[matched] <- decoded[matched] + out + } + ) +} + +.encodedColumnNamesFromCurrentDecoder <- function() { + snapshot <- tryCatch(columnDecoderSnapshot(), error = function(e) NULL) + if (inherits(snapshot, "jaspSyntaxColumnDecoder") && length(snapshot[["columns"]]) > 0L) { + return(names(snapshot[["columns"]])) + } + + decodedNames <- readDatasetHeader(decode = FALSE)$encodedName + encodeFunc <- get0(".encodeColNamesStrict", envir = .GlobalEnv, inherits = FALSE) + if (!is.function(encodeFunc) || length(decodedNames) == 0L) { + return(decodedNames) + } + + tryCatch( + vapply(decodedNames, function(name) { + encoded <- encodeFunc(name) + if (is.character(encoded) && length(encoded) == 1L && nzchar(encoded)) encoded else name + }, character(1L), USE.NAMES = FALSE), + error = function(e) decodedNames + ) +} + .isEncodedBridgeColumnName <- function(columnNames) { grepl("^JaspColumn_[[:alnum:]_]+_Encoded$", columnNames) | grepl("^jaspColumn[0-9]+$", columnNames) @@ -270,27 +343,8 @@ decodeColumnNames <- function(columnNames, strict = FALSE) { #' @export columnMapping <- function(encodedColumnNames = NULL, strict = FALSE) { strict <- .validateFlag(strict, "strict") - - if (is.null(encodedColumnNames)) { - # getVariableNames() returns the decoded (user-facing) column names, not the - # JaspColumn_X_Encoded tokens the bridge uses during analysis execution. - # Encode each name via the bridge's .encodeColNamesStrict to get the actual - # analysis-time encoding tokens, then build the encoded → decoded mapping. - decodedNames <- readDatasetHeader(decode = FALSE)$encodedName - encodeFunc <- get0(".encodeColNamesStrict", envir = .GlobalEnv, inherits = FALSE) - if (is.function(encodeFunc) && length(decodedNames) > 0L) { - encoded <- tryCatch( - vapply(decodedNames, function(n) { - enc <- encodeFunc(n) - if (is.character(enc) && length(enc) == 1L && nzchar(enc)) enc else n - }, character(1L), USE.NAMES = FALSE), - error = function(e) decodedNames - ) - encodedColumnNames <- if (!identical(encoded, decodedNames)) encoded else decodedNames - } else { - encodedColumnNames <- decodedNames - } - } + if (is.null(encodedColumnNames)) + encodedColumnNames <- .encodedColumnNamesFromCurrentDecoder() if (!is.character(encodedColumnNames)) { stop("`encodedColumnNames` must be a character vector", call. = FALSE) diff --git a/R/resultDecoding.R b/R/resultDecoding.R index 2a9c6f6..85ca6b2 100644 --- a/R/resultDecoding.R +++ b/R/resultDecoding.R @@ -38,8 +38,25 @@ decodeAnalysisResults <- function(results, requestedDataset = NULL, ) } + if (is.null(columnMapping) && is.data.frame(requestedDataset)) { + columnMapping <- tryCatch( + get("columnMapping", envir = asNamespace("jaspSyntax"))(names(requestedDataset), strict = FALSE), + error = function(e) NULL + ) + } + + columnDecoder <- .analysisResultColumnDecoder(columnMapping) + columnDecodeContext <- list( + columnMapping = columnMapping, + columnDecoder = columnDecoder + ) + if (!is.data.frame(requestedDataset)) { - return(list(factorValues = list(), columnMapping = columnMapping)) + return(list( + factorValues = list(), + columnMapping = columnMapping, + columnDecoder = columnDecoder + )) } factorValues <- list() @@ -51,7 +68,7 @@ decodeAnalysisResults <- function(results, requestedDataset = NULL, valueMap <- stats::setNames(levels(column), as.character(seq_along(levels(column)))) decodedName <- tryCatch( - .decodeAnalysisResultColumnNames(columnName, columnMapping), + .decodeAnalysisResultColumnNames(columnName, columnDecodeContext), error = function(e) columnName ) columnKeys <- unique(c( @@ -67,10 +84,29 @@ decodeAnalysisResults <- function(results, requestedDataset = NULL, } } - list(factorValues = factorValues, columnMapping = columnMapping) + list( + factorValues = factorValues, + columnMapping = columnMapping, + columnDecoder = columnDecoder + ) +} + +.analysisResultColumnDecoder <- function(columnMapping = NULL) { + tryCatch( + columnDecoderSnapshot(columnMapping), + error = function(e) NULL + ) } .decodeAnalysisResultObject <- function(x, fieldName = NULL, decodeContext) { + if (isS4(x) || is.call(x) || is.name(x)) { + return(x) + } + + if (is.object(x) && !is.data.frame(x)) { + return(x) + } + if (is.list(x)) { oldNames <- names(x) for (i in seq_len(length(x))) { @@ -80,10 +116,7 @@ decodeAnalysisResults <- function(results, requestedDataset = NULL, } if (!is.null(oldNames)) { - names(x) <- .decodeAnalysisResultColumnNames( - oldNames, - decodeContext[["columnMapping"]] - ) + names(x) <- .decodeAnalysisResultColumnNames(oldNames, decodeContext) } return(x) @@ -92,10 +125,7 @@ decodeAnalysisResults <- function(results, requestedDataset = NULL, x <- .decodeAnalysisResultFactorValues(x, fieldName, decodeContext) if (is.character(x)) { - x <- .decodeAnalysisResultColumnNames( - x, - decodeContext[["columnMapping"]] - ) + x <- .decodeAnalysisResultColumnNames(x, decodeContext) } x @@ -132,30 +162,23 @@ decodeAnalysisResults <- function(results, requestedDataset = NULL, columnMapping[valid] } -.decodeAnalysisResultColumnNames <- function(columnNames, columnMapping = NULL) { +.decodeAnalysisResultColumnNames <- function(columnNames, decodeContext = NULL) { if (!is.character(columnNames) || length(columnNames) == 0L) { return(columnNames) } - if (length(columnMapping) > 0L) { - decoded <- unname(columnMapping[columnNames]) - matched <- !is.na(decoded) - columnNames[matched] <- decoded[matched] - columnNames[!matched] <- .replaceAnalysisResultColumnNameTokens( - columnNames[!matched], - columnMapping - ) - return(columnNames) + columnMapping <- decodeContext[["columnMapping"]] + columnDecoder <- decodeContext[["columnDecoder"]] + + if (inherits(columnDecoder, "jaspSyntaxColumnDecoder")) { + return(decodeColumnText(columnNames, columnDecoder)) } - decoded <- decodeColumnNames(columnNames, strict = FALSE) - tokens <- unique(unlist(.analysisResultColumnNameTokens(columnNames), use.names = FALSE)) - if (length(tokens) == 0L) { - return(decoded) + if (length(columnMapping) > 0L) { + return(.decodeColumnNamesWithMapping(columnNames, columnMapping)) } - tokenMapping <- stats::setNames(decodeColumnNames(tokens, strict = FALSE), tokens) - .replaceAnalysisResultColumnNameTokens(decoded, tokenMapping) + decodeColumnText(columnNames) } .encodedAnalysisResultColumnNames <- function(decodedColumnName, @@ -167,40 +190,3 @@ decodeAnalysisResults <- function(results, requestedDataset = NULL, names(columnMapping)[!is.na(columnMapping) & columnMapping == decodedColumnName] } - -.analysisResultColumnNameTokens <- function(columnNames) { - matches <- gregexpr(.analysisResultColumnNamePattern(), columnNames, perl = TRUE) - regmatches(columnNames, matches) -} - -.analysisResultColumnNamePattern <- function() { - "JaspColumn_[[:alnum:]_]+_Encoded|jaspColumn[0-9]+" -} - -.replaceAnalysisResultColumnNameTokens <- function(columnNames, columnMapping) { - if (!is.character(columnNames) || length(columnNames) == 0L || - length(columnMapping) == 0L) { - return(columnNames) - } - - tokenLists <- .analysisResultColumnNameTokens(columnNames) - if (!any(lengths(tokenLists) > 0L)) { - return(columnNames) - } - - for (i in seq_along(columnNames)) { - tokens <- unique(tokenLists[[i]]) - if (length(tokens) == 0L) { - next - } - - for (token in tokens) { - replacement <- unname(columnMapping[token]) - if (!is.na(replacement) && nzchar(replacement)) { - columnNames[[i]] <- gsub(token, replacement, columnNames[[i]], fixed = TRUE) - } - } - } - - columnNames -} diff --git a/man/columnDecoderSnapshot.Rd b/man/columnDecoderSnapshot.Rd new file mode 100644 index 0000000..0a52cba --- /dev/null +++ b/man/columnDecoderSnapshot.Rd @@ -0,0 +1,28 @@ +\name{columnDecoderSnapshot} +\alias{columnDecoderSnapshot} +\alias{decodeColumnText} +\title{Native Column Decoder Snapshots} +\usage{ +columnDecoderSnapshot(columnMapping = NULL) + +decodeColumnText(text, decoderSnapshot = NULL) +} +\arguments{ +\item{columnMapping}{Optional named character vector mapping encoded column +tokens to decoded user-facing names.} + +\item{text}{Character vector to decode.} + +\item{decoderSnapshot}{Optional decoder returned by +\code{columnDecoderSnapshot()}. When omitted, the current native bridge decoder +is used.} +} +\value{ +\code{columnDecoderSnapshot()} returns a serializable native decoder snapshot. +\code{decodeColumnText()} returns a character vector with native column tokens +decoded. +} +\description{ +Capture and reuse SyntaxInterface's native \code{ColumnEncoder} decoder for +analysis result materialization. +} diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp index dd577aa..3277561 100644 --- a/src/RcppExports.cpp +++ b/src/RcppExports.cpp @@ -159,6 +159,28 @@ BEGIN_RCPP return rcpp_result_gen; END_RCPP } +// columnDecoderSnapshotNative +String columnDecoderSnapshotNative(); +RcppExport SEXP _jaspSyntax_columnDecoderSnapshotNative() { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + rcpp_result_gen = Rcpp::wrap(columnDecoderSnapshotNative()); + return rcpp_result_gen; +END_RCPP +} +// decodeColumnTextNative +Rcpp::CharacterVector decodeColumnTextNative(Rcpp::CharacterVector values, String decoderSnapshotJson); +RcppExport SEXP _jaspSyntax_decodeColumnTextNative(SEXP valuesSEXP, SEXP decoderSnapshotJsonSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type values(valuesSEXP); + Rcpp::traits::input_parameter< String >::type decoderSnapshotJson(decoderSnapshotJsonSEXP); + rcpp_result_gen = Rcpp::wrap(decodeColumnTextNative(values, decoderSnapshotJson)); + return rcpp_result_gen; +END_RCPP +} static const R_CallMethodDef CallEntries[] = { {"_jaspSyntax_cleanUp", (DL_FUNC) &_jaspSyntax_cleanUp, 0}, @@ -175,6 +197,8 @@ static const R_CallMethodDef CallEntries[] = { {"_jaspSyntax_analysisOptionsFromJaspFile", (DL_FUNC) &_jaspSyntax_analysisOptionsFromJaspFile, 2}, {"_jaspSyntax_generateAnalysisWrapper", (DL_FUNC) &_jaspSyntax_generateAnalysisWrapper, 2}, {"_jaspSyntax_getVariableNames", (DL_FUNC) &_jaspSyntax_getVariableNames, 0}, + {"_jaspSyntax_columnDecoderSnapshotNative", (DL_FUNC) &_jaspSyntax_columnDecoderSnapshotNative, 0}, + {"_jaspSyntax_decodeColumnTextNative", (DL_FUNC) &_jaspSyntax_decodeColumnTextNative, 2}, {NULL, NULL, 0} }; diff --git a/src/syntaxfunctions.cpp b/src/syntaxfunctions.cpp index 76fd3fa..755156a 100644 --- a/src/syntaxfunctions.cpp +++ b/src/syntaxfunctions.cpp @@ -402,5 +402,58 @@ Rcpp::List getVariableNames() return result; } +// [[Rcpp::export]] +String columnDecoderSnapshotNative() +{ + return callBridgeOrStop("syntaxBridgeColumnDecoderSnapshot", []() { + return syntaxBridgeColumnDecoderSnapshot(); + }); +} + +// [[Rcpp::export]] +Rcpp::CharacterVector decodeColumnTextNative(Rcpp::CharacterVector values, String decoderSnapshotJson) +{ + Json::Value input(Json::arrayValue); + for (R_xlen_t i = 0; i < values.size(); ++i) + { + Rcpp::String value = values[i]; + if (value == NA_STRING) + input.append(Json::Value()); + else + input.append(std::string(value.get_cstring())); + } + + const std::string inputJson = input.toStyledString(); + const std::string snapshotJson = std::string(decoderSnapshotJson.get_cstring()); + Json::Value decoded = parseBridgeJsonOrStop( + callBridgeOrStop("syntaxBridgeDecodeColumnText", [&]() { + return syntaxBridgeDecodeColumnText(inputJson.c_str(), snapshotJson.c_str()); + }), + "syntaxBridgeDecodeColumnText" + ); + + if (decoded.isObject() && decoded.isMember("ok") && !decoded["ok"].asBool()) + { + std::string error = decoded.isMember("error") ? decoded["error"].asString() : "unknown error"; + Rcpp::stop("syntaxBridgeDecodeColumnText failed: %s", error.c_str()); + } + + if (!decoded.isArray()) + Rcpp::stop("syntaxBridgeDecodeColumnText returned a non-array JSON value."); + + Rcpp::CharacterVector result(decoded.size()); + for (Json::ArrayIndex i = 0; i < decoded.size(); ++i) + { + if (decoded[i].isNull()) + result[i] = NA_STRING; + else if (decoded[i].isString()) + result[i] = decoded[i].asCString(); + else + Rcpp::stop("syntaxBridgeDecodeColumnText returned a non-string value."); + } + + return result; +} + diff --git a/tests/testthat/test-dataset-helpers.R b/tests/testthat/test-dataset-helpers.R index 480e947..2415cc1 100644 --- a/tests/testthat/test-dataset-helpers.R +++ b/tests/testthat/test-dataset-helpers.R @@ -54,6 +54,37 @@ localNamespaceBinding <- function(name, value, namespace) { } test_that("decodeColumnNames delegates to the native bridge decoder", { + restoreDecoder <- localNamespaceBinding( + "decodeColumnText", + function(text, decoderSnapshot = NULL) { + mapping <- c( + JaspColumn_1_Encoded = "raw score", + JaspColumn_2_Encoded = "group" + ) + unname(mapping[text]) + }, + asNamespace("jaspSyntax") + ) + on.exit(restoreDecoder(), add = TRUE) + + expect_equal( + jaspSyntax::decodeColumnNames(c("JaspColumn_1_Encoded", "JaspColumn_2_Encoded")), + c("raw score", "group") + ) + expect_equal( + jaspSyntax::columnMapping(c("JaspColumn_1_Encoded", "JaspColumn_2_Encoded")), + c(JaspColumn_1_Encoded = "raw score", JaspColumn_2_Encoded = "group") + ) +}) + +test_that("decodeColumnNames uses the legacy global decoder only when native decoding is unavailable", { + restoreNative <- localNamespaceBinding( + "decodeColumnText", + function(text, decoderSnapshot = NULL) { + stop("native decoder unavailable", call. = FALSE) + }, + asNamespace("jaspSyntax") + ) restoreDecoder <- localGlobalBinding( ".decodeColNamesStrict", function(columnName) { @@ -63,6 +94,7 @@ test_that("decodeColumnNames delegates to the native bridge decoder", { )[[columnName]] } ) + on.exit(restoreNative(), add = TRUE) on.exit(restoreDecoder(), add = TRUE) expect_equal( @@ -85,17 +117,37 @@ test_that("decodeColumnNames can fall back or fail when the decoder is unavailab ) expect_error( jaspSyntax::decodeColumnNames("JaspColumn_1_Encoded", strict = TRUE), - "did not expose `.decodeColNamesStrict`", + "native column decoder", fixed = TRUE ) expect_error( jaspSyntax::columnMapping("JaspColumn_1_Encoded", strict = TRUE), - "did not expose `.decodeColNamesStrict`", + "native column decoder", fixed = TRUE ) }) +test_that("empty column decoder snapshots do not fall through to live native state", { + snapshot <- jaspSyntax::columnDecoderSnapshot(stats::setNames(character(), character())) + + expect_equal( + jaspSyntax::decodeColumnText("JaspColumn_1_Encoded", snapshot), + "JaspColumn_1_Encoded" + ) +}) + test_that("decodeColumnNames does not send raw names to the strict native decoder", { + restoreNative <- localNamespaceBinding( + "decodeColumnText", + function(text, decoderSnapshot = NULL) { + mapping <- c(JaspColumn_1_Encoded = "score") + out <- text + matched <- text %in% names(mapping) + out[matched] <- unname(mapping[text[matched]]) + out + }, + asNamespace("jaspSyntax") + ) decoderCalls <- character(0) restoreDecoder <- localGlobalBinding( ".decodeColNamesStrict", @@ -104,6 +156,7 @@ test_that("decodeColumnNames does not send raw names to the strict native decode c(JaspColumn_1_Encoded = "score")[[columnName]] } ) + on.exit(restoreNative(), add = TRUE) on.exit(restoreDecoder(), add = TRUE) expect_equal( @@ -113,7 +166,7 @@ test_that("decodeColumnNames does not send raw names to the strict native decode ), c("score", "score.scale", "score") ) - expect_equal(decoderCalls, "JaspColumn_1_Encoded") + expect_equal(decoderCalls, character(0)) restoreDecoder() expect_equal( @@ -150,17 +203,17 @@ test_that("state readers fail loudly when decode is requested without decoder su expect_error( jaspSyntax::readLoadedDataset(decode = TRUE), - "did not expose `.decodeColNamesStrict`", + "native column decoder", fixed = TRUE ) expect_error( jaspSyntax::readRequestedDataset(decode = TRUE), - "did not expose `.decodeColNamesStrict`", + "native column decoder", fixed = TRUE ) expect_error( jaspSyntax::readDatasetHeader(decode = TRUE), - "did not expose `.decodeColNamesStrict`", + "native column decoder", fixed = TRUE ) @@ -248,7 +301,11 @@ test_that("decodeAnalysisResults decodes native column names and factor value to ) ) - decoded <- jaspSyntax::decodeAnalysisResults(results, requestedDataset = requestedDataset) + decoded <- jaspSyntax::decodeAnalysisResults( + results, + requestedDataset = requestedDataset, + columnMapping = c(JaspColumn_1_Encoded = "group") + ) firstRow <- decoded$results$table$data[[1L]] expect_equal(names(firstRow), c("group", "label")) diff --git a/tests/testthat/test-desktop-jasp-contract.R b/tests/testthat/test-desktop-jasp-contract.R index acbfc5f..0883ebc 100644 --- a/tests/testthat/test-desktop-jasp-contract.R +++ b/tests/testthat/test-desktop-jasp-contract.R @@ -127,6 +127,8 @@ test_that("native and R bridge exports keep the expected consumer formals", { expect_named(formals(jaspSyntax::readRequestedDataset), c("decode", "normalize")) expect_named(formals(jaspSyntax::readDatasetHeader), "decode") expect_named(formals(jaspSyntax::decodeColumnNames), c("columnNames", "strict")) + expect_named(formals(jaspSyntax::columnDecoderSnapshot), "columnMapping") + expect_named(formals(jaspSyntax::decodeColumnText), c("text", "decoderSnapshot")) expect_named(formals(jaspSyntax::decodeAnalysisResults), c("results", "requestedDataset", "columnMapping")) expect_named(formals(jaspSyntax::columnMapping), c("encodedColumnNames", "strict")) expect_named( From 2b2d73f8034ba9b8f3e88bbf7bf973140d3a6cfc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franti=C5=A1ek=20Barto=C5=A1?= Date: Tue, 2 Jun 2026 17:02:50 +0200 Subject: [PATCH 08/11] Require native column decoder for token decoding --- R/columnDecoder.R | 49 ++---- R/readDatasetFromJaspFile.R | 94 +++--------- R/resultDecoding.R | 22 ++- tests/testthat/test-dataset-helpers.R | 212 ++++++++++++++++---------- 4 files changed, 172 insertions(+), 205 deletions(-) diff --git a/R/columnDecoder.R b/R/columnDecoder.R index 8e0faf0..70582e7 100644 --- a/R/columnDecoder.R +++ b/R/columnDecoder.R @@ -5,8 +5,9 @@ #' native dataset changes. #' #' @param columnMapping Optional named character vector mapping encoded column -#' tokens to decoded user-facing names. This is mainly for tests and for -#' callers that already captured the mapping before native state changed. +#' tokens to decoded user-facing names. When supplied, the mapping is +#' serialized into a native decoder snapshot; token replacement still happens +#' in SyntaxInterface. #' #' @return A serializable column decoder object. #' @@ -36,15 +37,19 @@ decodeColumnText <- function(text, decoderSnapshot = NULL) { if (!is.character(text)) { stop("`text` must be a character vector", call. = FALSE) } + if (!.containsEncodedBridgeColumnTokens(text)) { + return(text) + } snapshotJson <- .columnDecoderSnapshotJson(decoderSnapshot) decoded <- tryCatch( decodeColumnTextNative(text, snapshotJson), error = function(e) { - if (.hasColumnDecoderFallback(decoderSnapshot)) { - return(.decodeColumnTextFallback(text, decoderSnapshot)) - } - stop(e) + stop( + "Native column decoder failed: ", + conditionMessage(e), + call. = FALSE + ) } ) if (!is.character(decoded) || length(decoded) != length(text)) { @@ -132,34 +137,10 @@ decodeColumnText <- function(text, decoderSnapshot = NULL) { decodeColumnText(text, .columnDecoderSnapshotFromMapping(columnMapping)) } -.decodeColumnTextFallback <- function(text, decoderSnapshot = NULL) { - mapping <- .columnDecoderSnapshotMapping(decoderSnapshot) - if (length(mapping) == 0L) { - return(text) - } - - tokens <- names(mapping) - tokens <- tokens[order(nchar(tokens), decreasing = TRUE)] - for (token in tokens) { - text <- gsub(token, unname(mapping[[token]]), text, fixed = TRUE) - } - - text -} - -.hasColumnDecoderFallback <- function(decoderSnapshot = NULL) { - inherits(decoderSnapshot, "jaspSyntaxColumnDecoder") || - (is.character(decoderSnapshot) && !is.null(names(decoderSnapshot))) -} - -.columnDecoderSnapshotMapping <- function(decoderSnapshot = NULL) { - if (inherits(decoderSnapshot, "jaspSyntaxColumnDecoder")) { - return(.validateAnalysisResultColumnMapping(decoderSnapshot[["columns"]])) - } - - if (is.character(decoderSnapshot) && !is.null(names(decoderSnapshot))) { - return(.validateAnalysisResultColumnMapping(decoderSnapshot)) +.containsEncodedBridgeColumnTokens <- function(text) { + if (!is.character(text) || length(text) == 0L) { + return(FALSE) } - stats::setNames(character(), character()) + any(grepl("(JaspColumn_[[:alnum:]_]+_Encoded|jaspColumn[0-9]+)", text, perl = TRUE), na.rm = TRUE) } diff --git a/R/readDatasetFromJaspFile.R b/R/readDatasetFromJaspFile.R index e6a4b52..c733d71 100644 --- a/R/readDatasetFromJaspFile.R +++ b/R/readDatasetFromJaspFile.R @@ -198,8 +198,8 @@ #' Decode Native JASP Column Names #' #' Decodes column names using the native bridge decoder installed by -#' SyntaxInterface. When the bridge does not expose a decoder, the default is to -#' return names unchanged so callers can still operate on non-encoded inputs. +#' SyntaxInterface. Raw/non-encoded names are returned unchanged; encoded bridge +#' names require a working native decoder. #' #' @param columnNames Character vector of column names. #' @param strict Whether to fail when an encoded bridge name cannot be decoded. @@ -220,64 +220,30 @@ decodeColumnNames <- function(columnNames, strict = FALSE) { } decodedNames <- columnNames - nativeError <- NULL nativeDecoded <- tryCatch( decodeColumnText(columnNames[encoded]), error = function(e) { - nativeError <<- e - NULL + stop( + "jaspSyntax bridge could not decode native column names: ", + conditionMessage(e), + call. = FALSE + ) } ) - nativeLeftEncoded <- FALSE - if (is.character(nativeDecoded) && length(nativeDecoded) == sum(encoded)) { - decodedNames[encoded] <- nativeDecoded - nativeLeftEncoded <- any(.isEncodedBridgeColumnName(decodedNames[encoded])) - if (!strict || !any(.isEncodedBridgeColumnName(decodedNames[encoded]))) { - return(decodedNames) - } - } - - decodeName <- get0(".decodeColNamesStrict", envir = .GlobalEnv, inherits = FALSE) - useLegacyDecoder <- is.function(decodeName) && - (!is.null(nativeError) || (nativeLeftEncoded && !.currentColumnDecoderHasMappings())) - if (useLegacyDecoder) { - decodedNames[encoded] <- vapply(columnNames[encoded], function(columnName) { - tryCatch( - { - decoded <- as.character(decodeName(columnName)) - if (length(decoded) != 1L || is.na(decoded)) { - stop("decoder returned an empty value") - } - decoded - }, - error = function(e) { - if (strict) { - stop( - "Could not decode column name `", columnName, "`: ", - conditionMessage(e), - call. = FALSE - ) - } - columnName - } - ) - }, character(1L), USE.NAMES = FALSE) - return(decodedNames) - } - - if (!is.null(nativeError) && strict) { + if (!is.character(nativeDecoded) || length(nativeDecoded) != sum(encoded)) { stop( - "jaspSyntax bridge could not decode native column names: ", - conditionMessage(nativeError), + "Native column decoder returned an invalid column-name result.", call. = FALSE ) } - if (strict && any(.isEncodedBridgeColumnName(decodedNames[encoded]))) { - failed <- columnNames[encoded][.isEncodedBridgeColumnName(decodedNames[encoded])][[1L]] + decodedNames[encoded] <- nativeDecoded + stillEncoded <- .isEncodedBridgeColumnName(decodedNames[encoded]) + if (any(stillEncoded)) { + failed <- columnNames[encoded][stillEncoded][[1L]] stop( - "Could not decode column name `", failed, "` with the native column decoder.", + "Native column decoder left encoded column name `", failed, "` unchanged.", call. = FALSE ) } @@ -285,47 +251,21 @@ decodeColumnNames <- function(columnNames, strict = FALSE) { decodedNames } -.currentColumnDecoderHasMappings <- function() { - snapshot <- tryCatch(columnDecoderSnapshot(), error = function(e) NULL) - inherits(snapshot, "jaspSyntaxColumnDecoder") && length(snapshot[["columns"]]) > 0L -} - .decodeColumnNamesWithMapping <- function(columnNames, columnMapping) { if (!is.character(columnNames) || length(columnNames) == 0L) { return(columnNames) } - tryCatch( - .decodeColumnTextWithMapping(columnNames, columnMapping), - error = function(e) { - decoded <- unname(columnMapping[columnNames]) - matched <- !is.na(decoded) - out <- columnNames - out[matched] <- decoded[matched] - out - } - ) + .decodeColumnTextWithMapping(columnNames, columnMapping) } .encodedColumnNamesFromCurrentDecoder <- function() { - snapshot <- tryCatch(columnDecoderSnapshot(), error = function(e) NULL) + snapshot <- columnDecoderSnapshot() if (inherits(snapshot, "jaspSyntaxColumnDecoder") && length(snapshot[["columns"]]) > 0L) { return(names(snapshot[["columns"]])) } - decodedNames <- readDatasetHeader(decode = FALSE)$encodedName - encodeFunc <- get0(".encodeColNamesStrict", envir = .GlobalEnv, inherits = FALSE) - if (!is.function(encodeFunc) || length(decodedNames) == 0L) { - return(decodedNames) - } - - tryCatch( - vapply(decodedNames, function(name) { - encoded <- encodeFunc(name) - if (is.character(encoded) && length(encoded) == 1L && nzchar(encoded)) encoded else name - }, character(1L), USE.NAMES = FALSE), - error = function(e) decodedNames - ) + readDatasetHeader(decode = FALSE)$encodedName } .isEncodedBridgeColumnName <- function(columnNames) { diff --git a/R/resultDecoding.R b/R/resultDecoding.R index 85ca6b2..d01b4f8 100644 --- a/R/resultDecoding.R +++ b/R/resultDecoding.R @@ -9,7 +9,8 @@ #' bridge if available. #' @param columnMapping Optional named character vector mapping encoded native #' column names to decoded user-facing column names. Supplying this avoids a -#' late native decoder call after analysis execution. +#' late native decoder snapshot call after analysis execution; replacement is +#' still performed by the native decoder. #' #' @return The result payload with decoded column names and factor values. #' @@ -39,10 +40,7 @@ decodeAnalysisResults <- function(results, requestedDataset = NULL, } if (is.null(columnMapping) && is.data.frame(requestedDataset)) { - columnMapping <- tryCatch( - get("columnMapping", envir = asNamespace("jaspSyntax"))(names(requestedDataset), strict = FALSE), - error = function(e) NULL - ) + columnMapping <- get("columnMapping", envir = asNamespace("jaspSyntax"))(names(requestedDataset), strict = FALSE) } columnDecoder <- .analysisResultColumnDecoder(columnMapping) @@ -67,10 +65,7 @@ decodeAnalysisResults <- function(results, requestedDataset = NULL, } valueMap <- stats::setNames(levels(column), as.character(seq_along(levels(column)))) - decodedName <- tryCatch( - .decodeAnalysisResultColumnNames(columnName, columnDecodeContext), - error = function(e) columnName - ) + decodedName <- .decodeAnalysisResultColumnNames(columnName, columnDecodeContext) columnKeys <- unique(c( columnName, decodedName, @@ -92,10 +87,11 @@ decodeAnalysisResults <- function(results, requestedDataset = NULL, } .analysisResultColumnDecoder <- function(columnMapping = NULL) { - tryCatch( - columnDecoderSnapshot(columnMapping), - error = function(e) NULL - ) + if (is.null(columnMapping)) { + return(NULL) + } + + columnDecoderSnapshot(columnMapping) } .decodeAnalysisResultObject <- function(x, fieldName = NULL, decodeContext) { diff --git a/tests/testthat/test-dataset-helpers.R b/tests/testthat/test-dataset-helpers.R index 2415cc1..d3fd570 100644 --- a/tests/testthat/test-dataset-helpers.R +++ b/tests/testthat/test-dataset-helpers.R @@ -53,18 +53,39 @@ localNamespaceBinding <- function(name, value, namespace) { } } -test_that("decodeColumnNames delegates to the native bridge decoder", { - restoreDecoder <- localNamespaceBinding( +localNativeColumnTextDecoder <- function(mapping) { + localNamespaceBinding( "decodeColumnText", function(text, decoderSnapshot = NULL) { - mapping <- c( - JaspColumn_1_Encoded = "raw score", - JaspColumn_2_Encoded = "group" - ) - unname(mapping[text]) + out <- text + tokens <- names(mapping) + tokens <- tokens[order(nchar(tokens), decreasing = TRUE)] + for (token in tokens) { + out <- gsub(token, unname(mapping[[token]]), out, fixed = TRUE) + } + out }, asNamespace("jaspSyntax") ) +} + +localFailingColumnTextDecoder <- function(message = "native decoder unavailable") { + localNamespaceBinding( + "decodeColumnText", + function(text, decoderSnapshot = NULL) { + stop(message, call. = FALSE) + }, + asNamespace("jaspSyntax") + ) +} + +test_that("decodeColumnNames delegates to the native bridge decoder", { + restoreDecoder <- localNativeColumnTextDecoder( + c( + JaspColumn_1_Encoded = "raw score", + JaspColumn_2_Encoded = "group" + ) + ) on.exit(restoreDecoder(), add = TRUE) expect_equal( @@ -77,14 +98,8 @@ test_that("decodeColumnNames delegates to the native bridge decoder", { ) }) -test_that("decodeColumnNames uses the legacy global decoder only when native decoding is unavailable", { - restoreNative <- localNamespaceBinding( - "decodeColumnText", - function(text, decoderSnapshot = NULL) { - stop("native decoder unavailable", call. = FALSE) - }, - asNamespace("jaspSyntax") - ) +test_that("decodeColumnNames errors when native decoding is unavailable", { + restoreNative <- localFailingColumnTextDecoder() restoreDecoder <- localGlobalBinding( ".decodeColNamesStrict", function(columnName) { @@ -97,32 +112,46 @@ test_that("decodeColumnNames uses the legacy global decoder only when native dec on.exit(restoreNative(), add = TRUE) on.exit(restoreDecoder(), add = TRUE) - expect_equal( + expect_error( jaspSyntax::decodeColumnNames(c("JaspColumn_1_Encoded", "JaspColumn_2_Encoded")), - c("raw score", "group") + "native decoder unavailable", + fixed = TRUE ) - expect_equal( + expect_error( jaspSyntax::columnMapping(c("JaspColumn_1_Encoded", "JaspColumn_2_Encoded")), - c(JaspColumn_1_Encoded = "raw score", JaspColumn_2_Encoded = "group") + "native decoder unavailable", + fixed = TRUE ) }) -test_that("decodeColumnNames can fall back or fail when the decoder is unavailable", { - restoreDecoder <- localGlobalAbsent(".decodeColNamesStrict") +test_that("decodeColumnNames fails when the decoder is unavailable", { + restoreDecoder <- localFailingColumnTextDecoder() on.exit(restoreDecoder(), add = TRUE) - expect_equal( + expect_error( jaspSyntax::decodeColumnNames(c("plain", "JaspColumn_1_Encoded")), - c("plain", "JaspColumn_1_Encoded") + "native decoder unavailable", + fixed = TRUE ) expect_error( jaspSyntax::decodeColumnNames("JaspColumn_1_Encoded", strict = TRUE), - "native column decoder", + "native decoder unavailable", fixed = TRUE ) expect_error( jaspSyntax::columnMapping("JaspColumn_1_Encoded", strict = TRUE), - "native column decoder", + "native decoder unavailable", + fixed = TRUE + ) +}) + +test_that("decodeColumnNames fails when native decoding leaves encoded names", { + restoreDecoder <- localNativeColumnTextDecoder(stats::setNames(character(), character())) + on.exit(restoreDecoder(), add = TRUE) + + expect_error( + jaspSyntax::decodeColumnNames("JaspColumn_1_Encoded"), + "left encoded column name", fixed = TRUE ) }) @@ -136,28 +165,37 @@ test_that("empty column decoder snapshots do not fall through to live native sta ) }) +test_that("decodeColumnText does not use R mapping replacement when native decoding fails", { + restoreNative <- localNamespaceBinding( + "decodeColumnTextNative", + function(values, decoderSnapshotJson) { + stop("native failure", call. = FALSE) + }, + asNamespace("jaspSyntax") + ) + on.exit(restoreNative(), add = TRUE) + + snapshot <- jaspSyntax::columnDecoderSnapshot(c(JaspColumn_1_Encoded = "score")) + expect_error( + jaspSyntax::decodeColumnText("JaspColumn_1_Encoded", snapshot), + "native failure", + fixed = TRUE + ) +}) + test_that("decodeColumnNames does not send raw names to the strict native decoder", { + observed <- character(0) restoreNative <- localNamespaceBinding( "decodeColumnText", function(text, decoderSnapshot = NULL) { - mapping <- c(JaspColumn_1_Encoded = "score") + observed <<- c(observed, text) out <- text - matched <- text %in% names(mapping) - out[matched] <- unname(mapping[text[matched]]) + out[text == "JaspColumn_1_Encoded"] <- "score" out }, asNamespace("jaspSyntax") ) - decoderCalls <- character(0) - restoreDecoder <- localGlobalBinding( - ".decodeColNamesStrict", - function(columnName) { - decoderCalls <<- c(decoderCalls, columnName) - c(JaspColumn_1_Encoded = "score")[[columnName]] - } - ) on.exit(restoreNative(), add = TRUE) - on.exit(restoreDecoder(), add = TRUE) expect_equal( jaspSyntax::decodeColumnNames( @@ -166,9 +204,8 @@ test_that("decodeColumnNames does not send raw names to the strict native decode ), c("score", "score.scale", "score") ) - expect_equal(decoderCalls, character(0)) + expect_equal(observed, "JaspColumn_1_Encoded") - restoreDecoder() expect_equal( jaspSyntax::decodeColumnNames(c("score", "score.scale"), strict = TRUE), c("score", "score.scale") @@ -176,7 +213,7 @@ test_that("decodeColumnNames does not send raw names to the strict native decode }) test_that("state readers fail loudly when decode is requested without decoder support", { - restoreDecoder <- localGlobalAbsent(".decodeColNamesStrict") + restoreDecoder <- localFailingColumnTextDecoder() restoreLoaded <- localGlobalBinding( ".readFullDatasetToEnd", function() { @@ -203,17 +240,17 @@ test_that("state readers fail loudly when decode is requested without decoder su expect_error( jaspSyntax::readLoadedDataset(decode = TRUE), - "native column decoder", + "native decoder unavailable", fixed = TRUE ) expect_error( jaspSyntax::readRequestedDataset(decode = TRUE), - "native column decoder", + "native decoder unavailable", fixed = TRUE ) expect_error( jaspSyntax::readDatasetHeader(decode = TRUE), - "native column decoder", + "native decoder unavailable", fixed = TRUE ) @@ -237,15 +274,17 @@ test_that("readLoadedDataset reads, decodes, and normalizes bridge data", { ) restoreDecoder <- localGlobalBinding( ".decodeColNamesStrict", - function(columnName) { - c( - JaspColumn_1_Encoded = "id", - JaspColumn_2_Encoded = "condition" - )[[columnName]] - } + function(columnName) stop("legacy decoder must not be used", call. = FALSE) + ) + restoreNative <- localNativeColumnTextDecoder( + c( + JaspColumn_1_Encoded = "id", + JaspColumn_2_Encoded = "condition" + ) ) on.exit(restoreDataset(), add = TRUE) on.exit(restoreDecoder(), add = TRUE) + on.exit(restoreNative(), add = TRUE) dataset <- jaspSyntax::readLoadedDataset() @@ -276,11 +315,8 @@ test_that("factor normalization preserves numeric-looking category labels", { }) test_that("decodeAnalysisResults decodes native column names and factor value tokens", { - restoreDecoder <- localGlobalBinding( - ".decodeColNamesStrict", - function(columnName) { - c(JaspColumn_1_Encoded = "group")[[columnName]] - } + restoreDecoder <- localNativeColumnTextDecoder( + c(JaspColumn_1_Encoded = "group") ) on.exit(restoreDecoder(), add = TRUE) @@ -313,12 +349,18 @@ test_that("decodeAnalysisResults decodes native column names and factor value to expect_equal(firstRow$label, "group") }) -test_that("decodeAnalysisResults can use captured column mapping without native decoder", { - restoreDecoder <- localGlobalBinding( - ".decodeColNamesStrict", - function(columnName) { - stop("native decoder should not be called") - } +test_that("decodeAnalysisResults passes captured column mapping to the native decoder", { + observedSnapshot <- NULL + restoreDecoder <- localNamespaceBinding( + "decodeColumnText", + function(text, decoderSnapshot = NULL) { + observedSnapshot <<- decoderSnapshot + out <- text + out <- gsub("JaspColumn_1_Encoded", "group", out, fixed = TRUE) + out <- gsub("jaspColumn2", "phase", out, fixed = TRUE) + out + }, + asNamespace("jaspSyntax") ) on.exit(restoreDecoder(), add = TRUE) @@ -355,14 +397,12 @@ test_that("decodeAnalysisResults can use captured column mapping without native expect_equal(firstRow$Interaction, "group:phase") expect_equal(firstRow$Note, "The following variables are used: 'group', 'phase'.") expect_equal(firstRow$Unmatched, "jaspColumn10") + expect_s3_class(observedSnapshot, "jaspSyntaxColumnDecoder") }) test_that("decodeAnalysisResults maps factor values with decoded requested datasets", { - restoreDecoder <- localGlobalBinding( - ".decodeColNamesStrict", - function(columnName) { - stop("native decoder should not be called") - } + restoreDecoder <- localNativeColumnTextDecoder( + c(JaspColumn_1_Encoded = "group") ) on.exit(restoreDecoder(), add = TRUE) @@ -403,12 +443,14 @@ test_that("readRequestedDataset exposes requested native dataset state", { ) restoreDecoder <- localGlobalBinding( ".decodeColNamesStrict", - function(columnName) { - c(JaspColumn_1_Encoded = "requested")[[columnName]] - } + function(columnName) stop("legacy decoder must not be used", call. = FALSE) + ) + restoreNative <- localNativeColumnTextDecoder( + c(JaspColumn_1_Encoded = "requested") ) on.exit(restoreDataset(), add = TRUE) on.exit(restoreDecoder(), add = TRUE) + on.exit(restoreNative(), add = TRUE) dataset <- jaspSyntax::readRequestedDataset() @@ -426,15 +468,17 @@ test_that("readDatasetHeader decodes native header names", { ) restoreDecoder <- localGlobalBinding( ".decodeColNamesStrict", - function(columnName) { - c( - JaspColumn_1_Encoded = "score", - JaspColumn_2_Encoded = "group" - )[[columnName]] - } + function(columnName) stop("legacy decoder must not be used", call. = FALSE) + ) + restoreNative <- localNativeColumnTextDecoder( + c( + JaspColumn_1_Encoded = "score", + JaspColumn_2_Encoded = "group" + ) ) on.exit(restoreNames(), add = TRUE) on.exit(restoreDecoder(), add = TRUE) + on.exit(restoreNative(), add = TRUE) header <- jaspSyntax::readDatasetHeader() @@ -500,12 +544,13 @@ test_that("loadAnalysisDataset returns loaded and requested state from native he ) restoreDecoder <- localGlobalBinding( ".decodeColNamesStrict", - function(columnName) { - c( - JaspColumn_1_Encoded = "score", - JaspColumn_2_Encoded = "group" - )[[columnName]] - } + function(columnName) stop("legacy decoder must not be used", call. = FALSE) + ) + restoreNative <- localNativeColumnTextDecoder( + c( + JaspColumn_1_Encoded = "score", + JaspColumn_2_Encoded = "group" + ) ) on.exit(restoreClear(), add = TRUE) on.exit(restoreLoad(), add = TRUE) @@ -513,6 +558,7 @@ test_that("loadAnalysisDataset returns loaded and requested state from native he on.exit(restoreLoaded(), add = TRUE) on.exit(restoreRequested(), add = TRUE) on.exit(restoreDecoder(), add = TRUE) + on.exit(restoreNative(), add = TRUE) rawDataset <- data.frame(score = c(1, 2), group = c("a", "b")) savedOptions <- list(variables = list(value = "score", types = "scale")) @@ -588,7 +634,10 @@ test_that("loadAnalysisDataset reuses native .jasp source when provenance is int ) restoreDecoder <- localGlobalBinding( ".decodeColNamesStrict", - function(columnName) c(JaspColumn_1_Encoded = "score")[[columnName]] + function(columnName) stop("legacy decoder must not be used", call. = FALSE) + ) + restoreNative <- localNativeColumnTextDecoder( + c(JaspColumn_1_Encoded = "score") ) on.exit(restoreClear(), add = TRUE) on.exit(restoreLoadDataFrame(), add = TRUE) @@ -597,6 +646,7 @@ test_that("loadAnalysisDataset reuses native .jasp source when provenance is int on.exit(restoreLoaded(), add = TRUE) on.exit(restoreRequested(), add = TRUE) on.exit(restoreDecoder(), add = TRUE) + on.exit(restoreNative(), add = TRUE) dataset <- jaspSyntax:::.attachJaspDatasetSource( data.frame(score = 1), From b9796f78df17014f4df1357fde464af4b76a1ee1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franti=C5=A1ek=20Barto=C5=A1?= Date: Wed, 3 Jun 2026 15:13:08 +0200 Subject: [PATCH 09/11] Use Desktop encoder context for column decoding --- NAMESPACE | 3 +- R/RcppExports.R | 8 +- R/bridgeSubprocess.R | 43 ++++-- R/columnDecoder.R | 157 ++++++++++---------- R/readDatasetFromJaspFile.R | 47 +----- R/resultDecoding.R | 127 ++++++---------- man/columnDecoderSnapshot.Rd | 28 ---- man/columnEncoderContext.Rd | 26 ++++ man/datasetBridgeHelpers.Rd | 15 +- man/decodeAnalysisResults.Rd | 16 +- src/RcppExports.cpp | 18 +-- src/syntaxfunctions.cpp | 12 +- tests/testthat/test-dataset-helpers.R | 110 ++++++++++---- tests/testthat/test-desktop-jasp-contract.R | 10 +- 14 files changed, 300 insertions(+), 320 deletions(-) delete mode 100644 man/columnDecoderSnapshot.Rd create mode 100644 man/columnEncoderContext.Rd diff --git a/NAMESPACE b/NAMESPACE index 686e0ac..a8d3b0e 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -6,10 +6,9 @@ export(clearDatasetState) export(clearNativeState) export(clearQmlForms) export(cleanUp) -export(columnMapping) +export(columnEncoderContext) export(decodeAnalysisResults) export(decodeColumnNames) -export(columnDecoderSnapshot) export(decodeColumnText) export(generateAnalysisWrapper) export(generateModuleWrappers) diff --git a/R/RcppExports.R b/R/RcppExports.R index 0282da6..46a21da 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -57,11 +57,11 @@ getVariableNames <- function() { .Call(`_jaspSyntax_getVariableNames`) } -columnDecoderSnapshotNative <- function() { - .Call(`_jaspSyntax_columnDecoderSnapshotNative`) +columnEncoderContextNative <- function() { + .Call(`_jaspSyntax_columnEncoderContextNative`) } -decodeColumnTextNative <- function(values, decoderSnapshotJson) { - .Call(`_jaspSyntax_decodeColumnTextNative`, values, decoderSnapshotJson) +decodeColumnTextNative <- function(values, encoderContextJson) { + .Call(`_jaspSyntax_decodeColumnTextNative`, values, encoderContextJson) } diff --git a/R/bridgeSubprocess.R b/R/bridgeSubprocess.R index 7098946..4549d82 100644 --- a/R/bridgeSubprocess.R +++ b/R/bridgeSubprocess.R @@ -117,7 +117,7 @@ } .bridgeSubprocessPackageLoader <- function() { - function(packageSpec) { + loader <- function(packageSpec) { pathEntries <- function(path = Sys.getenv("PATH", unset = "")) { entries <- strsplit(path, .Platform$path.sep, fixed = TRUE)[[1L]] normalizePath(entries[nzchar(entries)], winslash = "/", mustWork = FALSE) @@ -146,10 +146,13 @@ character(0) } buildDirs <- buildDirs[dir.exists(buildDirs)] - Sys.setenv(PATH = paste(unique(c(dllDirs, buildDirs, currentPathEntries)), collapse = .Platform$path.sep)) + Sys.setenv(PATH = paste(unique(c(buildDirs, dllDirs, currentPathEntries)), collapse = .Platform$path.sep)) message("jaspSyntax subprocess source package: ", packagePath) message("jaspSyntax subprocess DLL dirs: ", paste(dllDirs, collapse = ";")) - message("jaspSyntax subprocess PATH head: ", paste(head(strsplit(Sys.getenv("PATH"), .Platform$path.sep, fixed = TRUE)[[1L]], 8L), collapse = ";")) + if (length(buildDirs) > 0L) { + message("jaspSyntax subprocess build DLL dirs: ", paste(buildDirs, collapse = ";")) + } + message("jaspSyntax subprocess PATH head: ", paste(utils::head(strsplit(Sys.getenv("PATH"), .Platform$path.sep, fixed = TRUE)[[1L]], 8L), collapse = ";")) } if (!requireNamespace("pkgload", quietly = TRUE)) { @@ -161,6 +164,26 @@ suppressPackageStartupMessages(library(jaspSyntax)) } } + environment(loader) <- baseenv() + loader +} + +.bridgeSubprocessRunner <- function() { + runner <- function(target, input, packageSpec, loadPackage, resultPath) { + result <- tryCatch( + { + loadPackage(packageSpec) + do.call(getNamespace("jaspSyntax")[[target]], input) + }, + error = function(e) { + structure(list(message = conditionMessage(e)), class = "jaspSyntax_subprocess_error") + } + ) + saveRDS(result, resultPath) + invisible(NULL) + } + environment(runner) <- baseenv() + runner } .readBridgeSubprocessOutput <- function(stdoutPath, stderrPath) { @@ -188,19 +211,7 @@ tryCatch( callr::r( - func = function(target, input, packageSpec, loadPackage, resultPath) { - result <- tryCatch( - { - loadPackage(packageSpec) - do.call(getNamespace("jaspSyntax")[[target]], input) - }, - error = function(e) { - structure(list(message = conditionMessage(e)), class = "jaspSyntax_subprocess_error") - } - ) - saveRDS(result, resultPath) - invisible(NULL) - }, + func = .bridgeSubprocessRunner(), args = list( target = target, input = input, diff --git a/R/columnDecoder.R b/R/columnDecoder.R index 70582e7..7139393 100644 --- a/R/columnDecoder.R +++ b/R/columnDecoder.R @@ -1,39 +1,30 @@ -#' Capture a Native Column Decoder +#' Capture a Native Column Encoder Context #' -#' Captures the current SyntaxInterface `ColumnEncoder` decode mapping in a -#' serializable object. The captured decoder can be reused after the active -#' native dataset changes. +#' Captures the source state needed by SyntaxInterface to reconstruct the native +#' `ColumnEncoder`: dataset column names/types and extra QML option encodings. +#' The context can be reused after the active native dataset changes. #' -#' @param columnMapping Optional named character vector mapping encoded column -#' tokens to decoded user-facing names. When supplied, the mapping is -#' serialized into a native decoder snapshot; token replacement still happens -#' in SyntaxInterface. -#' -#' @return A serializable column decoder object. +#' @return A serializable column encoder context. #' #' @export -columnDecoderSnapshot <- function(columnMapping = NULL) { - if (!is.null(columnMapping)) { - return(.columnDecoderSnapshotFromMapping(columnMapping)) - } - - rawSnapshot <- columnDecoderSnapshotNative() - .columnDecoderSnapshotFromJson(rawSnapshot) +columnEncoderContext <- function() { + rawContext <- columnEncoderContextNative() + .columnEncoderContextFromJson(rawContext) } -#' Decode Text With a Native Column Decoder +#' Decode Text With a Native Column Encoder Context #' #' Decodes embedded JASP column tokens using SyntaxInterface's native #' `ColumnEncoder` replacement rules. #' #' @param text Character vector to decode. -#' @param decoderSnapshot Optional decoder returned by `columnDecoderSnapshot()`. -#' When omitted, the current native bridge decoder is used. +#' @param encoderContext Optional context returned by `columnEncoderContext()`. +#' When omitted, the current native bridge encoder state is used. #' #' @return A character vector with native column tokens decoded. #' #' @export -decodeColumnText <- function(text, decoderSnapshot = NULL) { +decodeColumnText <- function(text, encoderContext = NULL) { if (!is.character(text)) { stop("`text` must be a character vector", call. = FALSE) } @@ -41,9 +32,9 @@ decodeColumnText <- function(text, decoderSnapshot = NULL) { return(text) } - snapshotJson <- .columnDecoderSnapshotJson(decoderSnapshot) + contextJson <- .columnEncoderContextJson(encoderContext) decoded <- tryCatch( - decodeColumnTextNative(text, snapshotJson), + decodeColumnTextNative(text, contextJson), error = function(e) { stop( "Native column decoder failed: ", @@ -60,81 +51,93 @@ decodeColumnText <- function(text, decoderSnapshot = NULL) { decoded } -.columnDecoderSnapshotFromMapping <- function(columnMapping) { - columnMapping <- .validateAnalysisResultColumnMapping(columnMapping) - if (is.null(columnMapping)) { - columnMapping <- stats::setNames(character(), character()) +.columnEncoderContextFromJson <- function(rawContext) { + if (!is.character(rawContext) || length(rawContext) != 1L || is.na(rawContext)) { + stop("Native column encoder context must be a single JSON string.", call. = FALSE) } - columns <- unname(Map( - function(encoded, decoded) list(encoded = encoded, decoded = decoded), - names(columnMapping), - unname(columnMapping) - )) - - rawSnapshot <- as.character(jsonlite::toJSON( - list(version = 1L, columns = columns), - auto_unbox = TRUE, - null = "null" - )) - - .newColumnDecoderSnapshot(rawSnapshot, columnMapping) + parsed <- jsonlite::fromJSON(rawContext, simplifyVector = FALSE) + .newColumnEncoderContext( + rawContext = rawContext, + columns = .normalizeColumnEncoderContextColumns(parsed[["columns"]]), + extra = .normalizeColumnEncoderContextColumns(parsed[["extra"]]) + ) } -.columnDecoderSnapshotFromJson <- function(rawSnapshot) { - if (!is.character(rawSnapshot) || length(rawSnapshot) != 1L || is.na(rawSnapshot)) { - stop("Native column decoder snapshot must be a single JSON string.", call. = FALSE) - } +.newColumnEncoderContext <- function(rawContext = NULL, columns = list(), extra = list()) { + columns <- .normalizeColumnEncoderContextColumns(columns) + extra <- .normalizeColumnEncoderContextColumns(extra) - parsed <- jsonlite::fromJSON(rawSnapshot, simplifyVector = FALSE) - columns <- parsed[["columns"]] - if (is.null(columns) || length(columns) == 0L) { - return(.newColumnDecoderSnapshot( - rawSnapshot, - stats::setNames(character(), character()) + if (is.null(rawContext)) { + rawContext <- as.character(jsonlite::toJSON( + list(version = 1L, columns = columns, extra = extra), + auto_unbox = TRUE, + null = "null" )) } - encoded <- vapply(columns, `[[`, character(1L), "encoded", USE.NAMES = FALSE) - decoded <- vapply(columns, `[[`, character(1L), "decoded", USE.NAMES = FALSE) - mapping <- stats::setNames(decoded, encoded) - - .newColumnDecoderSnapshot(rawSnapshot, mapping) -} - -.newColumnDecoderSnapshot <- function(rawSnapshot, columnMapping) { structure( list( version = 1L, - columns = .validateAnalysisResultColumnMapping(columnMapping), - native = rawSnapshot + columns = columns, + extra = extra, + native = rawContext ), - class = "jaspSyntaxColumnDecoder" + class = "jaspSyntaxColumnEncoderContext" ) } -.columnDecoderSnapshotJson <- function(decoderSnapshot = NULL) { - if (is.null(decoderSnapshot)) { - return("") +.normalizeColumnEncoderContextColumns <- function(columns = NULL) { + if (is.null(columns) || length(columns) == 0L) { + return(list()) } - if (inherits(decoderSnapshot, "jaspSyntaxColumnDecoder")) { - return(decoderSnapshot[["native"]]) + if (is.data.frame(columns)) { + columns <- split(columns, seq_len(nrow(columns))) } - if (is.character(decoderSnapshot) && length(decoderSnapshot) == 1L && !is.na(decoderSnapshot)) { - return(decoderSnapshot) + if (!is.list(columns)) { + stop("Column encoder context columns must be a list.", call. = FALSE) } - if (is.character(decoderSnapshot) && !is.null(names(decoderSnapshot))) { - return(.columnDecoderSnapshotFromMapping(decoderSnapshot)[["native"]]) - } + lapply(columns, function(column) { + if (!is.list(column) || is.null(column[["name"]]) || is.null(column[["type"]])) { + stop("Column encoder context entries must contain `name` and `type`.", call. = FALSE) + } + + name <- column[["name"]] + type <- column[["type"]] + if (!is.character(name) || length(name) != 1L || is.na(name) || !nzchar(name) || + !is.character(type) || length(type) != 1L || is.na(type) || !nzchar(type)) { + stop("Column encoder context `name` and `type` entries must be non-empty strings.", call. = FALSE) + } - stop("`decoderSnapshot` must be a native decoder snapshot or named column mapping.", call. = FALSE) + list(name = name, type = type) + }) } -.decodeColumnTextWithMapping <- function(text, columnMapping) { - decodeColumnText(text, .columnDecoderSnapshotFromMapping(columnMapping)) +.columnEncoderContextJson <- function(encoderContext = NULL) { + if (is.null(encoderContext)) { + return("") + } + + if (inherits(encoderContext, "jaspSyntaxColumnEncoderContext")) { + return(encoderContext[["native"]]) + } + + if (is.character(encoderContext) && length(encoderContext) == 1L && !is.na(encoderContext)) { + return(encoderContext) + } + + if (is.list(encoderContext) && + (!is.null(encoderContext[["columns"]]) || !is.null(encoderContext[["extra"]]))) { + return(.newColumnEncoderContext( + columns = encoderContext[["columns"]], + extra = encoderContext[["extra"]] + )[["native"]]) + } + + stop("`encoderContext` must be a native column encoder context.", call. = FALSE) } .containsEncodedBridgeColumnTokens <- function(text) { @@ -142,5 +145,9 @@ decodeColumnText <- function(text, decoderSnapshot = NULL) { return(FALSE) } - any(grepl("(JaspColumn_[[:alnum:]_]+_Encoded|jaspColumn[0-9]+)", text, perl = TRUE), na.rm = TRUE) + any(grepl( + "(JaspColumn_[[:alnum:]_]+_Encoded|JaspExtraOptions_[[:alnum:]_]+_Encoded|jaspColumn[0-9]+)", + text, + perl = TRUE + ), na.rm = TRUE) } diff --git a/R/readDatasetFromJaspFile.R b/R/readDatasetFromJaspFile.R index c733d71..fca9b98 100644 --- a/R/readDatasetFromJaspFile.R +++ b/R/readDatasetFromJaspFile.R @@ -251,51 +251,11 @@ decodeColumnNames <- function(columnNames, strict = FALSE) { decodedNames } -.decodeColumnNamesWithMapping <- function(columnNames, columnMapping) { - if (!is.character(columnNames) || length(columnNames) == 0L) { - return(columnNames) - } - - .decodeColumnTextWithMapping(columnNames, columnMapping) -} - -.encodedColumnNamesFromCurrentDecoder <- function() { - snapshot <- columnDecoderSnapshot() - if (inherits(snapshot, "jaspSyntaxColumnDecoder") && length(snapshot[["columns"]]) > 0L) { - return(names(snapshot[["columns"]])) - } - - readDatasetHeader(decode = FALSE)$encodedName -} - .isEncodedBridgeColumnName <- function(columnNames) { grepl("^JaspColumn_[[:alnum:]_]+_Encoded$", columnNames) | grepl("^jaspColumn[0-9]+$", columnNames) } -#' @rdname decodeColumnNames -#' @param encodedColumnNames Optional encoded column names. When omitted, the -#' current native dataset header is used. -#' -#' @return `columnMapping()` returns a named character vector mapping encoded -#' names to decoded names. -#' -#' @export -columnMapping <- function(encodedColumnNames = NULL, strict = FALSE) { - strict <- .validateFlag(strict, "strict") - if (is.null(encodedColumnNames)) - encodedColumnNames <- .encodedColumnNamesFromCurrentDecoder() - - if (!is.character(encodedColumnNames)) { - stop("`encodedColumnNames` must be a character vector", call. = FALSE) - } - - stats::setNames( - decodeColumnNames(encodedColumnNames, strict = strict), - encodedColumnNames - ) -} - #' Read the Loaded Native Dataset #' #' Reads the full dataset currently loaded into the native SyntaxInterface @@ -375,8 +335,8 @@ readDatasetHeader <- function(decode = TRUE) { #' @inheritParams readLoadedDataset #' #' @return A list with `loadedDataset`, `requestedDataset`, -#' `resultDecodingDataset`, `runtimeOptions`, `columnMapping`, `modulePath`, -#' and `analysisName`. +#' `resultDecodingDataset`, `runtimeOptions`, `columnEncoderContext`, +#' `modulePath`, and `analysisName`. #' #' @export loadAnalysisDataset <- function(dataset, modulePath, analysisName, options = NULL, @@ -416,7 +376,6 @@ loadAnalysisDataset <- function(dataset, modulePath, analysisName, options = NUL loadedRaw <- .readBridgeDataset(".readFullDatasetToEnd", "loaded dataset") requestedRaw <- .readBridgeDataset(".readDataSetRequestedNative", "requested dataset") - rawColumnNames <- unique(c(names(loadedRaw), names(requestedRaw))) state <- list( loadedDataset = .prepareBridgeDataset( @@ -435,7 +394,7 @@ loadAnalysisDataset <- function(dataset, modulePath, analysisName, options = NUL normalize = FALSE ), runtimeOptions = runtimeOptions, - columnMapping = columnMapping(rawColumnNames, strict = decode), + columnEncoderContext = columnEncoderContext(), modulePath = modulePath, analysisName = analysisName ) diff --git a/R/resultDecoding.R b/R/resultDecoding.R index d01b4f8..b31b3f3 100644 --- a/R/resultDecoding.R +++ b/R/resultDecoding.R @@ -1,37 +1,34 @@ #' Decode JASP Analysis Result Payloads #' -#' Decodes native column-name tokens and factor value tokens in analysis results -#' using the current SyntaxInterface dataset state. +#' Decodes native column-name tokens through SyntaxInterface and factor value +#' tokens from the requested dataset used by the analysis. #' #' @param results A result payload list, typically decoded from jaspResults JSON. #' @param requestedDataset Optional requested dataset to use as the factor-label #' source. When omitted, the current native requested dataset is read from the #' bridge if available. -#' @param columnMapping Optional named character vector mapping encoded native -#' column names to decoded user-facing column names. Supplying this avoids a -#' late native decoder snapshot call after analysis execution; replacement is -#' still performed by the native decoder. +#' @param columnEncoderContext Optional context returned by +#' `columnEncoderContext()`. Supplying it lets result replay decode with the +#' dataset/module state that created the result even after native state changes. #' #' @return The result payload with decoded column names and factor values. #' #' @export decodeAnalysisResults <- function(results, requestedDataset = NULL, - columnMapping = NULL) { + columnEncoderContext = NULL) { if (!is.list(results)) { return(results) } decodeContext <- .analysisResultDecodeContext( requestedDataset, - columnMapping = columnMapping + columnEncoderContext = columnEncoderContext ) .decodeAnalysisResultObject(results, decodeContext = decodeContext) } .analysisResultDecodeContext <- function(requestedDataset = NULL, - columnMapping = NULL) { - columnMapping <- .validateAnalysisResultColumnMapping(columnMapping) - + columnEncoderContext = NULL) { if (is.null(requestedDataset)) { requestedDataset <- tryCatch( readRequestedDataset(decode = FALSE, normalize = FALSE), @@ -39,22 +36,21 @@ decodeAnalysisResults <- function(results, requestedDataset = NULL, ) } - if (is.null(columnMapping) && is.data.frame(requestedDataset)) { - columnMapping <- get("columnMapping", envir = asNamespace("jaspSyntax"))(names(requestedDataset), strict = FALSE) - } + factorValues <- .analysisResultFactorValues( + requestedDataset, + columnEncoderContext = columnEncoderContext + ) - columnDecoder <- .analysisResultColumnDecoder(columnMapping) - columnDecodeContext <- list( - columnMapping = columnMapping, - columnDecoder = columnDecoder + list( + factorValues = factorValues, + columnEncoderContext = columnEncoderContext ) +} +.analysisResultFactorValues <- function(requestedDataset = NULL, + columnEncoderContext = NULL) { if (!is.data.frame(requestedDataset)) { - return(list( - factorValues = list(), - columnMapping = columnMapping, - columnDecoder = columnDecoder - )) + return(list()) } factorValues <- list() @@ -65,12 +61,8 @@ decodeAnalysisResults <- function(results, requestedDataset = NULL, } valueMap <- stats::setNames(levels(column), as.character(seq_along(levels(column)))) - decodedName <- .decodeAnalysisResultColumnNames(columnName, columnDecodeContext) - columnKeys <- unique(c( - columnName, - decodedName, - .encodedAnalysisResultColumnNames(columnName, columnMapping) - )) + decodedName <- .decodeAnalysisResultColumnNames(columnName, columnEncoderContext) + columnKeys <- unique(c(columnName, decodedName)) for (columnKey in columnKeys) { if (is.character(columnKey) && length(columnKey) == 1L && nzchar(columnKey)) { @@ -79,19 +71,7 @@ decodeAnalysisResults <- function(results, requestedDataset = NULL, } } - list( - factorValues = factorValues, - columnMapping = columnMapping, - columnDecoder = columnDecoder - ) -} - -.analysisResultColumnDecoder <- function(columnMapping = NULL) { - if (is.null(columnMapping)) { - return(NULL) - } - - columnDecoderSnapshot(columnMapping) + factorValues } .decodeAnalysisResultObject <- function(x, fieldName = NULL, decodeContext) { @@ -112,7 +92,7 @@ decodeAnalysisResults <- function(results, requestedDataset = NULL, } if (!is.null(oldNames)) { - names(x) <- .decodeAnalysisResultColumnNames(oldNames, decodeContext) + names(x) <- .decodeAnalysisResultColumnNames(oldNames, decodeContext[["columnEncoderContext"]]) } return(x) @@ -121,18 +101,34 @@ decodeAnalysisResults <- function(results, requestedDataset = NULL, x <- .decodeAnalysisResultFactorValues(x, fieldName, decodeContext) if (is.character(x)) { - x <- .decodeAnalysisResultColumnNames(x, decodeContext) + x <- .decodeAnalysisResultColumnNames(x, decodeContext[["columnEncoderContext"]]) } x } .decodeAnalysisResultFactorValues <- function(x, fieldName, decodeContext) { - if (is.null(fieldName) || is.null(decodeContext[["factorValues"]][[fieldName]])) { + if (is.null(fieldName)) { + return(x) + } + + candidateFields <- unique(c( + fieldName, + .decodeAnalysisResultColumnNames(fieldName, decodeContext[["columnEncoderContext"]]) + )) + candidateFields <- candidateFields[!is.na(candidateFields) & nzchar(candidateFields)] + + valueMap <- NULL + for (candidateField in candidateFields) { + valueMap <- decodeContext[["factorValues"]][[candidateField]] + if (!is.null(valueMap)) { + break + } + } + if (is.null(valueMap)) { return(x) } - valueMap <- decodeContext[["factorValues"]][[fieldName]] key <- as.character(x) matched <- key %in% names(valueMap) if (!any(matched)) { @@ -144,45 +140,10 @@ decodeAnalysisResults <- function(results, requestedDataset = NULL, out } -.validateAnalysisResultColumnMapping <- function(columnMapping = NULL) { - if (is.null(columnMapping)) { - return(NULL) - } - - if (!is.character(columnMapping) || is.null(names(columnMapping))) { - stop("`columnMapping` must be a named character vector", call. = FALSE) - } - - valid <- !is.na(columnMapping) & nzchar(columnMapping) & - !is.na(names(columnMapping)) & nzchar(names(columnMapping)) - columnMapping[valid] -} - -.decodeAnalysisResultColumnNames <- function(columnNames, decodeContext = NULL) { +.decodeAnalysisResultColumnNames <- function(columnNames, columnEncoderContext = NULL) { if (!is.character(columnNames) || length(columnNames) == 0L) { return(columnNames) } - columnMapping <- decodeContext[["columnMapping"]] - columnDecoder <- decodeContext[["columnDecoder"]] - - if (inherits(columnDecoder, "jaspSyntaxColumnDecoder")) { - return(decodeColumnText(columnNames, columnDecoder)) - } - - if (length(columnMapping) > 0L) { - return(.decodeColumnNamesWithMapping(columnNames, columnMapping)) - } - - decodeColumnText(columnNames) -} - -.encodedAnalysisResultColumnNames <- function(decodedColumnName, - columnMapping = NULL) { - if (!is.character(decodedColumnName) || length(decodedColumnName) != 1L || - length(columnMapping) == 0L) { - return(character(0)) - } - - names(columnMapping)[!is.na(columnMapping) & columnMapping == decodedColumnName] + decodeColumnText(columnNames, columnEncoderContext) } diff --git a/man/columnDecoderSnapshot.Rd b/man/columnDecoderSnapshot.Rd deleted file mode 100644 index 0a52cba..0000000 --- a/man/columnDecoderSnapshot.Rd +++ /dev/null @@ -1,28 +0,0 @@ -\name{columnDecoderSnapshot} -\alias{columnDecoderSnapshot} -\alias{decodeColumnText} -\title{Native Column Decoder Snapshots} -\usage{ -columnDecoderSnapshot(columnMapping = NULL) - -decodeColumnText(text, decoderSnapshot = NULL) -} -\arguments{ -\item{columnMapping}{Optional named character vector mapping encoded column -tokens to decoded user-facing names.} - -\item{text}{Character vector to decode.} - -\item{decoderSnapshot}{Optional decoder returned by -\code{columnDecoderSnapshot()}. When omitted, the current native bridge decoder -is used.} -} -\value{ -\code{columnDecoderSnapshot()} returns a serializable native decoder snapshot. -\code{decodeColumnText()} returns a character vector with native column tokens -decoded. -} -\description{ -Capture and reuse SyntaxInterface's native \code{ColumnEncoder} decoder for -analysis result materialization. -} diff --git a/man/columnEncoderContext.Rd b/man/columnEncoderContext.Rd new file mode 100644 index 0000000..2be7dd4 --- /dev/null +++ b/man/columnEncoderContext.Rd @@ -0,0 +1,26 @@ +\name{columnEncoderContext} +\alias{columnEncoderContext} +\alias{decodeColumnText} +\title{Native Column Encoder Context} +\usage{ +columnEncoderContext() + +decodeColumnText(text, encoderContext = NULL) +} +\arguments{ +\item{text}{Character vector to decode.} + +\item{encoderContext}{Optional context returned by +\code{columnEncoderContext()}. When omitted, the current native bridge encoder +state is used.} +} +\value{ +\code{columnEncoderContext()} returns a serializable native encoder context. +\code{decodeColumnText()} returns a character vector with native column tokens +decoded. +} +\description{ +Capture and reuse the source state needed by SyntaxInterface's native +\code{ColumnEncoder}: dataset column names/types and extra QML option +encodings. +} diff --git a/man/datasetBridgeHelpers.Rd b/man/datasetBridgeHelpers.Rd index 4b0f3db..59038a1 100644 --- a/man/datasetBridgeHelpers.Rd +++ b/man/datasetBridgeHelpers.Rd @@ -4,7 +4,6 @@ \alias{readRequestedDataset} \alias{readDatasetHeader} \alias{decodeColumnNames} -\alias{columnMapping} \title{High-Level Native Dataset Helpers} \usage{ loadAnalysisDataset( @@ -25,8 +24,6 @@ readRequestedDataset(decode = TRUE, normalize = TRUE) readDatasetHeader(decode = TRUE) decodeColumnNames(columnNames, strict = FALSE) - -columnMapping(encodedColumnNames = NULL, strict = FALSE) } \arguments{ \item{dataset}{Raw data frame supplied by the caller.} @@ -48,20 +45,17 @@ columnMapping(encodedColumnNames = NULL, strict = FALSE) \item{columnNames}{Character vector of column names.} \item{strict}{Whether to fail when an encoded bridge name cannot be decoded. Raw/non-encoded names are returned unchanged.} - -\item{encodedColumnNames}{Optional encoded column names. When omitted, the current native dataset header is used.} } \value{ \code{loadAnalysisDataset()} returns a list with \code{loadedDataset}, \code{requestedDataset}, \code{resultDecodingDataset}, -\code{runtimeOptions}, \code{columnMapping}, \code{modulePath}, and +\code{runtimeOptions}, \code{columnEncoderContext}, \code{modulePath}, and \code{analysisName}. \code{readLoadedDataset()} and \code{readRequestedDataset()} return data frames. \code{readDatasetHeader()} returns a data frame with \code{name} and \code{encodedName} columns. \code{decodeColumnNames()} returns a character -vector. \code{columnMapping()} returns a named character vector mapping encoded -names to decoded names. +vector. } \description{ These helpers keep native dataset preload, requested-data state, and column-name @@ -71,9 +65,8 @@ option preparation. } \details{ \code{loadAnalysisDataset()} is the supported high-level entry point for -jaspTools-style replay. The direct state readers and column mapping helpers are -exported for bridge diagnostics and should be treated as native-facing -integration APIs. +jaspTools-style replay. The direct state readers are exported for bridge +diagnostics and should be treated as native-facing integration APIs. \code{loadAnalysisDataset()} loads the raw data frame into SyntaxInterface, replays saved/QML-bound options through \code{readAnalysisOptionsFromQml()} with diff --git a/man/decodeAnalysisResults.Rd b/man/decodeAnalysisResults.Rd index 64f3811..371e262 100644 --- a/man/decodeAnalysisResults.Rd +++ b/man/decodeAnalysisResults.Rd @@ -4,7 +4,11 @@ \alias{decodeAnalysisResults} \title{Decode JASP Analysis Result Payloads} \usage{ -decodeAnalysisResults(results, requestedDataset = NULL, columnMapping = NULL) +decodeAnalysisResults( + results, + requestedDataset = NULL, + columnEncoderContext = NULL +) } \arguments{ \item{results}{A result payload list, typically decoded from jaspResults JSON.} @@ -13,14 +17,14 @@ decodeAnalysisResults(results, requestedDataset = NULL, columnMapping = NULL) source. When omitted, the current native requested dataset is read from the bridge if available.} -\item{columnMapping}{Optional named character vector mapping encoded native -column names to decoded user-facing column names. Supplying this avoids a -late native decoder call after analysis execution.} +\item{columnEncoderContext}{Optional context returned by +\code{columnEncoderContext()}. Supplying it lets result replay decode with the +dataset/module state that created the result even after native state changes.} } \value{ The result payload with decoded column names and factor values. } \description{ -Decodes native column-name tokens and factor value tokens in analysis results -using the current SyntaxInterface dataset state. +Decodes native column-name tokens through SyntaxInterface and factor value +tokens from the requested dataset used by the analysis. } diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp index 3277561..5f08500 100644 --- a/src/RcppExports.cpp +++ b/src/RcppExports.cpp @@ -159,25 +159,25 @@ BEGIN_RCPP return rcpp_result_gen; END_RCPP } -// columnDecoderSnapshotNative -String columnDecoderSnapshotNative(); -RcppExport SEXP _jaspSyntax_columnDecoderSnapshotNative() { +// columnEncoderContextNative +String columnEncoderContextNative(); +RcppExport SEXP _jaspSyntax_columnEncoderContextNative() { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; - rcpp_result_gen = Rcpp::wrap(columnDecoderSnapshotNative()); + rcpp_result_gen = Rcpp::wrap(columnEncoderContextNative()); return rcpp_result_gen; END_RCPP } // decodeColumnTextNative -Rcpp::CharacterVector decodeColumnTextNative(Rcpp::CharacterVector values, String decoderSnapshotJson); -RcppExport SEXP _jaspSyntax_decodeColumnTextNative(SEXP valuesSEXP, SEXP decoderSnapshotJsonSEXP) { +Rcpp::CharacterVector decodeColumnTextNative(Rcpp::CharacterVector values, String encoderContextJson); +RcppExport SEXP _jaspSyntax_decodeColumnTextNative(SEXP valuesSEXP, SEXP encoderContextJsonSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type values(valuesSEXP); - Rcpp::traits::input_parameter< String >::type decoderSnapshotJson(decoderSnapshotJsonSEXP); - rcpp_result_gen = Rcpp::wrap(decodeColumnTextNative(values, decoderSnapshotJson)); + Rcpp::traits::input_parameter< String >::type encoderContextJson(encoderContextJsonSEXP); + rcpp_result_gen = Rcpp::wrap(decodeColumnTextNative(values, encoderContextJson)); return rcpp_result_gen; END_RCPP } @@ -197,7 +197,7 @@ static const R_CallMethodDef CallEntries[] = { {"_jaspSyntax_analysisOptionsFromJaspFile", (DL_FUNC) &_jaspSyntax_analysisOptionsFromJaspFile, 2}, {"_jaspSyntax_generateAnalysisWrapper", (DL_FUNC) &_jaspSyntax_generateAnalysisWrapper, 2}, {"_jaspSyntax_getVariableNames", (DL_FUNC) &_jaspSyntax_getVariableNames, 0}, - {"_jaspSyntax_columnDecoderSnapshotNative", (DL_FUNC) &_jaspSyntax_columnDecoderSnapshotNative, 0}, + {"_jaspSyntax_columnEncoderContextNative", (DL_FUNC) &_jaspSyntax_columnEncoderContextNative, 0}, {"_jaspSyntax_decodeColumnTextNative", (DL_FUNC) &_jaspSyntax_decodeColumnTextNative, 2}, {NULL, NULL, 0} }; diff --git a/src/syntaxfunctions.cpp b/src/syntaxfunctions.cpp index 755156a..72748b0 100644 --- a/src/syntaxfunctions.cpp +++ b/src/syntaxfunctions.cpp @@ -403,15 +403,15 @@ Rcpp::List getVariableNames() } // [[Rcpp::export]] -String columnDecoderSnapshotNative() +String columnEncoderContextNative() { - return callBridgeOrStop("syntaxBridgeColumnDecoderSnapshot", []() { - return syntaxBridgeColumnDecoderSnapshot(); + return callBridgeOrStop("syntaxBridgeColumnEncoderContext", []() { + return syntaxBridgeColumnEncoderContext(); }); } // [[Rcpp::export]] -Rcpp::CharacterVector decodeColumnTextNative(Rcpp::CharacterVector values, String decoderSnapshotJson) +Rcpp::CharacterVector decodeColumnTextNative(Rcpp::CharacterVector values, String encoderContextJson) { Json::Value input(Json::arrayValue); for (R_xlen_t i = 0; i < values.size(); ++i) @@ -424,10 +424,10 @@ Rcpp::CharacterVector decodeColumnTextNative(Rcpp::CharacterVector values, Strin } const std::string inputJson = input.toStyledString(); - const std::string snapshotJson = std::string(decoderSnapshotJson.get_cstring()); + const std::string contextJson = std::string(encoderContextJson.get_cstring()); Json::Value decoded = parseBridgeJsonOrStop( callBridgeOrStop("syntaxBridgeDecodeColumnText", [&]() { - return syntaxBridgeDecodeColumnText(inputJson.c_str(), snapshotJson.c_str()); + return syntaxBridgeDecodeColumnText(inputJson.c_str(), contextJson.c_str()); }), "syntaxBridgeDecodeColumnText" ); diff --git a/tests/testthat/test-dataset-helpers.R b/tests/testthat/test-dataset-helpers.R index d3fd570..8425fdc 100644 --- a/tests/testthat/test-dataset-helpers.R +++ b/tests/testthat/test-dataset-helpers.R @@ -56,7 +56,7 @@ localNamespaceBinding <- function(name, value, namespace) { localNativeColumnTextDecoder <- function(mapping) { localNamespaceBinding( "decodeColumnText", - function(text, decoderSnapshot = NULL) { + function(text, encoderContext = NULL) { out <- text tokens <- names(mapping) tokens <- tokens[order(nchar(tokens), decreasing = TRUE)] @@ -72,7 +72,7 @@ localNativeColumnTextDecoder <- function(mapping) { localFailingColumnTextDecoder <- function(message = "native decoder unavailable") { localNamespaceBinding( "decodeColumnText", - function(text, decoderSnapshot = NULL) { + function(text, encoderContext = NULL) { stop(message, call. = FALSE) }, asNamespace("jaspSyntax") @@ -92,10 +92,6 @@ test_that("decodeColumnNames delegates to the native bridge decoder", { jaspSyntax::decodeColumnNames(c("JaspColumn_1_Encoded", "JaspColumn_2_Encoded")), c("raw score", "group") ) - expect_equal( - jaspSyntax::columnMapping(c("JaspColumn_1_Encoded", "JaspColumn_2_Encoded")), - c(JaspColumn_1_Encoded = "raw score", JaspColumn_2_Encoded = "group") - ) }) test_that("decodeColumnNames errors when native decoding is unavailable", { @@ -117,11 +113,6 @@ test_that("decodeColumnNames errors when native decoding is unavailable", { "native decoder unavailable", fixed = TRUE ) - expect_error( - jaspSyntax::columnMapping(c("JaspColumn_1_Encoded", "JaspColumn_2_Encoded")), - "native decoder unavailable", - fixed = TRUE - ) }) test_that("decodeColumnNames fails when the decoder is unavailable", { @@ -138,11 +129,6 @@ test_that("decodeColumnNames fails when the decoder is unavailable", { "native decoder unavailable", fixed = TRUE ) - expect_error( - jaspSyntax::columnMapping("JaspColumn_1_Encoded", strict = TRUE), - "native decoder unavailable", - fixed = TRUE - ) }) test_that("decodeColumnNames fails when native decoding leaves encoded names", { @@ -156,38 +142,71 @@ test_that("decodeColumnNames fails when native decoding leaves encoded names", { ) }) -test_that("empty column decoder snapshots do not fall through to live native state", { - snapshot <- jaspSyntax::columnDecoderSnapshot(stats::setNames(character(), character())) +test_that("empty column encoder contexts do not fall through to live native state", { + observedContext <- NULL + restoreNative <- localNamespaceBinding( + "decodeColumnTextNative", + function(values, encoderContextJson) { + observedContext <<- jsonlite::fromJSON(encoderContextJson, simplifyVector = FALSE) + values + }, + asNamespace("jaspSyntax") + ) + on.exit(restoreNative(), add = TRUE) + + context <- jaspSyntax:::.newColumnEncoderContext() expect_equal( - jaspSyntax::decodeColumnText("JaspColumn_1_Encoded", snapshot), + jaspSyntax::decodeColumnText("JaspColumn_1_Encoded", context), "JaspColumn_1_Encoded" ) + expect_equal(observedContext$columns, list()) }) test_that("decodeColumnText does not use R mapping replacement when native decoding fails", { restoreNative <- localNamespaceBinding( "decodeColumnTextNative", - function(values, decoderSnapshotJson) { + function(values, encoderContextJson) { stop("native failure", call. = FALSE) }, asNamespace("jaspSyntax") ) on.exit(restoreNative(), add = TRUE) - snapshot <- jaspSyntax::columnDecoderSnapshot(c(JaspColumn_1_Encoded = "score")) + context <- jaspSyntax:::.newColumnEncoderContext( + columns = list(list(name = "score", type = "scale")) + ) expect_error( - jaspSyntax::decodeColumnText("JaspColumn_1_Encoded", snapshot), + jaspSyntax::decodeColumnText("JaspColumn_1_Encoded", context), "native failure", fixed = TRUE ) }) +test_that("decodeColumnText dispatches extra option tokens to the native decoder", { + observed <- NULL + restoreNative <- localNamespaceBinding( + "decodeColumnTextNative", + function(values, encoderContextJson) { + observed <<- values + gsub("JaspExtraOptions_0_Encoded", "Factor A", values, fixed = TRUE) + }, + asNamespace("jaspSyntax") + ) + on.exit(restoreNative(), add = TRUE) + + expect_equal( + jaspSyntax::decodeColumnText("JaspExtraOptions_0_Encoded"), + "Factor A" + ) + expect_equal(observed, "JaspExtraOptions_0_Encoded") +}) + test_that("decodeColumnNames does not send raw names to the strict native decoder", { observed <- character(0) restoreNative <- localNamespaceBinding( "decodeColumnText", - function(text, decoderSnapshot = NULL) { + function(text, encoderContext = NULL) { observed <<- c(observed, text) out <- text out[text == "JaspColumn_1_Encoded"] <- "score" @@ -319,6 +338,9 @@ test_that("decodeAnalysisResults decodes native column names and factor value to c(JaspColumn_1_Encoded = "group") ) on.exit(restoreDecoder(), add = TRUE) + encoderContext <- jaspSyntax:::.newColumnEncoderContext( + columns = list(list(name = "group", type = "nominal")) + ) requestedDataset <- data.frame( JaspColumn_1_Encoded = factor(c("control", "treatment")), @@ -340,7 +362,7 @@ test_that("decodeAnalysisResults decodes native column names and factor value to decoded <- jaspSyntax::decodeAnalysisResults( results, requestedDataset = requestedDataset, - columnMapping = c(JaspColumn_1_Encoded = "group") + columnEncoderContext = encoderContext ) firstRow <- decoded$results$table$data[[1L]] @@ -349,12 +371,12 @@ test_that("decodeAnalysisResults decodes native column names and factor value to expect_equal(firstRow$label, "group") }) -test_that("decodeAnalysisResults passes captured column mapping to the native decoder", { - observedSnapshot <- NULL +test_that("decodeAnalysisResults passes captured column encoder context to the native decoder", { + observedContext <- NULL restoreDecoder <- localNamespaceBinding( "decodeColumnText", - function(text, decoderSnapshot = NULL) { - observedSnapshot <<- decoderSnapshot + function(text, encoderContext = NULL) { + observedContext <<- encoderContext out <- text out <- gsub("JaspColumn_1_Encoded", "group", out, fixed = TRUE) out <- gsub("jaspColumn2", "phase", out, fixed = TRUE) @@ -363,6 +385,12 @@ test_that("decodeAnalysisResults passes captured column mapping to the native de asNamespace("jaspSyntax") ) on.exit(restoreDecoder(), add = TRUE) + encoderContext <- jaspSyntax:::.newColumnEncoderContext( + columns = list( + list(name = "group", type = "nominal"), + list(name = "phase", type = "nominal") + ) + ) requestedDataset <- data.frame( JaspColumn_1_Encoded = factor(c("control", "treatment")), @@ -387,7 +415,7 @@ test_that("decodeAnalysisResults passes captured column mapping to the native de decoded <- jaspSyntax::decodeAnalysisResults( results, requestedDataset = requestedDataset, - columnMapping = c(JaspColumn_1_Encoded = "group", jaspColumn2 = "phase") + columnEncoderContext = encoderContext ) firstRow <- decoded$results$table$data[[1L]] @@ -397,7 +425,7 @@ test_that("decodeAnalysisResults passes captured column mapping to the native de expect_equal(firstRow$Interaction, "group:phase") expect_equal(firstRow$Note, "The following variables are used: 'group', 'phase'.") expect_equal(firstRow$Unmatched, "jaspColumn10") - expect_s3_class(observedSnapshot, "jaspSyntaxColumnDecoder") + expect_s3_class(observedContext, "jaspSyntaxColumnEncoderContext") }) test_that("decodeAnalysisResults maps factor values with decoded requested datasets", { @@ -405,6 +433,9 @@ test_that("decodeAnalysisResults maps factor values with decoded requested datas c(JaspColumn_1_Encoded = "group") ) on.exit(restoreDecoder(), add = TRUE) + encoderContext <- jaspSyntax:::.newColumnEncoderContext( + columns = list(list(name = "group", type = "nominal")) + ) requestedDataset <- data.frame( group = factor(c("control", "treatment")), @@ -423,7 +454,7 @@ test_that("decodeAnalysisResults maps factor values with decoded requested datas decoded <- jaspSyntax::decodeAnalysisResults( results, requestedDataset = requestedDataset, - columnMapping = c(JaspColumn_1_Encoded = "group") + columnEncoderContext = encoderContext ) firstRow <- decoded$results$table$data[[1L]] @@ -552,6 +583,17 @@ test_that("loadAnalysisDataset returns loaded and requested state from native he JaspColumn_2_Encoded = "group" ) ) + encoderContext <- jaspSyntax:::.newColumnEncoderContext( + columns = list( + list(name = "score", type = "scale"), + list(name = "group", type = "nominal") + ) + ) + restoreContext <- localNamespaceBinding( + "columnEncoderContext", + function() encoderContext, + asNamespace("jaspSyntax") + ) on.exit(restoreClear(), add = TRUE) on.exit(restoreLoad(), add = TRUE) on.exit(restoreReadQml(), add = TRUE) @@ -559,6 +601,7 @@ test_that("loadAnalysisDataset returns loaded and requested state from native he on.exit(restoreRequested(), add = TRUE) on.exit(restoreDecoder(), add = TRUE) on.exit(restoreNative(), add = TRUE) + on.exit(restoreContext(), add = TRUE) rawDataset <- data.frame(score = c(1, 2), group = c("a", "b")) savedOptions <- list(variables = list(value = "score", types = "scale")) @@ -585,7 +628,8 @@ test_that("loadAnalysisDataset returns loaded and requested state from native he expect_s3_class(state$resultDecodingDataset$score, "factor") expect_equal(levels(state$resultDecodingDataset$score), c("control", "treatment")) expect_equal(state$runtimeOptions$variables, "JaspColumn_1_Encoded") - expect_equal(state$columnMapping, c(JaspColumn_1_Encoded = "score", JaspColumn_2_Encoded = "group")) + expect_s3_class(state$columnEncoderContext, "jaspSyntaxColumnEncoderContext") + expect_equal(state$columnEncoderContext$columns, encoderContext$columns) expect_s3_class(state, "jaspSyntax_analysis_dataset_state") }) @@ -805,6 +849,8 @@ test_that("subprocess package loading distinguishes source checkouts from instal "jaspSyntax subprocess PATH head", fixed = TRUE ) + expect_identical(environment(jaspSyntax:::.bridgeSubprocessPackageLoader()), baseenv()) + expect_identical(environment(jaspSyntax:::.bridgeSubprocessRunner()), baseenv()) descriptionCandidates <- c( file.path(getwd(), "DESCRIPTION"), diff --git a/tests/testthat/test-desktop-jasp-contract.R b/tests/testthat/test-desktop-jasp-contract.R index 0883ebc..a7d26ce 100644 --- a/tests/testthat/test-desktop-jasp-contract.R +++ b/tests/testthat/test-desktop-jasp-contract.R @@ -127,10 +127,12 @@ test_that("native and R bridge exports keep the expected consumer formals", { expect_named(formals(jaspSyntax::readRequestedDataset), c("decode", "normalize")) expect_named(formals(jaspSyntax::readDatasetHeader), "decode") expect_named(formals(jaspSyntax::decodeColumnNames), c("columnNames", "strict")) - expect_named(formals(jaspSyntax::columnDecoderSnapshot), "columnMapping") - expect_named(formals(jaspSyntax::decodeColumnText), c("text", "decoderSnapshot")) - expect_named(formals(jaspSyntax::decodeAnalysisResults), c("results", "requestedDataset", "columnMapping")) - expect_named(formals(jaspSyntax::columnMapping), c("encodedColumnNames", "strict")) + expect_true(is.null(formals(jaspSyntax::columnEncoderContext)) || + identical(names(formals(jaspSyntax::columnEncoderContext)), character(0))) + expect_named(formals(jaspSyntax::decodeColumnText), c("text", "encoderContext")) + expect_named(formals(jaspSyntax::decodeAnalysisResults), c("results", "requestedDataset", "columnEncoderContext")) + expect_false("columnMapping" %in% getNamespaceExports("jaspSyntax")) + expect_false("columnDecoderSnapshot" %in% getNamespaceExports("jaspSyntax")) expect_named( formals(jaspSyntax::readAnalysisOptionsFromJaspFile), c("jaspFilePath", "modulePath", "runtime", "includeMeta", "includeTypeOptions", "isolated") From e506f58f087fa8b3ac45702bd75d47403a511f3f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franti=C5=A1ek=20Barto=C5=A1?= Date: Thu, 4 Jun 2026 15:05:36 +0200 Subject: [PATCH 10/11] Bump native bridge API version --- DESCRIPTION | 4 ++-- R/readDatasetFromJaspFile.R | 5 +++-- man/datasetBridgeHelpers.Rd | 4 +++- tests/testthat/test-dataset-helpers.R | 14 ++++++++++++++ 4 files changed, 22 insertions(+), 5 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 8569dcb..bc4c407 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Package: jaspSyntax Type: Package Title: Makes JASP analyses available in R -Version: 1.3.2 -Date: 2026-05-11 +Version: 1.3.3 +Date: 2026-06-04 Author: JASP Team Website: jasp-stats.org Maintainer: JASP Team diff --git a/R/readDatasetFromJaspFile.R b/R/readDatasetFromJaspFile.R index fca9b98..eff715c 100644 --- a/R/readDatasetFromJaspFile.R +++ b/R/readDatasetFromJaspFile.R @@ -202,8 +202,9 @@ #' names require a working native decoder. #' #' @param columnNames Character vector of column names. -#' @param strict Whether to fail when an encoded bridge name cannot be decoded. -#' Raw/non-encoded names are returned unchanged. +#' @param strict Compatibility-only flag retained for callers that pass it. +#' Encoded bridge names always require native decoding; raw/non-encoded names +#' are returned unchanged. #' #' @return A character vector with decoded names. #' diff --git a/man/datasetBridgeHelpers.Rd b/man/datasetBridgeHelpers.Rd index 59038a1..b069222 100644 --- a/man/datasetBridgeHelpers.Rd +++ b/man/datasetBridgeHelpers.Rd @@ -44,7 +44,9 @@ decodeColumnNames(columnNames, strict = FALSE) \item{columnNames}{Character vector of column names.} -\item{strict}{Whether to fail when an encoded bridge name cannot be decoded. Raw/non-encoded names are returned unchanged.} +\item{strict}{Compatibility-only flag retained for callers that pass it. +Encoded bridge names always require native decoding; raw/non-encoded names are +returned unchanged.} } \value{ \code{loadAnalysisDataset()} returns a list with \code{loadedDataset}, diff --git a/tests/testthat/test-dataset-helpers.R b/tests/testthat/test-dataset-helpers.R index 8425fdc..3506360 100644 --- a/tests/testthat/test-dataset-helpers.R +++ b/tests/testthat/test-dataset-helpers.R @@ -131,6 +131,20 @@ test_that("decodeColumnNames fails when the decoder is unavailable", { ) }) +test_that("decodeColumnNames strict flag is compatibility-only", { + restoreDecoder <- localNativeColumnTextDecoder(c(JaspColumn_1_Encoded = "score")) + on.exit(restoreDecoder(), add = TRUE) + + expect_equal( + jaspSyntax::decodeColumnNames(c("plain", "JaspColumn_1_Encoded"), strict = FALSE), + c("plain", "score") + ) + expect_equal( + jaspSyntax::decodeColumnNames(c("plain", "JaspColumn_1_Encoded"), strict = TRUE), + c("plain", "score") + ) +}) + test_that("decodeColumnNames fails when native decoding leaves encoded names", { restoreDecoder <- localNativeColumnTextDecoder(stats::setNames(character(), character())) on.exit(restoreDecoder(), add = TRUE) From 0be081197a93ab6fcf2ba4256c6c921059fa5ff9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franti=C5=A1ek=20Barto=C5=A1?= Date: Fri, 5 Jun 2026 12:19:52 +0200 Subject: [PATCH 11/11] Add native column context regression tests --- tests/testthat/test-native-column-context.R | 116 ++++++++++++++++++++ 1 file changed, 116 insertions(+) create mode 100644 tests/testthat/test-native-column-context.R diff --git a/tests/testthat/test-native-column-context.R b/tests/testthat/test-native-column-context.R new file mode 100644 index 0000000..2e55336 --- /dev/null +++ b/tests/testthat/test-native-column-context.R @@ -0,0 +1,116 @@ +context("native column encoder context") + +localNativeColumnBridge <- function() { + tryCatch( + { + jaspSyntax::clearNativeState() + jaspSyntax::setParameter("verbose", "none") + invisible(TRUE) + }, + error = function(e) { + testthat::skip(paste0("Native SyntaxInterface bridge unavailable: ", conditionMessage(e))) + } + ) +} + +contextColumnNames <- function(context) { + vapply(context$columns, function(column) column$name, character(1L)) +} + +contextDecodeExpectation <- function(context) { + columnNames <- contextColumnNames(context) + c( + columnNames[[1L]], + columnNames[[2L]], + paste0("model uses ", columnNames[[1L]], " and ", columnNames[[2L]]) + ) +} + +loadContextDataset <- function(dataset) { + jaspSyntax::clearNativeState() + jaspSyntax::loadDataSet(dataset) + jaspSyntax::columnEncoderContext() +} + +test_that("native decoder contexts can be interleaved without mutating live state", { + localNativeColumnBridge() + on.exit(jaspSyntax::clearNativeState(), add = TRUE) + + datasets <- list( + alpha = data.frame( + alpha_group = c("a", "b", "a"), + alpha_score = c(1.1, 2.2, 3.3), + check.names = FALSE + ), + beta = data.frame( + beta_group = c("x", "y", "x"), + beta_score = c(10.5, 11.5, 12.5), + check.names = FALSE + ), + gamma = data.frame( + gamma_group = c("left", "right", "left"), + gamma_score = c(-1.25, 0.5, 1.75), + check.names = FALSE + ) + ) + + contexts <- lapply(datasets, loadContextDataset) + for (datasetName in names(datasets)) { + expect_equal(sort(contextColumnNames(contexts[[datasetName]])), names(datasets[[datasetName]])) + } + + jaspSyntax::clearNativeState() + jaspSyntax::loadDataSet(datasets$alpha) + liveContext <- jaspSyntax::columnEncoderContext() + + tokens <- c( + "JaspColumn_0_Encoded", + "JaspColumn_3_Encoded", + "model uses JaspColumn_0_Encoded and JaspColumn_3_Encoded" + ) + liveExpected <- contextDecodeExpectation(liveContext) + expect_equal(jaspSyntax::decodeColumnText(tokens), liveExpected) + + interleavedContexts <- contexts[c("beta", "gamma", "alpha", "beta", "alpha", "gamma")] + for (context in interleavedContexts) { + expect_equal( + jaspSyntax::decodeColumnText(tokens, context), + contextDecodeExpectation(context) + ) + expect_equal(jaspSyntax::decodeColumnText(tokens), liveExpected) + } + + restoredContext <- jaspSyntax::columnEncoderContext() + expect_equal(restoredContext$columns, liveContext$columns) + expect_equal(restoredContext$extra, liveContext$extra) + expect_equal(jaspSyntax::decodeColumnText(tokens), liveExpected) +}) + +test_that("native decoder C API reports malformed contexts without corrupting live state", { + localNativeColumnBridge() + on.exit(jaspSyntax::clearNativeState(), add = TRUE) + + dataset <- data.frame( + api_group = c("control", "treatment"), + api_score = c(1.25, 2.5), + check.names = FALSE + ) + jaspSyntax::loadDataSet(dataset) + + rawContext <- jaspSyntax:::columnEncoderContextNative() + parsedContext <- jsonlite::fromJSON(rawContext, simplifyVector = FALSE) + expect_equal(parsedContext$version, 1L) + expect_equal(sort(vapply(parsedContext$columns, `[[`, character(1L), "name")), names(dataset)) + expect_equal(parsedContext$extra, list()) + + tokens <- c("JaspColumn_0_Encoded", "JaspColumn_3_Encoded") + liveBefore <- jaspSyntax::decodeColumnText(tokens) + + expect_error( + jaspSyntax:::decodeColumnTextNative(tokens, "{not valid context json"), + "Could not parse column encoder context JSON", + fixed = TRUE + ) + + expect_equal(jaspSyntax::decodeColumnText(tokens), liveBefore) +})