From 3f062f4a913aa42fe357a7bd74a7fc252254d1f8 Mon Sep 17 00:00:00 2001 From: perrydv Date: Mon, 22 Jun 2026 14:04:48 -0700 Subject: [PATCH 01/27] changes to support work on nimble2 --- .../R/distributions_processInputList.R | 2 +- nimbleModel/R/miscFunctions.R | 69 ++++++++++--------- nimbleModel/R/nimbleModel.R | 7 +- 3 files changed, 42 insertions(+), 36 deletions(-) diff --git a/nimbleModel/R/distributions_processInputList.R b/nimbleModel/R/distributions_processInputList.R index 999ff44..89222d1 100644 --- a/nimbleModel/R/distributions_processInputList.R +++ b/nimbleModel/R/distributions_processInputList.R @@ -1081,7 +1081,7 @@ scalar_distribution_bool <- unlist(lapply(nms, function(x) all(unlist(lapply(get scalar_distribution_dFuns <- BUGSdistToRdist(nms[scalar_distribution_bool], dIncluded = TRUE) scalar_distribution_rFuns <- gsub("^d", "r", scalar_distribution_dFuns) -scalar_pqAvail_bool <- nimble:::getAllDistributionsInfo("pqAvail")[nms] & scalar_distribution_bool +scalar_pqAvail_bool <- getAllDistributionsInfo("pqAvail")[nms] & scalar_distribution_bool scalar_pqAvail_dFuns <- BUGSdistToRdist(nms[scalar_pqAvail_bool], dIncluded = TRUE) scalar_distribution_pFuns <- gsub("^d", "p", scalar_pqAvail_dFuns) scalar_distribution_qFuns <- gsub("^d", "q", scalar_pqAvail_dFuns) diff --git a/nimbleModel/R/miscFunctions.R b/nimbleModel/R/miscFunctions.R index aa390d9..acd3537 100644 --- a/nimbleModel/R/miscFunctions.R +++ b/nimbleModel/R/miscFunctions.R @@ -1,34 +1,37 @@ -# This needs to be sourced after `nimbleFunction` is defined, so can't be done in `distributions_inputList.R`. -calc_dmnormAltParams <- nimble::nimbleFunction( - name = "calc_dmnormAltParams", - run = function(cholesky = double(2), prec_param = double(), return_prec = double()) { - if (prec_param == return_prec) { - ans <- t(cholesky) %*% cholesky - } else { - I <- diag(dim(cholesky)[1]) - ans <- backsolve(cholesky, forwardsolve(t(cholesky), I)) - # Chris suggests: - # tmp <- forwardsolve(L, I) - # ans <- crossprod(tmp) - } - returnType(double(2)) - return(ans) - } -) +# These are commented out to avoid loading the nimble namespace +# # This needs to be sourced after `nimbleFunction` is defined, so can't be done in `distributions_inputList.R`. +calc_dmnormAltParams <- function() stop("Don't call this") +# calc_dmnormAltParams <- nimble::nimbleFunction( +# name = "calc_dmnormAltParams", +# run = function(cholesky = double(2), prec_param = double(), return_prec = double()) { +# if (prec_param == return_prec) { +# ans <- t(cholesky) %*% cholesky +# } else { +# I <- diag(dim(cholesky)[1]) +# ans <- backsolve(cholesky, forwardsolve(t(cholesky), I)) +# # Chris suggests: +# # tmp <- forwardsolve(L, I) +# # ans <- crossprod(tmp) +# } +# returnType(double(2)) +# return(ans) +# } +# ) -calc_dwishAltParams <- nimble::nimbleFunction( - name = "calc_dwishAltParams", - run = function(cholesky = double(2), scale_param = double(), return_scale = double()) { - if (scale_param == return_scale) { - ans <- t(cholesky) %*% cholesky - } else { - I <- diag(dim(cholesky)[1]) - ans <- backsolve(cholesky, forwardsolve(t(cholesky), I)) - # Chris suggests: - # tmp <- forwardsolve(L, I) - # ans <- crossprod(tmp) - } - returnType(double(2)) - return(ans) - } -) +calc_dwishAltParams <- function() stop("Don't call this") +# calc_dwishAltParams <- nimble::nimbleFunction( +# name = "calc_dwishAltParams", +# run = function(cholesky = double(2), scale_param = double(), return_scale = double()) { +# if (scale_param == return_scale) { +# ans <- t(cholesky) %*% cholesky +# } else { +# I <- diag(dim(cholesky)[1]) +# ans <- backsolve(cholesky, forwardsolve(t(cholesky), I)) +# # Chris suggests: +# # tmp <- forwardsolve(L, I) +# # ans <- crossprod(tmp) +# } +# returnType(double(2)) +# return(ans) +# } +# ) diff --git a/nimbleModel/R/nimbleModel.R b/nimbleModel/R/nimbleModel.R index dcb04fe..fab5884 100644 --- a/nimbleModel/R/nimbleModel.R +++ b/nimbleModel/R/nimbleModel.R @@ -385,7 +385,7 @@ makeModel_nClass <- function(modelVarInfo, # We also place the list itself in the class so that we can look up for uncompiled execution # the objects that need to be created in initialize. # If we someday make type declarations and initializations more automatic, we can avoid this duplication. - ans <- substitute( + generator_code <- substitute( nClass( classname = CLASSNAME, inherit = modelBase_nClass, @@ -416,7 +416,10 @@ makeModel_nClass <- function(modelVarInfo, BASECLASS = baseclass ) ) - eval(ans) + model_generator <- eval(generator_code) + model_generator$set("public", "NCgenerator", model_generator) + env$model_generator <- model_generator + model_generator } # Get varInfo from new nimbleModel From 2a6c093c5d6b5dcedc5168cb09d1c8c62b013f58 Mon Sep 17 00:00:00 2001 From: perrydv Date: Sat, 11 Jul 2026 12:29:40 -0700 Subject: [PATCH 02/27] Initial wiring of values() with copier and multiCopier works --- .gitignore | 2 + .vscode/settings.json | 3 + nimbleModel.Rproj | 15 +++ nimbleModel/DESCRIPTION | 1 + nimbleModel/NAMESPACE | 4 +- nimbleModel/R/copier.R | 96 ++++++++++++++++++ nimbleModel/R/instructions.R | 4 +- nimbleModel/inst/generate_predefined.R | 34 +++++++ .../inst/include/nimbleModel/predef/.DS_Store | Bin 6148 -> 8196 bytes .../predef/copier_nC_base/copier_nC_base.h | 9 ++ .../copier_nClass/copier_nClass_copyFiles.txt | 0 .../copier_nClass_cppContent.cpp | 47 +++++++++ .../copier_nClass/copier_nClass_filebase.txt | 1 + .../copier_nClass/copier_nClass_hContent.h | 28 +++++ .../copier_nClass/copier_nClass_manifest.txt | 7 ++ .../copier_nClass_post_cpp_compiler.txt | 0 .../copier_nClass/copier_nClass_preamble.cpp | 5 + .../multiCopier_nC_base/multiCopier_nC_base.h | 29 ++++++ .../multiCopier_nClass_copyFiles.txt | 0 .../multiCopier_nClass_cppContent.cpp | 62 +++++++++++ .../multiCopier_nClass_filebase.txt | 1 + .../multiCopier_nClass_hContent.h | 31 ++++++ .../multiCopier_nClass_manifest.txt | 7 ++ .../multiCopier_nClass_post_cpp_compiler.txt | 0 .../multiCopier_nClass_preamble.cpp | 5 + 25 files changed, 388 insertions(+), 3 deletions(-) create mode 100644 .vscode/settings.json create mode 100644 nimbleModel.Rproj create mode 100644 nimbleModel/R/copier.R create mode 100644 nimbleModel/inst/generate_predefined.R create mode 100644 nimbleModel/inst/include/nimbleModel/predef/copier_nC_base/copier_nC_base.h create mode 100644 nimbleModel/inst/include/nimbleModel/predef/copier_nClass/copier_nClass_copyFiles.txt create mode 100644 nimbleModel/inst/include/nimbleModel/predef/copier_nClass/copier_nClass_cppContent.cpp create mode 100644 nimbleModel/inst/include/nimbleModel/predef/copier_nClass/copier_nClass_filebase.txt create mode 100644 nimbleModel/inst/include/nimbleModel/predef/copier_nClass/copier_nClass_hContent.h create mode 100644 nimbleModel/inst/include/nimbleModel/predef/copier_nClass/copier_nClass_manifest.txt create mode 100644 nimbleModel/inst/include/nimbleModel/predef/copier_nClass/copier_nClass_post_cpp_compiler.txt create mode 100644 nimbleModel/inst/include/nimbleModel/predef/copier_nClass/copier_nClass_preamble.cpp create mode 100644 nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base/multiCopier_nC_base.h create mode 100644 nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_copyFiles.txt create mode 100644 nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_cppContent.cpp create mode 100644 nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_filebase.txt create mode 100644 nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_hContent.h create mode 100644 nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_manifest.txt create mode 100644 nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_post_cpp_compiler.txt create mode 100644 nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_preamble.cpp diff --git a/.gitignore b/.gitignore index 886732b..4843dbe 100644 --- a/.gitignore +++ b/.gitignore @@ -32,3 +32,5 @@ vignettes/*.pdf *.utf8.md *.knit.md .Rproj.user + +.DS_Store diff --git a/.vscode/settings.json b/.vscode/settings.json new file mode 100644 index 0000000..082b194 --- /dev/null +++ b/.vscode/settings.json @@ -0,0 +1,3 @@ +{ + "makefile.configureOnOpen": false +} \ No newline at end of file diff --git a/nimbleModel.Rproj b/nimbleModel.Rproj new file mode 100644 index 0000000..be80382 --- /dev/null +++ b/nimbleModel.Rproj @@ -0,0 +1,15 @@ +Version: 1.0 + +RestoreWorkspace: Default +SaveWorkspace: Default +AlwaysSaveHistory: Default + +EnableCodeIndexing: Yes +UseSpacesForTab: Yes +NumSpacesForTab: 2 +Encoding: UTF-8 + +RnwWeave: Sweave +LaTeX: pdfLaTeX + +BuildType: Makefile diff --git a/nimbleModel/DESCRIPTION b/nimbleModel/DESCRIPTION index 468276f..41e6880 100644 --- a/nimbleModel/DESCRIPTION +++ b/nimbleModel/DESCRIPTION @@ -17,6 +17,7 @@ Collate: aaa.R all_utils.R context.R + copier.R dataRules.R distributions_inputList.R distributions_processInputList.R diff --git a/nimbleModel/NAMESPACE b/nimbleModel/NAMESPACE index a7cc763..270c67a 100644 --- a/nimbleModel/NAMESPACE +++ b/nimbleModel/NAMESPACE @@ -4,6 +4,8 @@ import(nCompiler) ## Some exports are for testing convenience and may not need to be exported. ## Classes: R6 classes are exported as regular objects +export(copier_nClass) +export(multiCopier_nClass) export(indexRangeClass) export(indexRangeEmptyClass) export(indexRangeScalarClass) @@ -53,7 +55,6 @@ export(getSymbolicParentNodesRecurse) export(newIndexRange) export(newDataRules) - export(makeIndexRules) export(makeSeparableIndexSets) @@ -72,3 +73,4 @@ export(calc_dwishAltParams) export(nimbleModel) export(makeInstrList) +export(makeMultiCopier) diff --git a/nimbleModel/R/copier.R b/nimbleModel/R/copier.R new file mode 100644 index 0000000..d87e080 --- /dev/null +++ b/nimbleModel/R/copier.R @@ -0,0 +1,96 @@ +#' @export +copier_nClass <- nCompiler::nClass( + classname = "copier_nClass", + Cpublic = list( + varName = "string", + indsList = "nList(integerVector())" + ), + predefined = quote(system.file(file.path("include", "nimbleModel", "predef"), package = "nimbleModel") |> file.path("copier_nClass")), + compileInfo = list( + interface = "full", + createFromR = TRUE, + exportName = "copier_nClass_new", + needed_units = list("nList(integerVector())"), + packageNames = c(uncompiled = "copier_nClass_R", compiled = "copier_nClass"), + nClass_inherit = list("copier_nC_base") + ) +) + +#' @export +multiCopier_nClass <- nCompiler::nClass( + classname = "multiCopier_nClass", + Rpublic = list( + initialize = function(...) { + super$initialize(...) + self$copiers <- nList(copier_nClass())$new() + } + ), + Cpublic = list( + copiers = "nList(copier_nClass())", + init = nFunction( + name = "init", + function( model ) { + cat("need uncompiled multiCopier init() implementation.") + }, + compileInfo = list( + C_fun = function(model = "nimbleModel:::modelBase_nClass()"){ + cppLiteral("multiCopier_nC_base::init(this->copiers, model)") + } + ) + ), + getValues = nFunction( + name = "getValues", + function() { + cat("need uncompiled multiCopier getValues() implementation.") + }, + returnType = "numericVector", + compileInfo = list( + C_fun = function(){ + cppLiteral("return flatViewGroup.copyIntoVector()") + } + ) + ), + setValues = nFunction( + name = "setValues", + function(v = "numericVector") { + cat("need uncompiled multiCopier setValues() implementation.") + }, + compileInfo = list( + C_fun = function(v = "numericVector"){ + cppLiteral("flatViewGroup.copyFromVector(v)") + } + ) + ) + ), + predefined = quote(system.file(file.path("include", "nimbleModel", "predef"), package = "nimbleModel") |> file.path("multiCopier_nClass")), + compileInfo = list( + interface = "full", + createFromR = TRUE, + exportName = "multiCopier_nClass_new", + needed_units = list("nList(copier_nClass())", "modelBase_nClass()"), + packageNames = c(uncompiled = "multiCopier_nClass_R", compiled = "multiCopier_nClass"), + nClass_inherit = list("multiCopier_nC_base") + ) +) + +#' @export +makeMultiCopier <- function(model, nodes, ...) { + # This will be called from a nimble2 keyword processor + # The ... is to absorb further arguments that at the time of this writing are not fleshed out. + if(is.character(nodes)){ + nodes <- nodes |> lapply(\(x) nimbleModel:::varRangeClass$new(x)) + } + multiCopier <- multiCopier_nClass$new() + getRange <- function(indexRange) { + if(!inherits(indexRange, "indexRangeSequenceClass")) + stop("In a copy operation, only contiguous index blocks are supported") + c(indexRange$start, indexRange$end) + } + for(i in seq_along(nodes)) { + thisNode <- nodes[[i]] + multiCopier$copiers[[i]] <- copier_nClass$new() + multiCopier$copiers[[i]]$varName <- thisNode$varName + multiCopier$copiers[[i]]$indsList <- thisNode$indexRanges |> lapply(getRange) + } + multiCopier |> structure(NCgenerator = quote(nimbleModel:::multiCopier_nClass)) +} diff --git a/nimbleModel/R/instructions.R b/nimbleModel/R/instructions.R index 9f9f6ef..e85d649 100644 --- a/nimbleModel/R/instructions.R +++ b/nimbleModel/R/instructions.R @@ -200,7 +200,7 @@ instr_nClass <- nClass( nDim = "integerScalar", dims = "integerVector", slots = "integerVector", - values = "nList(integerVector)", + values = "nList(integerVector())", type = "integerScalar", sortID = "integerVector", declID = "integerScalar", @@ -216,7 +216,7 @@ instr_nClass <- nClass( interface = "full", createFromR = TRUE, exportName = "instr_nClass_new", - needed_units = list("nList(integerVector)"), + needed_units = list("nList(integerVector())"), packageNames = c(uncompiled = "instr_nClass_R", compiled = "instr_nClass") ) ) diff --git a/nimbleModel/inst/generate_predefined.R b/nimbleModel/inst/generate_predefined.R new file mode 100644 index 0000000..9260ad5 --- /dev/null +++ b/nimbleModel/inst/generate_predefined.R @@ -0,0 +1,34 @@ +## # To update the set of predefined nClasses: +## +## # generate new predef/instr_nC. Move that directly to package code inst/nimbleModel/predef/instr_nC +nCompile(instr_nClass = nimbleModel:::instr_nClass, control=list(generate_predefined=TRUE)) +test <- nCompile(instr_nClass = nimbleModel:::instr_nClass) +## # +## # generate new predef/declFunBase_nC. Move to package and add +## # "#include " in the hContent +## # And add "// [[Rcpp::depends(nimbleModel)]]" to the cppContent +## # after declaration of declFunBase_nClass +nCompile(nimbleModel:::declFunBase_nClass, control=list(generate_predefined=TRUE)) +test <- nCompile(nimbleModel:::declFunBase_nClass) +## # +## # generate new predef/modelBase_nC. Move to package and add +## # "#include " to the hContent +## # And add "// [[Rcpp::depends(nimbleModel)]]" to the cppContent +## # after the declaration of modelBase_nClass. +nCompile(modelBase_nClass = nimbleModel:::modelBase_nClass, control=list(generate_predefined=TRUE)) +test <- nCompile(nimbleModel:::modelBase_nClass) + +## # generate new predef/copier_nC. Move to package and add +## # "#include " to the hContent before the class declaration +## # And add "// [[Rcpp::depends(nimbleModel)]]" to the cppContent +## # after the declaration of copier_nClass. +nCompile(copier_nClass = nimbleModel:::copier_nClass, control=list(generate_predefined=TRUE)) +test <- nCompile(nimbleModel:::copier_nClass) + +## # generate new predef/multiCopier_nC. Move to package and add +## # "#include " to the hContent before the class declaration +## # And add "// [[Rcpp::depends(nimbleModel)]]" to the cppContent +## # after the declaration of copier_nClass. +## # Note there will be an expected set of errors when re-generating before the #include has been added. +nCompile(multiCopier_nClass = nimbleModel:::multiCopier_nClass, control=list(generate_predefined=TRUE)) +test <- nCompile(nimbleModel:::multiCopier_nClass) diff --git a/nimbleModel/inst/include/nimbleModel/predef/.DS_Store b/nimbleModel/inst/include/nimbleModel/predef/.DS_Store index dead564f3a3448bd60ad9581a43d10420182f518..11beb9f18243f4b16f519c5f1a19461920863ab7 100644 GIT binary patch delta 308 zcmZoMXmOBWU|?W$DortDU;r^WfEYvza8E20o2aKKDhZMY@);OX8HyO<8S)sM8FDrY za)_~PR^aGmUd+zHF|mO~1Eh?XA(dQht68!{h=Mh0QuF z-OQpw47m)Y3^@!XK=sZreUlfk%1Lo82O5T5`V6a#!UCbq(S5&`Luw-iJ1AzcHkZ=W=v$60y^JIP*Pmrk$Ob{DD MmNIOP=b6I{0FL7oegFUf diff --git a/nimbleModel/inst/include/nimbleModel/predef/copier_nC_base/copier_nC_base.h b/nimbleModel/inst/include/nimbleModel/predef/copier_nC_base/copier_nC_base.h new file mode 100644 index 0000000..35319db --- /dev/null +++ b/nimbleModel/inst/include/nimbleModel/predef/copier_nC_base/copier_nC_base.h @@ -0,0 +1,9 @@ +#ifndef __COPIER_NC_BASE +#define __COPIER_NC_BASE + +class copier_nC_base { + public: + int stuff; +}; + +#endif diff --git a/nimbleModel/inst/include/nimbleModel/predef/copier_nClass/copier_nClass_copyFiles.txt b/nimbleModel/inst/include/nimbleModel/predef/copier_nClass/copier_nClass_copyFiles.txt new file mode 100644 index 0000000..e69de29 diff --git a/nimbleModel/inst/include/nimbleModel/predef/copier_nClass/copier_nClass_cppContent.cpp b/nimbleModel/inst/include/nimbleModel/predef/copier_nClass/copier_nClass_cppContent.cpp new file mode 100644 index 0000000..b533196 --- /dev/null +++ b/nimbleModel/inst/include/nimbleModel/predef/copier_nClass/copier_nClass_cppContent.cpp @@ -0,0 +1,47 @@ +/* OPENER (Do not edit this comment) */ +#ifndef __copier_nClass_CPP +#define __copier_nClass_CPP +/* BODY (Do not edit this comment) */ +#ifndef R_NO_REMAP +#define R_NO_REMAP +#endif +#include +#include "copier_nClass_c_.h" +using namespace Rcpp; +// [[Rcpp::plugins(nCompiler_Eigen_plugin)]] +// [[Rcpp::depends(RcppParallel)]] +// [[Rcpp::depends(nCompiler)]] +// [[Rcpp::depends(Rcereal)]] +// [[Rcpp::depends(nimbleModel)]] + + copier_nClass::copier_nClass ( ) { +RESET_EIGEN_ERRORS +} + +// [[Rcpp::export(name = "copier_nClass_new")]] + SEXP new_copier_nClass ( ) { +RESET_EIGEN_ERRORS +return CREATE_NEW_NCOMP_OBJECT(copier_nClass);; +} + +// [[Rcpp::export(name = "set_CnClass_env_copier_nClass_new")]] + void set_CnClass_env_copier_nClass ( SEXP env ) { +RESET_EIGEN_ERRORS +SET_CNCLASS_ENV(copier_nClass, env);; +} + +// [[Rcpp::export(name = "get_CnClass_env_copier_nClass_new")]] + Rcpp::Environment get_CnClass_env_copier_nClass ( ) { +RESET_EIGEN_ERRORS +return GET_CNCLASS_ENV(copier_nClass);; +} + +NCOMPILER_INTERFACE( +copier_nClass, +NCOMPILER_FIELDS( +field("varName", &copier_nClass::varName), +field("indsList", &copier_nClass::indsList) +), +NCOMPILER_METHODS() +) +#endif diff --git a/nimbleModel/inst/include/nimbleModel/predef/copier_nClass/copier_nClass_filebase.txt b/nimbleModel/inst/include/nimbleModel/predef/copier_nClass/copier_nClass_filebase.txt new file mode 100644 index 0000000..a267b2c --- /dev/null +++ b/nimbleModel/inst/include/nimbleModel/predef/copier_nClass/copier_nClass_filebase.txt @@ -0,0 +1 @@ +copier_nClass_c_ diff --git a/nimbleModel/inst/include/nimbleModel/predef/copier_nClass/copier_nClass_hContent.h b/nimbleModel/inst/include/nimbleModel/predef/copier_nClass/copier_nClass_hContent.h new file mode 100644 index 0000000..3192903 --- /dev/null +++ b/nimbleModel/inst/include/nimbleModel/predef/copier_nClass/copier_nClass_hContent.h @@ -0,0 +1,28 @@ +/* OPENER (Do not edit this comment) */ +#ifndef __copier_nClass_H +#define __copier_nClass_H +/* BODY (Do not edit this comment) */ +#ifndef R_NO_REMAP +#define R_NO_REMAP +#endif +#include +#include "nList_I1_c_.h" +#include "copier_nClass_c_.h" +#include + +class copier_nClass : public interface_resolver< genericInterfaceC, copier_nC_base >, public loadedObjectHookC { +public: + copier_nClass ( ) ; + std::string varName; + std::shared_ptr indsList; + +}; + + SEXP new_copier_nClass ( ) ; + + void set_CnClass_env_copier_nClass ( SEXP env ) ; + + Rcpp::Environment get_CnClass_env_copier_nClass ( ) ; + + +#endif diff --git a/nimbleModel/inst/include/nimbleModel/predef/copier_nClass/copier_nClass_manifest.txt b/nimbleModel/inst/include/nimbleModel/predef/copier_nClass/copier_nClass_manifest.txt new file mode 100644 index 0000000..c12d80d --- /dev/null +++ b/nimbleModel/inst/include/nimbleModel/predef/copier_nClass/copier_nClass_manifest.txt @@ -0,0 +1,7 @@ +list(saved_at = structure(1783029690.54795, class = c("POSIXct", +"POSIXt")), packet_name = "copier_nClass", elements = c("preamble", +"cppContent", "hContent", "filebase", "post_cpp_compiler", "copyFiles" +), files = list(preamble = "copier_nClass_preamble.cpp", cppContent = "copier_nClass_cppContent.cpp", + hContent = "copier_nClass_hContent.h", filebase = "copier_nClass_filebase.txt", + post_cpp_compiler = "copier_nClass_post_cpp_compiler.txt", + copyFiles = "copier_nClass_copyFiles.txt")) diff --git a/nimbleModel/inst/include/nimbleModel/predef/copier_nClass/copier_nClass_post_cpp_compiler.txt b/nimbleModel/inst/include/nimbleModel/predef/copier_nClass/copier_nClass_post_cpp_compiler.txt new file mode 100644 index 0000000..e69de29 diff --git a/nimbleModel/inst/include/nimbleModel/predef/copier_nClass/copier_nClass_preamble.cpp b/nimbleModel/inst/include/nimbleModel/predef/copier_nClass/copier_nClass_preamble.cpp new file mode 100644 index 0000000..1a92ce3 --- /dev/null +++ b/nimbleModel/inst/include/nimbleModel/predef/copier_nClass/copier_nClass_preamble.cpp @@ -0,0 +1,5 @@ +#define NCOMPILER_HANDLE_EIGEN_ERRORS +#define NCOMPILER_USES_EIGEN +#define NCOMPILER_USES_NCPPVEC +#define USES_NCOMPILER +#define NCOMPILER_USES_NCLASS_INTERFACE diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base/multiCopier_nC_base.h b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base/multiCopier_nC_base.h new file mode 100644 index 0000000..3e4e72e --- /dev/null +++ b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base/multiCopier_nC_base.h @@ -0,0 +1,29 @@ +#ifndef __MULTICOPIER_NC_BASE +#define __MULTICOPIER_NC_BASE + +class multiCopier_nC_base { +public: + int stuff; + RuntimeFlatViewGroup flatViewGroup; + template + void init(std::shared_ptr multiCopier, std::shared_ptr model) { + const auto& copiers = multiCopier->contents(); + for(const auto& copier : copiers) { + auto acc = model->access(copier->varName); // acc will be std::unique_ptr + std::vector sizes = acc->intDims(); + std::cout<<"sizes from init: "; + for(auto s : sizes) std::cout< blocks; + const auto& indsList = copier->indsList->contents(); + for(const auto& inds : indsList) { + blocks.push_back(b__(inds[0]-1, inds[1]-1)); + std::cout<<"pushing back "<(acc->template S().data(), RuntimeSubviewInfo(sizes, blocks))); + } + std::cout<<"hw from init"< +#include "multiCopier_nClass_c_.h" +using namespace Rcpp; +// [[Rcpp::plugins(nCompiler_Eigen_plugin)]] +// [[Rcpp::depends(RcppParallel)]] +// [[Rcpp::depends(nCompiler)]] +// [[Rcpp::depends(Rcereal)]] +// [[Rcpp::depends(nimbleModel)]] + + void multiCopier_nClass::init ( std::shared_ptr model ) { +RESET_EIGEN_ERRORS +multiCopier_nC_base::init(this->copiers, model); +} + Eigen::Tensor multiCopier_nClass::getValues ( ) { +RESET_EIGEN_ERRORS +return flatViewGroup.copyIntoVector(); +} + void multiCopier_nClass::setValues ( Eigen::Tensor v ) { +RESET_EIGEN_ERRORS +flatViewGroup.copyFromVector(v); +} + multiCopier_nClass::multiCopier_nClass ( ) { +RESET_EIGEN_ERRORS +} + +// [[Rcpp::export(name = "multiCopier_nClass_new")]] + SEXP new_multiCopier_nClass ( ) { +RESET_EIGEN_ERRORS +return CREATE_NEW_NCOMP_OBJECT(multiCopier_nClass);; +} + +// [[Rcpp::export(name = "set_CnClass_env_multiCopier_nClass_new")]] + void set_CnClass_env_multiCopier_nClass ( SEXP env ) { +RESET_EIGEN_ERRORS +SET_CNCLASS_ENV(multiCopier_nClass, env);; +} + +// [[Rcpp::export(name = "get_CnClass_env_multiCopier_nClass_new")]] + Rcpp::Environment get_CnClass_env_multiCopier_nClass ( ) { +RESET_EIGEN_ERRORS +return GET_CNCLASS_ENV(multiCopier_nClass);; +} + +NCOMPILER_INTERFACE( +multiCopier_nClass, +NCOMPILER_FIELDS( +field("copiers", &multiCopier_nClass::copiers) +), +NCOMPILER_METHODS( +method("init", &multiCopier_nClass::init, args({{arg("model",copy)}})), +method("getValues", &multiCopier_nClass::getValues, args({{}})), +method("setValues", &multiCopier_nClass::setValues, args({{arg("v",copy)}})) +) +) +#endif diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_filebase.txt b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_filebase.txt new file mode 100644 index 0000000..c138443 --- /dev/null +++ b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_filebase.txt @@ -0,0 +1 @@ +multiCopier_nClass_c_ diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_hContent.h b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_hContent.h new file mode 100644 index 0000000..6c4bbc0 --- /dev/null +++ b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_hContent.h @@ -0,0 +1,31 @@ +/* OPENER (Do not edit this comment) */ +#ifndef __multiCopier_nClass_H +#define __multiCopier_nClass_H +/* BODY (Do not edit this comment) */ +#ifndef R_NO_REMAP +#define R_NO_REMAP +#endif +#include +#include "nList_copier_nClass_c_.h" +#include "multiCopier_nClass_c_.h" +#include "modelBase_nClass_c_.h" +#include + +class multiCopier_nClass : public interface_resolver< genericInterfaceC, multiCopier_nC_base >, public loadedObjectHookC { +public: + void init ( std::shared_ptr model ) ; + Eigen::Tensor getValues ( ) ; + void setValues ( Eigen::Tensor v ) ; + multiCopier_nClass ( ) ; + std::shared_ptr copiers; + +}; + + SEXP new_multiCopier_nClass ( ) ; + + void set_CnClass_env_multiCopier_nClass ( SEXP env ) ; + + Rcpp::Environment get_CnClass_env_multiCopier_nClass ( ) ; + + +#endif diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_manifest.txt b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_manifest.txt new file mode 100644 index 0000000..e9df6d7 --- /dev/null +++ b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_manifest.txt @@ -0,0 +1,7 @@ +list(saved_at = structure(1783726400.77224, class = c("POSIXct", +"POSIXt")), packet_name = "multiCopier_nClass", elements = c("preamble", +"cppContent", "hContent", "filebase", "post_cpp_compiler", "copyFiles" +), files = list(preamble = "multiCopier_nClass_preamble.cpp", + cppContent = "multiCopier_nClass_cppContent.cpp", hContent = "multiCopier_nClass_hContent.h", + filebase = "multiCopier_nClass_filebase.txt", post_cpp_compiler = "multiCopier_nClass_post_cpp_compiler.txt", + copyFiles = "multiCopier_nClass_copyFiles.txt")) diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_post_cpp_compiler.txt b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_post_cpp_compiler.txt new file mode 100644 index 0000000..e69de29 diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_preamble.cpp b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_preamble.cpp new file mode 100644 index 0000000..1a92ce3 --- /dev/null +++ b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_preamble.cpp @@ -0,0 +1,5 @@ +#define NCOMPILER_HANDLE_EIGEN_ERRORS +#define NCOMPILER_USES_EIGEN +#define NCOMPILER_USES_NCPPVEC +#define USES_NCOMPILER +#define NCOMPILER_USES_NCLASS_INTERFACE From 141def152b44e9df36a78120fe8c78325cecde0a Mon Sep 17 00:00:00 2001 From: perrydv Date: Mon, 13 Jul 2026 12:12:46 -0700 Subject: [PATCH 03/27] support values() in nimble2 via multiCopier and (uncompiled) values() --- .gitignore | 1 + nimbleModel/NAMESPACE | 3 + nimbleModel/R/copier.R | 68 ++++++++++++++++- .../multiCopier_nC_base/multiCopier_nC_base.h | 1 + nimbleModel/tests/testthat/test-copier.R | 74 +++++++++++++++++++ 5 files changed, 146 insertions(+), 1 deletion(-) create mode 100644 nimbleModel/tests/testthat/test-copier.R diff --git a/.gitignore b/.gitignore index 4843dbe..8547261 100644 --- a/.gitignore +++ b/.gitignore @@ -34,3 +34,4 @@ vignettes/*.pdf .Rproj.user .DS_Store +**/.DS_Store \ No newline at end of file diff --git a/nimbleModel/NAMESPACE b/nimbleModel/NAMESPACE index 270c67a..f7d03b1 100644 --- a/nimbleModel/NAMESPACE +++ b/nimbleModel/NAMESPACE @@ -74,3 +74,6 @@ export(calc_dwishAltParams) export(nimbleModel) export(makeInstrList) export(makeMultiCopier) + +export(values) +export("values<-") \ No newline at end of file diff --git a/nimbleModel/R/copier.R b/nimbleModel/R/copier.R index d87e080..1b23dc7 100644 --- a/nimbleModel/R/copier.R +++ b/nimbleModel/R/copier.R @@ -50,6 +50,10 @@ multiCopier_nClass <- nCompiler::nClass( } ) ), + # Note that this setValues works but it not actually used by nimble2 keyword processing + # which instead uses copiers->flatViewGroup.setValues_() which provides an operator=. + # It is possible that this setValues() will be useful in other contexts, or if not that we + # can eventually remove it to avoid confusion. setValues = nFunction( name = "setValues", function(v = "numericVector") { @@ -69,10 +73,21 @@ multiCopier_nClass <- nCompiler::nClass( exportName = "multiCopier_nClass_new", needed_units = list("nList(copier_nClass())", "modelBase_nClass()"), packageNames = c(uncompiled = "multiCopier_nClass_R", compiled = "multiCopier_nClass"), - nClass_inherit = list("multiCopier_nC_base") + nClass_inherit = list("multiCopier_nC_base"), + opDefs = list( + getOrSetValues = list( + labelAbstractTypes = list( + handler = "multiCopier_getOrSetValues_LAT" + ) + ) + ) ) ) +multiCopier_getOrSetValues_LAT <- function(...) { + browser() +} + #' @export makeMultiCopier <- function(model, nodes, ...) { # This will be called from a nimble2 keyword processor @@ -94,3 +109,54 @@ makeMultiCopier <- function(model, nodes, ...) { } multiCopier |> structure(NCgenerator = quote(nimbleModel:::multiCopier_nClass)) } + +#' @export +values <- function(model, nodes) { + if(is.character(nodes)) + nodes <- lapply(nodes, \(x) varRangeClass$new(x)) + # To-do: other checking and error-trapping on inputs + vals <- lapply(nodes, + \(x) { + eval(x$toExpr(), envir = model) |> as.numeric() + }) + do.call("c", vals) +} + +#' @export +`values<-` <- function(model, nodes, value) { + if(is.character(nodes)) + nodes <- lapply(nodes, \(x) varRangeClass$new(x)) + iV_start <- 1 + replExprTemplate <- quote(model_stuff <- value[iV_start:iV_end]) + for(i in seq_along(nodes)) { + thisNode <- nodes[[i]] + expr <- thisNode$toExpr() + if(is.name(expr)) + thisLength <- length(model[[expr]]) + else { + mm <- thisNode$getMinMax() + sizes <- mm[,2] - mm[,1] + 1 + ## This section about NAs in the sizes + ## anticipates how we would handle blank index slots + ## by putting NAs in the getMinMax() result. + ## But that is not in place while this is being drafted + NAsizes <- which(is.na(sizes)) + if(length(NAsizes)) { + thisDims <- dimOrLength(model[[ thisNode$varName ]]) + sizes[NAsizes] <- thisDims[NAsizes] + } + # + thisLength <- prod(sizes) + varExpr <- expr[[2]] + model_stuff <- quote(model$VAR) + model_stuff[[3]] <- varExpr + expr[[2]] <- model_stuff + } + iV_end <- iV_start + thisLength - 1 + replExpr <- replExprTemplate + replExpr[[2]] <- expr + eval(replExpr) + iV_start <- iV_end + 1 + } + model +} diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base/multiCopier_nC_base.h b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base/multiCopier_nC_base.h index 3e4e72e..2107055 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base/multiCopier_nC_base.h +++ b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base/multiCopier_nC_base.h @@ -7,6 +7,7 @@ class multiCopier_nC_base { RuntimeFlatViewGroup flatViewGroup; template void init(std::shared_ptr multiCopier, std::shared_ptr model) { + flatViewGroup.clear(); const auto& copiers = multiCopier->contents(); for(const auto& copier : copiers) { auto acc = model->access(copier->varName); // acc will be std::unique_ptr diff --git a/nimbleModel/tests/testthat/test-copier.R b/nimbleModel/tests/testthat/test-copier.R new file mode 100644 index 0000000..97bf81b --- /dev/null +++ b/nimbleModel/tests/testthat/test-copier.R @@ -0,0 +1,74 @@ +library(testthat) +library(nimbleModel) +library(nCompiler) + +message("multiCopier needs to handle single and blank indices.") + +test_that("multiCopier basics works", { + + code <- quote({ + tau ~ dunif(0, 100) + mu ~ dnorm(0, 1) + for (i in 1:5) { + y[i] ~ dnorm(mu, var = tau) + } + for(i in 1:5) { + for(j in 1:5) { + z[i, j] ~ dnorm(mu, var = tau) + } + } + }) + + inits <- list(tau = 25, mu = 0, + z = matrix(rnorm(25), nrow = 5)) + data <- list(y = rnorm(5)) + + mclass <- nimbleModel(code, inits = inits, data = data, returnClass = TRUE) +# m <- mclass$new() + + nf <- nClass( + Cpublic = list( + m = 'nimbleModel:::modelBase_nClass()', + multCopy = 'nimbleModel:::multiCopier_nClass()', + init = nFunction( + function() { + multCopy$init(m) + } + ), + get = nFunction( + function() { + res <- multCopy$getValues() + return(res) + }, + returnType = "numericVector" + ), + set = nFunction( + function(v = "numericVector") { + # Work is needed on opDef dispatch to support + # some assignment using multCopy in the syntax via an opDef. + cppLiteral("multCopy->flatViewGroup.setValues_() = v;") + } + ) + ) + ) + comp <- nCompile(mclass, nf) + + m <- comp$mclass$new() + set.seed(1) + m$simulate() + obj <- comp$nf$new() + obj$m <- m + varRangeList <- list( + varRangeClass$new("y[2:4]"), + varRangeClass$new("z[2:4, 3:5]") + ) + multCopy <- makeMultiCopier(m, varRangeList) + obj$multCopy <- multCopy + obj$init() + val <- c(m$y[2:4], as.numeric(m$z[2:4, 3:5])) + expect_equal(obj$get(), val) + val2 <- rnorm(length(val)) + obj$set(val2) + check2 <- c(m$y[2:4], as.numeric(m$z[2:4, 3:5])) + expect_equal(val2, check2) +}) From 8371b083795c1756519be44c32c4a6ebcd7cefbf Mon Sep 17 00:00:00 2001 From: perrydv Date: Fri, 17 Jul 2026 11:57:48 -0700 Subject: [PATCH 04/27] modelValues generated classes work --- nimbleModel/DESCRIPTION | 1 + nimbleModel/NAMESPACE | 5 +- nimbleModel/R/modelValues.R | 177 ++++++++++++++++++ nimbleModel/inst/generate_predefined.R | 7 + .../inst/include/nimbleModel/predef/.DS_Store | Bin 8196 -> 8196 bytes .../modelValuesBase_nClass_copyFiles.txt | 0 .../modelValuesBase_nClass_cppContent.cpp | 49 +++++ .../modelValuesBase_nClass_filebase.txt | 1 + .../modelValuesBase_nClass_hContent.h | 26 +++ .../modelValuesBase_nClass_manifest.txt | 7 + ...delValuesBase_nClass_post_cpp_compiler.txt | 0 .../modelValuesBase_nClass_preamble.cpp | 5 + .../modelValuesClass_/modelValuesClass_.h | 29 +++ nimbleModel/tests/testthat/test-modelValues.R | 138 ++++++++++++++ 14 files changed, 444 insertions(+), 1 deletion(-) create mode 100644 nimbleModel/R/modelValues.R create mode 100644 nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_copyFiles.txt create mode 100644 nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_cppContent.cpp create mode 100644 nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_filebase.txt create mode 100644 nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_hContent.h create mode 100644 nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_manifest.txt create mode 100644 nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_post_cpp_compiler.txt create mode 100644 nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_preamble.cpp create mode 100644 nimbleModel/inst/include/nimbleModel/predef/modelValuesClass_/modelValuesClass_.h create mode 100644 nimbleModel/tests/testthat/test-modelValues.R diff --git a/nimbleModel/DESCRIPTION b/nimbleModel/DESCRIPTION index 41e6880..7e6827e 100644 --- a/nimbleModel/DESCRIPTION +++ b/nimbleModel/DESCRIPTION @@ -38,6 +38,7 @@ Collate: modelDecl.R modelDef.R model.R + modelValues.R model_utils.R nodeRules.R options.R diff --git a/nimbleModel/NAMESPACE b/nimbleModel/NAMESPACE index f7d03b1..544c34e 100644 --- a/nimbleModel/NAMESPACE +++ b/nimbleModel/NAMESPACE @@ -76,4 +76,7 @@ export(makeInstrList) export(makeMultiCopier) export(values) -export("values<-") \ No newline at end of file +export("values<-") + +S3method("[", modelValues) +S3method("[<-", modelValues) \ No newline at end of file diff --git a/nimbleModel/R/modelValues.R b/nimbleModel/R/modelValues.R new file mode 100644 index 0000000..235d3e0 --- /dev/null +++ b/nimbleModel/R/modelValues.R @@ -0,0 +1,177 @@ +# Initial rough drafting of modelValues +library(nCompiler) + +modelValuesBase_nClass = nClass( + classname = "modelValuesBase_nClass", + Rpublic = list( + initialize = function(...) { + super$initialize(...) + } + ), + Cpublic = list( + sizes = 'RcppList', + current_nRow_ = 'integerScalar', + modelValuesBase_nClass = nFunction( + function() { + super$initialize() + current_nRow_ <<- 0 + sizes <<- list() + }, + compileInfo = list( + constructor = TRUE, + C_fun = function() { + current_nRow_ <- 0 + cppLiteral("this->sizes = Rcpp::List();") + } + ) + ), + set_sizes = nFunction( + name = "set_sizes", + fun = function(new_sizes = "RcppList") { + self$sizes <<- new_sizes + } + ) + ), + predefined = quote(system.file(file.path("include", "nimbleModel", "predef"), + package = "nimbleModel") |> file.path("modelValuesBase_nClass")), + compileInfo = list( + interface = "full", + createFromR = FALSE, + exportName = "modelValuesBase_nClass_new", + packageNames = c(uncompiled = "modeValuesBase_nClass_R", compiled = "modelValuesBase_nClass") + ) +) + +modelValues_resize <- function(self, m, sizes) { + # check preservation issues in resizing + for(v in names(sizes)) { + this_sizes <- sizes[[v]] + length(self[[v]]) <<- m + if(length(this_sizes)==1) { + for(i in 1:m) self[[v]][[i]] <- numeric(length = this_sizes) + } else { + for(i in 1:m) self[[v]][[i]] <- array(0, dim = this_sizes) + } + } +} + +make_modelValues_nClass <- function(varInfo, + classname) { + e <- environment() + CpublicVars <- varInfo$vars |> + lapply(\(x) { + nDim <- x$nDim + nLname <- paste0("nL", nDim, "D") + if(!exists(nLname, envir = e)) { + e[[nLname]] <- eval(substitute(nList(numericArray(nDim = NDIM)), list(NDIM=nDim))) + } + paste0(nLname) + } + ) + names(CpublicVars) <- varInfo$vars |> + lapply(\(x) x$name) |> + unlist() + ctor_lines <- varInfo$vars |> + lapply(\(x) { + nDim <- x$nDim + nLname <- paste0("nL", nDim, "D") + substitute(V <<- NL$new(), + list(V = as.name(x$name), NL = as.name(nLname))) + } + ) + resize_lines <- varInfo$vars |> + lapply(\(x) { + nDim <- x$nDim + nLname <- paste0("nL", nDim, "D") + Cline <- gsub("NDIM", nDim, "resize_one(V, m, as(this->sizes[NAME]))") + Cline <- gsub("NAME", paste0("\"", x$name, "\""), Cline) + Cline <- gsub("V", x$name, Cline) + substitute(nCpp(CLINE), list(CLINE = Cline)) + } + ) + # function() { + # mu <<- nL1D$new() + # cov <<- nL2D$new() + # } + c_ctor_fun <- function() {} + body(c_ctor_fun) <- as.call(c(as.name("{"), ctor_lines)) + + # function(m = 'integerScalar') { + # nCpp("resize_one<1>(mu, m, this->sizes[\"mu\"])") + # nCpp("resize_one<2>(cov, m, this->sizes[\"cov\"])") + # current_nRow_ <<- m + # } + c_resize_fun <- function(m) {} + body(c_resize_fun) <- as.call(c(as.name("{"), resize_lines)) + + classname <- "modelValues_class_make_this_generic" + + CPUBLIC <- c( + list( + CLASSNAME = nFunction( + fun = c_ctor_fun, + compileInfo = list( + constructor = TRUE + ) + ), + resize = nFunction( + name = "resize", + fun = function(m) { + modelValues_resize(self, m, sizes) + # check preservation issues in resizing + }, + compileInfo = list( + C_fun = c_resize_fun + ), + argTypes = list(m = "integerScalar") + ), + getLength = nFunction( + function() {return(current_nRow_); returnType('integerScalar')} + ) + ), + CpublicVars + ) + + names(CPUBLIC)[1] <- classname + + generator_code <- substitute( + nClass( + classname = CLASSNAME, + inherit = nimbleModel:::modelValuesBase_nClass, + compileInfo = list( + nClass_inherit = list(base = "modelValuesClass_") + ), + Rpublic = list( + initialize = function(...) { + super$initialize(...) + if(!isCompiled()) { + CLASSNAME() + } + } + ), + Cpublic = + CPUBLIC + ), + list(CLASSNAME = classname) + ) + generator <- eval(generator_code) + generator +} + +## This is automatic native behavior anyway +## However it returns an nList instead of a list. +## to-do: follow-up for backward compatability. +## `[[.modelValues` <- function(x, i) { +## x[[i]] +## } + +#' @export +`[.modelValues` <- function(x, var, ind) { + x[[var]][[ind]] +} + +#' @export +`[<-.modelValues` <- function(x, var, ind, value) { + x[[var]][[ind]] <- value + x +} diff --git a/nimbleModel/inst/generate_predefined.R b/nimbleModel/inst/generate_predefined.R index 9260ad5..6e3b75a 100644 --- a/nimbleModel/inst/generate_predefined.R +++ b/nimbleModel/inst/generate_predefined.R @@ -32,3 +32,10 @@ test <- nCompile(nimbleModel:::copier_nClass) ## # Note there will be an expected set of errors when re-generating before the #include has been added. nCompile(multiCopier_nClass = nimbleModel:::multiCopier_nClass, control=list(generate_predefined=TRUE)) test <- nCompile(nimbleModel:::multiCopier_nClass) + +## # generate new predef/modelValuesBase_nC. Move to package and add +## # "#include " to the hContent before the class declaration +## # And add "// [[Rcpp::depends(nimbleModel)]]" to the cppContent +## # after the declaration of modelValuesBase_nClass. +nCompile(modelValuesBase_nClass = nimbleModel:::modelValuesBase_nClass, control=list(generate_predefined=TRUE)) +test <- nCompile(nimbleModel:::modelValuesBase_nClass) diff --git a/nimbleModel/inst/include/nimbleModel/predef/.DS_Store b/nimbleModel/inst/include/nimbleModel/predef/.DS_Store index 11beb9f18243f4b16f519c5f1a19461920863ab7..ec61a6d8a08f3f8d322169586eb3749a856f102a 100644 GIT binary patch literal 8196 zcmeHMzi-n}5I#4db($8X1xgVhS?XGeL@fddA%!%+zz?AY6^VdC97k zzycBy3kb2W022s_g#`u{_zM`=7+~nX00Z}aqQd$nzrCEwl}NS5&oH)#cA$Ti zWV5DCO!U(~KDwMg^!?MBoiSEuOl?Kxb%oL!-x3FXS;2yZf;Wnxr-Qxa7}j1t{C1ef zFkt;E=|vC>;pNYY+ZbLb2bFI~FIyOYFZ=j;Wbf-MbAP{a=hauveSm+Dc@TduZ>IYg zR58tH4%vfpXZ#K0?c*!+9=`P9di4j(8{f5M#eZFht%^MJ_1}hfT;lDUD@P}gwU4LF z`CxwI_7vCJ*Sn|m&fZ?W29kg&iSH6-wvBgd8S}++zjkxpn=_*{!9wBX*p5888_h&M z)B8B&8oh}BbPcZ#EZ-)4bnv}~@EDl~K*=#*JpKHIh&d3l7il=8H$HlqU?0ZU#Ov6= zda%$}zzbmV`fRq`ny9qz%$i+s8_DDsZ734mGd!Y?=yCmKZiTdRjbfweW{UMZ{dN^g zzS;d;G?yynRw1!}fjEs~#VOYrpkkHL<;Jy&W06*dG#$%j*c?Bg$MjesG2L#b=4Or5 z-2D2i(N3L6o}4x2k0;mHWBP%aW2Y7it9I2P_h>lyn@#+-!wT&k_wj4MXxDOe$0p7) zT@L5uK#fG*-*OMU42qNU;MwHc{DYsY76m$|T$jRPy}7`09Vv$&5e}KA{r_42_y6G+ zRtTklQsBQ)K#OK`*$mR{*59qnX|HYIyoHkv>eu0xL2$#`akQ)*N4xolA$~T{m15Gu dcDThoIR5^N0QLM=&;Rb9)Z6q;qr2nz{~K)tX=MNa delta 44 zcmZp1XmOa}&nUSuU^hRb +#include "modelValuesBase_nClass_c_.h" +using namespace Rcpp; +// [[Rcpp::plugins(nCompiler_Eigen_plugin)]] +// [[Rcpp::depends(RcppParallel)]] +// [[Rcpp::depends(nCompiler)]] +// [[Rcpp::depends(Rcereal)]] +// [[Rcpp::depends(nimbleModel)]] + + modelValuesBase_nClass::modelValuesBase_nClass ( ) { +RESET_EIGEN_ERRORS +flex_(current_nRow_) = 0.0; +this->sizes = Rcpp::List();; +} + void modelValuesBase_nClass::set_sizes ( Rcpp::List new_sizes ) { +RESET_EIGEN_ERRORS +(this)->sizes = new_sizes; +} + +// [[Rcpp::export(name = "set_CnClass_env_modelValuesBase_nClass_new")]] + void set_CnClass_env_modelValuesBase_nClass ( SEXP env ) { +RESET_EIGEN_ERRORS +SET_CNCLASS_ENV(modelValuesBase_nClass, env);; +} + +// [[Rcpp::export(name = "get_CnClass_env_modelValuesBase_nClass_new")]] + Rcpp::Environment get_CnClass_env_modelValuesBase_nClass ( ) { +RESET_EIGEN_ERRORS +return GET_CNCLASS_ENV(modelValuesBase_nClass);; +} + +NCOMPILER_INTERFACE( +modelValuesBase_nClass, +NCOMPILER_FIELDS( +field("sizes", &modelValuesBase_nClass::sizes), +field("current_nRow_", &modelValuesBase_nClass::current_nRow_) +), +NCOMPILER_METHODS( +method("set_sizes", &modelValuesBase_nClass::set_sizes, args({{arg("new_sizes",copy)}})) +) +) +#endif diff --git a/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_filebase.txt b/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_filebase.txt new file mode 100644 index 0000000..e248f58 --- /dev/null +++ b/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_filebase.txt @@ -0,0 +1 @@ +modelValuesBase_nClass_c_ diff --git a/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_hContent.h b/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_hContent.h new file mode 100644 index 0000000..1857f44 --- /dev/null +++ b/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_hContent.h @@ -0,0 +1,26 @@ +/* OPENER (Do not edit this comment) */ +#ifndef __modelValuesBase_nClass_H +#define __modelValuesBase_nClass_H +/* BODY (Do not edit this comment) */ +#ifndef R_NO_REMAP +#define R_NO_REMAP +#endif +#include +#include "modelValuesBase_nClass_c_.h" + +class modelValuesBase_nClass : public interface_resolver< genericInterfaceC >, public loadedObjectHookC { +public: + modelValuesBase_nClass ( ) ; + void set_sizes ( Rcpp::List new_sizes ) ; + Rcpp::List sizes; + int current_nRow_; + +}; + + void set_CnClass_env_modelValuesBase_nClass ( SEXP env ) ; + + Rcpp::Environment get_CnClass_env_modelValuesBase_nClass ( ) ; + +#include + +#endif diff --git a/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_manifest.txt b/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_manifest.txt new file mode 100644 index 0000000..c90d4ef --- /dev/null +++ b/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_manifest.txt @@ -0,0 +1,7 @@ +list(saved_at = structure(1784313019.02997, class = c("POSIXct", +"POSIXt")), packet_name = "modelValuesBase_nClass", elements = c("preamble", +"cppContent", "hContent", "filebase", "post_cpp_compiler", "copyFiles" +), files = list(preamble = "modelValuesBase_nClass_preamble.cpp", + cppContent = "modelValuesBase_nClass_cppContent.cpp", hContent = "modelValuesBase_nClass_hContent.h", + filebase = "modelValuesBase_nClass_filebase.txt", post_cpp_compiler = "modelValuesBase_nClass_post_cpp_compiler.txt", + copyFiles = "modelValuesBase_nClass_copyFiles.txt")) diff --git a/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_post_cpp_compiler.txt b/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_post_cpp_compiler.txt new file mode 100644 index 0000000..e69de29 diff --git a/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_preamble.cpp b/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_preamble.cpp new file mode 100644 index 0000000..1a92ce3 --- /dev/null +++ b/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_preamble.cpp @@ -0,0 +1,5 @@ +#define NCOMPILER_HANDLE_EIGEN_ERRORS +#define NCOMPILER_USES_EIGEN +#define NCOMPILER_USES_NCPPVEC +#define USES_NCOMPILER +#define NCOMPILER_USES_NCLASS_INTERFACE diff --git a/nimbleModel/inst/include/nimbleModel/predef/modelValuesClass_/modelValuesClass_.h b/nimbleModel/inst/include/nimbleModel/predef/modelValuesClass_/modelValuesClass_.h new file mode 100644 index 0000000..e7debd3 --- /dev/null +++ b/nimbleModel/inst/include/nimbleModel/predef/modelValuesClass_/modelValuesClass_.h @@ -0,0 +1,29 @@ +#ifndef __MODELVALUESCLASS__ +#define __MODELVALUESCLASS__ + +class modelValuesClass_ : public modelValuesBase_nClass { +public: + int stuff; + // resize_one could move to the base class + template + void resize_one(NLtype &NL, + int m, + const SType &sizes) { + if(sizes.size() != nDim) Rcpp::stop("incorrect number of sizes when resizing an nList in a modelValues."); + NL->setLength(m); + std::array dims; + std::copy(sizes.data(), sizes.data() + sizes.size(), dims.begin()); + // To-do: make the Eigen::Tensor resizes preserve contents + for(int i = 0; i < m; i++) { + (*NL)[i].resize(dims); + } + } + template + void resize_one(NLtype &NL, + int m, + SEXP Ssizes) { + resize_one>(NL, m, Rcpp::as>(Ssizes)); + } +}; + +#endif diff --git a/nimbleModel/tests/testthat/test-modelValues.R b/nimbleModel/tests/testthat/test-modelValues.R new file mode 100644 index 0000000..853abc5 --- /dev/null +++ b/nimbleModel/tests/testthat/test-modelValues.R @@ -0,0 +1,138 @@ +library(nCompiler) +library(nimbleModel) + +test_that("basic modelValues class works", { + varInfo <- list( + vars = list( + mu = list(name = "mu", nDim = 1), + cov =list(name = "cov", nDim = 2) + ) + ) + debug(nimbleModel:::make_modelValues_nClass) + mvClass <- nimbleModel:::make_modelValues_nClass(varInfo) + CmvClass <- nCompile(mvClass) + obj <- CmvClass$new() + obj$mu |> as.list() + sizes <- list(mu = 2, cov = c(3, 4)) + obj$sizes <- sizes + obj$sizes + obj$resize(3) + obj$mu |> as.list() + obj$cov |> as.list() +}) + + +modelValues_resize <- function(self, m, sizes) { + # check preservation issues in resizing + for(v in names(sizes)) { + this_sizes <- sizes[[v]] + length(self[[v]]) <<- m + if(length(this_sizes)==1) { + for(i in 1:m) self[[v]][[i]] <- numeric(length = this_sizes) + } else { + for(i in 1:m) self[[v]][[i]] <- array(0, dim = this_sizes) + } + } + +} + +# prototype of a generated modelValues class. +nL1D <- nList(numericVector()) +nL2D <- nList(numericMatrix()) + +mv_nC <- nClass( + classname = "modelValues_demo", + inherit = nimbleModel:::modelValuesBase_nClass, + compileInfo = list( + nClass_inherit = list(base = "modelValuesClass_") + ), + Rpublic = list( + initialize = function(...) { + super$initialize(...) + if(!isCompiled()) { + modelValues_demo() + } + } + ), + Cpublic = list( + + mu = "nList(numericVector())", + cov = "nList(numericMatrix())", + modelValues_demo = nFunction( + fun = function() { + mu <<- nL1D$new() + cov <<- nL2D$new() + }, + compileInfo = list( + constructor = TRUE + ) + ), + set_sizes = nFunction( + name = "set_sizes", + fun = function(new_sizes = "RcppList") { + self$sizes <<- new_sizes + } + ), + resize = nFunction( + name = "resize", + fun = function(m) { + browser() + modelValues_resize(self, m, sizes) + # check preservation issues in resizing + }, + compileInfo = list( + C_fun = function(m = 'integerScalar') { + nCpp("resize_one<1>(mu, m, as >(this->sizes[\"mu\"]))") + nCpp("resize_one<2>(cov, m, as >(this->sizes[\"cov\"]))") + current_nRow_ <<- m + } + ) + ), + getsize = nFunction( + function() {return(current_nRow_); returnType('integerScalar')} + ) + ) +) + +undebug(nCompiler:::simpleTransformationsEnv$CheckOpAssignment) +debug(nCompiler:::compile_labelAbstractTypes) +comp <- nCompile(mv_nC) + +obj <- mv_nC$new() +obj$sizes <- list(mu = 3, cov = c(2, 4)) +obj$mu |> as.list() +obj$resize(2) +obj$cov |> as.list() + +obj[["mu"]][[2]] <- 1:3 +obj["mu", 2] +obj["mu", 2] <- 4:6 +obj["mu", 2] +obj[["mu"]][[2]] + +obj[["mu"]][[2]][2] <- 10 +obj["mu", 2] +obj["mu", 2][2] <- 11 +obj["mu", 2] + +Cobj <- comp$new() +Cobj$sizes <- list(mu = 3, cov = c(2, 4)) +Cobj$mu +Cobj$cov +Cobj$resize(2) +Cobj$mu |> as.list() +Cobj$cov |> as.list() +## comp <- nCompile(mv_nC, sizes_nC, returnList = TRUE) + +## obj <- comp$mv_nC$new() +## obj$sizes <- comp$sizes_nC$new() +## obj$mu <- list(1:3, 2:4) +## obj$mu |> as.list() +## obj$sizes$mu +## obj$set_sizes(list(mu = c(3), cov = c(3,3))) +## obj$sizes$mu +## obj$sizes$cov +## class(obj) +## obj[["mu"]][[1]] <- 5:7 +## obj[["mu"]] |> as.list() +## obj["mu"] From d4e63d9cd5551eace44934fd31345d93f1ba0c18 Mon Sep 17 00:00:00 2001 From: perrydv Date: Fri, 17 Jul 2026 13:02:15 -0700 Subject: [PATCH 05/27] clean up test-modelValues.R --- nimbleModel/tests/testthat/test-modelValues.R | 129 +----------------- 1 file changed, 6 insertions(+), 123 deletions(-) diff --git a/nimbleModel/tests/testthat/test-modelValues.R b/nimbleModel/tests/testthat/test-modelValues.R index 853abc5..651adfa 100644 --- a/nimbleModel/tests/testthat/test-modelValues.R +++ b/nimbleModel/tests/testthat/test-modelValues.R @@ -1,5 +1,5 @@ -library(nCompiler) -library(nimbleModel) +#library(nCompiler) +#library(nimbleModel) test_that("basic modelValues class works", { varInfo <- list( @@ -8,131 +8,14 @@ test_that("basic modelValues class works", { cov =list(name = "cov", nDim = 2) ) ) - debug(nimbleModel:::make_modelValues_nClass) mvClass <- nimbleModel:::make_modelValues_nClass(varInfo) CmvClass <- nCompile(mvClass) obj <- CmvClass$new() - obj$mu |> as.list() + expect_equal(obj$mu |> as.list(), list()) sizes <- list(mu = 2, cov = c(3, 4)) obj$sizes <- sizes - obj$sizes + expect_equal(obj$sizes, sizes) obj$resize(3) - obj$mu |> as.list() - obj$cov |> as.list() + expect_equal(obj$mu |> as.list(), rep(list(numeric(2)), 3)) + expect_equal(obj$cov |> as.list(), matrix(0, nrow = 3, ncol = 4) |> list() |> rep(3)) }) - - -modelValues_resize <- function(self, m, sizes) { - # check preservation issues in resizing - for(v in names(sizes)) { - this_sizes <- sizes[[v]] - length(self[[v]]) <<- m - if(length(this_sizes)==1) { - for(i in 1:m) self[[v]][[i]] <- numeric(length = this_sizes) - } else { - for(i in 1:m) self[[v]][[i]] <- array(0, dim = this_sizes) - } - } - -} - -# prototype of a generated modelValues class. -nL1D <- nList(numericVector()) -nL2D <- nList(numericMatrix()) - -mv_nC <- nClass( - classname = "modelValues_demo", - inherit = nimbleModel:::modelValuesBase_nClass, - compileInfo = list( - nClass_inherit = list(base = "modelValuesClass_") - ), - Rpublic = list( - initialize = function(...) { - super$initialize(...) - if(!isCompiled()) { - modelValues_demo() - } - } - ), - Cpublic = list( - - mu = "nList(numericVector())", - cov = "nList(numericMatrix())", - modelValues_demo = nFunction( - fun = function() { - mu <<- nL1D$new() - cov <<- nL2D$new() - }, - compileInfo = list( - constructor = TRUE - ) - ), - set_sizes = nFunction( - name = "set_sizes", - fun = function(new_sizes = "RcppList") { - self$sizes <<- new_sizes - } - ), - resize = nFunction( - name = "resize", - fun = function(m) { - browser() - modelValues_resize(self, m, sizes) - # check preservation issues in resizing - }, - compileInfo = list( - C_fun = function(m = 'integerScalar') { - nCpp("resize_one<1>(mu, m, as >(this->sizes[\"mu\"]))") - nCpp("resize_one<2>(cov, m, as >(this->sizes[\"cov\"]))") - current_nRow_ <<- m - } - ) - ), - getsize = nFunction( - function() {return(current_nRow_); returnType('integerScalar')} - ) - ) -) - -undebug(nCompiler:::simpleTransformationsEnv$CheckOpAssignment) -debug(nCompiler:::compile_labelAbstractTypes) -comp <- nCompile(mv_nC) - -obj <- mv_nC$new() -obj$sizes <- list(mu = 3, cov = c(2, 4)) -obj$mu |> as.list() -obj$resize(2) -obj$cov |> as.list() - -obj[["mu"]][[2]] <- 1:3 -obj["mu", 2] -obj["mu", 2] <- 4:6 -obj["mu", 2] -obj[["mu"]][[2]] - -obj[["mu"]][[2]][2] <- 10 -obj["mu", 2] -obj["mu", 2][2] <- 11 -obj["mu", 2] - -Cobj <- comp$new() -Cobj$sizes <- list(mu = 3, cov = c(2, 4)) -Cobj$mu -Cobj$cov -Cobj$resize(2) -Cobj$mu |> as.list() -Cobj$cov |> as.list() -## comp <- nCompile(mv_nC, sizes_nC, returnList = TRUE) - -## obj <- comp$mv_nC$new() -## obj$sizes <- comp$sizes_nC$new() -## obj$mu <- list(1:3, 2:4) -## obj$mu |> as.list() -## obj$sizes$mu -## obj$set_sizes(list(mu = c(3), cov = c(3,3))) -## obj$sizes$mu -## obj$sizes$cov -## class(obj) -## obj[["mu"]][[1]] <- 5:7 -## obj[["mu"]] |> as.list() -## obj["mu"] From 00f0df94a34e0ec149ea87f4499ad98b17b1c364 Mon Sep 17 00:00:00 2001 From: perrydv Date: Fri, 17 Jul 2026 13:08:23 -0700 Subject: [PATCH 06/27] run styler::style on recently changed files --- nimbleModel/R/copier.R | 43 ++++++------ nimbleModel/R/modelValues.R | 67 ++++++++++--------- nimbleModel/tests/testthat/test-copier.R | 17 ++--- nimbleModel/tests/testthat/test-modelValues.R | 6 +- 4 files changed, 71 insertions(+), 62 deletions(-) diff --git a/nimbleModel/R/copier.R b/nimbleModel/R/copier.R index 1b23dc7..3e3bf6a 100644 --- a/nimbleModel/R/copier.R +++ b/nimbleModel/R/copier.R @@ -29,11 +29,11 @@ multiCopier_nClass <- nCompiler::nClass( copiers = "nList(copier_nClass())", init = nFunction( name = "init", - function( model ) { + function(model) { cat("need uncompiled multiCopier init() implementation.") }, compileInfo = list( - C_fun = function(model = "nimbleModel:::modelBase_nClass()"){ + C_fun = function(model = "nimbleModel:::modelBase_nClass()") { cppLiteral("multiCopier_nC_base::init(this->copiers, model)") } ) @@ -45,7 +45,7 @@ multiCopier_nClass <- nCompiler::nClass( }, returnType = "numericVector", compileInfo = list( - C_fun = function(){ + C_fun = function() { cppLiteral("return flatViewGroup.copyIntoVector()") } ) @@ -60,7 +60,7 @@ multiCopier_nClass <- nCompiler::nClass( cat("need uncompiled multiCopier setValues() implementation.") }, compileInfo = list( - C_fun = function(v = "numericVector"){ + C_fun = function(v = "numericVector") { cppLiteral("flatViewGroup.copyFromVector(v)") } ) @@ -92,16 +92,17 @@ multiCopier_getOrSetValues_LAT <- function(...) { makeMultiCopier <- function(model, nodes, ...) { # This will be called from a nimble2 keyword processor # The ... is to absorb further arguments that at the time of this writing are not fleshed out. - if(is.character(nodes)){ + if (is.character(nodes)) { nodes <- nodes |> lapply(\(x) nimbleModel:::varRangeClass$new(x)) } multiCopier <- multiCopier_nClass$new() getRange <- function(indexRange) { - if(!inherits(indexRange, "indexRangeSequenceClass")) + if (!inherits(indexRange, "indexRangeSequenceClass")) { stop("In a copy operation, only contiguous index blocks are supported") + } c(indexRange$start, indexRange$end) } - for(i in seq_along(nodes)) { + for (i in seq_along(nodes)) { thisNode <- nodes[[i]] multiCopier$copiers[[i]] <- copier_nClass$new() multiCopier$copiers[[i]]$varName <- thisNode$varName @@ -112,37 +113,41 @@ makeMultiCopier <- function(model, nodes, ...) { #' @export values <- function(model, nodes) { - if(is.character(nodes)) + if (is.character(nodes)) { nodes <- lapply(nodes, \(x) varRangeClass$new(x)) + } # To-do: other checking and error-trapping on inputs - vals <- lapply(nodes, - \(x) { - eval(x$toExpr(), envir = model) |> as.numeric() - }) + vals <- lapply( + nodes, + \(x) { + eval(x$toExpr(), envir = model) |> as.numeric() + } + ) do.call("c", vals) } #' @export `values<-` <- function(model, nodes, value) { - if(is.character(nodes)) + if (is.character(nodes)) { nodes <- lapply(nodes, \(x) varRangeClass$new(x)) + } iV_start <- 1 replExprTemplate <- quote(model_stuff <- value[iV_start:iV_end]) - for(i in seq_along(nodes)) { + for (i in seq_along(nodes)) { thisNode <- nodes[[i]] expr <- thisNode$toExpr() - if(is.name(expr)) + if (is.name(expr)) { thisLength <- length(model[[expr]]) - else { + } else { mm <- thisNode$getMinMax() - sizes <- mm[,2] - mm[,1] + 1 + sizes <- mm[, 2] - mm[, 1] + 1 ## This section about NAs in the sizes ## anticipates how we would handle blank index slots ## by putting NAs in the getMinMax() result. ## But that is not in place while this is being drafted NAsizes <- which(is.na(sizes)) - if(length(NAsizes)) { - thisDims <- dimOrLength(model[[ thisNode$varName ]]) + if (length(NAsizes)) { + thisDims <- dimOrLength(model[[thisNode$varName]]) sizes[NAsizes] <- thisDims[NAsizes] } # diff --git a/nimbleModel/R/modelValues.R b/nimbleModel/R/modelValues.R index 235d3e0..3f24579 100644 --- a/nimbleModel/R/modelValues.R +++ b/nimbleModel/R/modelValues.R @@ -1,7 +1,7 @@ # Initial rough drafting of modelValues library(nCompiler) -modelValuesBase_nClass = nClass( +modelValuesBase_nClass <- nClass( classname = "modelValuesBase_nClass", Rpublic = list( initialize = function(...) { @@ -9,8 +9,8 @@ modelValuesBase_nClass = nClass( } ), Cpublic = list( - sizes = 'RcppList', - current_nRow_ = 'integerScalar', + sizes = "RcppList", + current_nRow_ = "integerScalar", modelValuesBase_nClass = nFunction( function() { super$initialize() @@ -33,7 +33,8 @@ modelValuesBase_nClass = nClass( ) ), predefined = quote(system.file(file.path("include", "nimbleModel", "predef"), - package = "nimbleModel") |> file.path("modelValuesBase_nClass")), + package = "nimbleModel" + ) |> file.path("modelValuesBase_nClass")), compileInfo = list( interface = "full", createFromR = FALSE, @@ -44,13 +45,13 @@ modelValuesBase_nClass = nClass( modelValues_resize <- function(self, m, sizes) { # check preservation issues in resizing - for(v in names(sizes)) { + for (v in names(sizes)) { this_sizes <- sizes[[v]] length(self[[v]]) <<- m - if(length(this_sizes)==1) { - for(i in 1:m) self[[v]][[i]] <- numeric(length = this_sizes) + if (length(this_sizes) == 1) { + for (i in 1:m) self[[v]][[i]] <- numeric(length = this_sizes) } else { - for(i in 1:m) self[[v]][[i]] <- array(0, dim = this_sizes) + for (i in 1:m) self[[v]][[i]] <- array(0, dim = this_sizes) } } } @@ -60,35 +61,34 @@ make_modelValues_nClass <- function(varInfo, e <- environment() CpublicVars <- varInfo$vars |> lapply(\(x) { - nDim <- x$nDim - nLname <- paste0("nL", nDim, "D") - if(!exists(nLname, envir = e)) { - e[[nLname]] <- eval(substitute(nList(numericArray(nDim = NDIM)), list(NDIM=nDim))) - } - paste0(nLname) - } - ) + nDim <- x$nDim + nLname <- paste0("nL", nDim, "D") + if (!exists(nLname, envir = e)) { + e[[nLname]] <- eval(substitute(nList(numericArray(nDim = NDIM)), list(NDIM = nDim))) + } + paste0(nLname) + }) names(CpublicVars) <- varInfo$vars |> lapply(\(x) x$name) |> unlist() ctor_lines <- varInfo$vars |> lapply(\(x) { - nDim <- x$nDim - nLname <- paste0("nL", nDim, "D") - substitute(V <<- NL$new(), - list(V = as.name(x$name), NL = as.name(nLname))) - } - ) + nDim <- x$nDim + nLname <- paste0("nL", nDim, "D") + substitute( + V <<- NL$new(), + list(V = as.name(x$name), NL = as.name(nLname)) + ) + }) resize_lines <- varInfo$vars |> lapply(\(x) { - nDim <- x$nDim - nLname <- paste0("nL", nDim, "D") - Cline <- gsub("NDIM", nDim, "resize_one(V, m, as(this->sizes[NAME]))") - Cline <- gsub("NAME", paste0("\"", x$name, "\""), Cline) - Cline <- gsub("V", x$name, Cline) - substitute(nCpp(CLINE), list(CLINE = Cline)) - } - ) + nDim <- x$nDim + nLname <- paste0("nL", nDim, "D") + Cline <- gsub("NDIM", nDim, "resize_one(V, m, as(this->sizes[NAME]))") + Cline <- gsub("NAME", paste0("\"", x$name, "\""), Cline) + Cline <- gsub("V", x$name, Cline) + substitute(nCpp(CLINE), list(CLINE = Cline)) + }) # function() { # mu <<- nL1D$new() # cov <<- nL2D$new() @@ -126,7 +126,10 @@ make_modelValues_nClass <- function(varInfo, argTypes = list(m = "integerScalar") ), getLength = nFunction( - function() {return(current_nRow_); returnType('integerScalar')} + function() { + return(current_nRow_) + returnType("integerScalar") + } ) ), CpublicVars @@ -144,7 +147,7 @@ make_modelValues_nClass <- function(varInfo, Rpublic = list( initialize = function(...) { super$initialize(...) - if(!isCompiled()) { + if (!isCompiled()) { CLASSNAME() } } diff --git a/nimbleModel/tests/testthat/test-copier.R b/nimbleModel/tests/testthat/test-copier.R index 97bf81b..e45f34f 100644 --- a/nimbleModel/tests/testthat/test-copier.R +++ b/nimbleModel/tests/testthat/test-copier.R @@ -5,31 +5,32 @@ library(nCompiler) message("multiCopier needs to handle single and blank indices.") test_that("multiCopier basics works", { - code <- quote({ tau ~ dunif(0, 100) mu ~ dnorm(0, 1) for (i in 1:5) { y[i] ~ dnorm(mu, var = tau) } - for(i in 1:5) { - for(j in 1:5) { + for (i in 1:5) { + for (j in 1:5) { z[i, j] ~ dnorm(mu, var = tau) } } }) - inits <- list(tau = 25, mu = 0, - z = matrix(rnorm(25), nrow = 5)) + inits <- list( + tau = 25, mu = 0, + z = matrix(rnorm(25), nrow = 5) + ) data <- list(y = rnorm(5)) mclass <- nimbleModel(code, inits = inits, data = data, returnClass = TRUE) -# m <- mclass$new() + # m <- mclass$new() nf <- nClass( Cpublic = list( - m = 'nimbleModel:::modelBase_nClass()', - multCopy = 'nimbleModel:::multiCopier_nClass()', + m = "nimbleModel:::modelBase_nClass()", + multCopy = "nimbleModel:::multiCopier_nClass()", init = nFunction( function() { multCopy$init(m) diff --git a/nimbleModel/tests/testthat/test-modelValues.R b/nimbleModel/tests/testthat/test-modelValues.R index 651adfa..8df36ff 100644 --- a/nimbleModel/tests/testthat/test-modelValues.R +++ b/nimbleModel/tests/testthat/test-modelValues.R @@ -1,11 +1,11 @@ -#library(nCompiler) -#library(nimbleModel) +# library(nCompiler) +# library(nimbleModel) test_that("basic modelValues class works", { varInfo <- list( vars = list( mu = list(name = "mu", nDim = 1), - cov =list(name = "cov", nDim = 2) + cov = list(name = "cov", nDim = 2) ) ) mvClass <- nimbleModel:::make_modelValues_nClass(varInfo) From a12bd9db3e7a487cc8e1377c83f6a422e4a0651d Mon Sep 17 00:00:00 2001 From: perrydv Date: Fri, 24 Jul 2026 11:31:09 -0700 Subject: [PATCH 07/27] cleaned up modelValues, set up nClassBuilder, add tests --- .gitignore | 5 +- nimbleModel/DESCRIPTION | 2 +- nimbleModel/R/modelValues.R | 106 +++++++++--- nimbleModel/R/model_utils.R | 5 +- nimbleModel/inst/generate_predefined.R | 2 +- .../inst/include/nimbleModel/.DS_Store | Bin 6148 -> 6148 bytes .../inst/include/nimbleModel/predef/.DS_Store | Bin 8196 -> 10244 bytes .../modelValuesBase_nClass_cppContent.cpp | 13 +- .../modelValuesBase_nClass_hContent.h | 2 + .../modelValuesBase_nClass_manifest.txt | 2 +- .../multiCopier_nC_base/multiCopier_nC_base.h | 21 +-- nimbleModel/tests/testthat/test-copier.R | 2 +- nimbleModel/tests/testthat/test-modelValues.R | 151 +++++++++++++++++- 13 files changed, 266 insertions(+), 45 deletions(-) diff --git a/.gitignore b/.gitignore index 8547261..2c21d50 100644 --- a/.gitignore +++ b/.gitignore @@ -34,4 +34,7 @@ vignettes/*.pdf .Rproj.user .DS_Store -**/.DS_Store \ No newline at end of file +**/.DS_Store + +# Symlink to inst/include for devtools::load_all() +nimbleModel/include \ No newline at end of file diff --git a/nimbleModel/DESCRIPTION b/nimbleModel/DESCRIPTION index 7e6827e..9021f48 100644 --- a/nimbleModel/DESCRIPTION +++ b/nimbleModel/DESCRIPTION @@ -9,7 +9,7 @@ Authors@R: c( Description: This package provides the ability to create 'nimble' models, generally hierarchical models, not necessarily Bayesian, in R that are compiled to C++. It includes graph processing tools (e.g., finding dependent and parent nodes), abstractions for efficiently storing variable ranges, e.g., `y[1:5, c(2,4)]` and sets of model nodes (e.g., `y[1,1:5],y[2,1:5],...`), and functions for calculating and simulating variables and nodes in a model. It has been developed to support nimble version 2.0 but can be used more generally for setting up models, doing graph queries and carrying out model calculations. Depends: R (>= 4.1.0) Imports: - methods,R6,nCompiler + digest,methods,R6,nCompiler License: BSD_3_clause + file LICENSE | GPL (>= 2) Encoding: UTF-8 LazyData: true diff --git a/nimbleModel/R/modelValues.R b/nimbleModel/R/modelValues.R index 3f24579..bc532c5 100644 --- a/nimbleModel/R/modelValues.R +++ b/nimbleModel/R/modelValues.R @@ -1,19 +1,20 @@ # Initial rough drafting of modelValues -library(nCompiler) -modelValuesBase_nClass <- nClass( +modelValuesBase_nClass <- nCompiler::nClass( classname = "modelValuesBase_nClass", Rpublic = list( initialize = function(...) { super$initialize(...) + if(!isCompiled()) { + modelValuesBase_nClass() + } } ), Cpublic = list( sizes = "RcppList", current_nRow_ = "integerScalar", - modelValuesBase_nClass = nFunction( + modelValuesBase_nClass = nCompiler::nFunction( function() { - super$initialize() current_nRow_ <<- 0 sizes <<- list() }, @@ -25,11 +26,32 @@ modelValuesBase_nClass <- nClass( } ) ), - set_sizes = nFunction( + set_sizes = nCompiler::nFunction( name = "set_sizes", fun = function(new_sizes = "RcppList") { self$sizes <<- new_sizes } + ), + resize = nCompiler::nFunction( + name = "resize", + fun = function(m) { + stop("Should not be calling uncompiled modelValuesBase_nClass resize().") + }, + compileInfo = list( + C_fun = function(m) { + cppLiteral('Rcpp::stop("Should not be calling compiled modelValuesBase_nClass resize().");') + }, + virtual = TRUE + ), + argTypes = list(m = "integerScalar") + ), + getLength = nCompiler::nFunction( + name = "getLength", + function() { + return(current_nRow_) + returnType("integerScalar") + }, + compileInfo = list(virtual = TRUE) ) ), predefined = quote(system.file(file.path("include", "nimbleModel", "predef"), @@ -47,7 +69,7 @@ modelValues_resize <- function(self, m, sizes) { # check preservation issues in resizing for (v in names(sizes)) { this_sizes <- sizes[[v]] - length(self[[v]]) <<- m + length(self[[v]]) <- m if (length(this_sizes) == 1) { for (i in 1:m) self[[v]][[i]] <- numeric(length = this_sizes) } else { @@ -58,6 +80,10 @@ modelValues_resize <- function(self, m, sizes) { make_modelValues_nClass <- function(varInfo, classname) { + if(missing(classname)) { + hashedID <- make_modelValues_hashID(varInfo) + classname <- Rname2CppName(paste0("MV_", hashedID)) + } e <- environment() CpublicVars <- varInfo$vars |> lapply(\(x) { @@ -95,41 +121,33 @@ make_modelValues_nClass <- function(varInfo, # } c_ctor_fun <- function() {} body(c_ctor_fun) <- as.call(c(as.name("{"), ctor_lines)) - # function(m = 'integerScalar') { # nCpp("resize_one<1>(mu, m, this->sizes[\"mu\"])") # nCpp("resize_one<2>(cov, m, this->sizes[\"cov\"])") # current_nRow_ <<- m # } c_resize_fun <- function(m) {} - body(c_resize_fun) <- as.call(c(as.name("{"), resize_lines)) - - classname <- "modelValues_class_make_this_generic" + body(c_resize_fun) <- as.call(c(as.name("{"), resize_lines, list(quote(current_nRow_ <- m)))) CPUBLIC <- c( list( - CLASSNAME = nFunction( + CLASSNAME = nCompiler::nFunction( fun = c_ctor_fun, compileInfo = list( constructor = TRUE ) ), - resize = nFunction( + resize = nCompiler::nFunction( name = "resize", fun = function(m) { modelValues_resize(self, m, sizes) + self$current_nRow_ <- m # check preservation issues in resizing }, compileInfo = list( C_fun = c_resize_fun ), argTypes = list(m = "integerScalar") - ), - getLength = nFunction( - function() { - return(current_nRow_) - returnType("integerScalar") - } ) ), CpublicVars @@ -138,9 +156,9 @@ make_modelValues_nClass <- function(varInfo, names(CPUBLIC)[1] <- classname generator_code <- substitute( - nClass( + nCompiler::nClass( classname = CLASSNAME, - inherit = nimbleModel:::modelValuesBase_nClass, + inherit = modelValuesBase_nClass, compileInfo = list( nClass_inherit = list(base = "modelValuesClass_") ), @@ -148,14 +166,15 @@ make_modelValues_nClass <- function(varInfo, initialize = function(...) { super$initialize(...) if (!isCompiled()) { - CLASSNAME() + CLASSNAME_() } } ), Cpublic = CPUBLIC ), - list(CLASSNAME = classname) + list(CLASSNAME = classname, + CLASSNAME_ = as.name(classname)) ) generator <- eval(generator_code) generator @@ -178,3 +197,46 @@ make_modelValues_nClass <- function(varInfo, x[[var]][[ind]] <- value x } + +make_modelValues_hashID <- function(varInfo) { + # We go to some lengths to normalize + # so that we obtain the same hash for equivalent varInfo. + varsList <- varInfo$vars + sortedNames <- sort(names(varsList)) + sortedVars <- varsList[sortedNames] + nested_normalize <- function(x) { + if(!is.list(x)) + stop("Elements of a modelValues varInfo list must be lists with elements 'name' and 'nDim' (or unnamed elements in that order)") + if(is.null(names(x))) { + if(length(x) != 2) { + stop("Elements of a modelValues varInfo list must have 2 elements (optionally named 'name' and 'nDim')") + } + if(!is.character(x[[1]]) || !is.numeric(x[[2]])) { + stop("Elements of a modelValues varInfo list, if not named, must have first element character (for the 'name') and second element numeric (for the 'nDim')") + } + x <- list(name = x[[1]], nDim = x[[2]]) + } + x <- x[sort(names(x))] + if(!identical(names(x), sort(c("name", "nDim")))) { + # use sort in the RHS of the identical() to avoid + # unknown sort ordering in other locales + stop("Elements of a modelValues varInfo list must be named 'name' and 'nDim'") + } + x + } + normalizedVars <- lapply(sortedVars, nested_normalize) + hashedID <- digest::digest(normalizedVars, algo = "crc32") + hashedID +} + +#' @export +modelValues <- function(varInfo, .ID = FALSE, env = parent.frame()) { + hashedID <- make_modelValues_hashID(varInfo) + classname <- Rname2CppName(paste0("MV_", hashedID)) + if(isTRUE(.ID)) { + return(classname) + } + ans <- make_modelValues_nClass(varInfo, classname = classname) + ans +} +class(modelValues) <- c("function", "nClassBuilder") diff --git a/nimbleModel/R/model_utils.R b/nimbleModel/R/model_utils.R index 1b89aa3..b7e3504 100644 --- a/nimbleModel/R/model_utils.R +++ b/nimbleModel/R/model_utils.R @@ -36,7 +36,10 @@ is.blank <- function(arg) { if (is.null(arg)) { return(FALSE) } - return(identical(arg, quote(x[])[[3]])) + # slightly simpler approach borrowed from rlang::is_missing + return(identical(arg, quote(expr =))) + # old approach + # return(identical(arg, quote(x[])[[3]])) } removeIndexing <- function(nodes) { diff --git a/nimbleModel/inst/generate_predefined.R b/nimbleModel/inst/generate_predefined.R index 6e3b75a..2db6e82 100644 --- a/nimbleModel/inst/generate_predefined.R +++ b/nimbleModel/inst/generate_predefined.R @@ -34,7 +34,7 @@ nCompile(multiCopier_nClass = nimbleModel:::multiCopier_nClass, control=list(gen test <- nCompile(nimbleModel:::multiCopier_nClass) ## # generate new predef/modelValuesBase_nC. Move to package and add -## # "#include " to the hContent before the class declaration +## # "#include " to the hContent ## # And add "// [[Rcpp::depends(nimbleModel)]]" to the cppContent ## # after the declaration of modelValuesBase_nClass. nCompile(modelValuesBase_nClass = nimbleModel:::modelValuesBase_nClass, control=list(generate_predefined=TRUE)) diff --git a/nimbleModel/inst/include/nimbleModel/.DS_Store b/nimbleModel/inst/include/nimbleModel/.DS_Store index c4c1caa1013374a9398c15e3ffbfbc0f7969916d..3c2037735aeda0d14d70bd6ce1b98056acee7f99 100644 GIT binary patch delta 312 zcmZoMXfc=|#>B)qu~2NHo}wrl0|Nsi1A_nqLn=dBQh9MfQcix-=825U8S6n(Yzzeq zML?+(WND!Iwxoib%;FLQgKLaT%q*;I>>TVI+#IpN8TsYGC5a`a#ZHMu(I8$(etu38 zjGdSimYG@}FCgNapI4HYnU`7w){vQ!3RDsko|%`DU+$D&nwL@x)Efdc3L?Y7$-x;f zAXZ&%prc@6RI8&B`mu~2NHo}wrV0|Nsi1A_nqLn=dBPP$=ma(-^X#KPr_ER*jsb#I=- ooXxU%0W&MpW_AvK4xqNp6Pdp=Pv#e~15g*AhLxS0I2K~!~g&Q diff --git a/nimbleModel/inst/include/nimbleModel/predef/.DS_Store b/nimbleModel/inst/include/nimbleModel/predef/.DS_Store index ec61a6d8a08f3f8d322169586eb3749a856f102a..4a1e6862b177d54ec14b4bddeaa8f20a4208be88 100644 GIT binary patch delta 442 zcmZp1XbF&DU|?W$DortDU{C-uIe-{M3-C-V6q~50D5?+SFar4u45vXlFT_%#a!yiyeh$NAc_D?(w*@=cCI?G8F>x)Q951OcdA}qN z#{!|v(S5&kbD SZSo-z$<6b{jxds7b{+sdRX#od diff --git a/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_cppContent.cpp b/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_cppContent.cpp index 943ead9..b4199fb 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_cppContent.cpp +++ b/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_cppContent.cpp @@ -16,12 +16,21 @@ using namespace Rcpp; modelValuesBase_nClass::modelValuesBase_nClass ( ) { RESET_EIGEN_ERRORS +Rcpp::Rcout << "base class compiled Cpublic init\n";; flex_(current_nRow_) = 0.0; this->sizes = Rcpp::List();; } void modelValuesBase_nClass::set_sizes ( Rcpp::List new_sizes ) { RESET_EIGEN_ERRORS (this)->sizes = new_sizes; +} + void modelValuesBase_nClass::resize ( int m ) { +RESET_EIGEN_ERRORS +Rcpp::stop("Should not be calling compiled modelValuesBase_nClass resize().");; +} + int modelValuesBase_nClass::getLength ( ) { +RESET_EIGEN_ERRORS +return(current_nRow_); } // [[Rcpp::export(name = "set_CnClass_env_modelValuesBase_nClass_new")]] @@ -43,7 +52,9 @@ field("sizes", &modelValuesBase_nClass::sizes), field("current_nRow_", &modelValuesBase_nClass::current_nRow_) ), NCOMPILER_METHODS( -method("set_sizes", &modelValuesBase_nClass::set_sizes, args({{arg("new_sizes",copy)}})) +method("set_sizes", &modelValuesBase_nClass::set_sizes, args({{arg("new_sizes",copy)}})), +method("resize", &modelValuesBase_nClass::resize, args({{arg("m",copy)}})), +method("getLength", &modelValuesBase_nClass::getLength, args({{}})) ) ) #endif diff --git a/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_hContent.h b/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_hContent.h index 1857f44..b0026a1 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_hContent.h +++ b/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_hContent.h @@ -12,6 +12,8 @@ class modelValuesBase_nClass : public interface_resolver< genericInterfaceC flatViewGroup; - template + + template void init(std::shared_ptr multiCopier, std::shared_ptr model) { flatViewGroup.clear(); const auto& copiers = multiCopier->contents(); for(const auto& copier : copiers) { auto acc = model->access(copier->varName); // acc will be std::unique_ptr - std::vector sizes = acc->intDims(); - std::cout<<"sizes from init: "; - for(auto s : sizes) std::cout< blocks; - const auto& indsList = copier->indsList->contents(); - for(const auto& inds : indsList) { - blocks.push_back(b__(inds[0]-1, inds[1]-1)); - std::cout<<"pushing back "<(acc->template S().data(), RuntimeSubviewInfo(sizes, blocks))); + flatViewGroup.add(makeRuntimeFlatView(acc, + copier->indsList->contents())); } - std::cout<<"hw from init"< as.list(), list()) + sizes <- list(mu = 2, cov = c(3, 4)) + obj$sizes <- sizes + expect_equal(obj$sizes, sizes) + obj$resize(3) + expect_equal(obj$mu |> as.list(), rep(list(numeric(2)), 3)) + expect_equal(obj$cov |> as.list(), matrix(0, nrow = 3, ncol = 4) |> list() |> rep(3)) + + CmvClass <- nCompiler::nCompile(mvClass) obj <- CmvClass$new() expect_equal(obj$mu |> as.list(), list()) sizes <- list(mu = 2, cov = c(3, 4)) @@ -19,3 +30,141 @@ test_that("basic modelValues class works", { expect_equal(obj$mu |> as.list(), rep(list(numeric(2)), 3)) expect_equal(obj$cov |> as.list(), matrix(0, nrow = 3, ncol = 4) |> list() |> rep(3)) }) + +test_that("modelValues hashedID works and is invariant to equivalent cases", { + suppressWarnings(rm(list = "varInfo")) + VI1 <- list( + vars = list( + mu = list(name = "mu", nDim = 1), + cov = list(name = "cov", nDim = 2) + ) + ) + hash1 <- nimbleModel:::make_modelValues_hashID(VI1) + VI2 <- VI1 + VI2$vars <- VI2$vars[c(2, 1)] + hash2 <- nimbleModel:::make_modelValues_hashID(VI2) + expect_equal(hash1, hash2) + VI3 <- VI2 + VI3$vars <- VI3$vars |> lapply(\(x) list(x[[1]], x[[2]])) # remove names "name" and "nDim" in nested elements + hash3 <- nimbleModel:::make_modelValues_hashID(VI3) + expect_equal(hash2, hash3) + VI4 <- VI1 + VI4$vars <- VI1$vars |> lapply(\(x) list(name_oops = x[[1]], nDim = x[[2]])) # create wrong names + expect_error( + nimbleModel:::make_modelValues_hashID(VI4) + ) + + VI5 <- VI1 + VI5$vars <- VI1$vars |> lapply(\(x) list(x[[2]], x[[1]])) # unnamed, with wrong types by order + expect_error( + nimbleModel:::make_modelValues_hashID(VI5) + ) + + VI6 <- VI1 + VI6$vars <- VI1$vars |> lapply(\(x) list(x[[1]], x[[2]], x[[1]])) # unnamed, with wrong number of arguments + expect_error( + nimbleModel:::make_modelValues_hashID(VI6) + ) + + VI7 <- VI1 + VI7$vars <- VI1$vars |> lapply(\(x) list(name = x[[1]], nDim = x[[2]], junk = x[[1]])) # named, with wrong number of arguments + expect_error( + nimbleModel:::make_modelValues_hashID(VI7) + ) +}) + +test_that("modelValues nClassBuilder types work in nCompiler", { + varInfo <- list( + vars = list( + mu = list(name = "mu", nDim = 1), + cov = list(name = "cov", nDim = 2) + ) + ) + + # example + #nCompiler:::type2symbol("nCompiler:::nList('integerScalar()')") |> + # nCompiler:::resolveOneTBDsymbol() + + sym <- nCompiler:::type2symbol("nimbleModel:::modelValues(varInfo)") |> + nCompiler:::resolveOneTBDsymbol() + + output <- capture_output( + sym$print() + ) + hashID <- nimbleModel:::make_modelValues_hashID(varInfo) + expect_true(grepl(hashID, output)) + + mvc <- nimbleModel:::modelValues(varInfo) + nc <- nCompiler::nClass( + Cpublic = list( + mv = "nimbleModel:::modelValues(varInfo)", + mvBase = "nimbleModel:::modelValuesBase_nClass()", + init = nCompiler::nFunction( + function() { + mv <- mvc$new() + mvBase <- mv + } + ) + ) + ) + + comp <- nCompiler:::nCompile(nc, mvc) + obj <- comp$nc$new() + obj$init() + sizes <- list(mu = 2, cov = c(3, 4)) + obj$mv$sizes <- sizes + expect_equal(obj$mv$sizes, sizes) + + sizes_alt <- list(mu = 4, cov = c(2, 1)) + obj$mvBase$set_sizes(sizes_alt) + expect_equal(obj$mv$sizes, sizes_alt) + + obj$mv$resize(3) + expect_equal(obj$mv$cov |> as.list(), rep( list(matrix(0, nrow = 2, ncol = 1)), 3)) + expect_equal(obj$mv$getLength(), 3) + expect_equal(obj$mvBase$getLength(), 3) + + obj$mvBase$resize(4) + expect_equal(obj$mv$cov |> as.list(), rep( list(matrix(0, nrow = 2, ncol = 1)), 4)) + expect_equal(obj$mv$getLength(), 4) + expect_equal(obj$mvBase$getLength(), 4) + + dup_mv_unc <- nimbleModel:::modelValues(varInfo) + obj_unc <- dup_mv_unc$new() + sizes2 <- list(mu = 3, cov = c(1, 2)) + obj_unc$sizes <- sizes2 + obj_unc$resize(5) + obj_unc$mu[[3]] <- 1:3 + obj$mv <- obj_unc + # because we assigned an uncompiled to a compiled that already + # had an instantiated object, it copied contents to the same + # compiled object. So mvBase will see this too since it + # still points to the same object. + + expect_true(obj$mv$isCompiled()) + expect_false(obj_unc$isCompiled()) + mu_exp <- rep(list(c(0,0,0)), 5) + mu_exp[[3]] <- 1:3 + expect_equal(obj_unc$mu |> as.list(), mu_exp) + expect_equal(obj$mv$mu |> as.list(), mu_exp) + + expect_equal(obj_unc$getLength(), 5) + expect_equal(obj$mv$getLength(), 5) + expect_equal(obj$mvBase$getLength(), 5) + + # new we will construct and assign a new compiled object + # This will result in mv pointing to the new object + # and mvBase pointing to the old object + obj_new_comp <- comp$mvc$new() + obj_new_comp$set_sizes(list(mu = c(6), cov = c(4, 1))) + obj_new_comp$resize(2) + expect_equal(obj_new_comp$mu |> as.list(), rep(list(rep(0, 6)), 2)) + obj$mv <- obj_new_comp + expect_equal(obj$mv$getLength(), 2) + expect_equal(obj$mvBase$getLength(), 5) + + # Finally we will assign the derived to the base ptr + # and they will point at the same thing again. + obj$mvBase <- obj$mv + expect_equal(obj$mvBase$getLength(), 2) +}) From 30077eb0845652ab317aac957a0ab4cd4b4e927d Mon Sep 17 00:00:00 2001 From: perrydv Date: Mon, 27 Jul 2026 17:11:11 -0700 Subject: [PATCH 08/27] add defaultSizes and varInfo to modelValues --- nimbleModel/R/modelValues.R | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/nimbleModel/R/modelValues.R b/nimbleModel/R/modelValues.R index bc532c5..bfb1d85 100644 --- a/nimbleModel/R/modelValues.R +++ b/nimbleModel/R/modelValues.R @@ -8,6 +8,7 @@ modelValuesBase_nClass <- nCompiler::nClass( if(!isCompiled()) { modelValuesBase_nClass() } + self$sizes <- self$defaultSizes } ), Cpublic = list( @@ -155,6 +156,14 @@ make_modelValues_nClass <- function(varInfo, names(CPUBLIC)[1] <- classname + defaultSizes <- varInfo$sizes + if(is.null(defaultSizes)) defaultSizes <- list() + for(v in names(varInfo$vars)) { + if(is.null(defaultSizes[[v]]) || length(defaultSizes[[v]]) == 0) { + defaultSizes[[v]] <- rep(0, varInfo$vars[[v]]$nDim) + } + } + generator_code <- substitute( nCompiler::nClass( classname = CLASSNAME, @@ -163,6 +172,8 @@ make_modelValues_nClass <- function(varInfo, nClass_inherit = list(base = "modelValuesClass_") ), Rpublic = list( + defaultSizes = defaultSizes, + varInfo = varInfo, initialize = function(...) { super$initialize(...) if (!isCompiled()) { @@ -177,6 +188,7 @@ make_modelValues_nClass <- function(varInfo, CLASSNAME_ = as.name(classname)) ) generator <- eval(generator_code) + generator$set("public", "NCgenerator", generator) generator } @@ -231,6 +243,9 @@ make_modelValues_hashID <- function(varInfo) { #' @export modelValues <- function(varInfo, .ID = FALSE, env = parent.frame()) { + if(inherits(varInfo, "modelBase_nClass")) { + varInfo <- get_varInfo_from_nimbleModel(varInfo) + } hashedID <- make_modelValues_hashID(varInfo) classname <- Rname2CppName(paste0("MV_", hashedID)) if(isTRUE(.ID)) { From 59cff2bfa1d29aab055a376f53314ae3825b835b Mon Sep 17 00:00:00 2001 From: perrydv Date: Wed, 5 Aug 2026 14:22:58 -0700 Subject: [PATCH 09/27] put scoping on nList uses for regularity and safety --- nimbleModel/R/copier.R | 8 ++++---- nimbleModel/R/instructions.R | 12 ++++++------ 2 files changed, 10 insertions(+), 10 deletions(-) diff --git a/nimbleModel/R/copier.R b/nimbleModel/R/copier.R index 3e3bf6a..90063b7 100644 --- a/nimbleModel/R/copier.R +++ b/nimbleModel/R/copier.R @@ -3,14 +3,14 @@ copier_nClass <- nCompiler::nClass( classname = "copier_nClass", Cpublic = list( varName = "string", - indsList = "nList(integerVector())" + indsList = "nCompiler:::nList(integerVector())" ), predefined = quote(system.file(file.path("include", "nimbleModel", "predef"), package = "nimbleModel") |> file.path("copier_nClass")), compileInfo = list( interface = "full", createFromR = TRUE, exportName = "copier_nClass_new", - needed_units = list("nList(integerVector())"), + needed_units = list("nCompiler:::nList(integerVector())"), packageNames = c(uncompiled = "copier_nClass_R", compiled = "copier_nClass"), nClass_inherit = list("copier_nC_base") ) @@ -26,7 +26,7 @@ multiCopier_nClass <- nCompiler::nClass( } ), Cpublic = list( - copiers = "nList(copier_nClass())", + copiers = "nCompiler:::nList(copier_nClass())", init = nFunction( name = "init", function(model) { @@ -71,7 +71,7 @@ multiCopier_nClass <- nCompiler::nClass( interface = "full", createFromR = TRUE, exportName = "multiCopier_nClass_new", - needed_units = list("nList(copier_nClass())", "modelBase_nClass()"), + needed_units = list("nCompiler:::nList(copier_nClass())", "modelBase_nClass()"), packageNames = c(uncompiled = "multiCopier_nClass_R", compiled = "multiCopier_nClass"), nClass_inherit = list("multiCopier_nC_base"), opDefs = list( diff --git a/nimbleModel/R/instructions.R b/nimbleModel/R/instructions.R index e85d649..404d440 100644 --- a/nimbleModel/R/instructions.R +++ b/nimbleModel/R/instructions.R @@ -140,7 +140,7 @@ makeInstrList <- function(model, input, use_vec = FALSE) { } if (is.list(input) && all(sapply(input, function(x) inherits(x, "instr_nClass")))) { # Create sort-ordered nList. - instrList <- nList(instr_nClass)$new() + instrList <- nList(instr_nClass())$new() numInstrs <- length(input) instrList$setLength(numInstrs) ord <- order(unlist(lapply(input, function(x) x$sortID))) @@ -159,7 +159,7 @@ makeInstrList <- function(model, input, use_vec = FALSE) { rule$makeCalcRange(rule$apply(vr)) }) })) - instrList <- nList(instr_nClass)$new() + instrList <- nList(instr_nClass())$new() numRanges <- length(ranges) instrList$setLength(numRanges) ord <- order(unlist(lapply(ranges, function(x) x$sortID))) @@ -181,7 +181,7 @@ instr_nClass <- nClass( self$nDim <- instr$nDim %||% 0L self$dims <- instr$dims %||% integer() self$slots <- instr$slots %||% integer() - self$values <- nList(integerVector)$new() + self$values <- nList(integerVector())$new() self$values$setLength(length(self$dims)) if (self$nDim) { for (i in 1:length(self$dims)) { @@ -200,13 +200,13 @@ instr_nClass <- nClass( nDim = "integerScalar", dims = "integerVector", slots = "integerVector", - values = "nList(integerVector())", + values = "nCompiler:::nList(integerVector())", type = "integerScalar", sortID = "integerVector", declID = "integerScalar", instr_nClass = nFunction( function() { - values <- nList(integerVector)$new() + values <- nList(integerVector())$new() }, compileInfo = list(constructor = TRUE) ) @@ -216,7 +216,7 @@ instr_nClass <- nClass( interface = "full", createFromR = TRUE, exportName = "instr_nClass_new", - needed_units = list("nList(integerVector())"), + needed_units = list("nCompiler:::nList(integerVector())"), packageNames = c(uncompiled = "instr_nClass_R", compiled = "instr_nClass") ) ) From b79337296c6a4976e3e059e5ed8740022cb70222 Mon Sep 17 00:00:00 2001 From: perrydv Date: Wed, 5 Aug 2026 16:34:30 -0700 Subject: [PATCH 10/27] fix model initialize routine to handle returned base class pointers and provided CppObjs. --- nimbleModel/R/modelBaseClass.R | 72 ++++++---- nimbleModel/R/modelValues.R | 2 +- nimbleModel/R/nimbleModel.R | 6 +- nimbleModel/tests/testthat/test-nimbleModel.R | 132 +++++++++++++----- 4 files changed, 154 insertions(+), 58 deletions(-) diff --git a/nimbleModel/R/modelBaseClass.R b/nimbleModel/R/modelBaseClass.R index f6e216d..de21ed0 100644 --- a/nimbleModel/R/modelBaseClass.R +++ b/nimbleModel/R/modelBaseClass.R @@ -7,21 +7,23 @@ modelBase_nClass <- nClass( nondataRules = NULL, predictiveRules = NULL, nonpredictiveRules = NULL, - initialize = function(sizes = list(), inits = list(), data = list(), ...) { + declFunList = NULL, + initialize = function(sizes = list(), inits = list(), data = list(), ..., .initialize = FALSE) { # It is not very easy to set debug onto the initialize function, so # here is a magic flag. if (isTRUE(.GlobalEnv$.debugModelInit)) browser() super$initialize(...) - # TODO: is there a better way to populate declFunNameToIndex in Cpublic? - declFunNameToIndex <- self$declFunNameToIndex_ + CppObj_provided <- "CppObj" %in% ...names() - declFunNames <- names(declFunNameToIndex) if (isCompiled()) { # self$setup_decl_mgmt_from_names(declFunNames) # setting up the canonically indexed vector of node functions # now happens in the C++ constructor. } else { + # This assumes there is a derived class. + declFunNameToIndex <- self$declFunNameToIndex_ + declFunNames <- names(declFunNameToIndex) self$declFunList <- list() length(self$declFunList) <- length(declFunNames) names(self$declFunList) <- declFunNames @@ -33,6 +35,39 @@ modelBase_nClass <- nClass( } # TODO: create a merge_and_set function that handles all three of the following. + if(isTRUE(.initialize)) { + # This assumes there is a derived object with defaultSizes, defaultInits, and defaultData. + + # TODO: do we want to handle data differently? + # TODO: need to work through not setting as 'data' if values are NA; + # check back against how dataRules work in nimbleModel work. + # # this and the next line used inits. was that a typo? I think so. + allData <- self$defaultData + if (!missing(data)) { + for (nm in names(data)) { + allData[[nm]] <- data[[nm]] + } + } + + if(!CppObj_provided) { + self$reset(sizes = sizes, inits = inits, allData = allData) + } + + dataVarIndices <- names(modelDef$constants) %in% modelDef$varNames & !names(modelDef$constants) %in% names(allData) # don't overwrite anything in 'allData' + # TODO: revise messaging below using new nimbleModel messaging system. + if (sum(names(modelDef$constants) %in% names(allData))) { + messageIfVerbose(" [Note] Found the same variable(s) in both 'data' and 'constants'; using variable(s) from 'data'.\n") + } + if (sum(dataVarIndices)) { + allData <- c(allData, modelDef$constants[dataVarIndices]) + messageIfVerbose(" [Note] Adding '", paste(names(modelDef$constants)[dataVarIndices], collapse = ", "), "' as data for building model.") + } + # To-do: possibly build these elsewhere, or make them lazy build-on-demand. + makeDataRules(allData) + makePredictiveRules() + } + }, + reset = function(sizes = list(), inits = list(), data = list(), allData = NULL) { allSizes <- self$defaultSizes if (!missing(sizes)) { for (nm in names(sizes)) { @@ -55,28 +90,17 @@ modelBase_nClass <- nClass( allInits <- self$defaultInits } else if (length(inits)) set_from_list(inits) - # TODO: do we want to handle data differently? - # TODO: need to work through not setting as 'data' if values are NA; - # check back against how dataRules work in nimbleModel work. - allData <- self$defaultData - if (!missing(inits)) { - for (nm in names(inits)) { - allData[[nm]] <- inits[[nm]] + if(is.null(allData)) { + allData <- self$defaultData + if (!missing(data)) { # this and the next line used inits. was that a typo? I think so. + for (nm in names(data)) { + allData[[nm]] <- data[[nm]] + } } } if (length(allData)) set_from_list(allData) - dataVarIndices <- names(modelDef$constants) %in% modelDef$varNames & !names(modelDef$constants) %in% names(allData) # don't overwrite anything in 'allData' - # TODO: revise messaging below using new nimbleModel messaging system. - if (sum(names(modelDef$constants) %in% names(allData))) { - messageIfVerbose(" [Note] Found the same variable(s) in both 'data' and 'constants'; using variable(s) from 'data'.\n") - } - if (sum(dataVarIndices)) { - allData <- c(allData, modelDef$constants[dataVarIndices]) - messageIfVerbose(" [Note] Adding '", paste(names(modelDef$constants)[dataVarIndices], collapse = ", "), "' as data for building model.") - } - makeDataRules(allData) - makePredictiveRules() + }, makeDataRules = function(data) { nms <- names(data) @@ -371,8 +395,8 @@ modelBase_nClass <- nClass( ), Cpublic = list( # TODO: using 'RcppObject' was resulting in a symbolTBD error - probably nCompiler issue 186. - declFunList = "numericScalar", # 'RcppObject', # This won't actually be used in C++, but needs to be in Cpublic for accessibility. - declFunNameToIndex = "RcppList", # Not sure what type this should be for use in C++. + #declFunList = "numericScalar", # 'RcppObject', # This won't actually be used in C++, but needs to be in Cpublic for accessibility. + #declFunNameToIndex = "RcppList", # Not sure what type this should be for use in C++. ping = nFunction( name = "ping", function() { diff --git a/nimbleModel/R/modelValues.R b/nimbleModel/R/modelValues.R index bfb1d85..a76e0af 100644 --- a/nimbleModel/R/modelValues.R +++ b/nimbleModel/R/modelValues.R @@ -91,7 +91,7 @@ make_modelValues_nClass <- function(varInfo, nDim <- x$nDim nLname <- paste0("nL", nDim, "D") if (!exists(nLname, envir = e)) { - e[[nLname]] <- eval(substitute(nList(numericArray(nDim = NDIM)), list(NDIM = nDim))) + e[[nLname]] <- eval(substitute(nCompiler:::nList(numericArray(nDim = NDIM)), list(NDIM = nDim))) } paste0(nLname) }) diff --git a/nimbleModel/R/nimbleModel.R b/nimbleModel/R/nimbleModel.R index fab5884..769df0c 100644 --- a/nimbleModel/R/nimbleModel.R +++ b/nimbleModel/R/nimbleModel.R @@ -408,7 +408,11 @@ makeModel_nClass <- function(modelVarInfo, defaultInits = inits, defaultData = data, modelDef = modelDef, - CpublicDeclFuns = CpublicDeclFuns + CpublicDeclFuns = CpublicDeclFuns, + initialize = function(...) { + if (isTRUE(.GlobalEnv$.debugModelInit)) browser() + super$initialize(..., .initialize=TRUE) + } ), # A concatenation of lists CPUBLIC = c(CpublicDeclFuns, Cpublic_setup_decl_mgmt, CpublicModelVars, CpublicCtor, CpublicMethods), diff --git a/nimbleModel/tests/testthat/test-nimbleModel.R b/nimbleModel/tests/testthat/test-nimbleModel.R index f117309..fb49785 100644 --- a/nimbleModel/tests/testthat/test-nimbleModel.R +++ b/nimbleModel/tests/testthat/test-nimbleModel.R @@ -19,8 +19,78 @@ test_that("basic testing of models, compiled and uncompiled", { ## Manual workflow mclass <- nimbleModel(code, inits = inits, data = data, returnClass = TRUE) m <- mclass$new() - cmclass <- nCompile(mclass) + + model_holder <- nClass( + Cpublic = list( + mymodel_base = "nimbleModel:::modelBase_nClass()", + mymodel_der = "mclass()" + ) + ) + + comp <- nCompile(mclass, model_holder) + cmclass <- comp$mclass # nCompile(mclass) cm <- cmclass$new() + cmh <- comp$model_holder$new() + cmh$mymodel_base <- cm + cmh$mymodel_der <- cm + + # derived uncompiled and compiled have all the same derived components + expect_identical(m$defaultSizes, cm$defaultSizes) + expect_identical(m$defaultInits, cm$defaultInits) + expect_identical(m$defaultData, cm$defaultData) + expect_identical(m$modelDef, cm$modelDef) + expect_identical(m$declFunNameToIndex_, cm$declFunNameToIndex_) + + # compiled object returned as a base class ptr has null elements + # and thus is not fully functional + returned_base_model <- cmh$mymodel_base + expect_true(is.null(returned_base_model$defaultSizes)) + expect_true(is.null(returned_base_model$defaultInits)) + expect_true(is.null(returned_base_model$defaultData)) + expect_true(is.null(returned_base_model$modelDef)) + expect_true(is.null(returned_base_model$declFunNameToIndex_)) + + # compiled object returned as a derived class ptr has everything filled in + returned_der_model <- cmh$mymodel_der + expect_false(is.null(returned_der_model$defaultSizes)) + expect_false(is.null(returned_der_model$defaultInits)) + expect_false(is.null(returned_der_model$defaultData)) + expect_false(is.null(returned_der_model$modelDef)) + expect_false(is.null(returned_der_model$declFunNameToIndex_)) + + # and everything matches the original model + expect_identical(returned_der_model$defaultSizes, m$defaultSizes) + expect_identical(returned_der_model$defaultInits, m$defaultInits) + expect_identical(returned_der_model$defaultData, m$defaultData) + expect_identical(returned_der_model$modelDef, m$modelDef) + expect_identical(returned_der_model$declFunNameToIndex_, m$declFunNameToIndex_) + + expect_identical(m$y, cm$y) + expect_true(is.null(returned_base_model$y)) + expect_identical(value(returned_base_model, "y"), cm$y) + expect_false(is.null(returned_der_model$y)) + expect_identical(returned_der_model$y, cm$y) + + # modify and then rebuild returned objects + cm$y[1] <- 100 + yref <- cm$y + cm$tau <- 12 + tauref <- cm$tau + returned_base_model <- cmh$mymodel_base + returned_der_model <- cmh$mymodel_der + # rebuilt interfaces did not re-initialize + expect_identical(returned_der_model$y, yref) + expect_identical(returned_der_model$tau, tauref) + # base object can be used to initialize a new derived interface + converted_der_model <- cmclass$new(CppObj = returned_base_model) + expect_identical(converted_der_model$y, yref) + expect_identical(converted_der_model$tau, tauref) + # check just one of these derived high content objects: + expect_identical(converted_der_model$modelDef, m$modelDef) + + # reset cm for the rest + cm$y <- m$y + cm$tau <- m$tau # Check a first calculation on a simple node Cans <- cm$calculate('tau') @@ -41,25 +111,25 @@ test_that("basic testing of models, compiled and uncompiled", { lp <- m$calculate(deps) expect_identical(m$lifted_sqrt_oPtau_cP, 5) expect_equal(lp, lp_y) - expect_identical(m$getLogProb('y'), lp) + expect_equal(m$getLogProb('y'), lp) clp <- cm$calculate(deps) - expect_identical(cm$lifted_sqrt_oPtau_cP, 5) + expect_equal(cm$lifted_sqrt_oPtau_cP, 5) expect_equal(clp, lp_y) - expect_identical(cm$getLogProb('y'), clp) + expect_equal(cm$getLogProb('y'), clp) ## Check that instrList is in correct order. instrList <- makeInstrList(m, c('y','lifted_sqrt_oPtau_cP')) - expect_identical(instrList[[1]]$lens, 1) # lifted node first + expect_equal(instrList[[1]]$lens, 1) # lifted node first lp <- m$calculate(instrList) - expect_identical(m$lifted_sqrt_oPtau_cP, 5) + expect_equal(m$lifted_sqrt_oPtau_cP, 5) expect_equal(lp, lp_y) - expect_identical(m$getLogProb(c('y','lifted_sqrt_oPtau_cP')), lp_y) - expect_identical(m$logProb_y, dnorm(m$y, 0, 5, log = TRUE)) + expect_equal(m$getLogProb(c('y','lifted_sqrt_oPtau_cP')), lp_y) + expect_equal(m$logProb_y, dnorm(m$y, 0, 5, log = TRUE)) lp <- cm$calculate(instrList) - expect_identical(cm$lifted_sqrt_oPtau_cP, 5) + expect_equal(cm$lifted_sqrt_oPtau_cP, 5) expect_equal(lp, lp_y) - expect_identical(cm$getLogProb(c('y','lifted_sqrt_oPtau_cP')), lp_y) - expect_identical(cm$logProb_y, dnorm(cm$y, 0, 5, log = TRUE)) + expect_equal(cm$getLogProb(c('y','lifted_sqrt_oPtau_cP')), lp_y) + expect_equal(cm$logProb_y, dnorm(cm$y, 0, 5, log = TRUE)) m$tau <- 1 lp <- m$calculate(c('y','lifted_sqrt_oPtau_cP')) # Ordering should be done internally. @@ -78,16 +148,16 @@ test_that("basic testing of models, compiled and uncompiled", { ## NOTE: `simulate` currently simulates data nodes by default. set.seed(1) m$simulate() - expect_identical(m$lifted_sqrt_oPtau_cP, sqrt(m$tau)) + expect_equal(m$lifted_sqrt_oPtau_cP, sqrt(m$tau)) expect_equal(m$mu, -0.326233360706) m$mu <- 100 m$tau <- 1 m$simulate(m$getDependencies('tau', self = FALSE)) expect_true(all(m$y > 95)) - + set.seed(1) cm$simulate() - expect_identical(cm$lifted_sqrt_oPtau_cP, sqrt(cm$tau)) + expect_equal(cm$lifted_sqrt_oPtau_cP, sqrt(cm$tau)) expect_equal(cm$mu, -0.326233360706) cm$mu <- 100 cm$tau <- 1 @@ -146,14 +216,13 @@ test_that("basic testing of models, compiled and uncompiled", { ## Override init value when creating model instance. mclass <- nimbleModel(code, data = data, inits = inits, returnClass = TRUE) m <- mclass$new(inits = list(tau = 7)) - expect_identical(m$tau, 7) + expect_equal(m$tau, 7) # Always end compiled tests with removing and garbage collecting # to ensure gc() happens while the DLL is still in place. - rm(cm, m); gc() + rm(cm, m, cmh, returned_base_model, returned_der_model, converted_der_model); gc() }) - test_that("no indices", { code <- quote({ mu ~ dnorm(0, 1) @@ -299,7 +368,7 @@ test_that("two index slots", { set.seed(1) cm$simulate(vr) expect_equal(c(t(cm$y[2:4,1:3])), result) - + ## seq-mat vr <- varRangeClass$new(list(newIndexRange(quote(2:4)), newIndexRange(matrix(c(3,1),ncol=1))), varName = 'y') truth <- sum(dnorm(m$y[2:4,c(1,3)], log=TRUE)) @@ -314,7 +383,7 @@ test_that("two index slots", { set.seed(1) cm$simulate(vr) expect_equal(c(t(cm$y[2:4,c(1,3)])), result) - + ## mat-seq vr <- varRangeClass$new(list(newIndexRange(matrix(c(2,4),ncol=1)), newIndexRange(quote(1:3))), varName = 'y') @@ -355,13 +424,13 @@ test_that("three index slots (plus different index variable ordering)", { for(j in 1:4) for(k in 1:3) y[k,j,i] ~ dnorm(0,1) # This changes order of use of indices to [idx[3],idx[2],idx[1]]. - }) + }) data <- list(y = array(rnorm(60),c(3,4,5))) mclass <- nimbleModel(code, data = data, returnClass = TRUE) m <- mclass$new() cmclass <- nCompile(mclass) cm <- cmclass$new() - + inds <- matrix(c(3,1,5, 3,4,1, 1,2,4), ncol=3, byrow=TRUE) vr <- varRangeClass$new(list(newIndexRange(inds)), varName = 'y') inds <- vr$indexRanges[[1]]$values # Rows have been shuffled... @@ -516,7 +585,7 @@ test_that("four index slots", { for(j in 1:4) for(k in 1:3) for(l in 1:2) - y[i,j,k,l] ~ dnorm(0,1) + y[i,j,k,l] ~ dnorm(0,1) }) data <- list(y = array(rnorm(120),c(5,4,3,2))) mclass <- nimbleModel(code, data = data, returnClass = TRUE) @@ -594,7 +663,7 @@ test_that("five index slots", { for(k in 1:3) for(l in 1:2) for(m in 1:4) - y[i,j,k,l,m] ~ dnorm(0,1) + y[i,j,k,l,m] ~ dnorm(0,1) }) data <- list(y = array(rnorm(480),c(5,4,3,2,4))) mclass <- nimbleModel(code, data = data, returnClass = TRUE) @@ -653,7 +722,7 @@ test_that("basic creation of list of instr_nClass objects", { code <- quote({ mu ~ dnorm(0, 1) - for(i in 1:5) + for(i in 1:5) y[i] ~ dnorm(mu, 1) }) @@ -700,10 +769,10 @@ test_that("basic creation of list of instr_nClass objects", { instr <- makeInstrList(m, varRangeClass$new(list(newIndexRange(quote(2:5)), newIndexRange(matrix(c(1,4),ncol=1))), varName = 'y'))[[1]] expect_identical(instr$type, 5) - + instr <- makeInstrList(m, varRangeClass$new(list(newIndexRange(matrix(c(1,4),ncol=1)), newIndexRange(quote(2:5))), varName = 'y'))[[1]] expect_identical(instr$type, 6) - + instr <- makeInstrList(m, varRangeClass$new(list(newIndexRange(matrix(c(1,4),ncol=1)), newIndexRange(matrix(c(2,4),ncol=1))), varName = 'y'))[[1]] expect_identical(instr$type, 7) @@ -737,10 +806,10 @@ test_that("basic creation of list of instr_nClass objects", { instr <- makeInstrList(m, varRangeClass$new(list(newIndexRange(quote(1:3)), newIndexRange(matrix(c(2,5),ncol=1))), varName = 'y'))[[1]] expect_identical(instr$type, 6) # shuffled - + instr <- makeInstrList(m, varRangeClass$new(list(newIndexRange(matrix(c(1,4),ncol=1)), newIndexRange(quote(2:5))), varName = 'y'))[[1]] expect_identical(instr$type, 5) # shuffled - + instr <- makeInstrList(m, varRangeClass$new(list(newIndexRange(matrix(c(1,4),ncol=1)), newIndexRange(matrix(c(2,5),ncol=1))), varName = 'y'))[[1]] expect_identical(instr$type, 7) @@ -758,7 +827,7 @@ test_that("basic creation of list of instr_nClass objects", { expect_identical(instr$slots, c(1,2)) expect_identical(instr$index_types, c(2,1)) - + code <- quote({ mu ~ dnorm(0, 1) for(i in 1:5) @@ -779,7 +848,7 @@ test_that("basic creation of list of instr_nClass objects", { data <- list(y = array(rnorm(60),c(5,4,3))) m <- nimbleModel(code, data = data) instr <- makeInstrList(m, varRangeClass$new(list(newIndexRange(quote(2:5)), newIndexRange(quote(1:2)), - newIndexRange(quote(1:2))), + newIndexRange(quote(1:2))), varName = 'y'))[[1]] expect_identical(instr$type, 12) # allseq @@ -827,7 +896,6 @@ test_that("basic creation of list of instr_nClass objects", { expect_identical(cinstr$dims, 1L) expect_identical(cinstr$lens, 4L) expect_identical(cinstr$values[[1]], 2L) - -}) +}) From 0ff1129b58fea8bd6be307687e435aaa45fc858a Mon Sep 17 00:00:00 2001 From: perrydv Date: Wed, 5 Aug 2026 19:03:12 -0700 Subject: [PATCH 11/27] fix modelValues base class initialize and cleanup --- nimbleModel/R/modelValues.R | 9 ++++--- .../modelValuesBase_nClass_cppContent.cpp | 1 - .../modelValuesBase_nClass_manifest.txt | 2 +- nimbleModel/tests/testthat/test-modelValues.R | 26 +++++++++++-------- 4 files changed, 22 insertions(+), 16 deletions(-) diff --git a/nimbleModel/R/modelValues.R b/nimbleModel/R/modelValues.R index a76e0af..38eebd8 100644 --- a/nimbleModel/R/modelValues.R +++ b/nimbleModel/R/modelValues.R @@ -5,10 +5,13 @@ modelValuesBase_nClass <- nCompiler::nClass( Rpublic = list( initialize = function(...) { super$initialize(...) - if(!isCompiled()) { - modelValuesBase_nClass() + CppObj_provided <- "CppObj" %in% ...names() + if(!CppObj_provided) { + if(!isCompiled()) { + modelValuesBase_nClass() + self$sizes <- self$defaultSizes + } } - self$sizes <- self$defaultSizes } ), Cpublic = list( diff --git a/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_cppContent.cpp b/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_cppContent.cpp index b4199fb..ded715d 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_cppContent.cpp +++ b/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_cppContent.cpp @@ -16,7 +16,6 @@ using namespace Rcpp; modelValuesBase_nClass::modelValuesBase_nClass ( ) { RESET_EIGEN_ERRORS -Rcpp::Rcout << "base class compiled Cpublic init\n";; flex_(current_nRow_) = 0.0; this->sizes = Rcpp::List();; } diff --git a/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_manifest.txt b/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_manifest.txt index 4f7ec55..fa6b612 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_manifest.txt +++ b/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_manifest.txt @@ -1,4 +1,4 @@ -list(saved_at = structure(1784914179.60862, class = c("POSIXct", +list(saved_at = structure(1785981567.15796, class = c("POSIXct", "POSIXt")), packet_name = "modelValuesBase_nClass", elements = c("preamble", "cppContent", "hContent", "filebase", "post_cpp_compiler", "copyFiles" ), files = list(preamble = "modelValuesBase_nClass_preamble.cpp", diff --git a/nimbleModel/tests/testthat/test-modelValues.R b/nimbleModel/tests/testthat/test-modelValues.R index aab1611..1a2993d 100644 --- a/nimbleModel/tests/testthat/test-modelValues.R +++ b/nimbleModel/tests/testthat/test-modelValues.R @@ -9,7 +9,7 @@ test_that("basic modelValues class works", { ) ) mvClass <- nimbleModel:::make_modelValues_nClass(varInfo) - + obj <- mvClass$new() #obj$mu expect_equal(obj$mu |> as.list(), list()) @@ -19,7 +19,7 @@ test_that("basic modelValues class works", { obj$resize(3) expect_equal(obj$mu |> as.list(), rep(list(numeric(2)), 3)) expect_equal(obj$cov |> as.list(), matrix(0, nrow = 3, ncol = 4) |> list() |> rep(3)) - + CmvClass <- nCompiler::nCompile(mvClass) obj <- CmvClass$new() expect_equal(obj$mu |> as.list(), list()) @@ -29,6 +29,7 @@ test_that("basic modelValues class works", { obj$resize(3) expect_equal(obj$mu |> as.list(), rep(list(numeric(2)), 3)) expect_equal(obj$cov |> as.list(), matrix(0, nrow = 3, ncol = 4) |> list() |> rep(3)) + rm(obj); gc() }) test_that("modelValues hashedID works and is invariant to equivalent cases", { @@ -114,21 +115,23 @@ test_that("modelValues nClassBuilder types work in nCompiler", { sizes <- list(mu = 2, cov = c(3, 4)) obj$mv$sizes <- sizes expect_equal(obj$mv$sizes, sizes) - + sizes_alt <- list(mu = 4, cov = c(2, 1)) obj$mvBase$set_sizes(sizes_alt) expect_equal(obj$mv$sizes, sizes_alt) - + obj$mv$resize(3) expect_equal(obj$mv$cov |> as.list(), rep( list(matrix(0, nrow = 2, ncol = 1)), 3)) + expect_equal(nCompiler::value(obj$mv, "cov") |> as.list(), rep( list(matrix(0, nrow = 2, ncol = 1)), 3)) expect_equal(obj$mv$getLength(), 3) expect_equal(obj$mvBase$getLength(), 3) - + obj$mvBase$resize(4) expect_equal(obj$mv$cov |> as.list(), rep( list(matrix(0, nrow = 2, ncol = 1)), 4)) + expect_equal(nCompiler::value(obj$mv, "cov") |> as.list(), rep( list(matrix(0, nrow = 2, ncol = 1)), 4)) expect_equal(obj$mv$getLength(), 4) expect_equal(obj$mvBase$getLength(), 4) - + dup_mv_unc <- nimbleModel:::modelValues(varInfo) obj_unc <- dup_mv_unc$new() sizes2 <- list(mu = 3, cov = c(1, 2)) @@ -138,16 +141,16 @@ test_that("modelValues nClassBuilder types work in nCompiler", { obj$mv <- obj_unc # because we assigned an uncompiled to a compiled that already # had an instantiated object, it copied contents to the same - # compiled object. So mvBase will see this too since it + # compiled object. So mvBase will see this too since it # still points to the same object. - + expect_true(obj$mv$isCompiled()) expect_false(obj_unc$isCompiled()) mu_exp <- rep(list(c(0,0,0)), 5) mu_exp[[3]] <- 1:3 expect_equal(obj_unc$mu |> as.list(), mu_exp) expect_equal(obj$mv$mu |> as.list(), mu_exp) - + expect_equal(obj_unc$getLength(), 5) expect_equal(obj$mv$getLength(), 5) expect_equal(obj$mvBase$getLength(), 5) @@ -161,10 +164,11 @@ test_that("modelValues nClassBuilder types work in nCompiler", { expect_equal(obj_new_comp$mu |> as.list(), rep(list(rep(0, 6)), 2)) obj$mv <- obj_new_comp expect_equal(obj$mv$getLength(), 2) - expect_equal(obj$mvBase$getLength(), 5) - + expect_equal(obj$mvBase$getLength(), 5) + # Finally we will assign the derived to the base ptr # and they will point at the same thing again. obj$mvBase <- obj$mv expect_equal(obj$mvBase$getLength(), 2) + rm(obj); gc() }) From 6dd28e971fde3a7bfd1342cca42d3d21cb0d01e6 Mon Sep 17 00:00:00 2001 From: perrydv Date: Thu, 6 Aug 2026 09:32:36 -0700 Subject: [PATCH 12/27] modelValues works with generic bracket and length getters and setters, and as.list() --- nimbleModel/NAMESPACE | 5 +- nimbleModel/R/modelValues.R | 95 +++++++++++++------ nimbleModel/tests/testthat/test-modelValues.R | 23 +++++ 3 files changed, 94 insertions(+), 29 deletions(-) diff --git a/nimbleModel/NAMESPACE b/nimbleModel/NAMESPACE index 544c34e..a0aebda 100644 --- a/nimbleModel/NAMESPACE +++ b/nimbleModel/NAMESPACE @@ -79,4 +79,7 @@ export(values) export("values<-") S3method("[", modelValues) -S3method("[<-", modelValues) \ No newline at end of file +S3method("[<-", modelValues) +S3method("length", modelValues) +S3method("length<-", modelValues) +S3method("as.list", modelValues) diff --git a/nimbleModel/R/modelValues.R b/nimbleModel/R/modelValues.R index 38eebd8..bd08fd5 100644 --- a/nimbleModel/R/modelValues.R +++ b/nimbleModel/R/modelValues.R @@ -83,11 +83,13 @@ modelValues_resize <- function(self, m, sizes) { } make_modelValues_nClass <- function(varInfo, - classname) { - if(missing(classname)) { + cpp_classname) { + if(missing(cpp_classname)) { hashedID <- make_modelValues_hashID(varInfo) - classname <- Rname2CppName(paste0("MV_", hashedID)) + cpp_classname <- Rname2CppName(paste0("MV_", hashedID)) } + # All cases get the same classname so that they share the same S3 dispatch for `[`, `[<-`, etc. + classname <- "modelValues" e <- environment() CpublicVars <- varInfo$vars |> lapply(\(x) { @@ -135,7 +137,7 @@ make_modelValues_nClass <- function(varInfo, CPUBLIC <- c( list( - CLASSNAME = nCompiler::nFunction( + CPP_CLASSNAME = nCompiler::nFunction( fun = c_ctor_fun, compileInfo = list( constructor = TRUE @@ -157,7 +159,7 @@ make_modelValues_nClass <- function(varInfo, CpublicVars ) - names(CPUBLIC)[1] <- classname + names(CPUBLIC)[1] <- cpp_classname defaultSizes <- varInfo$sizes if(is.null(defaultSizes)) defaultSizes <- list() @@ -172,6 +174,7 @@ make_modelValues_nClass <- function(varInfo, classname = CLASSNAME, inherit = modelValuesBase_nClass, compileInfo = list( + cpp_classname = CPP_CLASSNAME, nClass_inherit = list(base = "modelValuesClass_") ), Rpublic = list( @@ -180,7 +183,7 @@ make_modelValues_nClass <- function(varInfo, initialize = function(...) { super$initialize(...) if (!isCompiled()) { - CLASSNAME_() + CPP_CLASSNAME_() } } ), @@ -188,31 +191,14 @@ make_modelValues_nClass <- function(varInfo, CPUBLIC ), list(CLASSNAME = classname, - CLASSNAME_ = as.name(classname)) + CPP_CLASSNAME_ = as.name(cpp_classname), + CPP_CLASSNAME = cpp_classname) ) generator <- eval(generator_code) generator$set("public", "NCgenerator", generator) generator } -## This is automatic native behavior anyway -## However it returns an nList instead of a list. -## to-do: follow-up for backward compatability. -## `[[.modelValues` <- function(x, i) { -## x[[i]] -## } - -#' @export -`[.modelValues` <- function(x, var, ind) { - x[[var]][[ind]] -} - -#' @export -`[<-.modelValues` <- function(x, var, ind, value) { - x[[var]][[ind]] <- value - x -} - make_modelValues_hashID <- function(varInfo) { # We go to some lengths to normalize # so that we obtain the same hash for equivalent varInfo. @@ -250,11 +236,64 @@ modelValues <- function(varInfo, .ID = FALSE, env = parent.frame()) { varInfo <- get_varInfo_from_nimbleModel(varInfo) } hashedID <- make_modelValues_hashID(varInfo) - classname <- Rname2CppName(paste0("MV_", hashedID)) + cpp_classname <- Rname2CppName(paste0("MV_", hashedID)) if(isTRUE(.ID)) { - return(classname) + return(cpp_classname) } - ans <- make_modelValues_nClass(varInfo, classname = classname) + ans <- make_modelValues_nClass(varInfo, cpp_classname = cpp_classname) ans } class(modelValues) <- c("function", "nClassBuilder") + +## We don't need to overload `[[` or `[[<-` because they +## "just work" by accessing member variables that are nLists. +## However it does return an nList instead of a list. +## To-Do: For nimble backward compatability, we may +## want to provide an optional way to return a list. +## `[[.modelValues` <- function(x, i) { +## x[[i]] +## } + +#' @exportS3Method +#' @method `[` modelValues +`[.modelValues` <- function(x, var, ind) { + x[[var]][[ind]] +} + +#' @exportS3Method +#' @method `[<-` modelValues +`[<-.modelValues` <- function(x, var, ind, value) { + x[[var]][[ind]] <- value + x +} + +## To-Do: It would be nice to have an "as.list" that +## returns a list of lists. This needs +## access to the variable names and at the moment +## that will only work from a derived class, not +## from a returned base class ptr. +#' @exportS3Method +#' @method as.list modelValues +as.list.modelValues <- function(x) { + varNames <- x$varInfo$vars |> names() + if(!is.null(varNames)) { + return( + varNames |> lapply( + \(var) as.list(x[[var]])) |> + structure(names = varNames)) + } + NULL +} + +#' @exportS3Method +#' @method length modelValues +length.modelValues <- function(x) { + x$getLength() +} + +#' @exportS3Method +#' @method `length<-` modelValues +`length<-.modelValues` <- function(x, value) { + x$resize(value) + x +} diff --git a/nimbleModel/tests/testthat/test-modelValues.R b/nimbleModel/tests/testthat/test-modelValues.R index 1a2993d..43d9321 100644 --- a/nimbleModel/tests/testthat/test-modelValues.R +++ b/nimbleModel/tests/testthat/test-modelValues.R @@ -20,6 +20,17 @@ test_that("basic modelValues class works", { expect_equal(obj$mu |> as.list(), rep(list(numeric(2)), 3)) expect_equal(obj$cov |> as.list(), matrix(0, nrow = 3, ncol = 4) |> list() |> rep(3)) + expect_equal(length(obj), 3) + expect_equal(obj["mu", 1], c(0, 0)) + obj["mu", 1] <- c(1, 2) + expect_equal(obj["mu", 1], c(1, 2)) + length(obj) <- 2 + expect_equal(length(obj), 2) + obj["mu", 1] <- c(1, 2) + obj["mu", 2] <- c(3, 4) + list_exp <- list(mu = list(c(1,2), c(3, 4)), cov = matrix(0, nrow = 3, ncol = 4) |> list() |> rep(2)) + expect_equal(as.list(obj), list_exp) + CmvClass <- nCompiler::nCompile(mvClass) obj <- CmvClass$new() expect_equal(obj$mu |> as.list(), list()) @@ -29,6 +40,18 @@ test_that("basic modelValues class works", { obj$resize(3) expect_equal(obj$mu |> as.list(), rep(list(numeric(2)), 3)) expect_equal(obj$cov |> as.list(), matrix(0, nrow = 3, ncol = 4) |> list() |> rep(3)) + + expect_equal(length(obj), 3) + expect_equal(obj["mu", 1], c(0, 0)) + obj["mu", 1] <- c(1, 2) + expect_equal(obj["mu", 1], c(1, 2)) + length(obj) <- 2 + expect_equal(length(obj), 2) + obj["mu", 1] <- c(1, 2) + obj["mu", 2] <- c(3, 4) + list_exp <- list(mu = list(c(1,2), c(3, 4)), cov = matrix(0, nrow = 3, ncol = 4) |> list() |> rep(2)) + expect_equal(as.list(obj), list_exp) + rm(obj); gc() }) From 732801f0f628be8766c3eff00d05646733b8c516 Mon Sep 17 00:00:00 2001 From: perrydv Date: Tue, 11 Aug 2026 11:03:35 -0700 Subject: [PATCH 13/27] Make dot_sizeList and dot_current_nRow be "hidden" --- nimbleModel/R/modelValues.R | 115 +++++++++++------- nimbleModel/inst/generate_predefined.R | 4 +- .../modelValuesBase_nClass_cppContent.cpp | 22 ++-- .../modelValuesBase_nClass_hContent.h | 7 +- .../modelValuesBase_nClass_manifest.txt | 2 +- nimbleModel/tests/testthat/test-modelValues.R | 83 ++++++++++--- 6 files changed, 162 insertions(+), 71 deletions(-) diff --git a/nimbleModel/R/modelValues.R b/nimbleModel/R/modelValues.R index bd08fd5..bc62d0e 100644 --- a/nimbleModel/R/modelValues.R +++ b/nimbleModel/R/modelValues.R @@ -1,7 +1,7 @@ # Initial rough drafting of modelValues modelValuesBase_nClass <- nCompiler::nClass( - classname = "modelValuesBase_nClass", + classname = "modelValues", Rpublic = list( initialize = function(...) { super$initialize(...) @@ -9,31 +9,39 @@ modelValuesBase_nClass <- nCompiler::nClass( if(!CppObj_provided) { if(!isCompiled()) { modelValuesBase_nClass() - self$sizes <- self$defaultSizes + self$dot_sizeList <- self$defaultSizes } } } ), Cpublic = list( - sizes = "RcppList", - current_nRow_ = "integerScalar", + dot_sizeList = "RcppList", + dot_current_nRow = "integerScalar", modelValuesBase_nClass = nCompiler::nFunction( function() { - current_nRow_ <<- 0 - sizes <<- list() + self$dot_current_nRow <<- 0 + self$dot_sizeList <<- list() }, compileInfo = list( constructor = TRUE, C_fun = function() { - current_nRow_ <- 0 - cppLiteral("this->sizes = Rcpp::List();") + self$dot_current_nRow <- 0 + cppLiteral("this->dot_sizeList = Rcpp::List();") } ) ), - set_sizes = nCompiler::nFunction( - name = "set_sizes", - fun = function(new_sizes = "RcppList") { - self$sizes <<- new_sizes + set_sizeList = nCompiler::nFunction( + name = "set_sizeList", + fun = function(sizeList = "RcppList") { + dot_sizeList <<- sizeList + self$dot_sizeList <<- sizeList + } + ), + get_sizeList = nCompiler::nFunction( + name = "get_sizeList", + fun = function() { + return(self$dot_sizeList) + returnType("RcppList") } ), resize = nCompiler::nFunction( @@ -52,7 +60,7 @@ modelValuesBase_nClass <- nCompiler::nClass( getLength = nCompiler::nFunction( name = "getLength", function() { - return(current_nRow_) + return(self$dot_current_nRow) returnType("integerScalar") }, compileInfo = list(virtual = TRUE) @@ -62,6 +70,7 @@ modelValuesBase_nClass <- nCompiler::nClass( package = "nimbleModel" ) |> file.path("modelValuesBase_nClass")), compileInfo = list( + cpp_classname = "modelValuesBase_nClass", interface = "full", createFromR = FALSE, exportName = "modelValuesBase_nClass_new", @@ -69,15 +78,15 @@ modelValuesBase_nClass <- nCompiler::nClass( ) ) -modelValues_resize <- function(self, m, sizes) { +modelValues_resize <- function(self, m, sizeList) { # check preservation issues in resizing - for (v in names(sizes)) { - this_sizes <- sizes[[v]] + for (v in names(sizeList)) { + this_sizeList <- sizeList[[v]] length(self[[v]]) <- m - if (length(this_sizes) == 1) { - for (i in 1:m) self[[v]][[i]] <- numeric(length = this_sizes) + if (length(this_sizeList) == 1) { + for (i in 1:m) self[[v]][[i]] <- numeric(length = this_sizeList) } else { - for (i in 1:m) self[[v]][[i]] <- array(0, dim = this_sizes) + for (i in 1:m) self[[v]][[i]] <- array(0, dim = this_sizeList) } } } @@ -89,7 +98,7 @@ make_modelValues_nClass <- function(varInfo, cpp_classname <- Rname2CppName(paste0("MV_", hashedID)) } # All cases get the same classname so that they share the same S3 dispatch for `[`, `[<-`, etc. - classname <- "modelValues" + classname <- cpp_classname e <- environment() CpublicVars <- varInfo$vars |> lapply(\(x) { @@ -116,24 +125,17 @@ make_modelValues_nClass <- function(varInfo, lapply(\(x) { nDim <- x$nDim nLname <- paste0("nL", nDim, "D") - Cline <- gsub("NDIM", nDim, "resize_one(V, m, as(this->sizes[NAME]))") + Cline <- gsub("NDIM", nDim, "resize_one(V, m, as(this->dot_sizeList[NAME]))") Cline <- gsub("NAME", paste0("\"", x$name, "\""), Cline) Cline <- gsub("V", x$name, Cline) substitute(nCpp(CLINE), list(CLINE = Cline)) }) - # function() { - # mu <<- nL1D$new() - # cov <<- nL2D$new() - # } + c_ctor_fun <- function() {} body(c_ctor_fun) <- as.call(c(as.name("{"), ctor_lines)) - # function(m = 'integerScalar') { - # nCpp("resize_one<1>(mu, m, this->sizes[\"mu\"])") - # nCpp("resize_one<2>(cov, m, this->sizes[\"cov\"])") - # current_nRow_ <<- m - # } + c_resize_fun <- function(m) {} - body(c_resize_fun) <- as.call(c(as.name("{"), resize_lines, list(quote(current_nRow_ <- m)))) + body(c_resize_fun) <- as.call(c(as.name("{"), resize_lines, list(quote(dot_current_nRow <- m)))) CPUBLIC <- c( list( @@ -146,8 +148,8 @@ make_modelValues_nClass <- function(varInfo, resize = nCompiler::nFunction( name = "resize", fun = function(m) { - modelValues_resize(self, m, sizes) - self$current_nRow_ <- m + modelValues_resize(self, m, dot_sizeList) + self$dot_current_nRow <- m # check preservation issues in resizing }, compileInfo = list( @@ -257,13 +259,21 @@ class(modelValues) <- c("function", "nClassBuilder") #' @exportS3Method #' @method `[` modelValues `[.modelValues` <- function(x, var, ind) { - x[[var]][[ind]] + if(x$isCompiled()) { + nCompiler::value(x, var)[[1]] + } else { + x[[var]][[ind]] + } } #' @exportS3Method #' @method `[<-` modelValues `[<-.modelValues` <- function(x, var, ind, value) { - x[[var]][[ind]] <- value + if(x$isCompiled()) { + nCompiler::value(x, var)[[ind]] <- value + } else { + x[[var]][[ind]] <- value + } x } @@ -275,12 +285,23 @@ class(modelValues) <- c("function", "nClassBuilder") #' @exportS3Method #' @method as.list modelValues as.list.modelValues <- function(x) { - varNames <- x$varInfo$vars |> names() - if(!is.null(varNames)) { - return( - varNames |> lapply( - \(var) as.list(x[[var]])) |> - structure(names = varNames)) + if(x$isCompiled()) { + varNames <- nCompiler::interface_names(x, "members") + varNames <- varNames[!varNames %in% c("dot_sizeList", "dot_current_nRow")] + if(!is.null(varNames)) { + return( + varNames |> lapply( + \(var) as.list(nCompiler::value(x, var))) |> + structure(names = varNames)) + } + } else { + varNames <- x$varInfo$vars |> names() + if(!is.null(varNames)) { + return( + varNames |> lapply( + \(var) as.list(x[[var]]) ) |> + structure(names = varNames)) + } } NULL } @@ -288,12 +309,20 @@ as.list.modelValues <- function(x) { #' @exportS3Method #' @method length modelValues length.modelValues <- function(x) { - x$getLength() + if(x$isCompiled()) { + nCompiler::method(x, "getLength")() + } else { + x$getLength() + } } #' @exportS3Method #' @method `length<-` modelValues `length<-.modelValues` <- function(x, value) { - x$resize(value) + if(x$isCompiled()) { + nCompiler::method(x, "resize")(value) + } else { + x$resize(value) + } x } diff --git a/nimbleModel/inst/generate_predefined.R b/nimbleModel/inst/generate_predefined.R index 2db6e82..24fd58f 100644 --- a/nimbleModel/inst/generate_predefined.R +++ b/nimbleModel/inst/generate_predefined.R @@ -37,5 +37,5 @@ test <- nCompile(nimbleModel:::multiCopier_nClass) ## # "#include " to the hContent ## # And add "// [[Rcpp::depends(nimbleModel)]]" to the cppContent ## # after the declaration of modelValuesBase_nClass. -nCompile(modelValuesBase_nClass = nimbleModel:::modelValuesBase_nClass, control=list(generate_predefined=TRUE)) -test <- nCompile(nimbleModel:::modelValuesBase_nClass) +nCompiler::nCompile(modelValuesBase_nClass = nimbleModel:::modelValuesBase_nClass, control=list(generate_predefined=TRUE)) +test <- nCompiler::nCompile(nimbleModel:::modelValuesBase_nClass) diff --git a/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_cppContent.cpp b/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_cppContent.cpp index ded715d..50ee59d 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_cppContent.cpp +++ b/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_cppContent.cpp @@ -16,12 +16,17 @@ using namespace Rcpp; modelValuesBase_nClass::modelValuesBase_nClass ( ) { RESET_EIGEN_ERRORS -flex_(current_nRow_) = 0.0; -this->sizes = Rcpp::List();; +flex_((this)->dot_current_nRow) = 0.0; +this->dot_sizeList = Rcpp::List();; } - void modelValuesBase_nClass::set_sizes ( Rcpp::List new_sizes ) { + void modelValuesBase_nClass::set_sizeList ( Rcpp::List sizeList ) { RESET_EIGEN_ERRORS -(this)->sizes = new_sizes; +dot_sizeList = sizeList; +(this)->dot_sizeList = sizeList; +} + Rcpp::List modelValuesBase_nClass::get_sizeList ( ) { +RESET_EIGEN_ERRORS +return((this)->dot_sizeList); } void modelValuesBase_nClass::resize ( int m ) { RESET_EIGEN_ERRORS @@ -29,7 +34,7 @@ Rcpp::stop("Should not be calling compiled modelValuesBase_nClass resize().");; } int modelValuesBase_nClass::getLength ( ) { RESET_EIGEN_ERRORS -return(current_nRow_); +return((this)->dot_current_nRow); } // [[Rcpp::export(name = "set_CnClass_env_modelValuesBase_nClass_new")]] @@ -47,11 +52,12 @@ return GET_CNCLASS_ENV(modelValuesBase_nClass);; NCOMPILER_INTERFACE( modelValuesBase_nClass, NCOMPILER_FIELDS( -field("sizes", &modelValuesBase_nClass::sizes), -field("current_nRow_", &modelValuesBase_nClass::current_nRow_) +field("dot_sizeList", &modelValuesBase_nClass::dot_sizeList), +field("dot_current_nRow", &modelValuesBase_nClass::dot_current_nRow) ), NCOMPILER_METHODS( -method("set_sizes", &modelValuesBase_nClass::set_sizes, args({{arg("new_sizes",copy)}})), +method("set_sizeList", &modelValuesBase_nClass::set_sizeList, args({{arg("sizeList",copy)}})), +method("get_sizeList", &modelValuesBase_nClass::get_sizeList, args({{}})), method("resize", &modelValuesBase_nClass::resize, args({{arg("m",copy)}})), method("getLength", &modelValuesBase_nClass::getLength, args({{}})) ) diff --git a/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_hContent.h b/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_hContent.h index b0026a1..afd91a0 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_hContent.h +++ b/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_hContent.h @@ -11,11 +11,12 @@ class modelValuesBase_nClass : public interface_resolver< genericInterfaceC >, public loadedObjectHookC { public: modelValuesBase_nClass ( ) ; - void set_sizes ( Rcpp::List new_sizes ) ; + void set_sizeList ( Rcpp::List sizeList ) ; + Rcpp::List get_sizeList ( ) ; virtual void resize ( int m ) ; virtual int getLength ( ) ; - Rcpp::List sizes; - int current_nRow_; + Rcpp::List dot_sizeList; + int dot_current_nRow; }; diff --git a/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_manifest.txt b/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_manifest.txt index fa6b612..fb4bb2c 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_manifest.txt +++ b/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_manifest.txt @@ -1,4 +1,4 @@ -list(saved_at = structure(1785981567.15796, class = c("POSIXct", +list(saved_at = structure(1786470263.32434, class = c("POSIXct", "POSIXt")), packet_name = "modelValuesBase_nClass", elements = c("preamble", "cppContent", "hContent", "filebase", "post_cpp_compiler", "copyFiles" ), files = list(preamble = "modelValuesBase_nClass_preamble.cpp", diff --git a/nimbleModel/tests/testthat/test-modelValues.R b/nimbleModel/tests/testthat/test-modelValues.R index 43d9321..fabbff5 100644 --- a/nimbleModel/tests/testthat/test-modelValues.R +++ b/nimbleModel/tests/testthat/test-modelValues.R @@ -11,15 +11,17 @@ test_that("basic modelValues class works", { mvClass <- nimbleModel:::make_modelValues_nClass(varInfo) obj <- mvClass$new() - #obj$mu + + # Basic uncompiled uses: expect_equal(obj$mu |> as.list(), list()) sizes <- list(mu = 2, cov = c(3, 4)) - obj$sizes <- sizes - expect_equal(obj$sizes, sizes) + obj$set_sizeList(sizes) + expect_equal(obj$get_sizeList(), sizes) obj$resize(3) expect_equal(obj$mu |> as.list(), rep(list(numeric(2)), 3)) expect_equal(obj$cov |> as.list(), matrix(0, nrow = 3, ncol = 4) |> list() |> rep(3)) + # S3 interface, uncompiled expect_equal(length(obj), 3) expect_equal(obj["mu", 1], c(0, 0)) obj["mu", 1] <- c(1, 2) @@ -31,16 +33,32 @@ test_that("basic modelValues class works", { list_exp <- list(mu = list(c(1,2), c(3, 4)), cov = matrix(0, nrow = 3, ncol = 4) |> list() |> rep(2)) expect_equal(as.list(obj), list_exp) - CmvClass <- nCompiler::nCompile(mvClass) + # Make a holder class so we can test a compiled mv returned + # as a base class + + mvHolder <- nCompiler::nClass( + Cpublic = list( + mv = "modelValuesBase_nClass" + ) + ) + +# debug(nCompiler:::compile_generateCpp) +# debug(nCompiler:::process_inheritance) + comp <- nCompiler::nCompile(mvClass, mvHolder) + CmvClass <- comp$mvClass + CmvHolder <- comp$mvHolder obj <- CmvClass$new() + + # Basic compiled uses expect_equal(obj$mu |> as.list(), list()) sizes <- list(mu = 2, cov = c(3, 4)) - obj$sizes <- sizes - expect_equal(obj$sizes, sizes) + obj$set_sizeList(sizes) + expect_equal(obj$get_sizeList(), sizes) obj$resize(3) expect_equal(obj$mu |> as.list(), rep(list(numeric(2)), 3)) expect_equal(obj$cov |> as.list(), matrix(0, nrow = 3, ncol = 4) |> list() |> rep(3)) + # S3 interface, compiled expect_equal(length(obj), 3) expect_equal(obj["mu", 1], c(0, 0)) obj["mu", 1] <- c(1, 2) @@ -50,9 +68,46 @@ test_that("basic modelValues class works", { obj["mu", 1] <- c(1, 2) obj["mu", 2] <- c(3, 4) list_exp <- list(mu = list(c(1,2), c(3, 4)), cov = matrix(0, nrow = 3, ncol = 4) |> list() |> rep(2)) - expect_equal(as.list(obj), list_exp) + expect_equal(as.list(obj), list_exp[sort(names(list_exp)) ] ) - rm(obj); gc() + # Accessed by base class pointer as a member of another class + obj <- CmvClass$new() + mvh <- CmvHolder$new() + mvh$mv <- obj # assign the derived obj to be held by base class pointer + obj <- mvh$mv # obj is now a base class pointer + + # In direct use, we need to use value and method because the base class + # interface does not have active bindings for the derived content like the specific variables + expect_true(is.null(obj$mu)) + expect_equal(nCompiler::value(obj, "mu") |> as.list(), list()) + sizes <- list(mu = 2, cov = c(3, 4)) + nCompiler::method(obj, "set_sizeList")(sizes) + expect_equal(nCompiler::method(obj, "get_sizeList")(), sizes) + nCompiler::method(obj, "resize")(3) + expect_equal(nCompiler::value(obj, "mu") |> as.list(), rep(list(numeric(2)), 3)) + expect_equal(nCompiler::value(obj, "cov") |> as.list(), matrix(0, nrow = 3, ncol = 4) |> list() |> rep(3)) + + # In S3 interface use, normal syntax should work + # because the S3 interface functions use value() and method() + expect_equal(length(obj), 3) + expect_equal(obj["mu", 1], c(0, 0)) + obj["mu", 1] <- c(1, 2) + expect_equal(obj["mu", 1], c(1, 2)) + length(obj) <- 2 + expect_equal(length(obj), 2) + obj["mu", 1] <- c(1, 2) + obj["mu", 2] <- c(3, 4) + list_exp <- list(mu = list(c(1,2), c(3, 4)), cov = matrix(0, nrow = 3, ncol = 4) |> list() |> rep(2)) + expect_equal(as.list(obj), list_exp[sort(names(list_exp))]) + + # We can create a new derived interface object with the same underlying C++ object + # Then we have the active bindings + obj_restored <- CmvClass$new(CppObj = obj) + expect_equal(obj_restored[["mu"]][[1]], c(1, 2)) + expect_equal(obj_restored[["mu"]][[2]], c(3, 4)) + expect_equal(obj_restored$get_sizeList()$cov, c(3, 4)) + + rm(obj, mvh, obj_restored); gc() }) test_that("modelValues hashedID works and is invariant to equivalent cases", { @@ -136,12 +191,12 @@ test_that("modelValues nClassBuilder types work in nCompiler", { obj <- comp$nc$new() obj$init() sizes <- list(mu = 2, cov = c(3, 4)) - obj$mv$sizes <- sizes - expect_equal(obj$mv$sizes, sizes) + obj$mv$set_sizeList(sizes) + expect_equal(obj$mv$get_sizeList(), sizes) sizes_alt <- list(mu = 4, cov = c(2, 1)) - obj$mvBase$set_sizes(sizes_alt) - expect_equal(obj$mv$sizes, sizes_alt) + obj$mvBase$set_sizeList(sizes_alt) + expect_equal(obj$mv$get_sizeList(), sizes_alt) obj$mv$resize(3) expect_equal(obj$mv$cov |> as.list(), rep( list(matrix(0, nrow = 2, ncol = 1)), 3)) @@ -158,7 +213,7 @@ test_that("modelValues nClassBuilder types work in nCompiler", { dup_mv_unc <- nimbleModel:::modelValues(varInfo) obj_unc <- dup_mv_unc$new() sizes2 <- list(mu = 3, cov = c(1, 2)) - obj_unc$sizes <- sizes2 + obj_unc$set_sizeList(sizes2) obj_unc$resize(5) obj_unc$mu[[3]] <- 1:3 obj$mv <- obj_unc @@ -182,7 +237,7 @@ test_that("modelValues nClassBuilder types work in nCompiler", { # This will result in mv pointing to the new object # and mvBase pointing to the old object obj_new_comp <- comp$mvc$new() - obj_new_comp$set_sizes(list(mu = c(6), cov = c(4, 1))) + obj_new_comp$set_sizeList(list(mu = c(6), cov = c(4, 1))) obj_new_comp$resize(2) expect_equal(obj_new_comp$mu |> as.list(), rep(list(rep(0, 6)), 2)) obj$mv <- obj_new_comp From 906a59ec06053b53ef3a636d611617260e6d8b20 Mon Sep 17 00:00:00 2001 From: perrydv Date: Fri, 14 Aug 2026 14:30:45 -0700 Subject: [PATCH 14/27] Add multiCopier variant for modelValues. Update both variants to reset data pointers on every copy call. --- nimbleModel/R/copier.R | 97 +++++++++++++- nimbleModel/R/modelValues.R | 8 +- nimbleModel/inst/generate_predefined.R | 18 ++- .../inst/include/nimbleModel/.DS_Store | Bin 6148 -> 6148 bytes .../multiCopierMV_nClass_copyFiles.txt | 0 .../multiCopierMV_nClass_cppContent.cpp | 67 ++++++++++ .../multiCopierMV_nClass_filebase.txt | 1 + .../multiCopierMV_nClass_hContent.h | 31 +++++ .../multiCopierMV_nClass_manifest.txt | 7 + ...multiCopierMV_nClass_post_cpp_compiler.txt | 0 .../multiCopierMV_nClass_preamble.cpp | 5 + .../multiCopier_modelValues_nC_base.h | 121 ++++++++++++++++++ .../multiCopier_model_nC_base.h | 55 ++++++++ .../multiCopier_nC_base/multiCopier_nC_base.h | 41 ++++-- .../multiCopier_nClass_cppContent.cpp | 2 +- .../multiCopier_nClass_hContent.h | 4 +- .../multiCopier_nClass_manifest.txt | 2 +- 17 files changed, 430 insertions(+), 29 deletions(-) create mode 100644 nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass/multiCopierMV_nClass_copyFiles.txt create mode 100644 nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass/multiCopierMV_nClass_cppContent.cpp create mode 100644 nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass/multiCopierMV_nClass_filebase.txt create mode 100644 nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass/multiCopierMV_nClass_hContent.h create mode 100644 nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass/multiCopierMV_nClass_manifest.txt create mode 100644 nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass/multiCopierMV_nClass_post_cpp_compiler.txt create mode 100644 nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass/multiCopierMV_nClass_preamble.cpp create mode 100644 nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base/multiCopier_modelValues_nC_base.h create mode 100644 nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base/multiCopier_model_nC_base.h diff --git a/nimbleModel/R/copier.R b/nimbleModel/R/copier.R index 90063b7..3548ca8 100644 --- a/nimbleModel/R/copier.R +++ b/nimbleModel/R/copier.R @@ -34,7 +34,7 @@ multiCopier_nClass <- nCompiler::nClass( }, compileInfo = list( C_fun = function(model = "nimbleModel:::modelBase_nClass()") { - cppLiteral("multiCopier_nC_base::init(this->copiers, model)") + cppLiteral("multiCopier_model_nC_base::init(this->copiers, model)") } ) ), @@ -73,7 +73,7 @@ multiCopier_nClass <- nCompiler::nClass( exportName = "multiCopier_nClass_new", needed_units = list("nCompiler:::nList(copier_nClass())", "modelBase_nClass()"), packageNames = c(uncompiled = "multiCopier_nClass_R", compiled = "multiCopier_nClass"), - nClass_inherit = list("multiCopier_nC_base"), + nClass_inherit = list("multiCopier_model_nC_base"), opDefs = list( getOrSetValues = list( labelAbstractTypes = list( @@ -89,13 +89,95 @@ multiCopier_getOrSetValues_LAT <- function(...) { } #' @export -makeMultiCopier <- function(model, nodes, ...) { +multiCopierMV_nClass <- nCompiler::nClass( + classname = "multiCopierMV_nClass", + Rpublic = list( + initialize = function(...) { + super$initialize(...) + self$copiers <- nList(copier_nClass())$new() + } + ), + Cpublic = list( + copiers = "nCompiler:::nList(copier_nClass())", + init = nFunction( + name = "init", + function(modelValues) { + cat("need uncompiled multiCopierMV init() implementation.") + }, + compileInfo = list( + C_fun = function(modelValues = "nimbleModel:::modelValuesBase_nClass()") { + cppLiteral("multiCopier_modelValues_nC_base::init(this->copiers, modelValues)") + } + ) + ), + # Selects which row of each variable's nList the flatViewGroup reads + # from/writes to. Must be called at least once, after the modelValues has + # been resized to have at least one row, before getValues/setValues/ + # nimCopy_ are used. See multiCopier_modelValues_nC_base::setActiveRow. + setActiveRow = nFunction( + name = "setActiveRow", + function(row) { + cat("need uncompiled multiCopierMV setActiveRow() implementation.") + }, + compileInfo = list( + C_fun = function(row) { + cppLiteral("multiCopier_modelValues_nC_base::setActiveRow(row)") + } + ), + argTypes = list(row = "integerScalar") + ), + getValues = nFunction( + name = "getValues", + function() { + cat("need uncompiled multiCopierMV getValues() implementation.") + }, + returnType = "numericVector", + compileInfo = list( + C_fun = function() { + cppLiteral("return flatViewGroup.copyIntoVector()") + } + ) + ), + # See the note on multiCopier_nClass$setValues above: kept for other + # contexts even though nimble2 keyword processing uses + # copiers->flatViewGroup.setValues_() directly. + setValues = nFunction( + name = "setValues", + function(v = "numericVector") { + cat("need uncompiled multiCopierMV setValues() implementation.") + }, + compileInfo = list( + C_fun = function(v = "numericVector") { + cppLiteral("flatViewGroup.copyFromVector(v)") + } + ) + ) + ), + predefined = quote(system.file(file.path("include", "nimbleModel", "predef"), package = "nimbleModel") |> file.path("multiCopierMV_nClass")), + compileInfo = list( + interface = "full", + createFromR = TRUE, + exportName = "multiCopierMV_nClass_new", + needed_units = list("nCompiler:::nList(copier_nClass())", "modelValuesBase_nClass()"), + packageNames = c(uncompiled = "multiCopierMV_nClass_R", compiled = "multiCopierMV_nClass"), + nClass_inherit = list("multiCopier_modelValues_nC_base") + ) +) + +#' @export +makeMultiCopier <- function(source, nodes, + sourceType = c("model", "modelValues"), ...) { # This will be called from a nimble2 keyword processor # The ... is to absorb further arguments that at the time of this writing are not fleshed out. if (is.character(nodes)) { nodes <- nodes |> lapply(\(x) nimbleModel:::varRangeClass$new(x)) } - multiCopier <- multiCopier_nClass$new() + sourceType <- match.arg(sourceType) + multiCopier <- + switch(sourceType, + model = multiCopier_nClass$new(), + modelValues = multiCopierMV_nClass$new() + ) getRange <- function(indexRange) { if (!inherits(indexRange, "indexRangeSequenceClass")) { stop("In a copy operation, only contiguous index blocks are supported") @@ -108,7 +190,12 @@ makeMultiCopier <- function(model, nodes, ...) { multiCopier$copiers[[i]]$varName <- thisNode$varName multiCopier$copiers[[i]]$indsList <- thisNode$indexRanges |> lapply(getRange) } - multiCopier |> structure(NCgenerator = quote(nimbleModel:::multiCopier_nClass)) + attr(multiCopier, "NCgenerator") <- + switch(sourceType, + model = quote(nimbleModel:::multiCopier_nClass), + modelValues = quote(nimbleModel:::multiCopierMV_nClass) + ) + multiCopier } #' @export diff --git a/nimbleModel/R/modelValues.R b/nimbleModel/R/modelValues.R index bc62d0e..4795d01 100644 --- a/nimbleModel/R/modelValues.R +++ b/nimbleModel/R/modelValues.R @@ -82,6 +82,7 @@ modelValues_resize <- function(self, m, sizeList) { # check preservation issues in resizing for (v in names(sizeList)) { this_sizeList <- sizeList[[v]] + if(length(this_sizeList) == 0) this_sizeList <- 1 length(self[[v]]) <- m if (length(this_sizeList) == 1) { for (i in 1:m) self[[v]][[i]] <- numeric(length = this_sizeList) @@ -121,7 +122,8 @@ make_modelValues_nClass <- function(varInfo, list(V = as.name(x$name), NL = as.name(nLname)) ) }) - resize_lines <- varInfo$vars |> + needs_resize <- varInfo$vars |> vapply(\(x) x$nDim > 0, logical(1)) + resize_lines <- varInfo$vars[needs_resize] |> lapply(\(x) { nDim <- x$nDim nLname <- paste0("nL", nDim, "D") @@ -235,7 +237,7 @@ make_modelValues_hashID <- function(varInfo) { #' @export modelValues <- function(varInfo, .ID = FALSE, env = parent.frame()) { if(inherits(varInfo, "modelBase_nClass")) { - varInfo <- get_varInfo_from_nimbleModel(varInfo) + varInfo <- get_varInfo_from_nimbleModel(varInfo$modelDef) } hashedID <- make_modelValues_hashID(varInfo) cpp_classname <- Rname2CppName(paste0("MV_", hashedID)) @@ -260,7 +262,7 @@ class(modelValues) <- c("function", "nClassBuilder") #' @method `[` modelValues `[.modelValues` <- function(x, var, ind) { if(x$isCompiled()) { - nCompiler::value(x, var)[[1]] + nCompiler::value(x, var)[[ind]] } else { x[[var]][[ind]] } diff --git a/nimbleModel/inst/generate_predefined.R b/nimbleModel/inst/generate_predefined.R index 24fd58f..c6a4407 100644 --- a/nimbleModel/inst/generate_predefined.R +++ b/nimbleModel/inst/generate_predefined.R @@ -25,13 +25,21 @@ test <- nCompile(nimbleModel:::modelBase_nClass) nCompile(copier_nClass = nimbleModel:::copier_nClass, control=list(generate_predefined=TRUE)) test <- nCompile(nimbleModel:::copier_nClass) -## # generate new predef/multiCopier_nC. Move to package and add -## # "#include " to the hContent before the class declaration +## # generate new predef/multiCopier_nClass. Move to package and add +## # "#include " to the hContent before the class declaration ## # And add "// [[Rcpp::depends(nimbleModel)]]" to the cppContent ## # after the declaration of copier_nClass. -## # Note there will be an expected set of errors when re-generating before the #include has been added. -nCompile(multiCopier_nClass = nimbleModel:::multiCopier_nClass, control=list(generate_predefined=TRUE)) -test <- nCompile(nimbleModel:::multiCopier_nClass) +## # Note there will be an EXPECTED SET OF ERRORS when re-generating before the #include has been added. +nCompiler::nCompile(multiCopier_nClass = nimbleModel:::multiCopier_nClass, control=list(generate_predefined=TRUE)) +test <- nCompiler::nCompile(nimbleModel:::multiCopier_nClass) + +## # generate new predef/multiCopierMV_nC. Move to package and add +## # "#include " to the hContent before the class declaration +## # And add "// [[Rcpp::depends(nimbleModel)]]" to the cppContent +## # after the declaration of copier_nClass. +## # Note there will be an EXPECTED SET OF ERRORS when re-generating before the #include has been added. +nCompiler::nCompile(multiCopierMV_nClass = nimbleModel:::multiCopierMV_nClass, control=list(generate_predefined=TRUE)) +test <- nCompiler::nCompile(nimbleModel:::multiCopierMV_nClass) ## # generate new predef/modelValuesBase_nC. Move to package and add ## # "#include " to the hContent diff --git a/nimbleModel/inst/include/nimbleModel/.DS_Store b/nimbleModel/inst/include/nimbleModel/.DS_Store index 3c2037735aeda0d14d70bd6ce1b98056acee7f99..252a5b58506cdf7c107c2a56cbd048b78e3e6dc5 100644 GIT binary patch delta 68 zcmZoMXffEJ&cwKVvIbM3ns{}!nURiysZp(tLbaipp#_j_U{+hp$sww&Zygk$os*lF X-#K|7lRRVB=6g&Utee?6{_+C=mM0Vh delta 67 zcmZoMXffEJ&cwKFvIbM3s#tZkfsTTOQLT +#include "multiCopierMV_nClass_c_.h" +using namespace Rcpp; +// [[Rcpp::plugins(nCompiler_Eigen_plugin)]] +// [[Rcpp::depends(RcppParallel)]] +// [[Rcpp::depends(nCompiler)]] +// [[Rcpp::depends(Rcereal)]] +// [[Rcpp::depends(nimbleModel)]] + + void multiCopierMV_nClass::init ( std::shared_ptr modelValues ) { +RESET_EIGEN_ERRORS +multiCopier_modelValues_nC_base::init(this->copiers, modelValues); +} + void multiCopierMV_nClass::setActiveRow ( int row ) { +RESET_EIGEN_ERRORS +multiCopier_modelValues_nC_base::setActiveRow(row); +} + Eigen::Tensor multiCopierMV_nClass::getValues ( ) { +RESET_EIGEN_ERRORS +return flatViewGroup.copyIntoVector(); +} + void multiCopierMV_nClass::setValues ( Eigen::Tensor v ) { +RESET_EIGEN_ERRORS +flatViewGroup.copyFromVector(v); +} + multiCopierMV_nClass::multiCopierMV_nClass ( ) { +RESET_EIGEN_ERRORS +} + +// [[Rcpp::export(name = "multiCopierMV_nClass_new")]] + SEXP new_multiCopierMV_nClass ( ) { +RESET_EIGEN_ERRORS +return CREATE_NEW_NCOMP_OBJECT(multiCopierMV_nClass);; +} + +// [[Rcpp::export(name = "set_CnClass_env_multiCopierMV_nClass_new")]] + void set_CnClass_env_multiCopierMV_nClass ( SEXP env ) { +RESET_EIGEN_ERRORS +SET_CNCLASS_ENV(multiCopierMV_nClass, env);; +} + +// [[Rcpp::export(name = "get_CnClass_env_multiCopierMV_nClass_new")]] + Rcpp::Environment get_CnClass_env_multiCopierMV_nClass ( ) { +RESET_EIGEN_ERRORS +return GET_CNCLASS_ENV(multiCopierMV_nClass);; +} + +NCOMPILER_INTERFACE( +multiCopierMV_nClass, +NCOMPILER_FIELDS( +field("copiers", &multiCopierMV_nClass::copiers) +), +NCOMPILER_METHODS( +method("init", &multiCopierMV_nClass::init, args({{arg("modelValues",copy)}})), +method("setActiveRow", &multiCopierMV_nClass::setActiveRow, args({{arg("row",copy)}})), +method("getValues", &multiCopierMV_nClass::getValues, args({{}})), +method("setValues", &multiCopierMV_nClass::setValues, args({{arg("v",copy)}})) +) +) +#endif diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass/multiCopierMV_nClass_filebase.txt b/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass/multiCopierMV_nClass_filebase.txt new file mode 100644 index 0000000..e9ce114 --- /dev/null +++ b/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass/multiCopierMV_nClass_filebase.txt @@ -0,0 +1 @@ +multiCopierMV_nClass_c_ diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass/multiCopierMV_nClass_hContent.h b/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass/multiCopierMV_nClass_hContent.h new file mode 100644 index 0000000..cd87ef3 --- /dev/null +++ b/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass/multiCopierMV_nClass_hContent.h @@ -0,0 +1,31 @@ +/* OPENER (Do not edit this comment) */ +#ifndef __multiCopierMV_nClass_H +#define __multiCopierMV_nClass_H +/* BODY (Do not edit this comment) */ +#ifndef R_NO_REMAP +#define R_NO_REMAP +#endif +#include +#include "nList_copier_nClass_c_.h" +#include "multiCopierMV_nClass_c_.h" +#include "modelValuesBase_nClass_c_.h" +#include +class multiCopierMV_nClass : public interface_resolver< genericInterfaceC, multiCopier_modelValues_nC_base >, public loadedObjectHookC { +public: + void init ( std::shared_ptr modelValues ) ; + void setActiveRow ( int row ) ; + Eigen::Tensor getValues ( ) ; + void setValues ( Eigen::Tensor v ) ; + multiCopierMV_nClass ( ) ; + std::shared_ptr copiers; + +}; + + SEXP new_multiCopierMV_nClass ( ) ; + + void set_CnClass_env_multiCopierMV_nClass ( SEXP env ) ; + + Rcpp::Environment get_CnClass_env_multiCopierMV_nClass ( ) ; + + +#endif diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass/multiCopierMV_nClass_manifest.txt b/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass/multiCopierMV_nClass_manifest.txt new file mode 100644 index 0000000..1efc875 --- /dev/null +++ b/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass/multiCopierMV_nClass_manifest.txt @@ -0,0 +1,7 @@ +list(saved_at = structure(1786643687.02694, class = c("POSIXct", +"POSIXt")), packet_name = "multiCopierMV_nClass", elements = c("preamble", +"cppContent", "hContent", "filebase", "post_cpp_compiler", "copyFiles" +), files = list(preamble = "multiCopierMV_nClass_preamble.cpp", + cppContent = "multiCopierMV_nClass_cppContent.cpp", hContent = "multiCopierMV_nClass_hContent.h", + filebase = "multiCopierMV_nClass_filebase.txt", post_cpp_compiler = "multiCopierMV_nClass_post_cpp_compiler.txt", + copyFiles = "multiCopierMV_nClass_copyFiles.txt")) diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass/multiCopierMV_nClass_post_cpp_compiler.txt b/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass/multiCopierMV_nClass_post_cpp_compiler.txt new file mode 100644 index 0000000..e69de29 diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass/multiCopierMV_nClass_preamble.cpp b/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass/multiCopierMV_nClass_preamble.cpp new file mode 100644 index 0000000..1a92ce3 --- /dev/null +++ b/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass/multiCopierMV_nClass_preamble.cpp @@ -0,0 +1,5 @@ +#define NCOMPILER_HANDLE_EIGEN_ERRORS +#define NCOMPILER_USES_EIGEN +#define NCOMPILER_USES_NCPPVEC +#define USES_NCOMPILER +#define NCOMPILER_USES_NCLASS_INTERFACE diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base/multiCopier_modelValues_nC_base.h b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base/multiCopier_modelValues_nC_base.h new file mode 100644 index 0000000..8e5a6b6 --- /dev/null +++ b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base/multiCopier_modelValues_nC_base.h @@ -0,0 +1,121 @@ +#ifndef __MULTICOPIER_MODELVALUES_NC_BASE +#define __MULTICOPIER_MODELVALUES_NC_BASE + +#include + +// modelValues-backed multiCopier setup: each copier's varName resolves to an +// nList (one element per row) rather than directly to a value, so getting an +// ETaccessorBase for a variable additionally requires picking a row via +// nListBase_nClass::access_at(row). setActiveRow(row) is how that row gets +// (re)selected, and it can be called repeatedly to retarget the same +// flatViewGroup at a different row without re-resolving variable names. +// +// Unlike the model-backed sibling class, the nList a variable currently +// resolves to cannot be cached across calls: modelValues variables are +// exposed to R via genericInterfaceC, and an R-level assignment onto a +// compiled-nList-typed field (accessor_class::set(), P_is_shared_ptr +// branch) reassigns the member outright rather than mutating it in place. +// A cached std::shared_ptr copy would not see that -- it +// would keep pointing at the old (now orphaned but still valid, since our +// copy owns a reference to it) nList, silently disconnected from whatever +// the field now holds. There is no safe way to hold a live "pointer to the +// member slot" through the type-erased genericInterfaceBaseC interface +// either (that would need a reinterpret_cast between unrelated shared_ptr +// instantiations). So instead, only the name -> accessor_base resolution is +// cached (fieldAccessors, resolved once in init()); the nList itself is +// re-derived from the live modelValues object via accessor_base:: +// getInterfacePtr() on every use (see resolveRowSource) -- no map lookup by +// name, but always a fresh read, so a reassignment is never missed. +class multiCopier_modelValues_nC_base : public multiCopier_nC_base { +public: + // One accessor per copier, parallel to (and in the same order as) the + // views held in flatViewGroup once built. This is the field's + // name-resolved accessor_base, NOT the nList it currently resolves to -- + // see the class comment above for why the nList itself must not be cached. + std::vector> fieldAccessors; + // Keeps modelValues itself alive (and is the intBasePtr argument to + // fieldAccessors[k]->getInterfacePtr()) for as long as fieldAccessors hold + // resolutions against it -- same reasoning as modelKeepAlive in + // multiCopier_model_nC_base. + std::shared_ptr modelValuesKeepAlive; + // Saved index-block selections, one per copier, needed to (re)build a view + // the first time a row is actually available (see setActiveRow). + std::vector> ssList; + // Whether flatViewGroup has been fully built (shape + data) yet. + bool built = false; + + // Resolves each copier's varName to its accessor_base, via modelValues's + // own (virtual) get_name2access(), so this works through a base + // modelValuesBase_nClass pointer -- no need for the caller to have the + // fully-derived generated modelValues type in hand. + // + // Deliberately does NOT touch flatViewGroup: at this point modelValues may + // have declared/initialized each nList but not yet resized it (a row count + // of 0 is possible), so there may be no row yet to read shape/data from. + // setActiveRow() must be called at least once, after rows exist, before + // flatViewGroup is used for anything (getValues/setValues/nimCopy_/etc.). + template + void init(std::shared_ptr copiers, + std::shared_ptr modelValues) { + flatViewGroup.clear(); + fieldAccessors.clear(); + ssList.clear(); + built = false; + modelValuesKeepAlive = modelValues; + const auto& name2access = modelValues->get_name2access(); + for (const auto& copier : copiers->contents()) { + auto it = name2access.find(copier->varName); + if (it == name2access.end()) + Rcpp::stop("multiCopier (modelValues): variable not found: " + copier->varName); + fieldAccessors.push_back(it->second); + ssList.push_back(vec_2_vecB__(copier->indsList->contents())); + } + } + + // Re-derives fieldAccessors[k]'s current nList from the live modelValues + // object -- see the class comment for why this must not be cached. + std::shared_ptr resolveRowSource(size_t k) { + std::shared_ptr ip = + fieldAccessors[k]->getInterfacePtr(modelValuesKeepAlive.get()); + std::shared_ptr nlPtr = + std::dynamic_pointer_cast(ip); + if (!nlPtr) + Rcpp::stop("multiCopier (modelValues): variable is not an nList."); + return nlPtr; + } + + // Rebinds every view to row `newRow`. The first call also builds each + // view's shape (from that row's accessor); every later call assumes all + // rows of a variable share that shape (an invariant of + // modelValuesClass_::resize_one, which always resizes every row to the + // same dims) and only swaps the data pointer. + void setActiveRow(int newRow) { + if (!built) { + flatViewGroup.clear(); + for (size_t k = 0; k < fieldAccessors.size(); ++k) { + auto acc = resolveRowSource(k)->access_at(newRow); + flatViewGroup.add(makeRuntimeFlatView(acc, ssList[k])); + } + built = true; + } else { + // TODO(perf): this is a hot path (called on every sampler iteration in + // MCMC). resolveRowSource()+access_at() each do a dynamic_cast plus + // access_at() builds a whole ETaccessorBase -- 2 heap allocations (the + // accessor object + its intDims_ vector, the latter never even read + // here) -- just to reach .data(). Once the shape is known (built == + // true), all we actually need is the raw pointer, re-derived fresh + // (both the current nList and the current row's data are still + // re-read every call, since either can change underneath us -- see the + // class comment). A lightweight nListBase_nClass::data_ptr_at(int i) + // (contents_.at(i).data(), no ETaccessorBase involved) would let this + // branch skip the ETaccessorBase allocation. Deferred until this shows + // up as a real bottleneck; see conversation for the sizing. + flatViewGroup.prepare_for_setData(); + for (size_t k = 0; k < fieldAccessors.size(); ++k) { + auto acc = resolveRowSource(k)->access_at(newRow); + flatViewGroup.setNextData(acc->template S().data()); + } + } + } +}; +#endif diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base/multiCopier_model_nC_base.h b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base/multiCopier_model_nC_base.h new file mode 100644 index 0000000..5851281 --- /dev/null +++ b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base/multiCopier_model_nC_base.h @@ -0,0 +1,55 @@ +#ifndef __MULTICOPIER_MODEL_NC_BASE +#define __MULTICOPIER_MODEL_NC_BASE + +#include + +// Model-backed multiCopier setup: each copier's varName resolves directly +// (via the model's own access()) to an ETaccessorBase for a live field, no +// intermediate row concept. +// +// A field's own storage (e.g. an Eigen::Tensor member) can be reallocated +// in place -- resize_from_list() in modelClass_.h calls +// ETA->template ref().resize(...), which reallocates that Tensor's +// internal buffer -- between the time this multiCopier is built and the +// time its flatViewGroup is next used. ETaccessorBase::data() re-derefs the +// live field on every call rather than caching a pointer at construction +// time, so holding onto the accessors (moved, not just read from once) and +// asking them again via setActiveRow is enough to track that: no need to +// go back through the (slow) name-based access() scheme. +class multiCopier_model_nC_base : public multiCopier_nC_base { +public: + // One accessor per copier, parallel to (and in the same order as) the + // views held in flatViewGroup. Moved (not copied) from model->access() so + // that S().data() can be re-read later to pick up any + // reallocation of the field's own storage. + std::vector> accessors; + // Keeps the model itself alive for as long as accessors hold references + // into its fields (ETaccessorBase binds a bare reference to the field, + // not an owning pointer to the model). + std::shared_ptr modelKeepAlive; + + template + void init(std::shared_ptr copiers, std::shared_ptr model) { + flatViewGroup.clear(); + accessors.clear(); + modelKeepAlive = model; + for (const auto& copier : copiers->contents()) { + auto acc = model->access(copier->varName); // acc will be std::unique_ptr + flatViewGroup.add(makeRuntimeFlatView(acc, + copier->indsList->contents())); + accessors.push_back(std::move(acc)); + } + } + + // Shadows multiCopier_nC_base's no-op. There is no "row" concept here -- + // `row` is ignored -- but nimCopy_ calls setActiveRow(row) unconditionally + // on both its src and dst, so this is the natural place to re-sync + // flatViewGroup's data pointers with any reallocation that may have + // happened to the model's fields since the last use. + void setActiveRow(int /*row*/) { + flatViewGroup.prepare_for_setData(); + for (auto& acc : accessors) + flatViewGroup.setNextData(acc->template S().data()); + } +}; +#endif diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base/multiCopier_nC_base.h b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base/multiCopier_nC_base.h index af37613..06efdff 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base/multiCopier_nC_base.h +++ b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base/multiCopier_nC_base.h @@ -1,21 +1,38 @@ #ifndef __MULTICOPIER_NC_BASE #define __MULTICOPIER_NC_BASE +// Common base for every multiCopier flavor (model-backed, modelValues-backed, +// ...). Holds the one piece of state every flavor needs -- a flattened view +// over the selected variables/index-ranges -- plus a `setActiveRow` hook so +// generic code (nimCopy_ below) can address a "current row" uniformly, even +// for backends, like a model, that have no notion of rows at all. +// +// Flavor-specific setup (`init`) lives in each flavor's own base class +// (e.g. multiCopier_model_nC_base, multiCopier_modelValues_nC_base) since the +// source object each flavor reads from differs in kind, not just in type. class multiCopier_nC_base { public: - int stuff; RuntimeFlatViewGroup flatViewGroup; - template - void init(std::shared_ptr multiCopier, std::shared_ptr model) { - flatViewGroup.clear(); - const auto& copiers = multiCopier->contents(); - for(const auto& copier : copiers) { - auto acc = model->access(copier->varName); // acc will be std::unique_ptr - flatViewGroup.add(makeRuntimeFlatView(acc, - copier->indsList->contents())); - } - std::cout<<"hw from init"< +void nimCopy_(const std::shared_ptr &src, int srcRow, + const std::shared_ptr &dst, int dstRow) { + src->setActiveRow(srcRow); + dst->setActiveRow(dstRow); + src->flatViewGroup.copyTo(dst->flatViewGroup); +} + #endif diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_cppContent.cpp b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_cppContent.cpp index 9bf465f..d9f952b 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_cppContent.cpp +++ b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_cppContent.cpp @@ -16,7 +16,7 @@ using namespace Rcpp; void multiCopier_nClass::init ( std::shared_ptr model ) { RESET_EIGEN_ERRORS -multiCopier_nC_base::init(this->copiers, model); +multiCopier_model_nC_base::init(this->copiers, model); } Eigen::Tensor multiCopier_nClass::getValues ( ) { RESET_EIGEN_ERRORS diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_hContent.h b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_hContent.h index 6c4bbc0..766d014 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_hContent.h +++ b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_hContent.h @@ -9,9 +9,9 @@ #include "nList_copier_nClass_c_.h" #include "multiCopier_nClass_c_.h" #include "modelBase_nClass_c_.h" -#include +#include -class multiCopier_nClass : public interface_resolver< genericInterfaceC, multiCopier_nC_base >, public loadedObjectHookC { +class multiCopier_nClass : public interface_resolver< genericInterfaceC, multiCopier_model_nC_base >, public loadedObjectHookC { public: void init ( std::shared_ptr model ) ; Eigen::Tensor getValues ( ) ; diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_manifest.txt b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_manifest.txt index e9df6d7..37bc49b 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_manifest.txt +++ b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_manifest.txt @@ -1,4 +1,4 @@ -list(saved_at = structure(1783726400.77224, class = c("POSIXct", +list(saved_at = structure(1786643399.92521, class = c("POSIXct", "POSIXt")), packet_name = "multiCopier_nClass", elements = c("preamble", "cppContent", "hContent", "filebase", "post_cpp_compiler", "copyFiles" ), files = list(preamble = "multiCopier_nClass_preamble.cpp", From 3a99b0fe24759f0b525efd67de99932ae55458ff Mon Sep 17 00:00:00 2001 From: perrydv Date: Tue, 18 Aug 2026 17:13:49 -0700 Subject: [PATCH 15/27] basic getParam works --- nimbleModel/R/declFunBaseClass.R | 125 ++++++++ nimbleModel/R/modelBaseClass.R | 50 ++- nimbleModel/R/nimbleModel.R | 60 +++- nimbleModel/inst/generate_predefined.R | 8 +- .../declFunBase_nClass_cppContent.cpp | 5 + .../declFunBase_nClass_hContent.h | 3 + .../declFunBase_nClass_manifest.txt | 2 +- .../predef/declFunClass_/declFunClass_.h | 292 ++++++++++++++---- .../modelBase_nClass_cppContent.cpp | 20 +- .../modelBase_nC/modelBase_nClass_hContent.h | 6 +- .../modelBase_nClass_manifest.txt | 2 +- .../predef/modelClass_/modelClass_.h | 6 + nimbleModel/tests/testthat/test-getParam.R | 21 ++ 13 files changed, 513 insertions(+), 87 deletions(-) create mode 100644 nimbleModel/tests/testthat/test-getParam.R diff --git a/nimbleModel/R/declFunBaseClass.R b/nimbleModel/R/declFunBaseClass.R index 5d641d9..bec5931 100644 --- a/nimbleModel/R/declFunBaseClass.R +++ b/nimbleModel/R/declFunBaseClass.R @@ -758,7 +758,117 @@ declFunBase_nClass <- nClass( } } } + }, + # getParam: use only the first entry in the instr. + getParam = function(instr, paramID) { + fi <- first_idx(instr) + if (fi$multiple) { + warning("getParam: instr covers more than one node; using the first node only.") } + getParam_one(fi$idx, paramID) + }, + first_idx = function(instr) { + multiple <- FALSE + idx <- switch(as.character(instr$type), + "0" = { + multiple <- FALSE + instr$lens + }, + "1" = , + "2" = { + multiple <- instr$lens[1] > 1 + instr$values[[1]][1] + }, + "3" = { + multiple <- instr$lens[1] > 1 + instr$values[[1]][1:instr$dims[1]] + }, + "18" = { + multiple <- instr$lens[1] > 1 + out <- rep(0L, instr$dims[1]) + out[instr$slots] <- instr$values[[1]][1:instr$dims[1]] + out + }, + "4" = , + "5" = , + "6" = , + "7" = { + multiple <- instr$lens[1] * instr$lens[2] > 1 + c(instr$values[[1]][1], instr$values[[2]][1]) + }, + "8" = { + multiple <- instr$lens[1] * instr$lens[2] > 1 + out <- rep(0L, instr$nDim) + out[instr$slots[1]] <- instr$values[[1]][1] + out[instr$slots[2:instr$nDim]] <- instr$values[[2]][1:instr$dims[2]] + out + }, + "9" = { + multiple <- instr$lens[1] * instr$lens[2] > 1 + out <- rep(0L, instr$nDim) + out[instr$slots[1:instr$dims[1]]] <- instr$values[[1]][1:instr$dims[1]] + out[instr$slots[instr$nDim]] <- instr$values[[2]][1] + out + }, + "10" = { + multiple <- instr$lens[1] * instr$lens[2] > 1 + out <- rep(0L, instr$nDim) + out[instr$slots[1:instr$dims[1]]] <- instr$values[[1]][1:instr$dims[1]] + out[instr$slots[(instr$dims[1] + 1):instr$nDim]] <- instr$values[[2]][1:instr$dims[2]] + out + }, + "11" = { + multiple <- instr$lens[1] * instr$lens[2] > 1 + # Hardcoded swap, matching calc_2_x_y_ord: idx[2] from range 1, idx[1] from range 2. + out <- rep(0L, 2) + out[2] <- instr$values[[1]][1] + out[1] <- instr$values[[2]][1] + out + }, + "12" = { + multiple <- instr$lens[1] * instr$lens[2] * instr$lens[3] > 1 + c(instr$values[[1]][1], instr$values[[2]][1], instr$values[[3]][1]) + }, + "13" = { + multiple <- instr$lens[1] * instr$lens[2] * instr$lens[3] > 1 + first_idx_generic(instr, 3) + }, + "14" = { + multiple <- prod(instr$lens[1:4]) > 1 + sapply(instr$values[1:4], `[`, 1) + }, + "15" = { + multiple <- prod(instr$lens[1:4]) > 1 + first_idx_generic(instr, 4) + }, + "16" = { + multiple <- prod(instr$lens[1:5]) > 1 + sapply(instr$values[1:5], `[`, 1) + }, + "17" = { + multiple <- prod(instr$lens[1:5]) > 1 + first_idx_generic(instr, 5) + }, + stop("getParam: unrecognized instr type ", instr$type) + ) + list(idx = idx, multiple = multiple) + }, + # Shared "generic" (slot-placed, mixed seq/matp per range) first-tuple logic + # for instr types 13, 15, 17, parameterized by the number of ranges `nRanges`. + first_idx_generic = function(instr, nRanges) { + idx <- rep(0L, instr$nDim) + offset <- 0 + for (r in 1:nRanges) { + if (instr$index_types[r] == 1) { + idx[instr$slots[offset + 1]] <- instr$values[[r]][1] + } else { + d <- instr$dims[r] + idx[instr$slots[(offset + 1):(offset + d)]] <- instr$values[[r]][1:d] + } + offset <- offset + instr$dims[r] + } + idx + } ), Cpublic = list( # model = 'modelBase_nClass', @@ -824,6 +934,20 @@ declFunBase_nClass <- nClass( cppLiteral('Rprintf("declFunBase_nClass virtual base simulate_cpp should never be called (something is wrong)\\n");') } ) + ), + getParam_cpp = nFunction( + name = "getParam_cpp", + function(instr, paramID) { + stop("Uncompiled version of getParam_cpp should not be called.") + }, + returnType = "ETaccessor()", + compileInfo = list( + virtual = TRUE, + C_fun = function(instr = "instr_nClass", paramID = "integerScalar") { + cppLiteral('Rprintf("declFunBase_nClass virtual base getParam_cpp should never be called (something is wrong)\\n");') + return(ETaccess(0, copy = TRUE)) + } + ) ) ), # We haven't dealt with ensuring a virtual destructor when any method is virtual @@ -834,6 +958,7 @@ declFunBase_nClass <- nClass( interface = "full", createFromR = FALSE, exportName = "declFunBase_nClass_new", + interfaceExclude = "getParam_cpp", needed_units = list("instr_nClass"), packageNames = c(uncompiled = "declFunBase_nClass_R", compiled = "declFunBase_nClass") ) diff --git a/nimbleModel/R/modelBaseClass.R b/nimbleModel/R/modelBaseClass.R index de21ed0..9a06856 100644 --- a/nimbleModel/R/modelBaseClass.R +++ b/nimbleModel/R/modelBaseClass.R @@ -391,12 +391,30 @@ modelBase_nClass <- nClass( } } return(invisible(NULL)) + }, + # `one_instr` is a single instr_nClass (not a list of them). + # Within it, one node will be used (see declFunBase_nClass$first_idx). + # `param` is an integer paramID or a character param name. + getParam = function(one_instr, param) { + if (!inherits(one_instr, "instr_nClass")) { + stop("getParam: argument `one_instr` must be an instr_nClass object") + } + if(is.numeric(param)) paramID <- param + else if(is.character(param)) { + paramID <- getParamID(self$modelDef$declInfo[[one_instr$declID]]$distributionName, + param) + if (is.na(paramID)) stop("getParam: argument `param` is not a valid parameter name for this node.") + } else { + stop("getParam: argument `param` must be an integer paramID or a character param name.") + } + if (isCompiled()) { + if (!one_instr$isCompiled()) one_instr <- makeCompiledInstr(one_instr) + return(self$getParam_impl(one_instr, paramID)) + } + declFunList[[one_instr$declID]]$getParam(one_instr, paramID) } ), Cpublic = list( - # TODO: using 'RcppObject' was resulting in a symbolTBD error - probably nCompiler issue 186. - #declFunList = "numericScalar", # 'RcppObject', # This won't actually be used in C++, but needs to be in Cpublic for accessibility. - #declFunNameToIndex = "RcppList", # Not sure what type this should be for use in C++. ping = nFunction( name = "ping", function() { @@ -414,6 +432,17 @@ modelBase_nClass <- nClass( }, returnType = "nList(instr_nClass)" ), + # Like `makeCompiledInstrList` but for a single instr_nClass (used by + # `getParam`, which takes one node rather than a list of them). + makeCompiledInstr = nFunction( + name = "makeCompiledInstr", + function(input = "SEXP") { + ans <- instr_nClass$new() + cppLiteral("ans->set_all_values(input);") + return(ans) + }, + returnType = "instr_nClass" + ), calculate_impl = nFunction( name = "calculate_impl", function(instrList) { @@ -476,6 +505,21 @@ modelBase_nClass <- nClass( }, virtual = TRUE ) + ), + getParam_impl = nFunction( + name = "getParam_impl", + function(node, paramID) { + cat("Uncompiled `getParam_impl` should never be called.\n") + return(NULL) + }, + # We must return a general object because it may have different nDim + returnType = "SEXP", + compileInfo = list( + C_fun = function(node = "instr_nClass", paramID = "integerScalar") { + cppLiteral('Rprintf("modelBase_nClass getParam_impl (should not see this)\\n"); return R_NilValue;') + }, + virtual = TRUE + ) ) ), # See comment above about needing to ensure a virtual destructor diff --git a/nimbleModel/R/nimbleModel.R b/nimbleModel/R/nimbleModel.R index 769df0c..48c1b10 100644 --- a/nimbleModel/R/nimbleModel.R +++ b/nimbleModel/R/nimbleModel.R @@ -83,7 +83,7 @@ make_modelClass_from_nimbleModel <- function(modelDef, data, inits, name = NULL) lapply(\(x) all.vars(body(x))) |> unlist() |> unique() |> - setdiff(c("idx", "LocalNewLogProb_", "LocalAns_", "model")) %||% character() + setdiff(c("idx", "paramID_", "LocalNewLogProb_", "LocalAns_", "model")) %||% character() declVarInfo <- modelVarInfo$vars[declVars] declID <- as.numeric(declInfo$declRule$ID) # Formerly `sourceLineNumber`, which may not be unique. declFun_membername <- declFunNames[i] @@ -207,7 +207,8 @@ make_declFun_nClass <- function(varInfo = list(), Cpublic = CPUBLIC, compileInfo = list( createFromR = FALSE, # Without a default constructor (which we've disabled here), createFromR is impossible - nClass_inherit = list(base = BASECLASS) + nClass_inherit = list(base = BASECLASS), + interfaceExclude = "getParam_one" ) # Ideally this line would be obtained from a base nClass, but we insert it directly for now ), list( @@ -589,6 +590,8 @@ make_decl_methods_from_declInfo <- function(declInfo) { ), list(DETERMCALC = make_determ_calc_line(LHSrep, RHSrep)) )) + # Dummy version of getParam_one: + getParamMethods <- list(getParam_one = make_getParam_one_nFxn()) } if (type == "stoch") { logProbExpr <- declInfo$genLogProbExpr() @@ -623,8 +626,59 @@ make_decl_methods_from_declInfo <- function(declInfo) { STOCHCALC_DIFF = make_stoch_calc_line(LHSrep, RHSrep, logProbExprRep, diff = TRUE) ) )) + getParamMethods <- make_getParam_methods(declInfo, LHSrep, RHSrep) } - methodList + c(methodList, getParamMethods) +} + +make_getParam_methods <- function(declInfo, LHSrep, RHSrep) { + distName <- declInfo$distributionName + reqdExprs <- if (length(RHSrep) > 1) as.list(RHSrep)[-1] else list() + if (length(reqdExprs) > 0) names(reqdExprs) <- names(RHSrep)[-1] + allParamExprs <- c(list(value = LHSrep), reqdExprs, declInfo$altParamExprs) + paramNames <- names(allParamExprs) + paramIDs <- as.integer(getParamID(distName, paramNames)) + sort_order <- order(paramIDs) + paramNames <- paramNames[sort_order] + paramIDs <- paramIDs[sort_order] + allParamExprs <- allParamExprs[sort_order] + nDims <- as.integer(getDimension(distName, paramNames)) + + getParamOne <- make_getParam_one_nFxn(paramIDs, allParamExprs, isRef, computeMethodNames) + list(getParam_one = getParamOne) +} + +make_getParam_one_nFxn <- function(paramIDs = integer(0), exprs = list(), + isRefFlags = logical(0), computeMethodNames = character(0)) { + if(!length(paramIDs)) { + fun <- function(idx, paramID_) { + return(ETaccess(0, copy=TRUE)) + } + } else { + case_lines <- lapply(exprs, + function(expr) { + # LocalAns_ is already filtered out of all.vars results + # to determine model variables, so use that name here too. + bquote(LocalAns_ <- ETaccess(.(expr), copy=TRUE)) + }) + + + switch_line <- bquote(nSwitch(paramID_, .(paramIDs))) + switch_line[3 + (1:(length(case_lines)))] <- case_lines + + fun <- bquote( + function(idx, paramID_) { + .(switch_line) + return(LocalAns_) + } + ) |> eval() + } + nFunction( + name = "getParam_one", + fun, + returnType = "ETaccessor()", + argTypes = list(idx = "integerVector", paramID_ = "integerScalar") + ) } #' @export diff --git a/nimbleModel/inst/generate_predefined.R b/nimbleModel/inst/generate_predefined.R index c6a4407..a87aec4 100644 --- a/nimbleModel/inst/generate_predefined.R +++ b/nimbleModel/inst/generate_predefined.R @@ -8,15 +8,15 @@ test <- nCompile(instr_nClass = nimbleModel:::instr_nClass) ## # "#include " in the hContent ## # And add "// [[Rcpp::depends(nimbleModel)]]" to the cppContent ## # after declaration of declFunBase_nClass -nCompile(nimbleModel:::declFunBase_nClass, control=list(generate_predefined=TRUE)) -test <- nCompile(nimbleModel:::declFunBase_nClass) +nCompiler::nCompile(nimbleModel:::declFunBase_nClass, control=list(generate_predefined=TRUE)) +test <- nCompiler::nCompile(nimbleModel:::declFunBase_nClass) ## # ## # generate new predef/modelBase_nC. Move to package and add ## # "#include " to the hContent ## # And add "// [[Rcpp::depends(nimbleModel)]]" to the cppContent ## # after the declaration of modelBase_nClass. -nCompile(modelBase_nClass = nimbleModel:::modelBase_nClass, control=list(generate_predefined=TRUE)) -test <- nCompile(nimbleModel:::modelBase_nClass) +nCompiler::nCompile(modelBase_nClass = nimbleModel:::modelBase_nClass, control=list(generate_predefined=TRUE)) +test <- nCompiler::nCompile(nimbleModel:::modelBase_nClass) ## # generate new predef/copier_nC. Move to package and add ## # "#include " to the hContent before the class declaration diff --git a/nimbleModel/inst/include/nimbleModel/predef/declFunBase_nC/declFunBase_nClass_cppContent.cpp b/nimbleModel/inst/include/nimbleModel/predef/declFunBase_nC/declFunBase_nClass_cppContent.cpp index fdc948f..95590f2 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/declFunBase_nC/declFunBase_nClass_cppContent.cpp +++ b/nimbleModel/inst/include/nimbleModel/predef/declFunBase_nC/declFunBase_nClass_cppContent.cpp @@ -36,6 +36,11 @@ return(0.0); void declFunBase_nClass::simulate_cpp ( std::shared_ptr instr ) { RESET_EIGEN_ERRORS Rprintf("declFunBase_nClass virtual base simulate_cpp should never be called (something is wrong)\n");; +} + std::unique_ptr declFunBase_nClass::getParam_cpp ( std::shared_ptr instr, int paramID ) { +RESET_EIGEN_ERRORS +Rprintf("declFunBase_nClass virtual base getParam_cpp should never be called (something is wrong)\n");; +return(ETaccessPtr(0.0)); } declFunBase_nClass::declFunBase_nClass ( ) { RESET_EIGEN_ERRORS diff --git a/nimbleModel/inst/include/nimbleModel/predef/declFunBase_nC/declFunBase_nClass_hContent.h b/nimbleModel/inst/include/nimbleModel/predef/declFunBase_nC/declFunBase_nClass_hContent.h index fe06f27..18c26e6 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/declFunBase_nC/declFunBase_nClass_hContent.h +++ b/nimbleModel/inst/include/nimbleModel/predef/declFunBase_nC/declFunBase_nClass_hContent.h @@ -6,6 +6,7 @@ #define R_NO_REMAP #endif #include +#include "declFunBase_nClass_c_.h" #include "instr_nClass_c_.h" class declFunBase_nClass : public interface_resolver< genericInterfaceC >, public loadedObjectHookC { @@ -15,7 +16,9 @@ class declFunBase_nClass : public interface_resolver< genericInterfaceC instr ) ; virtual double getLogProb_cpp ( std::shared_ptr instr ) ; virtual void simulate_cpp ( std::shared_ptr instr ) ; + virtual std::unique_ptr getParam_cpp ( std::shared_ptr instr, int paramID ) ; declFunBase_nClass ( ) ; + }; void set_CnClass_env_declFunBase_nClass ( SEXP env ) ; diff --git a/nimbleModel/inst/include/nimbleModel/predef/declFunBase_nC/declFunBase_nClass_manifest.txt b/nimbleModel/inst/include/nimbleModel/predef/declFunBase_nC/declFunBase_nClass_manifest.txt index 72394be..06d87e8 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/declFunBase_nC/declFunBase_nClass_manifest.txt +++ b/nimbleModel/inst/include/nimbleModel/predef/declFunBase_nC/declFunBase_nClass_manifest.txt @@ -1,4 +1,4 @@ -list(saved_at = structure(1780285145.92737, class = c("POSIXct", +list(saved_at = structure(1787098079.272, class = c("POSIXct", "POSIXt")), packet_name = "declFunBase_nClass", elements = c("preamble", "cppContent", "hContent", "filebase", "post_cpp_compiler", "copyFiles" ), files = list(preamble = "declFunBase_nClass_preamble.cpp", diff --git a/nimbleModel/inst/include/nimbleModel/predef/declFunClass_/declFunClass_.h b/nimbleModel/inst/include/nimbleModel/predef/declFunClass_/declFunClass_.h index e6527e9..694ff53 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/declFunClass_/declFunClass_.h +++ b/nimbleModel/inst/include/nimbleModel/predef/declFunClass_/declFunClass_.h @@ -55,7 +55,7 @@ class declFunClass_ : public declFunBase_nClass { if(len < 1) return(0); int iStart = instr->values->operator[](0)[0]; int iEnd = iStart + len; - Eigen::Tensor idx(1); + Eigen::Tensor idx(1); double logProb(0.); for(int i = iStart; i < iEnd; ++i) { idx[0] = i; @@ -72,7 +72,7 @@ class declFunClass_ : public declFunBase_nClass { Eigen::Tensor idx(1); double logProb(0.); for(int i = 0; i < len; ++i) { - idx[0] = vals[i]; + idx[0] = vals[i]; logProb += (static_cast(this)->*Method)(idx); } return(logProb); @@ -89,7 +89,7 @@ class declFunClass_ : public declFunBase_nClass { for(int i = 0; i < len; ++i) { for(int p = 0; p < nDim; ++p) idx[p] = vals[i*nDim+p]; - logProb += (static_cast(this)->*Method)(idx); + logProb += (static_cast(this)->*Method)(idx); } return(logProb); } @@ -107,8 +107,8 @@ class declFunClass_ : public declFunBase_nClass { double logProb(0.); for(int i = 0; i < len; ++i) { for(int p = 0; p < nDim; ++p) - idx[slots[p]] = vals[i*nDim+p]; - logProb += (static_cast(this)->*Method)(idx); + idx[slots[p]] = vals[i*nDim+p]; + logProb += (static_cast(this)->*Method)(idx); } return(logProb); } @@ -128,7 +128,7 @@ class declFunClass_ : public declFunBase_nClass { idx[0] = i; for(int j = iStart2; j < iEnd2; ++j) { idx[1] = j; - logProb += (static_cast(this)->*Method)(idx); + logProb += (static_cast(this)->*Method)(idx); } } return(logProb); @@ -149,7 +149,7 @@ class declFunClass_ : public declFunBase_nClass { idx[0] = i; for(int j = 0; j < len2; ++j) { idx[1] = vals2[j]; - logProb += (static_cast(this)->*Method)(idx); + logProb += (static_cast(this)->*Method)(idx); } } return(logProb); @@ -170,7 +170,7 @@ class declFunClass_ : public declFunBase_nClass { idx[0] = vals1[i]; for(int j = iStart2; j < iEnd2; ++j) { idx[1] = j; - logProb += (static_cast(this)->*Method)(idx); + logProb += (static_cast(this)->*Method)(idx); } } return(logProb); @@ -191,7 +191,7 @@ class declFunClass_ : public declFunBase_nClass { idx[0] = vals1[i]; for(int j = 0; j < len2; ++j) { idx[1] = vals2[j]; - logProb += (static_cast(this)->*Method)(idx); + logProb += (static_cast(this)->*Method)(idx); } } return(logProb); @@ -219,8 +219,8 @@ class declFunClass_ : public declFunBase_nClass { idx[slots[0]] = i; for(int j = 0; j < len2; ++j) { for(int p = 0; p < dim2; ++p) - idx[slots[p+1]] = vals2[j*dim2+p]; - logProb += (static_cast(this)->*Method)(idx); + idx[slots[p+1]] = vals2[j*dim2+p]; + logProb += (static_cast(this)->*Method)(idx); } } return(logProb); @@ -247,7 +247,7 @@ class declFunClass_ : public declFunBase_nClass { idx[slots[p]] = vals1[i*dim1+p]; for(int j = iStart2; j < iEnd2; ++j) { idx[slots[dim1]] = j; - logProb += (static_cast(this)->*Method)(idx); + logProb += (static_cast(this)->*Method)(idx); } } return(logProb); @@ -272,11 +272,11 @@ class declFunClass_ : public declFunBase_nClass { double logProb(0.); for(int i = 0; i < len1; ++i) { for(int p = 0; p < dim1; ++p) - idx[slots[p]] = vals1[i*dim1+p]; + idx[slots[p]] = vals1[i*dim1+p]; for(int j = 0; j < len2; ++j) { for(int p = 0; p < dim2; ++p) - idx[slots[p+dim1]] = vals2[j*dim2+p]; - logProb += (static_cast(this)->*Method)(idx); + idx[slots[p+dim1]] = vals2[j*dim2+p]; + logProb += (static_cast(this)->*Method)(idx); } } return(logProb); @@ -308,12 +308,12 @@ class declFunClass_ : public declFunBase_nClass { for(int i = 0; i < len1; ++i) { if(index_type1 == 1) { idx[1] = iStart1 + i; - } else idx[1] = vals1[i]; + } else idx[1] = vals1[i]; for(int j = 0; j < len2; ++j) { if(index_type2 == 1) { idx[0] = iStart2 + j; } else idx[0] = vals2[j]; - logProb += (static_cast(this)->*Method)(idx); + logProb += (static_cast(this)->*Method)(idx); } } return(logProb); @@ -340,7 +340,7 @@ class declFunClass_ : public declFunBase_nClass { idx[1] = j; for(int k = iStart3; k < iEnd3; ++k) { idx[2] = k; - logProb += (static_cast(this)->*Method)(idx); + logProb += (static_cast(this)->*Method)(idx); } } } @@ -380,22 +380,22 @@ class declFunClass_ : public declFunBase_nClass { for(int i = 0; i < len1; ++i) { if(index_type1 == 1) { idx[slots[0]] = iStart1 + i; - } else + } else for(int p = 0; p < dim1; ++p) - idx[slots[p]] = vals1[i*dim1+p]; + idx[slots[p]] = vals1[i*dim1+p]; for(int j = 0; j < len2; ++j) { if(index_type2 == 1) { idx[slots[dim1]] = iStart2 + j; - } else + } else for(int p = 0; p < dim2; ++p) idx[slots[p+dim1]] = vals2[j*dim2+p]; for(int k = 0; k < len3; ++k) { if(index_type3 == 1) { idx[slots[cumdim2]] = iStart3 + k; - } else + } else for(int p = 0; p < dim3; ++p) idx[slots[p+cumdim2]] = vals3[k*dim3+p]; - logProb += (static_cast(this)->*Method)(idx); + logProb += (static_cast(this)->*Method)(idx); } } } @@ -459,34 +459,34 @@ class declFunClass_ : public declFunBase_nClass { if(index_types[1] == 2 && lens[1]*dims[1] != vals1.size()) std::cout<<"lens[1]*dims[1] != vals1.size() in calc_4_generic_"< idx(nDim); double logProb(0.); for(int i0 = 0; i0 < lens[0]; ++i0) { if(index_types[0] == 1) { idx[slots[0]] = iStart[0] + i0; - } else + } else for(int p = 0; p < dims[0]; ++p) - idx[slots[p]] = vals0[i0*dims[0]+p]; + idx[slots[p]] = vals0[i0*dims[0]+p]; for(int i1 = 0; i1 < lens[1]; ++i1) { if(index_types[1] == 1) { idx[slots[dims[0]]] = iStart[1] + i1; - } else + } else for(int p = 0; p < dims[1]; ++p) idx[slots[p+dims[0]]] = vals1[i1*dims[1]+p]; for(int i2 = 0; i2 < lens[2]; ++i2) { if(index_types[2] == 1) { idx[slots[cumdim1]] = iStart[2] + i2; - } else + } else for(int p = 0; p < dims[2]; ++p) idx[slots[p+cumdim1]] = vals2[i2*dims[2]+p]; for(int i3 = 0; i3 < lens[3]; ++i3) { if(index_types[3] == 1) { idx[slots[cumdim2]] = iStart[3] + i3; - } else + } else for(int p = 0; p < dims[3]; ++p) idx[slots[p+cumdim2]] = vals3[i3*dims[3]+p]; - logProb += (static_cast(this)->*Method)(idx); + logProb += (static_cast(this)->*Method)(idx); } } } @@ -557,40 +557,40 @@ class declFunClass_ : public declFunBase_nClass { if(index_types[2] == 2 && lens[2]*dims[2] != vals2.size()) std::cout<<"lens[2]*dims[2] != vals2.size() in calc_5_generic_"< idx(nDim); double logProb(0.); for(int i0 = 0; i0 < lens[0]; ++i0) { if(index_types[0] == 1) { idx[slots[0]] = iStart[0] + i0; - } else + } else for(int p = 0; p < dims[0]; ++p) - idx[slots[p]] = vals0[i0*dims[0]+p]; + idx[slots[p]] = vals0[i0*dims[0]+p]; for(int i1 = 0; i1 < lens[1]; ++i1) { if(index_types[1] == 1) { idx[slots[dims[0]]] = iStart[1] + i1; - } else + } else for(int p = 0; p < dims[1]; ++p) idx[slots[p+dims[0]]] = vals1[i1*dims[1]+p]; for(int i2 = 0; i2 < lens[2]; ++i2) { if(index_types[2] == 1) { idx[slots[cumdim1]] = iStart[2] + i2; - } else + } else for(int p = 0; p < dims[2]; ++p) idx[slots[p+cumdim1]] = vals2[i2*dims[2]+p]; for(int i3 = 0; i3 < lens[3]; ++i3) { if(index_types[3] == 1) { idx[slots[cumdim2]] = iStart[3] + i3; - } else + } else for(int p = 0; p < dims[3]; ++p) idx[slots[p+cumdim2]] = vals3[i3*dims[3]+p]; for(int i4 = 0; i4 < lens[4]; ++i4) { if(index_types[4] == 1) { idx[slots[cumdim3]] = iStart[4] + i4; - } else + } else for(int p = 0; p < dims[4]; ++p) idx[slots[p+cumdim3]] = vals4[i4*dims[4]+p]; - logProb += (static_cast(this)->*Method)(idx); + logProb += (static_cast(this)->*Method)(idx); } } } @@ -598,7 +598,163 @@ class declFunClass_ : public declFunBase_nClass { } return(logProb); } - + + // getParam + // + // This is a bit simpler because we only need the first index. + // Unpacks the first node from `instr`, warns (does not error) if `instr` + // actually represents more than one node, and dispatches to the + // per-distribution generated `getParam_one(idx, paramID)`. + std::unique_ptr getParam_cpp(std::shared_ptr instr, int paramID) override { + RESET_EIGEN_ERRORS; + bool multiple = false; + Eigen::Tensor idx = first_idx_(instr, multiple); + if (multiple) { + Rcpp::warning("getParam: instr covers more than one node; using the first node only."); + } + return static_cast(this)->getParam_one(idx, paramID); + } + + Eigen::Tensor first_idx_(std::shared_ptr instr, bool &multiple) { + int nDim = instr->nDim; + switch (instr->type) { + case 0: { + // Dummy/unindexed node: `calc_0_` passes `instr->lens` through as a + // placeholder idx that generated code for an unindexed decl ignores. + multiple = false; + return instr->lens; + } + case 1: case 2: { // 1_seq, 1_mat: single scalar index. + multiple = instr->lens[0] > 1; + Eigen::Tensor idx(1); + idx[0] = instr->values->operator[](0)[0]; + return idx; + } + case 3: { // 1_matp: single range, nDim components, no slot reordering. + multiple = instr->lens[0] > 1; + Eigen::Tensor idx(nDim); + const auto& vals = instr->values->operator[](0); + for (int p = 0; p < nDim; ++p) idx[p] = vals[p]; + return idx; + } + case 18: { // 1_matp_ord: single range, nDim components, slot-placed. + multiple = instr->lens[0] > 1; + Eigen::Tensor idx(nDim); + Eigen::Tensor slots(nDim); + for (int p = 0; p < nDim; ++p) slots[p] = instr->slots[p] - 1; + const auto& vals = instr->values->operator[](0); + for (int p = 0; p < nDim; ++p) idx[slots[p]] = vals[p]; + return idx; + } + case 4: case 5: case 6: case 7: { // 2_{seq,mat}_{seq,mat}: two scalar indices, no slots. + multiple = (instr->lens[0] * instr->lens[1]) > 1; + Eigen::Tensor idx(2); + idx[0] = instr->values->operator[](0)[0]; + idx[1] = instr->values->operator[](1)[0]; + return idx; + } + case 8: { // 2_seq_matp: range0 is a single seq slot; range1 is dims[1] components. + multiple = (instr->lens[0] * instr->lens[1]) > 1; + int dim2 = instr->dims[1]; + Eigen::Tensor idx(nDim); + Eigen::Tensor slots(nDim); + for (int p = 0; p < nDim; ++p) slots[p] = instr->slots[p] - 1; + idx[slots[0]] = instr->values->operator[](0)[0]; + const auto& vals2 = instr->values->operator[](1); + for (int p = 0; p < dim2; ++p) idx[slots[p + 1]] = vals2[p]; + return idx; + } + case 9: { // 2_matp_seq: range0 is dims[0] components; range1 is a single seq slot. + multiple = (instr->lens[0] * instr->lens[1]) > 1; + int dim1 = instr->dims[0]; + Eigen::Tensor idx(nDim); + Eigen::Tensor slots(nDim); + for (int p = 0; p < nDim; ++p) slots[p] = instr->slots[p] - 1; + const auto& vals1 = instr->values->operator[](0); + for (int p = 0; p < dim1; ++p) idx[slots[p]] = vals1[p]; + idx[slots[dim1]] = instr->values->operator[](1)[0]; + return idx; + } + case 10: { // 2_matp_matp: both ranges are multi-component, slot-placed. + multiple = (instr->lens[0] * instr->lens[1]) > 1; + int dim1 = instr->dims[0]; + int dim2 = instr->dims[1]; + Eigen::Tensor idx(nDim); + Eigen::Tensor slots(nDim); + for (int p = 0; p < nDim; ++p) slots[p] = instr->slots[p] - 1; + const auto& vals1 = instr->values->operator[](0); + const auto& vals2 = instr->values->operator[](1); + for (int p = 0; p < dim1; ++p) idx[slots[p]] = vals1[p]; + for (int p = 0; p < dim2; ++p) idx[slots[p + dim1]] = vals2[p]; + return idx; + } + case 11: { // 2_x_y_ord: hardcoded swap (idx[1] from range0, idx[0] from range1). + // At the first tuple, iStart == values[p][0] regardless of index_type, + // so no need to branch on index_types here. + multiple = (instr->lens[0] * instr->lens[1]) > 1; + Eigen::Tensor idx(2); + idx[1] = instr->values->operator[](0)[0]; + idx[0] = instr->values->operator[](1)[0]; + return idx; + } + case 12: { // 3_allseq: three scalar indices, no slots. + multiple = (instr->lens[0] * instr->lens[1] * instr->lens[2]) > 1; + Eigen::Tensor idx(3); + for (int r = 0; r < 3; ++r) idx[r] = instr->values->operator[](r)[0]; + return idx; + } + case 13: { // 3_generic: slot-placed, each range either 1 (seq) or dims[r] components. + multiple = (instr->lens[0] * instr->lens[1] * instr->lens[2]) > 1; + return first_idx_generic_(instr, 3, multiple); + } + case 14: { // 4_allseq: four scalar indices, no slots. + multiple = (instr->lens[0] * instr->lens[1] * instr->lens[2] * instr->lens[3]) > 1; + Eigen::Tensor idx(4); + for (int r = 0; r < 4; ++r) idx[r] = instr->values->operator[](r)[0]; + return idx; + } + case 15: { // 4_generic + multiple = (instr->lens[0] * instr->lens[1] * instr->lens[2] * instr->lens[3]) > 1; + return first_idx_generic_(instr, 4, multiple); + } + case 16: { // 5_allseq: five scalar indices, no slots. + multiple = (instr->lens[0] * instr->lens[1] * instr->lens[2] * instr->lens[3] * instr->lens[4]) > 1; + Eigen::Tensor idx(5); + for (int r = 0; r < 5; ++r) idx[r] = instr->values->operator[](r)[0]; + return idx; + } + case 17: { // 5_generic + multiple = (instr->lens[0] * instr->lens[1] * instr->lens[2] * instr->lens[3] * instr->lens[4]) > 1; + return first_idx_generic_(instr, 5, multiple); + } + default: + Rcpp::stop("getParam: unrecognized instr type."); + } + return instr->lens; // unreachable; keeps compiler happy. + } + + // Shared "generic" (slot-placed, mixed seq/matp per range) first-tuple logic + // for instr types 13, 15, 17, parameterized by the number of ranges `nRanges`. + // Mirrors calc_3_generic_/calc_4_generic_/calc_5_generic_ at their first + // (i=j=k=...=0) iteration. + Eigen::Tensor first_idx_generic_(std::shared_ptr instr, int nRanges, bool &multiple) { + int nDim = instr->nDim; + Eigen::Tensor idx(nDim); + Eigen::Tensor slots(nDim); + for (int p = 0; p < nDim; ++p) slots[p] = instr->slots[p] - 1; + int offset = 0; + for (int r = 0; r < nRanges; ++r) { + const auto& vals = instr->values->operator[](r); + if (instr->index_types[r] == 1) { + idx[slots[offset]] = vals[0]; + } else { + for (int p = 0; p < instr->dims[r]; ++p) idx[slots[offset + p]] = vals[p]; + } + offset += instr->dims[r]; + } + return idx; + } + // simulate void simulate_cpp ( std::shared_ptr instr ) { RESET_EIGEN_ERRORS; @@ -771,8 +927,8 @@ class declFunClass_ : public declFunBase_nClass { idx[slots[0]] = i; for(int j = 0; j < len2; ++j) { for(int p = 0; p < dim2; ++p) - idx[slots[p+1]] = vals2[j*dim2+p]; - static_cast(this)->sim_one(idx); + idx[slots[p+1]] = vals2[j*dim2+p]; + static_cast(this)->sim_one(idx); } } } @@ -796,7 +952,7 @@ class declFunClass_ : public declFunBase_nClass { idx[slots[p]] = vals1[i*dim1+p]; for(int j = iStart2; j < iEnd2; ++j) { idx[slots[dim1]] = j; - static_cast(this)->sim_one(idx); + static_cast(this)->sim_one(idx); } } } @@ -818,11 +974,11 @@ class declFunClass_ : public declFunBase_nClass { slots[p] = instr->slots[p]-1; for(int i = 0; i < len1; ++i) { for(int p = 0; p < dim1; ++p) - idx[slots[p]] = vals1[i*dim1+p]; + idx[slots[p]] = vals1[i*dim1+p]; for(int j = 0; j < len2; ++j) { for(int p = 0; p < dim2; ++p) - idx[slots[p+dim1]] = vals2[j*dim2+p]; - static_cast(this)->sim_one(idx); + idx[slots[p+dim1]] = vals2[j*dim2+p]; + static_cast(this)->sim_one(idx); } } } @@ -851,12 +1007,12 @@ class declFunClass_ : public declFunBase_nClass { for(int i = 0; i < len1; ++i) { if(index_type1 == 1) { idx[1] = iStart1 + i; - } else idx[1] = vals1[i]; + } else idx[1] = vals1[i]; for(int j = 0; j < len2; ++j) { if(index_type2 == 1) { idx[0] = iStart2 + j; } else idx[0] = vals2[j]; - static_cast(this)->sim_one(idx); + static_cast(this)->sim_one(idx); } } } @@ -880,7 +1036,7 @@ class declFunClass_ : public declFunBase_nClass { idx[1] = j; for(int k = iStart3; k < iEnd3; ++k) { idx[2] = k; - static_cast(this)->sim_one(idx); + static_cast(this)->sim_one(idx); } } } @@ -917,22 +1073,22 @@ class declFunClass_ : public declFunBase_nClass { for(int i = 0; i < len1; ++i) { if(index_type1 == 1) { idx[slots[0]] = iStart1 + i; - } else + } else for(int p = 0; p < dim1; ++p) - idx[slots[p]] = vals1[i*dim1+p]; + idx[slots[p]] = vals1[i*dim1+p]; for(int j = 0; j < len2; ++j) { if(index_type2 == 1) { idx[slots[dim1]] = iStart2 + j; - } else + } else for(int p = 0; p < dim2; ++p) idx[slots[p+dim1]] = vals2[j*dim2+p]; for(int k = 0; k < len3; ++k) { if(index_type3 == 1) { idx[slots[cumdim2]] = iStart3 + k; - } else + } else for(int p = 0; p < dim3; ++p) idx[slots[p+cumdim2]] = vals3[k*dim3+p]; - static_cast(this)->sim_one(idx); + static_cast(this)->sim_one(idx); } } } @@ -991,33 +1147,33 @@ class declFunClass_ : public declFunBase_nClass { if(index_types[1] == 2 && lens[1]*dims[1] != vals1.size()) std::cout<<"lens[1]*dims[1] != vals1.size() in sim_4_generic_"< idx(nDim); for(int i0 = 0; i0 < lens[0]; ++i0) { if(index_types[0] == 1) { idx[slots[0]] = iStart[0] + i0; - } else + } else for(int p = 0; p < dims[0]; ++p) - idx[slots[p]] = vals0[i0*dims[0]+p]; + idx[slots[p]] = vals0[i0*dims[0]+p]; for(int i1 = 0; i1 < lens[1]; ++i1) { if(index_types[1] == 1) { idx[slots[dims[0]]] = iStart[1] + i1; - } else + } else for(int p = 0; p < dims[1]; ++p) idx[slots[p+dims[0]]] = vals1[i1*dims[1]+p]; for(int i2 = 0; i2 < lens[2]; ++i2) { if(index_types[2] == 1) { idx[slots[cumdim1]] = iStart[2] + i2; - } else + } else for(int p = 0; p < dims[2]; ++p) idx[slots[p+cumdim1]] = vals2[i2*dims[2]+p]; for(int i3 = 0; i3 < lens[3]; ++i3) { if(index_types[3] == 1) { idx[slots[cumdim2]] = iStart[3] + i3; - } else + } else for(int p = 0; p < dims[3]; ++p) idx[slots[p+cumdim2]] = vals3[i3*dims[3]+p]; - static_cast(this)->sim_one(idx); + static_cast(this)->sim_one(idx); } } } @@ -1083,39 +1239,39 @@ class declFunClass_ : public declFunBase_nClass { if(index_types[2] == 2 && lens[2]*dims[2] != vals2.size()) std::cout<<"lens[2]*dims[2] != vals2.size() in sim_5_generic_"< idx(nDim); for(int i0 = 0; i0 < lens[0]; ++i0) { if(index_types[0] == 1) { idx[slots[0]] = iStart[0] + i0; - } else + } else for(int p = 0; p < dims[0]; ++p) - idx[slots[p]] = vals0[i0*dims[0]+p]; + idx[slots[p]] = vals0[i0*dims[0]+p]; for(int i1 = 0; i1 < lens[1]; ++i1) { if(index_types[1] == 1) { idx[slots[dims[0]]] = iStart[1] + i1; - } else + } else for(int p = 0; p < dims[1]; ++p) idx[slots[p+dims[0]]] = vals1[i1*dims[1]+p]; for(int i2 = 0; i2 < lens[2]; ++i2) { if(index_types[2] == 1) { idx[slots[cumdim1]] = iStart[2] + i2; - } else + } else for(int p = 0; p < dims[2]; ++p) idx[slots[p+cumdim1]] = vals2[i2*dims[2]+p]; for(int i3 = 0; i3 < lens[3]; ++i3) { if(index_types[3] == 1) { idx[slots[cumdim2]] = iStart[3] + i3; - } else + } else for(int p = 0; p < dims[3]; ++p) idx[slots[p+cumdim2]] = vals3[i3*dims[3]+p]; for(int i4 = 0; i4 < lens[4]; ++i4) { if(index_types[4] == 1) { idx[slots[cumdim3]] = iStart[4] + i4; - } else + } else for(int p = 0; p < dims[4]; ++p) idx[slots[p+cumdim3]] = vals4[i4*dims[4]+p]; - static_cast(this)->sim_one(idx); + static_cast(this)->sim_one(idx); } } } diff --git a/nimbleModel/inst/include/nimbleModel/predef/modelBase_nC/modelBase_nClass_cppContent.cpp b/nimbleModel/inst/include/nimbleModel/predef/modelBase_nC/modelBase_nClass_cppContent.cpp index d545f78..2393a0c 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/modelBase_nC/modelBase_nClass_cppContent.cpp +++ b/nimbleModel/inst/include/nimbleModel/predef/modelBase_nC/modelBase_nClass_cppContent.cpp @@ -24,6 +24,13 @@ std::shared_ptr ans; ans = nClass_builder()(); ans->set_all_values(input);; return(ans); +} + std::shared_ptr modelBase_nClass::makeCompiledInstr ( SEXP input ) { +RESET_EIGEN_ERRORS +std::shared_ptr ans; +ans = nClass_builder()(); +ans->set_all_values(input);; +return(ans); } double modelBase_nClass::calculate_impl ( std::shared_ptr instrList ) { RESET_EIGEN_ERRORS @@ -43,6 +50,10 @@ return(0.0); void modelBase_nClass::simulate_impl ( std::shared_ptr instrList ) { RESET_EIGEN_ERRORS Rprintf("modelBase_nClass simulate_impl (should not see this)\n");; +} + SEXP modelBase_nClass::getParam_impl ( std::shared_ptr node, int paramID ) { +RESET_EIGEN_ERRORS +Rprintf("modelBase_nClass getParam_impl (should not see this)\n"); return R_NilValue;; } modelBase_nClass::modelBase_nClass ( ) { RESET_EIGEN_ERRORS @@ -62,17 +73,16 @@ return GET_CNCLASS_ENV(modelBase_nClass);; NCOMPILER_INTERFACE( modelBase_nClass, -NCOMPILER_FIELDS( -field("declFunList", &modelBase_nClass::declFunList), -field("declFunNameToIndex", &modelBase_nClass::declFunNameToIndex) -), +NCOMPILER_FIELDS(), NCOMPILER_METHODS( method("ping", &modelBase_nClass::ping, args({{}})), method("makeCompiledInstrList", &modelBase_nClass::makeCompiledInstrList, args({{arg("input",copy)}})), +method("makeCompiledInstr", &modelBase_nClass::makeCompiledInstr, args({{arg("input",copy)}})), method("calculate_impl", &modelBase_nClass::calculate_impl, args({{arg("instrList",copy)}})), method("calculateDiff_impl", &modelBase_nClass::calculateDiff_impl, args({{arg("instrList",copy)}})), method("getLogProb_impl", &modelBase_nClass::getLogProb_impl, args({{arg("instrList",copy)}})), -method("simulate_impl", &modelBase_nClass::simulate_impl, args({{arg("instrList",copy)}})) +method("simulate_impl", &modelBase_nClass::simulate_impl, args({{arg("instrList",copy)}})), +method("getParam_impl", &modelBase_nClass::getParam_impl, args({{arg("node",copy)},{arg("paramID",copy)}})) ) ) #endif diff --git a/nimbleModel/inst/include/nimbleModel/predef/modelBase_nC/modelBase_nClass_hContent.h b/nimbleModel/inst/include/nimbleModel/predef/modelBase_nC/modelBase_nClass_hContent.h index 6422f2a..eaa50bf 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/modelBase_nC/modelBase_nClass_hContent.h +++ b/nimbleModel/inst/include/nimbleModel/predef/modelBase_nC/modelBase_nClass_hContent.h @@ -6,6 +6,7 @@ #define R_NO_REMAP #endif #include +#include "modelBase_nClass_c_.h" #include "declFunBase_nClass_c_.h" #include "instr_nClass_c_.h" #include "nList_instr_nClass_c_.h" @@ -14,13 +15,14 @@ class modelBase_nClass : public interface_resolver< genericInterfaceC makeCompiledInstrList ( SEXP input ) ; + std::shared_ptr makeCompiledInstr ( SEXP input ) ; virtual double calculate_impl ( std::shared_ptr instrList ) ; virtual double calculateDiff_impl ( std::shared_ptr instrList ) ; virtual double getLogProb_impl ( std::shared_ptr instrList ) ; virtual void simulate_impl ( std::shared_ptr instrList ) ; + virtual SEXP getParam_impl ( std::shared_ptr node, int paramID ) ; modelBase_nClass ( ) ; - double declFunList; - Rcpp::List declFunNameToIndex; + }; void set_CnClass_env_modelBase_nClass ( SEXP env ) ; diff --git a/nimbleModel/inst/include/nimbleModel/predef/modelBase_nC/modelBase_nClass_manifest.txt b/nimbleModel/inst/include/nimbleModel/predef/modelBase_nC/modelBase_nClass_manifest.txt index 01c4ca6..6339b8a 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/modelBase_nC/modelBase_nClass_manifest.txt +++ b/nimbleModel/inst/include/nimbleModel/predef/modelBase_nC/modelBase_nClass_manifest.txt @@ -1,4 +1,4 @@ -list(saved_at = structure(1780285516.41106, class = c("POSIXct", +list(saved_at = structure(1787098119.31298, class = c("POSIXct", "POSIXt")), packet_name = "modelBase_nClass", elements = c("preamble", "cppContent", "hContent", "filebase", "post_cpp_compiler", "copyFiles" ), files = list(preamble = "modelBase_nClass_preamble.cpp", cppContent = "modelBase_nClass_cppContent.cpp", diff --git a/nimbleModel/inst/include/nimbleModel/predef/modelClass_/modelClass_.h b/nimbleModel/inst/include/nimbleModel/predef/modelClass_/modelClass_.h index 04db667..b4a8a87 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/modelClass_/modelClass_.h +++ b/nimbleModel/inst/include/nimbleModel/predef/modelClass_/modelClass_.h @@ -35,6 +35,12 @@ class modelClass_ : public modelBase_nClass { return(logProb); } + // `node` is a single instr_nClass (not a list): identifies one declaration + // (via declID) and (per declFunClass_::first_idx_) one node within it. + SEXP getParam_impl(std::shared_ptr node, int paramID) override { + return declFunPtrs[node->declID - 1]->getParam_cpp(node, paramID)->get(); + } + void simulate_impl(std::shared_ptr instrList) { const auto& instrVec = instrList->contents(); for (const auto& instr : instrVec) { diff --git a/nimbleModel/tests/testthat/test-getParam.R b/nimbleModel/tests/testthat/test-getParam.R new file mode 100644 index 0000000..3958d95 --- /dev/null +++ b/nimbleModel/tests/testthat/test-getParam.R @@ -0,0 +1,21 @@ +library(nimbleModel) +library(testthat) + +code <- quote({ + for(i in 3:10) + y[i] ~ dnorm(0,1) +}) +data <- list(y = rnorm(10)) +mclass <- nimbleModel(code, data = data, returnClass = TRUE) +m <- mclass$new() +options(error=recover) +cmclass <- nCompiler::nCompile(mclass) +cm <- cmclass$new() + +vr <- varRangeClass$new('y[3]') +instr <- instr_nClass$new(vr) +test <- makeInstrList(m, vr) +test |> length() +test[[1]]$declID +debug(cm$getParam) +cm$getParam(test[[1]], "value") From 54f108e8f171331eca0696a85c21176418952f60 Mon Sep 17 00:00:00 2001 From: perrydv Date: Tue, 25 Aug 2026 16:01:39 -0700 Subject: [PATCH 16/27] getParam and getBound work, compiled and uncompiled, tested only for scalar nodes so far --- nimbleModel/R/declFunBaseClass.R | 22 +++++ nimbleModel/R/modelBaseClass.R | 29 +++++++ nimbleModel/R/nimbleModel.R | 87 +++++++++++++++++-- .../declFunBase_nClass_cppContent.cpp | 8 +- .../declFunBase_nClass_hContent.h | 1 + .../declFunBase_nClass_manifest.txt | 2 +- .../predef/declFunClass_/declFunClass_.h | 12 ++- .../modelBase_nClass_cppContent.cpp | 8 +- .../modelBase_nC/modelBase_nClass_hContent.h | 1 + .../modelBase_nClass_manifest.txt | 2 +- .../predef/modelClass_/modelClass_.h | 4 + nimbleModel/tests/testthat/test-getParam.R | 21 ----- .../tests/testthat/test-getParam_getBound.R | 56 ++++++++++++ 13 files changed, 220 insertions(+), 33 deletions(-) delete mode 100644 nimbleModel/tests/testthat/test-getParam.R create mode 100644 nimbleModel/tests/testthat/test-getParam_getBound.R diff --git a/nimbleModel/R/declFunBaseClass.R b/nimbleModel/R/declFunBaseClass.R index bec5931..f51cae7 100644 --- a/nimbleModel/R/declFunBaseClass.R +++ b/nimbleModel/R/declFunBaseClass.R @@ -767,6 +767,14 @@ declFunBase_nClass <- nClass( } getParam_one(fi$idx, paramID) }, + # getBound: use only the first entry in the instr. + getBound = function(instr, boundID) { + fi <- first_idx(instr) + if (fi$multiple) { + warning("getBound: instr covers more than one node; using the first node only.") + } + getBound_one(fi$idx, boundID) + }, first_idx = function(instr) { multiple <- FALSE idx <- switch(as.character(instr$type), @@ -948,6 +956,20 @@ declFunBase_nClass <- nClass( return(ETaccess(0, copy = TRUE)) } ) + ), + getBound_cpp = nFunction( + name = "getBound_cpp", + function(instr, boundID) { + stop("Uncompiled version of getBound_cpp should not be called.") + }, + returnType = "numericScalar", + compileInfo = list( + virtual = TRUE, + C_fun = function(instr = "instr_nClass", boundID = "integerScalar") { + cppLiteral('Rprintf("declFunBase_nClass virtual base getBound_cpp should never be called (something is wrong)\\n");') + return(0) + } + ) ) ), # We haven't dealt with ensuring a virtual destructor when any method is virtual diff --git a/nimbleModel/R/modelBaseClass.R b/nimbleModel/R/modelBaseClass.R index 9a06856..89bd63b 100644 --- a/nimbleModel/R/modelBaseClass.R +++ b/nimbleModel/R/modelBaseClass.R @@ -412,6 +412,19 @@ modelBase_nClass <- nClass( return(self$getParam_impl(one_instr, paramID)) } declFunList[[one_instr$declID]]$getParam(one_instr, paramID) + }, + getBound = function(one_instr, bound) { + if (!inherits(one_instr, "instr_nClass")) { + stop("getBound: argument `one_instr` must be an instr_nClass object") + } + if(!bound %in% c('lower', 'upper')) + stop("getBound: 'bound' must be either 'lower' or 'upper'") + boundID <- if(bound == 'lower') 0 else 1 + if (isCompiled()) { + if (!one_instr$isCompiled()) one_instr <- makeCompiledInstr(one_instr) + return(self$getBound_impl(one_instr, boundID)) + } + declFunList[[one_instr$declID]]$getBound(one_instr, boundID) } ), Cpublic = list( @@ -520,6 +533,22 @@ modelBase_nClass <- nClass( }, virtual = TRUE ) + ), + getBound_impl = nFunction( + name = "getBound_impl", + function(node, boundID) { + cat("Uncompiled `getBound_impl` should never be called.\n") + return(0) + }, + # We must return a general object because it may have different nDim + returnType = "numericScalar", + compileInfo = list( + C_fun = function(node = "instr_nClass", boundID = "integerScalar") { + cppLiteral('Rprintf("modelBase_nClass getBound_impl (should not see this)\\n");') + return(0) + }, + virtual = TRUE + ) ) ), # See comment above about needing to ensure a virtual destructor diff --git a/nimbleModel/R/nimbleModel.R b/nimbleModel/R/nimbleModel.R index 48c1b10..1d4f437 100644 --- a/nimbleModel/R/nimbleModel.R +++ b/nimbleModel/R/nimbleModel.R @@ -83,7 +83,7 @@ make_modelClass_from_nimbleModel <- function(modelDef, data, inits, name = NULL) lapply(\(x) all.vars(body(x))) |> unlist() |> unique() |> - setdiff(c("idx", "paramID_", "LocalNewLogProb_", "LocalAns_", "model")) %||% character() + setdiff(c("idx", "paramID_", "boundID_","LocalNewLogProb_", "LocalAns_", "model")) %||% character() declVarInfo <- modelVarInfo$vars[declVars] declID <- as.numeric(declInfo$declRule$ID) # Formerly `sourceLineNumber`, which may not be unique. declFun_membername <- declFunNames[i] @@ -592,6 +592,7 @@ make_decl_methods_from_declInfo <- function(declInfo) { )) # Dummy version of getParam_one: getParamMethods <- list(getParam_one = make_getParam_one_nFxn()) + getBoundMethods <- list(getBound_one = make_getBound_one_nFxn()) } if (type == "stoch") { logProbExpr <- declInfo$genLogProbExpr() @@ -627,8 +628,9 @@ make_decl_methods_from_declInfo <- function(declInfo) { ) )) getParamMethods <- make_getParam_methods(declInfo, LHSrep, RHSrep) + getBoundMethods <- make_getBound_methods(declInfo, LHSrep, RHSrep) } - c(methodList, getParamMethods) + c(methodList, getParamMethods, getBoundMethods) } make_getParam_methods <- function(declInfo, LHSrep, RHSrep) { @@ -651,9 +653,12 @@ make_getParam_methods <- function(declInfo, LHSrep, RHSrep) { make_getParam_one_nFxn <- function(paramIDs = integer(0), exprs = list(), isRefFlags = logical(0), computeMethodNames = character(0)) { if(!length(paramIDs)) { - fun <- function(idx, paramID_) { + Cfun <- function(idx, paramID_) { return(ETaccess(0, copy=TRUE)) } + Rfun <- function(idx, paramID_) { + return(0) + } } else { case_lines <- lapply(exprs, function(expr) { @@ -666,21 +671,91 @@ make_getParam_one_nFxn <- function(paramIDs = integer(0), exprs = list(), switch_line <- bquote(nSwitch(paramID_, .(paramIDs))) switch_line[3 + (1:(length(case_lines)))] <- case_lines - fun <- bquote( + Cfun <- bquote( function(idx, paramID_) { .(switch_line) return(LocalAns_) } ) |> eval() - } + + R_case_lines <- lapply(exprs, + function(expr) { + # LocalAns_ is already filtered out of all.vars results + # to determine model variables, so use that name here too. + bquote(LocalAns_ <- .(expr)) + }) + R_switch_line <- bquote(nSwitch(paramID_, .(paramIDs))) + R_switch_line[3 + (1:(length(R_case_lines)))] <- R_case_lines + Rfun <- bquote( + function(idx, paramID_) { + .(R_switch_line) + return(LocalAns_) + } + ) |> eval() + body(Rfun) <- nm_addModelDollarSign(body(Rfun), exceptionNames = c("idx", "paramID_", "LocalAns_")) + } nFunction( name = "getParam_one", - fun, + Rfun, + compileInfo = list(C_fun = Cfun), returnType = "ETaccessor()", argTypes = list(idx = "integerVector", paramID_ = "integerScalar") ) } +make_getBound_methods <- function(declInfo, LHSrep, RHSrep) { + distName <- declInfo$distributionName + boundExprs <- declInfo$boundExprs + getBoundOne <- make_getBound_one_nFxn(boundExprs) + list(getBound_one = getBoundOne) +} + +make_getBound_one_nFxn <- function(boundExprs = list()) { + if(!length(boundExprs)) { + Rfun <- function(idx, boundID_) { + return(NA) + } + Cfun <- function(idx, boundID_) { + return(0) + } + } else { + init_line <- quote(LocalAns_ <- 0) # avoid Windows compile warning of possibly uninitialized return value. + case_lines <- lapply(boundExprs, + function(expr) { + # LocalAns_ is already filtered out of all.vars results + # to determine model variables, so use that name here too. + bquote(LocalAns_ <- .(expr)) + }) + + + switch_line <- bquote(nSwitch(boundID_, 0:1)) + switch_line[3 + (1:(length(case_lines)))] <- case_lines + + Rfun <- bquote( + function(idx, boundID_) { + .(init_line) + .(switch_line) + return(LocalAns_) + } + ) |> eval() + Cfun <- bquote( + function(idx, boundID_) { + .(init_line) + .(switch_line) + return(LocalAns_) + } + ) |> eval() + body(Rfun) <- nm_addModelDollarSign(body(Rfun), exceptionNames = c("idx", "boundID_", "LocalAns_")) + } + nFunction( + name = "getBound_one", + Rfun, + compileInfo = list(C_fun = Cfun), + returnType = "numericScalar", + argTypes = list(idx = "integerVector", boundID_ = "integerScalar") + ) +} + #' @export #' Turn model code into an object for use in \code{nimbleModel} or \code{readBUGSmodel} #' diff --git a/nimbleModel/inst/include/nimbleModel/predef/declFunBase_nC/declFunBase_nClass_cppContent.cpp b/nimbleModel/inst/include/nimbleModel/predef/declFunBase_nC/declFunBase_nClass_cppContent.cpp index 95590f2..f138e01 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/declFunBase_nC/declFunBase_nClass_cppContent.cpp +++ b/nimbleModel/inst/include/nimbleModel/predef/declFunBase_nC/declFunBase_nClass_cppContent.cpp @@ -41,6 +41,11 @@ Rprintf("declFunBase_nClass virtual base simulate_cpp should never be called (so RESET_EIGEN_ERRORS Rprintf("declFunBase_nClass virtual base getParam_cpp should never be called (something is wrong)\n");; return(ETaccessPtr(0.0)); +} + double declFunBase_nClass::getBound_cpp ( std::shared_ptr instr, int boundID ) { +RESET_EIGEN_ERRORS +Rprintf("declFunBase_nClass virtual base getBound_cpp should never be called (something is wrong)\n");; +return(0.0); } declFunBase_nClass::declFunBase_nClass ( ) { RESET_EIGEN_ERRORS @@ -66,7 +71,8 @@ method("ping", &declFunBase_nClass::ping, args({{}})), method("calculate_cpp", &declFunBase_nClass::calculate_cpp, args({{arg("instr",copy)}})), method("calculateDiff_cpp", &declFunBase_nClass::calculateDiff_cpp, args({{arg("instr",copy)}})), method("getLogProb_cpp", &declFunBase_nClass::getLogProb_cpp, args({{arg("instr",copy)}})), -method("simulate_cpp", &declFunBase_nClass::simulate_cpp, args({{arg("instr",copy)}})) +method("simulate_cpp", &declFunBase_nClass::simulate_cpp, args({{arg("instr",copy)}})), +method("getBound_cpp", &declFunBase_nClass::getBound_cpp, args({{arg("instr",copy)},{arg("boundID",copy)}})) ) ) #endif diff --git a/nimbleModel/inst/include/nimbleModel/predef/declFunBase_nC/declFunBase_nClass_hContent.h b/nimbleModel/inst/include/nimbleModel/predef/declFunBase_nC/declFunBase_nClass_hContent.h index 18c26e6..6cd635d 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/declFunBase_nC/declFunBase_nClass_hContent.h +++ b/nimbleModel/inst/include/nimbleModel/predef/declFunBase_nC/declFunBase_nClass_hContent.h @@ -17,6 +17,7 @@ class declFunBase_nClass : public interface_resolver< genericInterfaceC instr ) ; virtual void simulate_cpp ( std::shared_ptr instr ) ; virtual std::unique_ptr getParam_cpp ( std::shared_ptr instr, int paramID ) ; + virtual double getBound_cpp ( std::shared_ptr instr, int boundID ) ; declFunBase_nClass ( ) ; }; diff --git a/nimbleModel/inst/include/nimbleModel/predef/declFunBase_nC/declFunBase_nClass_manifest.txt b/nimbleModel/inst/include/nimbleModel/predef/declFunBase_nC/declFunBase_nClass_manifest.txt index 06d87e8..fec5ff5 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/declFunBase_nC/declFunBase_nClass_manifest.txt +++ b/nimbleModel/inst/include/nimbleModel/predef/declFunBase_nC/declFunBase_nClass_manifest.txt @@ -1,4 +1,4 @@ -list(saved_at = structure(1787098079.272, class = c("POSIXct", +list(saved_at = structure(1787685630.7344, class = c("POSIXct", "POSIXt")), packet_name = "declFunBase_nClass", elements = c("preamble", "cppContent", "hContent", "filebase", "post_cpp_compiler", "copyFiles" ), files = list(preamble = "declFunBase_nClass_preamble.cpp", diff --git a/nimbleModel/inst/include/nimbleModel/predef/declFunClass_/declFunClass_.h b/nimbleModel/inst/include/nimbleModel/predef/declFunClass_/declFunClass_.h index 694ff53..c6a3c51 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/declFunClass_/declFunClass_.h +++ b/nimbleModel/inst/include/nimbleModel/predef/declFunClass_/declFunClass_.h @@ -614,7 +614,15 @@ class declFunClass_ : public declFunBase_nClass { } return static_cast(this)->getParam_one(idx, paramID); } - + double getBound_cpp(std::shared_ptr instr, int boundID) override { + RESET_EIGEN_ERRORS; + bool multiple = false; + Eigen::Tensor idx = first_idx_(instr, multiple); + if (multiple) { + Rcpp::warning("getBound: instr covers more than one node; using the first node only."); + } + return static_cast(this)->getBound_one(idx, boundID); + } Eigen::Tensor first_idx_(std::shared_ptr instr, bool &multiple) { int nDim = instr->nDim; switch (instr->type) { @@ -728,7 +736,7 @@ class declFunClass_ : public declFunBase_nClass { return first_idx_generic_(instr, 5, multiple); } default: - Rcpp::stop("getParam: unrecognized instr type."); + Rcpp::stop("getParam or getBound: unrecognized instr type."); } return instr->lens; // unreachable; keeps compiler happy. } diff --git a/nimbleModel/inst/include/nimbleModel/predef/modelBase_nC/modelBase_nClass_cppContent.cpp b/nimbleModel/inst/include/nimbleModel/predef/modelBase_nC/modelBase_nClass_cppContent.cpp index 2393a0c..512697c 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/modelBase_nC/modelBase_nClass_cppContent.cpp +++ b/nimbleModel/inst/include/nimbleModel/predef/modelBase_nC/modelBase_nClass_cppContent.cpp @@ -54,6 +54,11 @@ Rprintf("modelBase_nClass simulate_impl (should not see this)\n");; SEXP modelBase_nClass::getParam_impl ( std::shared_ptr node, int paramID ) { RESET_EIGEN_ERRORS Rprintf("modelBase_nClass getParam_impl (should not see this)\n"); return R_NilValue;; +} + double modelBase_nClass::getBound_impl ( std::shared_ptr node, int boundID ) { +RESET_EIGEN_ERRORS +Rprintf("modelBase_nClass getBound_impl (should not see this)\n");; +return(0.0); } modelBase_nClass::modelBase_nClass ( ) { RESET_EIGEN_ERRORS @@ -82,7 +87,8 @@ method("calculate_impl", &modelBase_nClass::calculate_impl, args({{arg("instrLis method("calculateDiff_impl", &modelBase_nClass::calculateDiff_impl, args({{arg("instrList",copy)}})), method("getLogProb_impl", &modelBase_nClass::getLogProb_impl, args({{arg("instrList",copy)}})), method("simulate_impl", &modelBase_nClass::simulate_impl, args({{arg("instrList",copy)}})), -method("getParam_impl", &modelBase_nClass::getParam_impl, args({{arg("node",copy)},{arg("paramID",copy)}})) +method("getParam_impl", &modelBase_nClass::getParam_impl, args({{arg("node",copy)},{arg("paramID",copy)}})), +method("getBound_impl", &modelBase_nClass::getBound_impl, args({{arg("node",copy)},{arg("boundID",copy)}})) ) ) #endif diff --git a/nimbleModel/inst/include/nimbleModel/predef/modelBase_nC/modelBase_nClass_hContent.h b/nimbleModel/inst/include/nimbleModel/predef/modelBase_nC/modelBase_nClass_hContent.h index eaa50bf..aaad758 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/modelBase_nC/modelBase_nClass_hContent.h +++ b/nimbleModel/inst/include/nimbleModel/predef/modelBase_nC/modelBase_nClass_hContent.h @@ -21,6 +21,7 @@ class modelBase_nClass : public interface_resolver< genericInterfaceC instrList ) ; virtual void simulate_impl ( std::shared_ptr instrList ) ; virtual SEXP getParam_impl ( std::shared_ptr node, int paramID ) ; + virtual double getBound_impl ( std::shared_ptr node, int boundID ) ; modelBase_nClass ( ) ; }; diff --git a/nimbleModel/inst/include/nimbleModel/predef/modelBase_nC/modelBase_nClass_manifest.txt b/nimbleModel/inst/include/nimbleModel/predef/modelBase_nC/modelBase_nClass_manifest.txt index 6339b8a..2f1c8e4 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/modelBase_nC/modelBase_nClass_manifest.txt +++ b/nimbleModel/inst/include/nimbleModel/predef/modelBase_nC/modelBase_nClass_manifest.txt @@ -1,4 +1,4 @@ -list(saved_at = structure(1787098119.31298, class = c("POSIXct", +list(saved_at = structure(1787686089.49483, class = c("POSIXct", "POSIXt")), packet_name = "modelBase_nClass", elements = c("preamble", "cppContent", "hContent", "filebase", "post_cpp_compiler", "copyFiles" ), files = list(preamble = "modelBase_nClass_preamble.cpp", cppContent = "modelBase_nClass_cppContent.cpp", diff --git a/nimbleModel/inst/include/nimbleModel/predef/modelClass_/modelClass_.h b/nimbleModel/inst/include/nimbleModel/predef/modelClass_/modelClass_.h index b4a8a87..31eaddf 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/modelClass_/modelClass_.h +++ b/nimbleModel/inst/include/nimbleModel/predef/modelClass_/modelClass_.h @@ -41,6 +41,10 @@ class modelClass_ : public modelBase_nClass { return declFunPtrs[node->declID - 1]->getParam_cpp(node, paramID)->get(); } + double getBound_impl(std::shared_ptr node, int boundID) override { + return declFunPtrs[node->declID - 1]->getBound_cpp(node, boundID); + } + void simulate_impl(std::shared_ptr instrList) { const auto& instrVec = instrList->contents(); for (const auto& instr : instrVec) { diff --git a/nimbleModel/tests/testthat/test-getParam.R b/nimbleModel/tests/testthat/test-getParam.R deleted file mode 100644 index 3958d95..0000000 --- a/nimbleModel/tests/testthat/test-getParam.R +++ /dev/null @@ -1,21 +0,0 @@ -library(nimbleModel) -library(testthat) - -code <- quote({ - for(i in 3:10) - y[i] ~ dnorm(0,1) -}) -data <- list(y = rnorm(10)) -mclass <- nimbleModel(code, data = data, returnClass = TRUE) -m <- mclass$new() -options(error=recover) -cmclass <- nCompiler::nCompile(mclass) -cm <- cmclass$new() - -vr <- varRangeClass$new('y[3]') -instr <- instr_nClass$new(vr) -test <- makeInstrList(m, vr) -test |> length() -test[[1]]$declID -debug(cm$getParam) -cm$getParam(test[[1]], "value") diff --git a/nimbleModel/tests/testthat/test-getParam_getBound.R b/nimbleModel/tests/testthat/test-getParam_getBound.R new file mode 100644 index 0000000..8300aaa --- /dev/null +++ b/nimbleModel/tests/testthat/test-getParam_getBound.R @@ -0,0 +1,56 @@ +library(nimbleModel) +library(testthat) + +cat("getParam and getBound need multivariate tests\n") + +test_that("basic getParam and getBound works", { + # We need a vector node test, but at the time of this writing, + # dmnorm is blocked by calc_dmnormAltParams + # ddirch is blocked by needing handlers for rdirch + code <- quote({ + mu ~ dnorm(0, 1) + sd ~ dunif(0, 2) + for(i in 1:5) + y[i] ~ dnorm(mean = mu + 1, sd = 2*sd) + v ~ dunif(mu + 1, mu + 5) + # z[1:5] ~ ddirch(alpha[1:5]) + }) + set.seed(1) + y <- rnorm(5) + alpha <- runif(5) + 1 + z <- runif(5) + z <- z / sum(z) + mu <- rnorm(1) + sd <- runif(1, 0, 2) + data <- list(y = y, z = z, alpha = alpha) + inits <- list(mu = mu, sd = sd, v = mu + 2.2) + mclass <- nimbleModel(code, data = data, inits = inits, returnClass = TRUE) + m <- mclass$new() + cmclass <- nCompiler::nCompile(mclass) + cm <- cmclass$new() + m$calculate() + cm$calculate() + + vr <- varRangeClass$new('y[3]') + instrList <- makeInstrList(m, vr) + y3 <- instrList[[1]] + vr <- varRangeClass$new("v") + instrList <- makeInstrList(m, vr) + v <- instrList[[1]] + for(case in c("comp", "uncomp")) { + obj <- switch(case, comp = cm, uncomp = m) + expect_equal(obj$getParam(y3, "value"), y[3]) + expect_equal(obj$getParam(y3, "mean"), mu + 1) + expect_equal(obj$getParam(y3, "sd"), 2*sd) + expect_equal(obj$getParam(y3, "var"), (2*sd)^2) + expect_equal(obj$getParam(y3, "tau"), 1/(2*sd)^2) + expect_equal(obj$getBound(y3, "upper"), Inf) + expect_equal(obj$getBound(y3, "lower"), -Inf) + + expect_equal(obj$getParam(v, "value"), mu+2.2) + expect_equal(obj$getParam(v, "min"), mu + 1) + expect_equal(obj$getParam(v, "max"), mu + 5) + expect_equal(obj$getBound(v, "lower"), mu + 1) + expect_equal(obj$getBound(v, "upper"), mu + 5) + } +}) From 5459387470462dda47d6f8bcb5ea5ee6840c57d7 Mon Sep 17 00:00:00 2001 From: perrydv Date: Wed, 26 Aug 2026 14:46:35 -0700 Subject: [PATCH 17/27] catching up on styler formatting --- nimbleModel/R/all_utils.R | 6 ++- nimbleModel/R/copier.R | 14 +++---- nimbleModel/R/modelBaseClass.R | 30 ++++++------- nimbleModel/R/modelValues.R | 77 ++++++++++++++++++---------------- nimbleModel/R/model_utils.R | 4 +- nimbleModel/R/nimbleModel.R | 68 ++++++++++++++++-------------- nimbleModel/R/types_util.R | 20 +++++---- 7 files changed, 120 insertions(+), 99 deletions(-) diff --git a/nimbleModel/R/all_utils.R b/nimbleModel/R/all_utils.R index 85d4ea9..fd3e369 100644 --- a/nimbleModel/R/all_utils.R +++ b/nimbleModel/R/all_utils.R @@ -1,6 +1,8 @@ dimOrLength <- function(obj, scalarize = FALSE) { - if (scalarize) if (length(obj) == 1) { - return(integer(0)) + if (scalarize) { + if (length(obj) == 1) { + return(integer(0)) + } } if (is.null(dim(obj))) { return(length(obj)) diff --git a/nimbleModel/R/copier.R b/nimbleModel/R/copier.R index 3548ca8..dc32677 100644 --- a/nimbleModel/R/copier.R +++ b/nimbleModel/R/copier.R @@ -165,7 +165,7 @@ multiCopierMV_nClass <- nCompiler::nClass( ) #' @export -makeMultiCopier <- function(source, nodes, +makeMultiCopier <- function(source, nodes, sourceType = c("model", "modelValues"), ...) { # This will be called from a nimble2 keyword processor # The ... is to absorb further arguments that at the time of this writing are not fleshed out. @@ -173,11 +173,11 @@ makeMultiCopier <- function(source, nodes, nodes <- nodes |> lapply(\(x) nimbleModel:::varRangeClass$new(x)) } sourceType <- match.arg(sourceType) - multiCopier <- - switch(sourceType, - model = multiCopier_nClass$new(), - modelValues = multiCopierMV_nClass$new() - ) + multiCopier <- + switch(sourceType, + model = multiCopier_nClass$new(), + modelValues = multiCopierMV_nClass$new() + ) getRange <- function(indexRange) { if (!inherits(indexRange, "indexRangeSequenceClass")) { stop("In a copy operation, only contiguous index blocks are supported") @@ -190,7 +190,7 @@ makeMultiCopier <- function(source, nodes, multiCopier$copiers[[i]]$varName <- thisNode$varName multiCopier$copiers[[i]]$indsList <- thisNode$indexRanges |> lapply(getRange) } - attr(multiCopier, "NCgenerator") <- + attr(multiCopier, "NCgenerator") <- switch(sourceType, model = quote(nimbleModel:::multiCopier_nClass), modelValues = quote(nimbleModel:::multiCopierMV_nClass) diff --git a/nimbleModel/R/modelBaseClass.R b/nimbleModel/R/modelBaseClass.R index 89bd63b..852b3b4 100644 --- a/nimbleModel/R/modelBaseClass.R +++ b/nimbleModel/R/modelBaseClass.R @@ -35,7 +35,7 @@ modelBase_nClass <- nClass( } # TODO: create a merge_and_set function that handles all three of the following. - if(isTRUE(.initialize)) { + if (isTRUE(.initialize)) { # This assumes there is a derived object with defaultSizes, defaultInits, and defaultData. # TODO: do we want to handle data differently? @@ -49,10 +49,10 @@ modelBase_nClass <- nClass( } } - if(!CppObj_provided) { + if (!CppObj_provided) { self$reset(sizes = sizes, inits = inits, allData = allData) } - + dataVarIndices <- names(modelDef$constants) %in% modelDef$varNames & !names(modelDef$constants) %in% names(allData) # don't overwrite anything in 'allData' # TODO: revise messaging below using new nimbleModel messaging system. if (sum(names(modelDef$constants) %in% names(allData))) { @@ -90,17 +90,15 @@ modelBase_nClass <- nClass( allInits <- self$defaultInits } else if (length(inits)) set_from_list(inits) - if(is.null(allData)) { + if (is.null(allData)) { allData <- self$defaultData - if (!missing(data)) { # this and the next line used inits. was that a typo? I think so. + if (!missing(data)) { # this and the next line used inits. was that a typo? I think so. for (nm in names(data)) { allData[[nm]] <- data[[nm]] } } } if (length(allData)) set_from_list(allData) - - }, makeDataRules = function(data) { nms <- names(data) @@ -393,16 +391,19 @@ modelBase_nClass <- nClass( return(invisible(NULL)) }, # `one_instr` is a single instr_nClass (not a list of them). - # Within it, one node will be used (see declFunBase_nClass$first_idx). + # Within it, one node will be used (see declFunBase_nClass$first_idx). # `param` is an integer paramID or a character param name. getParam = function(one_instr, param) { if (!inherits(one_instr, "instr_nClass")) { stop("getParam: argument `one_instr` must be an instr_nClass object") } - if(is.numeric(param)) paramID <- param - else if(is.character(param)) { - paramID <- getParamID(self$modelDef$declInfo[[one_instr$declID]]$distributionName, - param) + if (is.numeric(param)) { + paramID <- param + } else if (is.character(param)) { + paramID <- getParamID( + self$modelDef$declInfo[[one_instr$declID]]$distributionName, + param + ) if (is.na(paramID)) stop("getParam: argument `param` is not a valid parameter name for this node.") } else { stop("getParam: argument `param` must be an integer paramID or a character param name.") @@ -417,9 +418,10 @@ modelBase_nClass <- nClass( if (!inherits(one_instr, "instr_nClass")) { stop("getBound: argument `one_instr` must be an instr_nClass object") } - if(!bound %in% c('lower', 'upper')) + if (!bound %in% c("lower", "upper")) { stop("getBound: 'bound' must be either 'lower' or 'upper'") - boundID <- if(bound == 'lower') 0 else 1 + } + boundID <- if (bound == "lower") 0 else 1 if (isCompiled()) { if (!one_instr$isCompiled()) one_instr <- makeCompiledInstr(one_instr) return(self$getBound_impl(one_instr, boundID)) diff --git a/nimbleModel/R/modelValues.R b/nimbleModel/R/modelValues.R index 4795d01..53efcf4 100644 --- a/nimbleModel/R/modelValues.R +++ b/nimbleModel/R/modelValues.R @@ -6,8 +6,8 @@ modelValuesBase_nClass <- nCompiler::nClass( initialize = function(...) { super$initialize(...) CppObj_provided <- "CppObj" %in% ...names() - if(!CppObj_provided) { - if(!isCompiled()) { + if (!CppObj_provided) { + if (!isCompiled()) { modelValuesBase_nClass() self$dot_sizeList <- self$defaultSizes } @@ -82,7 +82,7 @@ modelValues_resize <- function(self, m, sizeList) { # check preservation issues in resizing for (v in names(sizeList)) { this_sizeList <- sizeList[[v]] - if(length(this_sizeList) == 0) this_sizeList <- 1 + if (length(this_sizeList) == 0) this_sizeList <- 1 length(self[[v]]) <- m if (length(this_sizeList) == 1) { for (i in 1:m) self[[v]][[i]] <- numeric(length = this_sizeList) @@ -94,7 +94,7 @@ modelValues_resize <- function(self, m, sizeList) { make_modelValues_nClass <- function(varInfo, cpp_classname) { - if(missing(cpp_classname)) { + if (missing(cpp_classname)) { hashedID <- make_modelValues_hashID(varInfo) cpp_classname <- Rname2CppName(paste0("MV_", hashedID)) } @@ -166,9 +166,9 @@ make_modelValues_nClass <- function(varInfo, names(CPUBLIC)[1] <- cpp_classname defaultSizes <- varInfo$sizes - if(is.null(defaultSizes)) defaultSizes <- list() - for(v in names(varInfo$vars)) { - if(is.null(defaultSizes[[v]]) || length(defaultSizes[[v]]) == 0) { + if (is.null(defaultSizes)) defaultSizes <- list() + for (v in names(varInfo$vars)) { + if (is.null(defaultSizes[[v]]) || length(defaultSizes[[v]]) == 0) { defaultSizes[[v]] <- rep(0, varInfo$vars[[v]]$nDim) } } @@ -194,9 +194,11 @@ make_modelValues_nClass <- function(varInfo, Cpublic = CPUBLIC ), - list(CLASSNAME = classname, - CPP_CLASSNAME_ = as.name(cpp_classname), - CPP_CLASSNAME = cpp_classname) + list( + CLASSNAME = classname, + CPP_CLASSNAME_ = as.name(cpp_classname), + CPP_CLASSNAME = cpp_classname + ) ) generator <- eval(generator_code) generator$set("public", "NCgenerator", generator) @@ -210,20 +212,21 @@ make_modelValues_hashID <- function(varInfo) { sortedNames <- sort(names(varsList)) sortedVars <- varsList[sortedNames] nested_normalize <- function(x) { - if(!is.list(x)) + if (!is.list(x)) { stop("Elements of a modelValues varInfo list must be lists with elements 'name' and 'nDim' (or unnamed elements in that order)") - if(is.null(names(x))) { - if(length(x) != 2) { + } + if (is.null(names(x))) { + if (length(x) != 2) { stop("Elements of a modelValues varInfo list must have 2 elements (optionally named 'name' and 'nDim')") } - if(!is.character(x[[1]]) || !is.numeric(x[[2]])) { + if (!is.character(x[[1]]) || !is.numeric(x[[2]])) { stop("Elements of a modelValues varInfo list, if not named, must have first element character (for the 'name') and second element numeric (for the 'nDim')") } x <- list(name = x[[1]], nDim = x[[2]]) } x <- x[sort(names(x))] - if(!identical(names(x), sort(c("name", "nDim")))) { - # use sort in the RHS of the identical() to avoid + if (!identical(names(x), sort(c("name", "nDim")))) { + # use sort in the RHS of the identical() to avoid # unknown sort ordering in other locales stop("Elements of a modelValues varInfo list must be named 'name' and 'nDim'") } @@ -236,12 +239,12 @@ make_modelValues_hashID <- function(varInfo) { #' @export modelValues <- function(varInfo, .ID = FALSE, env = parent.frame()) { - if(inherits(varInfo, "modelBase_nClass")) { + if (inherits(varInfo, "modelBase_nClass")) { varInfo <- get_varInfo_from_nimbleModel(varInfo$modelDef) } hashedID <- make_modelValues_hashID(varInfo) cpp_classname <- Rname2CppName(paste0("MV_", hashedID)) - if(isTRUE(.ID)) { + if (isTRUE(.ID)) { return(cpp_classname) } ans <- make_modelValues_nClass(varInfo, cpp_classname = cpp_classname) @@ -261,17 +264,17 @@ class(modelValues) <- c("function", "nClassBuilder") #' @exportS3Method #' @method `[` modelValues `[.modelValues` <- function(x, var, ind) { - if(x$isCompiled()) { + if (x$isCompiled()) { nCompiler::value(x, var)[[ind]] } else { - x[[var]][[ind]] + x[[var]][[ind]] } } #' @exportS3Method #' @method `[<-` modelValues `[<-.modelValues` <- function(x, var, ind, value) { - if(x$isCompiled()) { + if (x$isCompiled()) { nCompiler::value(x, var)[[ind]] <- value } else { x[[var]][[ind]] <- value @@ -280,29 +283,33 @@ class(modelValues) <- c("function", "nClassBuilder") } ## To-Do: It would be nice to have an "as.list" that -## returns a list of lists. This needs +## returns a list of lists. This needs ## access to the variable names and at the moment ## that will only work from a derived class, not -## from a returned base class ptr. +## from a returned base class ptr. #' @exportS3Method #' @method as.list modelValues as.list.modelValues <- function(x) { - if(x$isCompiled()) { + if (x$isCompiled()) { varNames <- nCompiler::interface_names(x, "members") varNames <- varNames[!varNames %in% c("dot_sizeList", "dot_current_nRow")] - if(!is.null(varNames)) { + if (!is.null(varNames)) { return( - varNames |> lapply( - \(var) as.list(nCompiler::value(x, var))) |> - structure(names = varNames)) + varNames |> lapply( + \(var) as.list(nCompiler::value(x, var)) + ) |> + structure(names = varNames) + ) } } else { varNames <- x$varInfo$vars |> names() - if(!is.null(varNames)) { + if (!is.null(varNames)) { return( - varNames |> lapply( - \(var) as.list(x[[var]]) ) |> - structure(names = varNames)) + varNames |> lapply( + \(var) as.list(x[[var]]) + ) |> + structure(names = varNames) + ) } } NULL @@ -311,8 +318,8 @@ as.list.modelValues <- function(x) { #' @exportS3Method #' @method length modelValues length.modelValues <- function(x) { - if(x$isCompiled()) { - nCompiler::method(x, "getLength")() + if (x$isCompiled()) { + nCompiler::method(x, "getLength")() } else { x$getLength() } @@ -321,7 +328,7 @@ length.modelValues <- function(x) { #' @exportS3Method #' @method `length<-` modelValues `length<-.modelValues` <- function(x, value) { - if(x$isCompiled()) { + if (x$isCompiled()) { nCompiler::method(x, "resize")(value) } else { x$resize(value) diff --git a/nimbleModel/R/model_utils.R b/nimbleModel/R/model_utils.R index b7e3504..f870096 100644 --- a/nimbleModel/R/model_utils.R +++ b/nimbleModel/R/model_utils.R @@ -37,8 +37,8 @@ is.blank <- function(arg) { return(FALSE) } # slightly simpler approach borrowed from rlang::is_missing - return(identical(arg, quote(expr =))) - # old approach + return(identical(arg, quote(expr = ))) + # old approach # return(identical(arg, quote(x[])[[3]])) } diff --git a/nimbleModel/R/nimbleModel.R b/nimbleModel/R/nimbleModel.R index 1d4f437..6a5a4b2 100644 --- a/nimbleModel/R/nimbleModel.R +++ b/nimbleModel/R/nimbleModel.R @@ -83,7 +83,7 @@ make_modelClass_from_nimbleModel <- function(modelDef, data, inits, name = NULL) lapply(\(x) all.vars(body(x))) |> unlist() |> unique() |> - setdiff(c("idx", "paramID_", "boundID_","LocalNewLogProb_", "LocalAns_", "model")) %||% character() + setdiff(c("idx", "paramID_", "boundID_", "LocalNewLogProb_", "LocalAns_", "model")) %||% character() declVarInfo <- modelVarInfo$vars[declVars] declID <- as.numeric(declInfo$declRule$ID) # Formerly `sourceLineNumber`, which may not be unique. declFun_membername <- declFunNames[i] @@ -412,7 +412,7 @@ makeModel_nClass <- function(modelVarInfo, CpublicDeclFuns = CpublicDeclFuns, initialize = function(...) { if (isTRUE(.GlobalEnv$.debugModelInit)) browser() - super$initialize(..., .initialize=TRUE) + super$initialize(..., .initialize = TRUE) } ), # A concatenation of lists @@ -651,26 +651,28 @@ make_getParam_methods <- function(declInfo, LHSrep, RHSrep) { } make_getParam_one_nFxn <- function(paramIDs = integer(0), exprs = list(), - isRefFlags = logical(0), computeMethodNames = character(0)) { - if(!length(paramIDs)) { + isRefFlags = logical(0), computeMethodNames = character(0)) { + if (!length(paramIDs)) { Cfun <- function(idx, paramID_) { - return(ETaccess(0, copy=TRUE)) + return(ETaccess(0, copy = TRUE)) } Rfun <- function(idx, paramID_) { return(0) } } else { - case_lines <- lapply(exprs, - function(expr) { - # LocalAns_ is already filtered out of all.vars results - # to determine model variables, so use that name here too. - bquote(LocalAns_ <- ETaccess(.(expr), copy=TRUE)) - }) - - + case_lines <- lapply( + exprs, + function(expr) { + # LocalAns_ is already filtered out of all.vars results + # to determine model variables, so use that name here too. + bquote(LocalAns_ <- ETaccess(.(expr), copy = TRUE)) + } + ) + + switch_line <- bquote(nSwitch(paramID_, .(paramIDs))) switch_line[3 + (1:(length(case_lines)))] <- case_lines - + Cfun <- bquote( function(idx, paramID_) { .(switch_line) @@ -678,12 +680,14 @@ make_getParam_one_nFxn <- function(paramIDs = integer(0), exprs = list(), } ) |> eval() - R_case_lines <- lapply(exprs, - function(expr) { - # LocalAns_ is already filtered out of all.vars results - # to determine model variables, so use that name here too. - bquote(LocalAns_ <- .(expr)) - }) + R_case_lines <- lapply( + exprs, + function(expr) { + # LocalAns_ is already filtered out of all.vars results + # to determine model variables, so use that name here too. + bquote(LocalAns_ <- .(expr)) + } + ) R_switch_line <- bquote(nSwitch(paramID_, .(paramIDs))) R_switch_line[3 + (1:(length(R_case_lines)))] <- R_case_lines Rfun <- bquote( @@ -711,7 +715,7 @@ make_getBound_methods <- function(declInfo, LHSrep, RHSrep) { } make_getBound_one_nFxn <- function(boundExprs = list()) { - if(!length(boundExprs)) { + if (!length(boundExprs)) { Rfun <- function(idx, boundID_) { return(NA) } @@ -720,17 +724,19 @@ make_getBound_one_nFxn <- function(boundExprs = list()) { } } else { init_line <- quote(LocalAns_ <- 0) # avoid Windows compile warning of possibly uninitialized return value. - case_lines <- lapply(boundExprs, - function(expr) { - # LocalAns_ is already filtered out of all.vars results - # to determine model variables, so use that name here too. - bquote(LocalAns_ <- .(expr)) - }) - - + case_lines <- lapply( + boundExprs, + function(expr) { + # LocalAns_ is already filtered out of all.vars results + # to determine model variables, so use that name here too. + bquote(LocalAns_ <- .(expr)) + } + ) + + switch_line <- bquote(nSwitch(boundID_, 0:1)) switch_line[3 + (1:(length(case_lines)))] <- case_lines - + Rfun <- bquote( function(idx, boundID_) { .(init_line) @@ -746,7 +752,7 @@ make_getBound_one_nFxn <- function(boundExprs = list()) { } ) |> eval() body(Rfun) <- nm_addModelDollarSign(body(Rfun), exceptionNames = c("idx", "boundID_", "LocalAns_")) - } + } nFunction( name = "getBound_one", Rfun, diff --git a/nimbleModel/R/types_util.R b/nimbleModel/R/types_util.R index f28ffde..7d873fd 100644 --- a/nimbleModel/R/types_util.R +++ b/nimbleModel/R/types_util.R @@ -32,10 +32,12 @@ nl_expandNodeIndexExpr <- function(nodeExpr, env = parent.frame()) { scipen <- options("scipen")[[1]] options(scipen = 1000000) on.exit(options(scipen = scipen)) - if (length(nodeExpr) == 1) if (is.name(nodeExpr)) { - return(as.character(nodeExpr)) - } else { - stop("node expression with only one element, but not a variable name") + if (length(nodeExpr) == 1) { + if (is.name(nodeExpr)) { + return(as.character(nodeExpr)) + } else { + stop("node expression with only one element, but not a variable name") + } } indexExprs <- nodeExpr[-c(1, 2)] indexStrs <- lapply(indexExprs, function(ind) as.character(eval(ind, envir = env))) @@ -62,10 +64,12 @@ nl_expandNodeIndex <- function(node, env = parent.frame()) { options(scipen = 1000000) on.exit(options(scipen = scipen)) nodeExpr <- parse(text = node, keep.source = FALSE)[[1]] - if (length(nodeExpr) == 1) if (is.name(nodeExpr)) { - return(as.character(nodeExpr)) - } else { - stop("node expression with only one element, but not a variable name") + if (length(nodeExpr) == 1) { + if (is.name(nodeExpr)) { + return(as.character(nodeExpr)) + } else { + stop("node expression with only one element, but not a variable name") + } } indexExprs <- nodeExpr[-c(1, 2)] indexStrs <- lapply(indexExprs, function(ind) as.character(eval(ind, envir = env))) From 5c1276951cba316d61d72b2dde1e28e3f5da1a0d Mon Sep 17 00:00:00 2001 From: perrydv Date: Wed, 30 Sep 2026 18:00:00 -0700 Subject: [PATCH 18/27] mostly cleanup. Add .onLoad. Add some opDefs. --- nimbleModel/DESCRIPTION | 2 + nimbleModel/NAMESPACE | 8 + nimbleModel/R/copier.R | 21 +- nimbleModel/R/modelValues.R | 436 +++++++++++++++--- nimbleModel/R/nimbleModel.R | 2 + nimbleModel/R/opDefs.R | 25 + nimbleModel/R/options.R | 1 + nimbleModel/R/types_util.R | 346 +++++++------- nimbleModel/R/zzz.R | 8 + .../modelValuesBase_nClass_cppContent.cpp | 21 +- .../modelValuesBase_nClass_hContent.h | 15 +- .../modelValuesBase_nClass_manifest.txt | 2 +- .../modelValuesClass_/modelValuesClass_.h | 56 ++- .../multiCopier_modelValues_nC_base.h | 67 +-- .../multiCopier_model_nC_base.h | 46 +- .../multiCopier_nC_base/multiCopier_nC_base.h | 40 +- .../tests/testthat/test-getParam_getBound.R | 2 +- nimbleModel/tests/testthat/test-modelValues.R | 249 ++++++++-- 18 files changed, 962 insertions(+), 385 deletions(-) create mode 100644 nimbleModel/R/opDefs.R create mode 100644 nimbleModel/R/zzz.R diff --git a/nimbleModel/DESCRIPTION b/nimbleModel/DESCRIPTION index 9021f48..08bede1 100644 --- a/nimbleModel/DESCRIPTION +++ b/nimbleModel/DESCRIPTION @@ -41,6 +41,7 @@ Collate: modelValues.R model_utils.R nodeRules.R + opDefs.R options.R originalIndexingRules.R processModelGraph.R @@ -53,6 +54,7 @@ Collate: modelBaseClass.R instructions.R nimbleModel.R + zzz.R diff --git a/nimbleModel/NAMESPACE b/nimbleModel/NAMESPACE index a0aebda..3fa1c24 100644 --- a/nimbleModel/NAMESPACE +++ b/nimbleModel/NAMESPACE @@ -71,6 +71,7 @@ export(messageIfVerbose) export(calc_dmnormAltParams) export(calc_dwishAltParams) +export(nimbleCode) export(nimbleModel) export(makeInstrList) export(makeMultiCopier) @@ -78,8 +79,15 @@ export(makeMultiCopier) export(values) export("values<-") +export(modelValues) +export(modelValuesConf) +export(getsize) +export(resize) + S3method("[", modelValues) S3method("[<-", modelValues) S3method("length", modelValues) S3method("length<-", modelValues) S3method("as.list", modelValues) +S3method("as.matrix", modelValues) +export(matrix2mv) \ No newline at end of file diff --git a/nimbleModel/R/copier.R b/nimbleModel/R/copier.R index dc32677..768c63f 100644 --- a/nimbleModel/R/copier.R +++ b/nimbleModel/R/copier.R @@ -1,3 +1,20 @@ +# Classes and tools to support nimble2's values() and nimCopy(), both getting and setting. +# +# copier_nClass is just a data structure for one variable name and index information. It doesn't actually copy. +# +# multiCopier_nClass holds multiple copier_nClass's and does values() copying (for a model only). +# It has a C++ layer that uses the flatViewGroup class to do the copying. +# +# multiCopierMV_nClass is like multiCopier_nClass but for modelValues objects, +# but is used only for nimCopy. +# +# multiCopier_nClass and multiCopierMV_nClass share a C++ base class. +# The C++ step of nimCopy_ takes two multiCopier base classes and copies from one to the other. +# +# An important aspect on the C++ side is avoiding repeated name-based lookups of variables +# within the model or modelValues. + + #' @export copier_nClass <- nCompiler::nClass( classname = "copier_nClass", @@ -50,7 +67,7 @@ multiCopier_nClass <- nCompiler::nClass( } ) ), - # Note that this setValues works but it not actually used by nimble2 keyword processing + # Note that this setValues works but is not actually used by nimble2 keyword processing # which instead uses copiers->flatViewGroup.setValues_() which provides an operator=. # It is possible that this setValues() will be useful in other contexts, or if not that we # can eventually remove it to avoid confusion. @@ -198,6 +215,8 @@ makeMultiCopier <- function(source, nodes, multiCopier } +# Uncompiled implementations of values(model, nodes) and `values<-`(model, nodes, value). + #' @export values <- function(model, nodes) { if (is.character(nodes)) { diff --git a/nimbleModel/R/modelValues.R b/nimbleModel/R/modelValues.R index 53efcf4..6ee226d 100644 --- a/nimbleModel/R/modelValues.R +++ b/nimbleModel/R/modelValues.R @@ -7,10 +7,13 @@ modelValuesBase_nClass <- nCompiler::nClass( super$initialize(...) CppObj_provided <- "CppObj" %in% ...names() if (!CppObj_provided) { + # Compiled constructor will be called automatically (even without this full interface). + # Uncompiled matching steps are done by direct call. if (!isCompiled()) { modelValuesBase_nClass() - self$dot_sizeList <- self$defaultSizes } + # Initialize for anything with this full interface (uncompiled for full-interface compiled). + self$dot_sizeList <- self$defaultSizes } } ), @@ -24,6 +27,10 @@ modelValuesBase_nClass <- nCompiler::nClass( }, compileInfo = list( constructor = TRUE, + # By writing it this way, we ensure that even an object + # created in C++ or without a full interface will have + # these initializations done. + # In the full interface case, dot_sizeList is then set to defaultSizes. C_fun = function() { self$dot_current_nRow <- 0 cppLiteral("this->dot_sizeList = Rcpp::List();") @@ -33,7 +40,6 @@ modelValuesBase_nClass <- nCompiler::nClass( set_sizeList = nCompiler::nFunction( name = "set_sizeList", fun = function(sizeList = "RcppList") { - dot_sizeList <<- sizeList self$dot_sizeList <<- sizeList } ), @@ -64,6 +70,14 @@ modelValuesBase_nClass <- nCompiler::nClass( returnType("integerScalar") }, compileInfo = list(virtual = TRUE) + ), + getSize = nCompiler::nFunction( # this is an alias for getLength for backward compatibility. + name = "getSize", + function() { + return(self$getLength()) + returnType("integerScalar") + }, + compileInfo = list(virtual = TRUE) ) ), predefined = quote(system.file(file.path("include", "nimbleModel", "predef"), @@ -74,22 +88,47 @@ modelValuesBase_nClass <- nCompiler::nClass( interface = "full", createFromR = FALSE, exportName = "modelValuesBase_nClass_new", - packageNames = c(uncompiled = "modeValuesBase_nClass_R", compiled = "modelValuesBase_nClass") + packageNames = c(uncompiled = "modeValuesBase_nClass_R", compiled = "modelValuesBase_nClass"), + overloadDefs = list( + resize = list( + labelAbstractTypes = list( + handler = "custom_call", + recurse = TRUE, + returnType = "void()" + ), + eigenImpl = list(handler = 'PtrMethod', methodName = "resize") + ), + getsize = list( + labelAbstractTypes = list( + handler = "custom_call", + recurse = TRUE, + returnType = "integerScalar()" + ), + eigenImpl = list(handler = 'PtrMethod', methodName = "getLength") + ) + # In a future it could be nice to support `[` and `[[` by overloaded opDefs. + # However at the moment we are targeting nimble2 support and will achieve that + # in its keyword processing system. + ) ) ) -modelValues_resize <- function(self, m, sizeList) { - # check preservation issues in resizing - for (v in names(sizeList)) { +modelValues_resize <- function(self, m, sizeList, v) { +# for (v in names(sizeList)) { this_sizeList <- sizeList[[v]] + # This next check is an uncompiled safety fallback. + # However, the sizeList entry for a scalar should be length 1, not empty. if (length(this_sizeList) == 0) this_sizeList <- 1 - length(self[[v]]) <- m - if (length(this_sizeList) == 1) { - for (i in 1:m) self[[v]][[i]] <- numeric(length = this_sizeList) - } else { - for (i in 1:m) self[[v]][[i]] <- array(0, dim = this_sizeList) + old_m <- length(self[[v]]) + length(self[[v]]) <- m # This invokes nList resizing. + if(m > old_m) { + if (length(this_sizeList) == 1) { + for (i in (old_m+1):m) self[[v]][[i]] <- numeric(length = this_sizeList) + } else { + for (i in (old_m+1):m) self[[v]][[i]] <- array(0, dim = this_sizeList) + } } - } +# } } make_modelValues_nClass <- function(varInfo, @@ -122,12 +161,12 @@ make_modelValues_nClass <- function(varInfo, list(V = as.name(x$name), NL = as.name(nLname)) ) }) - needs_resize <- varInfo$vars |> vapply(\(x) x$nDim > 0, logical(1)) - resize_lines <- varInfo$vars[needs_resize] |> + resize_lines <- varInfo$vars |> lapply(\(x) { nDim <- x$nDim - nLname <- paste0("nL", nDim, "D") - Cline <- gsub("NDIM", nDim, "resize_one(V, m, as(this->dot_sizeList[NAME]))") + # nLname <- paste0("nL", nDim, "D") + Cline <- gsub("NDIM", nDim, "resize_one(V, m, this->getSizeOrNULL(this->dot_sizeList, NAME))") + # Cline <- gsub("NDIM", nDim, "resize_one(V, m, as(this->dot_sizeList[NAME]))") Cline <- gsub("NAME", paste0("\"", x$name, "\""), Cline) Cline <- gsub("V", x$name, Cline) substitute(nCpp(CLINE), list(CLINE = Cline)) @@ -139,6 +178,16 @@ make_modelValues_nClass <- function(varInfo, c_resize_fun <- function(m) {} body(c_resize_fun) <- as.call(c(as.name("{"), resize_lines, list(quote(dot_current_nRow <- m)))) + r_resize_lines <- varInfo$vars |> + lapply(\(x) { + substitute( + modelValues_resize(self, m, dot_sizeList, v = V), + list(V = x$name)) + }) + r_resize_body <- as.call(c(as.name("{"), r_resize_lines, list(quote(self$dot_current_nRow <- m)))) + r_resize_fun <- function(m) {} + body(r_resize_fun) <- r_resize_body + CPUBLIC <- c( list( CPP_CLASSNAME = nCompiler::nFunction( @@ -149,11 +198,12 @@ make_modelValues_nClass <- function(varInfo, ), resize = nCompiler::nFunction( name = "resize", - fun = function(m) { - modelValues_resize(self, m, dot_sizeList) - self$dot_current_nRow <- m - # check preservation issues in resizing - }, + fun = r_resize_fun, + # fun = function(m) { + # modelValues_resize(self, m, dot_sizeList) + # self$dot_current_nRow <- m + # # check preservation issues in resizing + # }, compileInfo = list( C_fun = c_resize_fun ), @@ -169,7 +219,7 @@ make_modelValues_nClass <- function(varInfo, if (is.null(defaultSizes)) defaultSizes <- list() for (v in names(varInfo$vars)) { if (is.null(defaultSizes[[v]]) || length(defaultSizes[[v]]) == 0) { - defaultSizes[[v]] <- rep(0, varInfo$vars[[v]]$nDim) + defaultSizes[[v]] <- rep(0, max(varInfo$vars[[v]]$nDim, 1)) } } @@ -238,20 +288,91 @@ make_modelValues_hashID <- function(varInfo) { } #' @export -modelValues <- function(varInfo, .ID = FALSE, env = parent.frame()) { - if (inherits(varInfo, "modelBase_nClass")) { - varInfo <- get_varInfo_from_nimbleModel(varInfo$modelDef) +modelValues <- function(varInfo, .ID = FALSE, env = parent.frame(), ...) { + dotsArgs <- list(...) + # Use legacy mode if legacy_nimble is TRUE or the nimbleModel option is set + legacy_nimble <- isTRUE(getNimbleModelOption("legacy_nimble")) || isTRUE(dotsArgs$legacy_nimble) + # But even for legacy mode, when called from modelValueConf, we want to use non-legacy case, + # so legacy_nimble=FALSE over-rides and gives non-legacy behavior. + legacy_nimble <- legacy_nimble && !isFALSE(dotsArgs$legacy_nimble) + if(!legacy_nimble) { + if (inherits(varInfo, "modelBase_nClass")) { + varInfo <- get_varInfo_from_nimbleModel(varInfo$modelDef) + } else if (inherits(varInfo, "modelDefClass")) { + varInfo <- get_varInfo_from_nimbleModel(varInfo) + } + hashedID <- make_modelValues_hashID(varInfo) + cpp_classname <- Rname2CppName(paste0("MV_", hashedID)) + if (isTRUE(.ID)) { + return(cpp_classname) + } + ans <- make_modelValues_nClass(varInfo, cpp_classname = cpp_classname) + return(ans) } - hashedID <- make_modelValues_hashID(varInfo) - cpp_classname <- Rname2CppName(paste0("MV_", hashedID)) - if (isTRUE(.ID)) { - return(cpp_classname) + # legacy nimble from here down. + # call could be for prototype modelValues(conf, m), so check for named args in ... + # or grab ordered args from varInfo and .ID + if("conf" %in% names(dotsArgs)) { + conf <- dotsArgs$conf + confNamed <- TRUE + } else { + conf <- varInfo + confNamed <- FALSE } - ans <- make_modelValues_nClass(varInfo, cpp_classname = cpp_classname) - ans + if("m" %in% names(dotsArgs)) { + m <- dotsArgs$m + } else { + m <- if(confNamed) varInfo else .ID + } + } class(modelValues) <- c("function", "nClassBuilder") +#' Create the confs for a custom NIMBLE modelValues object (legacy version) +#' +#' Builds an R-based modelValues conf object +#' +#' @param vars A vector of character strings naming each variable in the modelValues object +#' @param types A vector of character strings describing the type of data for the modelValues object. +#' Options include `double' (for real-valued variables) and `int'. +#' @param sizes A list in which the named items of the list match the \code{var} arguments and each item is a numeric vector of the dimensions +#' @param symTab For internal use only +#' @param className For internal use only +#' @param where For internal use only +#' @param modelDef For internal use only +#' @author Clifford Anderson-Bergman +#' @export +#' @details +#' See the \href{https://r-nimble.org/manual/cha-welcome-nimble.html}{User Manual} or \code{help(modelValuesBaseClass)} and \code{help(modelValues)} for information +#' +#' @examples +#' #Custom modelValues object: +#' mvConf <- modelValuesConf(vars = c('x', 'y'), +#' types = c('double', 'int'), +#' sizes = list(x = 3, y = c(2,2))) +#' custom_mv <- modelValues(mvConf, m = 2) +#' custom_mv['y',] +modelValuesConf <- function(symTab, className, vars, types, sizes, + modelDef = NA, where = globalenv() ) { + #if(missing(className)) className <- 'modelValuesConf' ## uniqueID will be appended + if(!missing(className)) stop("modelValuesConf no longer supports the className argument.") + if(!missing(symTab)) stop("modelValuesConf no longer supports the symTab argument.") + varsList <- vector("list", length(vars)) + names(varsList) <- vars + for(i in seq_along(vars)) { + varsList[[i]] <- list(name = vars[i], nDim = length(sizes[[i]])) + } + sizes <- sizes[vars] + varInfo <- list(vars = varsList, sizes = sizes) + mvClass <- modelValues(varInfo, .ID = FALSE, legacy_nimble = FALSE) + ans <- function(nrow = 1L) { + res <- mvClass$new() + res$resize(nrow) + res + } + ans +} + ## We don't need to overload `[[` or `[[<-` because they ## "just work" by accessing member variables that are nLists. ## However it does return an nList instead of a list. @@ -264,57 +385,144 @@ class(modelValues) <- c("function", "nClassBuilder") #' @exportS3Method #' @method `[` modelValues `[.modelValues` <- function(x, var, ind) { + # nimble attempts to handle missing var (i) by using all vars, but the behavior is unused and broken. + if(missing(var)) stop("Bracket access of a modelValues object requires a variable in the brackets.") + # nimble code appears to handle multiple variables but it is untested and broken. + # It must have been a draft that was not determined be important and not cleaned up. + if(length(var) != 1) stop("Bracket access of a modelValues object handles only variable at a time.") + if(missing(ind)) ind <- 1:length(x) if (x$isCompiled()) { - nCompiler::value(x, var)[[ind]] + if(length(ind) == 1) + nCompiler::value(x, var)[[ind]] + else { + res <- nCompiler::value(x, var)[ind] # nimble returns a list here when nimble2 returns an nList + if(isTRUE(getNimbleModelOption("legacy_nimble"))) + as.list(res) + else + res + } } else { - x[[var]][[ind]] + if(length(ind) == 1) + x[[var]][[ind]] + else { + res <- x[[var]][ind] + if(isTRUE(getNimbleModelOption("legacy_nimble"))) + as.list(res) + else + res + } } } #' @exportS3Method #' @method `[<-` modelValues `[<-.modelValues` <- function(x, var, ind, value) { + if(missing(var)) stop("Bracket access of a modelValues object requires a variable in the brackets.") + if(length(var) != 1) stop("Bracket access of a modelValues object handles only variable at a time.") + if(missing(ind)) ind <- 1:length(x) if (x$isCompiled()) { - nCompiler::value(x, var)[[ind]] <- value + if(length(ind) == 1) + nCompiler::value(x, var)[[ind]] <- value + else + nCompiler::value(x, var)[ind] <- value # value could be an nList or a list. } else { - x[[var]][[ind]] <- value + if(length(ind) == 1) + x[[var]][[ind]] <- value + else + x[[var]][ind] <- value } x } -## To-Do: It would be nice to have an "as.list" that -## returns a list of lists. This needs -## access to the variable names and at the moment -## that will only work from a derived class, not -## from a returned base class ptr. +modelValues_varNames <- function(x) { + if (nCompiler::isCompiled(x)) { + res <- nCompiler::interface_names(x, "members") + res <- res[!res %in% c("dot_sizeList", "dot_current_nRow")] + res + } else { + x$varInfo$vars |> names() + } +} + +## Early versions of this were cruder. +## Now this code is generic to compiled vs uncompiled +## and also to generic vs. full interface. #' @exportS3Method #' @method as.list modelValues -as.list.modelValues <- function(x) { - if (x$isCompiled()) { - varNames <- nCompiler::interface_names(x, "members") - varNames <- varNames[!varNames %in% c("dot_sizeList", "dot_current_nRow")] - if (!is.null(varNames)) { - return( - varNames |> lapply( - \(var) as.list(nCompiler::value(x, var)) - ) |> - structure(names = varNames) - ) - } - } else { - varNames <- x$varInfo$vars |> names() - if (!is.null(varNames)) { - return( - varNames |> lapply( - \(var) as.list(x[[var]]) - ) |> - structure(names = varNames) - ) +as.list.modelValues <- function(x, varNames, stack = TRUE, flatten = FALSE, iterationAsLastIndex = FALSE, ...) { + if (missing(varNames)) + varNames <- modelValues_varNames(x) + if (length(varNames)) { + ans <- vector("list", length(varNames)) |> setNames(varNames) + for(var in varNames) { + res <- as.list(nCompiler::value(x, var)) # converts nList to list; compiled or uncompiled. + if(flatten) { + rawDims <- dimOrLength(res[[1]]) + this_colnames <- dims_2_colnames(rawDims, var = var) + } + if(stack) { + res <- simplify2array(res, higher = !flatten) + dims <- dim(res) + nDim <- length(dims) + if(!iterationAsLastIndex) { + res <- aperm(res, c(nDim, 1:(nDim-1))) + if(flatten) { + colnames(res) <- this_colnames + names(dimnames(res)) <- c("iteration", "element") + } + } else { + if(flatten) { + rownames(res) <- this_colnames + names(dimnames(res)) <- c("element", "iteration") + } + } + } else { + if(flatten) { + res <- lapply(res, \(x) { + dim(x) <- c(1, length(x)) + names(x) <- this_colnames + x + }) + } + } + ans[[var]] <- res } + return(ans) } - NULL + list() } +# as.list.modelValues <- function(x) { +# if (x$isCompiled()) { +# varNames <- nCompiler::interface_names(x, "members") +# varNames <- varNames[!varNames %in% c("dot_sizeList", "dot_current_nRow")] +# # Name ordering of nCompiler's interface_names() was updated to guarantee +# # the order matches the defintion order, so we no longer sort +# # and the ordering should match a user's expectation. +# if (!is.null(varNames)) { +# #varNames <- sort(varNames) +# return( +# varNames |> lapply( +# \(var) as.list(nCompiler::value(x, var)) +# ) |> +# structure(names = varNames) +# ) +# } +# } else { +# varNames <- x$varInfo$vars |> names() +# #varNames <- sort(varNames) +# if (!is.null(varNames)) { +# return( +# varNames |> lapply( +# \(var) as.list(x[[var]]) +# ) |> +# structure(names = varNames) +# ) +# } +# } +# NULL +# } + #' @exportS3Method #' @method length modelValues length.modelValues <- function(x) { @@ -335,3 +543,107 @@ length.modelValues <- function(x) { } x } + +dims_2_colnames <- function(dims, var = "x") { + dim_strings <- dims |> + lapply(\(x) 1:x) |> + expand.grid() |> + apply(1, \(x) paste0(as.character(x), collapse = ", ")) + colnames <- paste0(var, "[", dim_strings, "]") +} + +#' @exportS3Method +#' @method as.matrix modelValues +as.matrix.modelValues <- function(x) { + varNames <- modelValues_varNames(x) + # Sorting is not necessary after updating nCompiler to guarantee order matches definition. + # varNames <- sort(varNames) # could be different from interface_names than definition order + matrices <- list() + for(vn in varNames) { + this_list <- nCompiler::value(x, vn) + if(length(this_list) == 0) next + dim_x <- dimOrLength(this_list[[1]]) + tot_len <- prod(dim_x) + this_colnames <- dims_2_colnames(dim_x, var = vn) + # Possibly add check that all elements have the same dim + this_matrix <- this_list |> lapply(\(x) {dim(x) <- c(1, tot_len); x}) |> + (\(x) do.call("rbind", x))() + colnames(this_matrix) <- this_colnames + matrices[[vn]] <- this_matrix + } + do.call("cbind", matrices) +} + +#' @export +matrix2mv <- function(mat, mv) { + # inverse of as.matrix.modelValues + k <- nrow(mat) + colNames <- colnames(mat) + colNamesVars <- colNames |> (\(x) sub('\\[.*', '', x))() + uniqueColNameVars <- colNamesVars |> unique() + for(vN in uniqueColNameVars){ + varInds <- colNamesVars == vN + numCols <- sum(varInds) + theseColNames <- colNames[varInds] + idxPart <- sub("^[^[]*", "", theseColNames) # remove the variable name in case it includes any digits. + allInds <- lapply(regmatches(idxPart, gregexpr("[0-9]+", idxPart)), as.numeric) + theseSizes <- do.call("rbind", allInds) |> apply(2, max) + + if(numCols != prod(theseSizes)) + stop(paste0("matrix2mv had a problem with the dimensions of ", vN)) + if(length(theseSizes) > 1) { + res <- apply(mat[, varInds, drop = FALSE], 1, \(x) { + dim(x) <- theseSizes + x + }, + simplify = FALSE) + } else { + res <- apply(mat[, varInds, drop = FALSE], 1, \(x) { + x + }, + simplify = FALSE) + } + # We must use value() in case mv is a base class or generic interface. + nCompiler::value(mv, vN) <- res + # mv[[vN]] <- res + } + mv +} + +#' Resizes a modelValues object +#' +#' Adds or removes rows to a modelValues object. If rows are added to a modelValues object, the default values are \code{NA}. Works in both R and NIMBLE. +#' +#' @param container modelValues object +#' @param k number of rows that modelValues is set to +#' @export +#' @examples +#' mvConf <- modelValuesConf(vars = c('a', 'b'), +#' types = c('double', 'double'), +#' sizes = list(a = 1, b = c(2,2) ) ) +#' mv <- modelValues(mvConf) +#' as.matrix(mv) +#' resize(mv, 3) +#' as.matrix(mv) +#' +#' @export +resize <- function(container, k) { + container$resize( as.integer(k) ) +} + +#' Returns number of rows of modelValues +#' +#' Returns the number of rows of NIMBLE modelValues object. Works in R and NIMBLE. +#' +#' @param container modelValues object +#' +#' @export +#' +#' @examples +#' mvConf <- modelValuesConf(vars = 'a', types = 'double', sizes = list(a = 1) ) +#' mv <- modelValues(mvConf) +#' resize(mv, 10) +#' getsize(mv) +getsize <- function(container) { + container$getSize() +} diff --git a/nimbleModel/R/nimbleModel.R b/nimbleModel/R/nimbleModel.R index 6a5a4b2..ed306f8 100644 --- a/nimbleModel/R/nimbleModel.R +++ b/nimbleModel/R/nimbleModel.R @@ -268,6 +268,8 @@ makeModel_nClass <- function(modelVarInfo, names(CpublicModelVars) <- modelVarInfo$vars |> lapply(\(x) x$name) |> unlist() + # These opDefs are in place but not actually used. They should start from custom_default + # and nCompiler needs to support custom opDefs for calls like obj$method(). opDefs <- list( base_ping = nCompiler:::getOperatorDef("custom_call"), setup_auto_decl_mgmt = nCompiler:::getOperatorDef("custom_call"), diff --git a/nimbleModel/R/opDefs.R b/nimbleModel/R/opDefs.R new file mode 100644 index 0000000..480bb66 --- /dev/null +++ b/nimbleModel/R/opDefs.R @@ -0,0 +1,25 @@ +nimbleModel_error_LAT <- function(code, symTab, auxEnv, info) { + # LATenv <- nCompiler:::labelAbstractTypesEnv + stop(exprClassProcessingErrorMsg( + code, + 'resize is not supported for the given argument type.' + ), call. = FALSE) + stop("resize is not supported for the given argument type.") +} + +nimbleModel_nCompiler_opDefs <- list( + resize = list( + matchDef = function(obj, size) {}, + isGeneric = TRUE, + labelAbstractTypes = list( + handler = nimbleModel_error_LAT # this serves as a generic to catch errors. An overload will be provided for modelValues. + ) + ), + getsize = list( + matchDef = function(obj) {}, + isGeneric = TRUE, + labelAbstractTypes = list( + handler = nimbleModel_error_LAT + ) + ) +) \ No newline at end of file diff --git a/nimbleModel/R/options.R b/nimbleModel/R/options.R index 37e4037..dd38a2f 100644 --- a/nimbleModel/R/options.R +++ b/nimbleModel/R/options.R @@ -8,6 +8,7 @@ # but this has .GlobalEnv as a parent. processBackwardsModelIndexRanges = TRUE, disallowMultivariateArgumentExpressions = TRUE, + legacy_nimble = FALSE, # TRUE means stricter use of original nimble behavior in some cases. verbose = TRUE ) ) diff --git a/nimbleModel/R/types_util.R b/nimbleModel/R/types_util.R index 7d873fd..b8c9fa8 100644 --- a/nimbleModel/R/types_util.R +++ b/nimbleModel/R/types_util.R @@ -173,185 +173,185 @@ nl_removeNodeNamesNotInSymbolTable <- function(nodeNames, st) { nl_getVarNameFromNodeName <- function(nodeName) gsub("\\[.*", "", nodeName) -expandMVNames <- function(mv, varNames) { - scipen <- options("scipen")[[1]] - options(scipen = 1000000) - on.exit(options(scipen = scipen)) - sizeList <- mv$sizes - nodeNames <- NA - nodeIndex <- 0 - for (i in seq_along(varNames)) { - baseName <- varNames[i] - dims <- mv$symTab$getSymbolObject(baseName)$size - if (length(dims) == 0) { - nodeNames[nodeIndex + 1] <- baseName - nodeIndex <- nodeIndex + 1 - } else { - mins <- rep(1, length(dims)) - indexStuff <- paste(mins, dims, sep = ":", collapse = ", ") - compactNodeNames <- paste0(baseName, "[", indexStuff, "]") - expandedNodeNames <- nl_expandNodeIndex(compactNodeNames) - nodeNames[nodeIndex + 1:length(expandedNodeNames)] <- expandedNodeNames - nodeIndex <- nodeIndex + length(expandedNodeNames) - } - } - return(nodeNames) -} +# expandMVNames <- function(mv, varNames) { +# scipen <- options("scipen")[[1]] +# options(scipen = 1000000) +# on.exit(options(scipen = scipen)) +# sizeList <- mv$sizes +# nodeNames <- NA +# nodeIndex <- 0 +# for (i in seq_along(varNames)) { +# baseName <- varNames[i] +# dims <- mv$symTab$getSymbolObject(baseName)$size +# if (length(dims) == 0) { +# nodeNames[nodeIndex + 1] <- baseName +# nodeIndex <- nodeIndex + 1 +# } else { +# mins <- rep(1, length(dims)) +# indexStuff <- paste(mins, dims, sep = ":", collapse = ", ") +# compactNodeNames <- paste0(baseName, "[", indexStuff, "]") +# expandedNodeNames <- nl_expandNodeIndex(compactNodeNames) +# nodeNames[nodeIndex + 1:length(expandedNodeNames)] <- expandedNodeNames +# nodeIndex <- nodeIndex + length(expandedNodeNames) +# } +# } +# return(nodeNames) +# } -as.matrix.modelValuesBaseClass <- function(x, varNames, ...) { - if (missing(varNames)) { - varNames <- x$varNames - } - if (!length(varNames)) { - return(NULL) - } - nrows <- getsize(x) - flatNames <- expandMVNames(x, varNames) - ans <- matrix(as.numeric(NA), nrow = nrows, ncol = length(flatNames)) - colIndex <- 1 - for (i in seq_along(varNames)) { - .Call(fastMatrixInsert, ans, modelValuesElement2Matrix(x, varNames[i]), as.integer(1), as.integer(colIndex)) - colIndex <- colIndex + prod(x$sizes[[varNames[i]]]) - } - colnames(ans) <- flatNames - return(ans) -} +# as.matrix.modelValuesBaseClass <- function(x, varNames, ...) { +# if (missing(varNames)) { +# varNames <- x$varNames +# } +# if (!length(varNames)) { +# return(NULL) +# } +# nrows <- getsize(x) +# flatNames <- expandMVNames(x, varNames) +# ans <- matrix(as.numeric(NA), nrow = nrows, ncol = length(flatNames)) +# colIndex <- 1 +# for (i in seq_along(varNames)) { +# .Call(fastMatrixInsert, ans, modelValuesElement2Matrix(x, varNames[i]), as.integer(1), as.integer(colIndex)) +# colIndex <- colIndex + prod(x$sizes[[varNames[i]]]) +# } +# colnames(ans) <- flatNames +# return(ans) +# } -as.matrix.CmodelValues <- function(x, varNames, ...) { - if (missing(varNames)) { - varNames <- x$varNames - } - if (!length(varNames)) { - return(NULL) - } - nrows <- getsize(x) - flatNames <- expandMVNames(x, varNames) - ans <- matrix(as.numeric(NA), nrow = nrows, ncol = length(flatNames)) - colIndex <- 1 - for (i in seq_along(varNames)) { - .Call(fastMatrixInsert, ans, modelValuesElement2Matrix(x, varNames[i]), as.integer(1), as.integer(colIndex)) - colIndex <- colIndex + prod(x$sizes[[varNames[i]]]) - } - colnames(ans) <- flatNames - return(ans) -} +# as.matrix.CmodelValues <- function(x, varNames, ...) { +# if (missing(varNames)) { +# varNames <- x$varNames +# } +# if (!length(varNames)) { +# return(NULL) +# } +# nrows <- getsize(x) +# flatNames <- expandMVNames(x, varNames) +# ans <- matrix(as.numeric(NA), nrow = nrows, ncol = length(flatNames)) +# colIndex <- 1 +# for (i in seq_along(varNames)) { +# .Call(fastMatrixInsert, ans, modelValuesElement2Matrix(x, varNames[i]), as.integer(1), as.integer(colIndex)) +# colIndex <- colIndex + prod(x$sizes[[varNames[i]]]) +# } +# colnames(ans) <- flatNames +# return(ans) +# } -as.list.modelValuesBaseClass <- function(x, varNames, iterationAsLastIndex = FALSE, ...) { - if (missing(varNames)) { - varNames <- x$varNames - } - nrows <- getsize(x) - results <- list() - for (v in varNames) { - samples <- x[[v]] - dims <- dimOrLength(samples[[1]]) - matrixVersion <- do.call("c", lapply(samples, as.numeric)) - ansDims <- c(dims, nrows) - results[[v]] <- array(matrixVersion, dim = ansDims) - if (!iterationAsLastIndex) { - nDim <- length(ansDims) - results[[v]] <- aperm(results[[v]], c(nDim, 1:(nDim - 1))) - } - } - results -} +# as.list.modelValuesBaseClass <- function(x, varNames, iterationAsLastIndex = FALSE, ...) { +# if (missing(varNames)) { +# varNames <- x$varNames +# } +# nrows <- getsize(x) +# results <- list() +# for (v in varNames) { +# samples <- x[[v]] +# dims <- dimOrLength(samples[[1]]) +# matrixVersion <- do.call("c", lapply(samples, as.numeric)) +# ansDims <- c(dims, nrows) +# results[[v]] <- array(matrixVersion, dim = ansDims) +# if (!iterationAsLastIndex) { +# nDim <- length(ansDims) +# results[[v]] <- aperm(results[[v]], c(nDim, 1:(nDim - 1))) +# } +# } +# results +# } -as.list.CmodelValues <- function(x, varNames, iterationAsLastIndex = FALSE, ...) { - if (missing(varNames)) { - varNames <- x$varNames - } - nrows <- getsize(x) - results <- list() - for (v in varNames) { - samples <- x[[v]] - dims <- dimOrLength(samples[[1]]) - matrixVersion <- do.call("c", lapply(samples, as.numeric)) - ansDims <- c(dims, nrows) - results[[v]] <- array(matrixVersion, dim = ansDims) - if (!iterationAsLastIndex) { - nDim <- length(ansDims) - results[[v]] <- aperm(results[[v]], c(nDim, 1:(nDim - 1))) - } - } - results -} +# as.list.CmodelValues <- function(x, varNames, iterationAsLastIndex = FALSE, ...) { +# if (missing(varNames)) { +# varNames <- x$varNames +# } +# nrows <- getsize(x) +# results <- list() +# for (v in varNames) { +# samples <- x[[v]] +# dims <- dimOrLength(samples[[1]]) +# matrixVersion <- do.call("c", lapply(samples, as.numeric)) +# ansDims <- c(dims, nrows) +# results[[v]] <- array(matrixVersion, dim = ansDims) +# if (!iterationAsLastIndex) { +# nDim <- length(ansDims) +# results[[v]] <- aperm(results[[v]], c(nDim, 1:(nDim - 1))) +# } +# } +# results +# } -modelValuesElement2Matrix <- function(mv, varName) { - if (length(varName) != 1) { - stop("modelValuesElement2Matrix is a call for a single variable. For multiple variables, use modelValues2Matrix") - } - matrix(as.numeric(unlist(mv[[varName]])), ncol = prod(mv$sizes[[varName]]), byrow = TRUE) -} +# modelValuesElement2Matrix <- function(mv, varName) { +# if (length(varName) != 1) { +# stop("modelValuesElement2Matrix is a call for a single variable. For multiple variables, use modelValues2Matrix") +# } +# matrix(as.numeric(unlist(mv[[varName]])), ncol = prod(mv$sizes[[varName]]), byrow = TRUE) +# } -Cmatrix2mvOneVar <- function(mat, mv, varName, k) { - ptr <- mv$componentExtptrs[[varName]] - if (inherits(ptr, "externalptr")) { - eval(call(".Call", nimbleUserNamespace$sessionSpecificDll$matrix2VecNimArr, ptr, mat, rowStart = as.integer(1), rowEnd = k)) - } else { - stop("varName not found in modelValues") - } -} +# Cmatrix2mvOneVar <- function(mat, mv, varName, k) { +# ptr <- mv$componentExtptrs[[varName]] +# if (inherits(ptr, "externalptr")) { +# eval(call(".Call", nimbleUserNamespace$sessionSpecificDll$matrix2VecNimArr, ptr, mat, rowStart = as.integer(1), rowEnd = k)) +# } else { +# stop("varName not found in modelValues") +# } +# } -#' Set values of one variable of a modelValues object from an R matrix -#' -#' Normally a modelValues object is accessed one "row" at a time. This function allows all rows for one variable to set from a matrix with one dimension more than the variable to be set. -#' -#' @param mat Input matrix -#' -#' @param mv modelValues object to be modified. -#' -#' @param varName Character string giving the name of the variable on \code{mv} to be set -#' -#' @param k Number of rows to use -#' -#' @export -#' @details -#' This function may be deprecated in the future when a more natural system for interacting with modelValues objects is developed. -Rmatrix2mvOneVar <- function(mat, mv, varName, k) { - if (mv$symTab$symbols[[varName]][["type"]] == "double") { - storage.mode(mat) <- "double" - len <- ncol(mat) - .Call(matrix2ListDouble, mat, mv[[varName]], listStartIndex = as.integer(1), RnRows = k, Rlength = as.integer(mv$sizes[[varName]])) - } - if (mv$symTab$symbols[[varName]][["type"]] == "int") { - storage.mode(mat) <- "integer" - len <- ncol(mat) - .Call(matrix2ListInt, mat, mv[[varName]], listStartIndex = as.integer(1), RnRows = k, Rlength = as.integer(mv$sizes[[varName]])) - } -} +# #' Set values of one variable of a modelValues object from an R matrix +# #' +# #' Normally a modelValues object is accessed one "row" at a time. This function allows all rows for one variable to set from a matrix with one dimension more than the variable to be set. +# #' +# #' @param mat Input matrix +# #' +# #' @param mv modelValues object to be modified. +# #' +# #' @param varName Character string giving the name of the variable on \code{mv} to be set +# #' +# #' @param k Number of rows to use +# #' +# #' @export +# #' @details +# #' This function may be deprecated in the future when a more natural system for interacting with modelValues objects is developed. +# Rmatrix2mvOneVar <- function(mat, mv, varName, k) { +# if (mv$symTab$symbols[[varName]][["type"]] == "double") { +# storage.mode(mat) <- "double" +# len <- ncol(mat) +# .Call(matrix2ListDouble, mat, mv[[varName]], listStartIndex = as.integer(1), RnRows = k, Rlength = as.integer(mv$sizes[[varName]])) +# } +# if (mv$symTab$symbols[[varName]][["type"]] == "int") { +# storage.mode(mat) <- "integer" +# len <- ncol(mat) +# .Call(matrix2ListInt, mat, mv[[varName]], listStartIndex = as.integer(1), RnRows = k, Rlength = as.integer(mv$sizes[[varName]])) +# } +# } -matrix2mv <- function(mat, mv) { - k <- nrow(mat) - if (mv$getSize() < k) { - mv$resize(k) - } - mvVarNames <- mv$varNames - mvSizes <- mv$sizes - colNames <- colnames(mat) - colNames <- removeIndexing(colNames) - uniqueColNames <- unique(colNames) - if (inherits(mv, "CmodelValues")) { - for (vN in uniqueColNames) { - totVals <- prod(mvSizes[[vN]]) - varInds <- colNames == vN - if (totVals != sum(varInds)) { - stop("matrix2mv halted because dimensions of variables do not match") - } - subMatrix <- as.matrix(mat[, varInds, drop = FALSE]) - Cmatrix2mvOneVar(subMatrix, mv, vN, k) - } - } else if (inherits(mv, "modelValuesBaseClass")) { - for (vN in uniqueColNames) { - totVals <- prod(mvSizes[[vN]]) - varInds <- colNames == vN - if (totVals != sum(varInds)) { - stop("matrix2mv halted because dimensions of variables do not match") - } - subMatrix <- as.matrix(mat[, varInds, drop = FALSE]) - Rmatrix2mvOneVar(subMatrix, mv, vN, k) - } - } else { - stop("argument mv is neither a CmodelValues or RmodelValues object") - } -} +# matrix2mv <- function(mat, mv) { +# k <- nrow(mat) +# if (mv$getSize() < k) { +# mv$resize(k) +# } +# mvVarNames <- mv$varNames +# mvSizes <- mv$sizes +# colNames <- colnames(mat) +# colNames <- removeIndexing(colNames) +# uniqueColNames <- unique(colNames) +# if (inherits(mv, "CmodelValues")) { +# for (vN in uniqueColNames) { +# totVals <- prod(mvSizes[[vN]]) +# varInds <- colNames == vN +# if (totVals != sum(varInds)) { +# stop("matrix2mv halted because dimensions of variables do not match") +# } +# subMatrix <- as.matrix(mat[, varInds, drop = FALSE]) +# Cmatrix2mvOneVar(subMatrix, mv, vN, k) +# } +# } else if (inherits(mv, "modelValuesBaseClass")) { +# for (vN in uniqueColNames) { +# totVals <- prod(mvSizes[[vN]]) +# varInds <- colNames == vN +# if (totVals != sum(varInds)) { +# stop("matrix2mv halted because dimensions of variables do not match") +# } +# subMatrix <- as.matrix(mat[, varInds, drop = FALSE]) +# Rmatrix2mvOneVar(subMatrix, mv, vN, k) +# } +# } else { +# stop("argument mv is neither a CmodelValues or RmodelValues object") +# } +# } diff --git a/nimbleModel/R/zzz.R b/nimbleModel/R/zzz.R new file mode 100644 index 0000000..f2e8fe3 --- /dev/null +++ b/nimbleModel/R/zzz.R @@ -0,0 +1,8 @@ +.onLoad <- function(libname, pkgname) { + # ns <- asNamespace(pkgname) + nCompiler::registerOpDef(nimbleModel_nCompiler_opDefs) +} + +.onUnload <- function(libpath) { + nCompiler::deregisterOpDef(names(nimbleModel_nCompiler_opDefs)) +} diff --git a/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_cppContent.cpp b/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_cppContent.cpp index 50ee59d..aee24a3 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_cppContent.cpp +++ b/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_cppContent.cpp @@ -14,37 +14,41 @@ using namespace Rcpp; // [[Rcpp::depends(Rcereal)]] // [[Rcpp::depends(nimbleModel)]] - modelValuesBase_nClass::modelValuesBase_nClass ( ) { + modelValuesBase_nClass::modelValuesBase_nClass ( ) { RESET_EIGEN_ERRORS flex_((this)->dot_current_nRow) = 0.0; this->dot_sizeList = Rcpp::List();; } - void modelValuesBase_nClass::set_sizeList ( Rcpp::List sizeList ) { + void modelValuesBase_nClass::set_sizeList ( Rcpp::List sizeList ) { RESET_EIGEN_ERRORS dot_sizeList = sizeList; (this)->dot_sizeList = sizeList; } - Rcpp::List modelValuesBase_nClass::get_sizeList ( ) { + Rcpp::List modelValuesBase_nClass::get_sizeList ( ) { RESET_EIGEN_ERRORS return((this)->dot_sizeList); } - void modelValuesBase_nClass::resize ( int m ) { + void modelValuesBase_nClass::resize ( int m ) { RESET_EIGEN_ERRORS Rcpp::stop("Should not be calling compiled modelValuesBase_nClass resize().");; } - int modelValuesBase_nClass::getLength ( ) { + int modelValuesBase_nClass::getLength ( ) { RESET_EIGEN_ERRORS return((this)->dot_current_nRow); +} + int modelValuesBase_nClass::getSize ( ) { +RESET_EIGEN_ERRORS +return((this)->getLength()); } // [[Rcpp::export(name = "set_CnClass_env_modelValuesBase_nClass_new")]] - void set_CnClass_env_modelValuesBase_nClass ( SEXP env ) { + void set_CnClass_env_modelValuesBase_nClass ( SEXP env ) { RESET_EIGEN_ERRORS SET_CNCLASS_ENV(modelValuesBase_nClass, env);; } // [[Rcpp::export(name = "get_CnClass_env_modelValuesBase_nClass_new")]] - Rcpp::Environment get_CnClass_env_modelValuesBase_nClass ( ) { + Rcpp::Environment get_CnClass_env_modelValuesBase_nClass ( ) { RESET_EIGEN_ERRORS return GET_CNCLASS_ENV(modelValuesBase_nClass);; } @@ -59,7 +63,8 @@ NCOMPILER_METHODS( method("set_sizeList", &modelValuesBase_nClass::set_sizeList, args({{arg("sizeList",copy)}})), method("get_sizeList", &modelValuesBase_nClass::get_sizeList, args({{}})), method("resize", &modelValuesBase_nClass::resize, args({{arg("m",copy)}})), -method("getLength", &modelValuesBase_nClass::getLength, args({{}})) +method("getLength", &modelValuesBase_nClass::getLength, args({{}})), +method("getSize", &modelValuesBase_nClass::getSize, args({{}})) ) ) #endif diff --git a/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_hContent.h b/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_hContent.h index afd91a0..6a30d5e 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_hContent.h +++ b/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_hContent.h @@ -10,19 +10,20 @@ class modelValuesBase_nClass : public interface_resolver< genericInterfaceC >, public loadedObjectHookC { public: - modelValuesBase_nClass ( ) ; - void set_sizeList ( Rcpp::List sizeList ) ; - Rcpp::List get_sizeList ( ) ; - virtual void resize ( int m ) ; - virtual int getLength ( ) ; + modelValuesBase_nClass ( ) ; + void set_sizeList ( Rcpp::List sizeList ) ; + Rcpp::List get_sizeList ( ) ; + virtual void resize ( int m ) ; + virtual int getLength ( ) ; + virtual int getSize ( ) ; Rcpp::List dot_sizeList; int dot_current_nRow; }; - void set_CnClass_env_modelValuesBase_nClass ( SEXP env ) ; + void set_CnClass_env_modelValuesBase_nClass ( SEXP env ) ; - Rcpp::Environment get_CnClass_env_modelValuesBase_nClass ( ) ; + Rcpp::Environment get_CnClass_env_modelValuesBase_nClass ( ) ; #include diff --git a/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_manifest.txt b/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_manifest.txt index fb4bb2c..6e9054a 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_manifest.txt +++ b/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_manifest.txt @@ -1,4 +1,4 @@ -list(saved_at = structure(1786470263.32434, class = c("POSIXct", +list(saved_at = structure(1789772169.37104, class = c("POSIXct", "POSIXt")), packet_name = "modelValuesBase_nClass", elements = c("preamble", "cppContent", "hContent", "filebase", "post_cpp_compiler", "copyFiles" ), files = list(preamble = "modelValuesBase_nClass_preamble.cpp", diff --git a/nimbleModel/inst/include/nimbleModel/predef/modelValuesClass_/modelValuesClass_.h b/nimbleModel/inst/include/nimbleModel/predef/modelValuesClass_/modelValuesClass_.h index e7debd3..53aeec8 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/modelValuesClass_/modelValuesClass_.h +++ b/nimbleModel/inst/include/nimbleModel/predef/modelValuesClass_/modelValuesClass_.h @@ -3,27 +3,47 @@ class modelValuesClass_ : public modelValuesBase_nClass { public: - int stuff; - // resize_one could move to the base class - template - void resize_one(NLtype &NL, - int m, - const SType &sizes) { - if(sizes.size() != nDim) Rcpp::stop("incorrect number of sizes when resizing an nList in a modelValues."); - NL->setLength(m); - std::array dims; - std::copy(sizes.data(), sizes.data() + sizes.size(), dims.begin()); - // To-do: make the Eigen::Tensor resizes preserve contents - for(int i = 0; i < m; i++) { - (*NL)[i].resize(dims); + int stuff; + // resize_one could move to the base class + template + void resize_one(NLtype &NL, + int m, + const SType &sizes) { + if constexpr(nDim > 0) { + if(sizes.size() != nDim) Rcpp::stop("incorrect number of sizes when resizing an nList in a modelValues."); + } + int old_m = NL->getLength(); + NL->setLength(m); // Change number of elements in the list for this variable. Should be data-preserving. + std::array dims; + if constexpr(nDim > 0) { + std::copy(sizes.data(), sizes.data() + sizes.size(), dims.begin()); + // To-do: make the Eigen::Tensor resizes preserve contents + if(m > old_m) { + for(int i = old_m; i < m; i++) { + (*NL)[i].resize(dims); } + } + } + } + template + void resize_one(NLtype &NL, + int m, + SEXP Ssizes) { + if constexpr(nDim == 0) { + return resize_one(NL, m, Ssizes); // Ssizes will be compile-time ignored. + } + if(Ssizes == R_NilValue) { + Rcpp::stop("A non-scalar variable in a modelValues is missing a sizeList entry."); } - template - void resize_one(NLtype &NL, - int m, - SEXP Ssizes) { - resize_one>(NL, m, Rcpp::as>(Ssizes)); + resize_one>(NL, m, Rcpp::as>(Ssizes)); + } + SEXP getSizeOrNULL(const Rcpp::List &sizeList, const std::string &varName) { + if (sizeList.containsElementNamed(varName.c_str())) { + return as(sizeList[varName]); + } else { + return R_NilValue; } + } }; #endif diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base/multiCopier_modelValues_nC_base.h b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base/multiCopier_modelValues_nC_base.h index 8e5a6b6..efbb914 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base/multiCopier_modelValues_nC_base.h +++ b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base/multiCopier_modelValues_nC_base.h @@ -28,32 +28,22 @@ // name, but always a fresh read, so a reassignment is never missed. class multiCopier_modelValues_nC_base : public multiCopier_nC_base { public: - // One accessor per copier, parallel to (and in the same order as) the - // views held in flatViewGroup once built. This is the field's - // name-resolved accessor_base, NOT the nList it currently resolves to -- - // see the class comment above for why the nList itself must not be cached. + // The accessor_base here is the base class for the generic interface scheme + // for name-based lookup. (This is not related to ETaccessors). + // E.g. for a variable "mu", we can cache the accessor for "mu" without + // repeating the name-based lookup, but that's as close as we can get. + // For safety we need to re-obtain the nList for "mu" on each copy usage. std::vector> fieldAccessors; - // Keeps modelValues itself alive (and is the intBasePtr argument to - // fieldAccessors[k]->getInterfacePtr()) for as long as fieldAccessors hold - // resolutions against it -- same reasoning as modelKeepAlive in - // multiCopier_model_nC_base. + // Ensure the modelValues stays alive. This shouldn't be needed in + // nimble2's design but is here for safety and is cheap. std::shared_ptr modelValuesKeepAlive; - // Saved index-block selections, one per copier, needed to (re)build a view - // the first time a row is actually available (see setActiveRow). + // Saved index-block information for deferring (lazy) setup of the RuntimeFlatViews. std::vector> ssList; - // Whether flatViewGroup has been fully built (shape + data) yet. bool built = false; - // Resolves each copier's varName to its accessor_base, via modelValues's - // own (virtual) get_name2access(), so this works through a base - // modelValuesBase_nClass pointer -- no need for the caller to have the - // fully-derived generated modelValues type in hand. - // - // Deliberately does NOT touch flatViewGroup: at this point modelValues may - // have declared/initialized each nList but not yet resized it (a row count - // of 0 is possible), so there may be no row yet to read shape/data from. - // setActiveRow() must be called at least once, after rows exist, before - // flatViewGroup is used for anything (getValues/setValues/nimCopy_/etc.). + // When init is called, there is no guarantee that the variables will be + // initialized so we can't count on reading their sizes. + // Hence we defer that step until the first actual copy (via setActiveRow). template void init(std::shared_ptr copiers, std::shared_ptr modelValues) { @@ -72,8 +62,7 @@ class multiCopier_modelValues_nC_base : public multiCopier_nC_base { } } - // Re-derives fieldAccessors[k]'s current nList from the live modelValues - // object -- see the class comment for why this must not be cached. + // Get an nList base class pointer from the accessor_base for the k-th variable. std::shared_ptr resolveRowSource(size_t k) { std::shared_ptr ip = fieldAccessors[k]->getInterfacePtr(modelValuesKeepAlive.get()); @@ -84,36 +73,28 @@ class multiCopier_modelValues_nC_base : public multiCopier_nC_base { return nlPtr; } - // Rebinds every view to row `newRow`. The first call also builds each - // view's shape (from that row's accessor); every later call assumes all - // rows of a variable share that shape (an invariant of - // modelValuesClass_::resize_one, which always resizes every row to the - // same dims) and only swaps the data pointer. + // On the first call, we assume we can obtain size information + // that will be constant thereafter (based on whichever row was chosen first!) void setActiveRow(int newRow) { if (!built) { flatViewGroup.clear(); for (size_t k = 0; k < fieldAccessors.size(); ++k) { auto acc = resolveRowSource(k)->access_at(newRow); + // makeRuntimeFlatView does initialize the data pointer, so the + // prepare_for_setData and setNextData steps are not necessary. flatViewGroup.add(makeRuntimeFlatView(acc, ssList[k])); } built = true; } else { - // TODO(perf): this is a hot path (called on every sampler iteration in - // MCMC). resolveRowSource()+access_at() each do a dynamic_cast plus - // access_at() builds a whole ETaccessorBase -- 2 heap allocations (the - // accessor object + its intDims_ vector, the latter never even read - // here) -- just to reach .data(). Once the shape is known (built == - // true), all we actually need is the raw pointer, re-derived fresh - // (both the current nList and the current row's data are still - // re-read every call, since either can change underneath us -- see the - // class comment). A lightweight nListBase_nClass::data_ptr_at(int i) - // (contents_.at(i).data(), no ETaccessorBase involved) would let this - // branch skip the ETaccessorBase allocation. Deferred until this shows - // up as a real bottleneck; see conversation for the sizing. - flatViewGroup.prepare_for_setData(); + // See comment in multiCopier_model_nC_base. + // Performance note for the modelValues case: + // the nListBase_nClass::access_at(row) allocates a new ETaccessor + // every time. Future optimization could re-use a single ETaccessor, + // but that would take a small extension of ETaccessor. + flatViewGroup.prepare_for_setData(); // reset the counter. for (size_t k = 0; k < fieldAccessors.size(); ++k) { - auto acc = resolveRowSource(k)->access_at(newRow); - flatViewGroup.setNextData(acc->template S().data()); + auto acc = resolveRowSource(k)->access_at(newRow); // Get an ETaccessor. + flatViewGroup.setNextData(acc->template S().data()); // reset the data pointer. } } } diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base/multiCopier_model_nC_base.h b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base/multiCopier_model_nC_base.h index 5851281..62afc4b 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base/multiCopier_model_nC_base.h +++ b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base/multiCopier_model_nC_base.h @@ -3,31 +3,23 @@ #include -// Model-backed multiCopier setup: each copier's varName resolves directly -// (via the model's own access()) to an ETaccessorBase for a live field, no -// intermediate row concept. +// model version of a multiCopier. // -// A field's own storage (e.g. an Eigen::Tensor member) can be reallocated -// in place -- resize_from_list() in modelClass_.h calls -// ETA->template ref().resize(...), which reallocates that Tensor's -// internal buffer -- between the time this multiCopier is built and the -// time its flatViewGroup is next used. ETaccessorBase::data() re-derefs the -// live field on every call rather than caching a pointer at construction -// time, so holding onto the accessors (moved, not just read from once) and -// asking them again via setActiveRow is enough to track that: no need to -// go back through the (slow) name-based access() scheme. +// When an Eigen::Tensor is reallocated (e.g. resized), its allocated +// memory (its data pointer) changes, but the Eigen::Tensor object +// itself does not. So we hold a reference to the Eigen::Tensor +// (via an ETaccessorBase that is an ETaccessor for that Tensor). class multiCopier_model_nC_base : public multiCopier_nC_base { public: - // One accessor per copier, parallel to (and in the same order as) the - // views held in flatViewGroup. Moved (not copied) from model->access() so - // that S().data() can be re-read later to pick up any - // reallocation of the field's own storage. + // ETaccessors (for a non-scalar) hold a reference to an Eigen::Tensor. + // The allows us to check the data pointer on each use, in case the + // Eigen::Tensor has been reallocated since the last call. std::vector> accessors; - // Keeps the model itself alive for as long as accessors hold references - // into its fields (ETaccessorBase binds a bare reference to the field, - // not an owning pointer to the model). + // Hold a shared_ptr to the model to keep it alive. + // In normal nimble usage, this should not be necessary, but it is safer and cheap. std::shared_ptr modelKeepAlive; + // init sets the vectors of ETaccessors and RuntimeFlatView. template void init(std::shared_ptr copiers, std::shared_ptr model) { flatViewGroup.clear(); @@ -41,15 +33,17 @@ class multiCopier_model_nC_base : public multiCopier_nC_base { } } - // Shadows multiCopier_nC_base's no-op. There is no "row" concept here -- - // `row` is ignored -- but nimCopy_ calls setActiveRow(row) unconditionally - // on both its src and dst, so this is the natural place to re-sync - // flatViewGroup's data pointers with any reallocation that may have - // happened to the model's fields since the last use. + // RuntimeFlatViewGroup and RuntimeFlatView have a system of updating + // all the data pointers to be used (with the precomputed and cached + // indexing and striding, which [along with the sizes of the variables themselves] + // are assumed to be constant after initialization). + // The system assumes the data pointers will always be provided in the same order, + // i.e. the order of the ETaccessors. + // The argument is ignored (it is used for rows of the modelValues case). void setActiveRow(int /*row*/) { - flatViewGroup.prepare_for_setData(); + flatViewGroup.prepare_for_setData(); // reset counter to 0 for (auto& acc : accessors) - flatViewGroup.setNextData(acc->template S().data()); + flatViewGroup.setNextData(acc->template S().data()); // update each one's data pointer. } }; #endif diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base/multiCopier_nC_base.h b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base/multiCopier_nC_base.h index 06efdff..9a59b71 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base/multiCopier_nC_base.h +++ b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base/multiCopier_nC_base.h @@ -1,32 +1,34 @@ #ifndef __MULTICOPIER_NC_BASE #define __MULTICOPIER_NC_BASE -// Common base for every multiCopier flavor (model-backed, modelValues-backed, -// ...). Holds the one piece of state every flavor needs -- a flattened view -// over the selected variables/index-ranges -- plus a `setActiveRow` hook so -// generic code (nimCopy_ below) can address a "current row" uniformly, even -// for backends, like a model, that have no notion of rows at all. +// multiCopier is used for nimble2's implementations of values() and nimCopy(). +// It represents access to a set of variables and index ranges for each variable. +// It use's nCompiler's RuntimeFlatViewGroup for the actual copying (including indexing and striding). // -// Flavor-specific setup (`init`) lives in each flavor's own base class -// (e.g. multiCopier_model_nC_base, multiCopier_modelValues_nC_base) since the -// source object each flavor reads from differs in kind, not just in type. +// Here is the base class for model and modelValues versions of multiCopies +// and the universal nimCopy_ implementation between any two multiCopiers. +// +// The trick is that we want to look up named variables only once, but hold +// access to each member variable (e.g. an Eigen::Tensor for a model or an +// nList > for a modelValues), not the data +// it points to. That way if the member variable is reset, we don't point to +// stale data. For a model, we hold a reference to the Eigen::Tensor. For +// a modelValues, it is harder: we hold the generic accessor object (accessor +// of the generic interface scheme, not to be confused with ETaccessor for +// type-flexible access to Eigen::Tensors). +// A second trick is that we want to precompute and cache indexing and striding +// info for each copiers, but we need to update the data pointer every time +// in case it has changed. setActiveRow() does that, with the row concept +// relevant only for modelValue. +// +// All copying machinery assumes that the sizes of variables, and the +// selection of indexed blocks of variables, will not change after initialization. class multiCopier_nC_base { public: RuntimeFlatViewGroup flatViewGroup; - - // No-op default: most backends (e.g. a model) have nothing to key by row. - // multiCopier_modelValues_nC_base shadows this with a real implementation. - // Not virtual: which flavor is in play is always known statically at the - // call site (see nimCopy_), so ordinary name lookup/shadowing is enough. void setActiveRow(int row) {} }; -// Copies flatViewGroup-to-flatViewGroup from src (at row srcRow) to dst (at -// row dstRow), after pointing each one at its requested row first. SrcT/DstT -// are resolved at compile time, so this one function works uninformed of -// which concrete multiCopier flavor either side is -- setActiveRow is a -// no-op for a flavor (e.g. model-backed) that doesn't have rows, and does -// the real rebind for one (e.g. modelValues-backed) that does. template void nimCopy_(const std::shared_ptr &src, int srcRow, const std::shared_ptr &dst, int dstRow) { diff --git a/nimbleModel/tests/testthat/test-getParam_getBound.R b/nimbleModel/tests/testthat/test-getParam_getBound.R index 8300aaa..9c57466 100644 --- a/nimbleModel/tests/testthat/test-getParam_getBound.R +++ b/nimbleModel/tests/testthat/test-getParam_getBound.R @@ -3,7 +3,7 @@ library(testthat) cat("getParam and getBound need multivariate tests\n") -test_that("basic getParam and getBound works", { +test_that("basic getParam and getBound works from full interface", { # We need a vector node test, but at the time of this writing, # dmnorm is blocked by calc_dmnormAltParams # ddirch is blocked by needing handlers for rdirch diff --git a/nimbleModel/tests/testthat/test-modelValues.R b/nimbleModel/tests/testthat/test-modelValues.R index fabbff5..52b74e7 100644 --- a/nimbleModel/tests/testthat/test-modelValues.R +++ b/nimbleModel/tests/testthat/test-modelValues.R @@ -18,32 +18,78 @@ test_that("basic modelValues class works", { obj$set_sizeList(sizes) expect_equal(obj$get_sizeList(), sizes) obj$resize(3) - expect_equal(obj$mu |> as.list(), rep(list(numeric(2)), 3)) - expect_equal(obj$cov |> as.list(), matrix(0, nrow = 3, ncol = 4) |> list() |> rep(3)) + default_mu3 <- rep(list(numeric(2)), 3) + default_cov3 <- matrix(0, nrow = 3, ncol = 4) |> list() |> rep(3) + expect_equal(obj$mu |> as.list(), default_mu3) + expect_equal(obj$cov |> as.list(), default_cov3) + + legacy_setting <- getNimbleModelOption("legacy_nimble") + on.exit(setNimbleModelOption("legacy_nimble", legacy_setting)) # S3 interface, uncompiled expect_equal(length(obj), 3) + # Access for var and row expect_equal(obj["mu", 1], c(0, 0)) + # Access all rows for one var + setNimbleModelOption("legacy_nimble", FALSE) + expect_equal(obj["mu"] |> as.list(), default_mu3) + # With legacy_nimble TRUE, `[.modelValues` returns a list instead of an nList + setNimbleModelOption("legacy_nimble", TRUE) + expect_equal(obj["mu"], default_mu3) + setNimbleModelOption("legacy_nimble", FALSE) + # Set all rows for one var + testList <- list(c(1, 2), c(3, 4)) + cat("expected warning about wrong number of items to replace:\n") + expect_warning(obj["mu"] <- testList) # Warning for wrong length + test_muList <- list(c(1, 2), c(3, 4), c(5, 6)) + obj["mu"] <- test_muList + expect_equal(obj["mu"] |> as.list(), test_muList) + obj["mu"] <- default_mu3 + # Set for var and row obj["mu", 1] <- c(1, 2) expect_equal(obj["mu", 1], c(1, 2)) + + # Change length using `length<-`, checking for preserved values. + obj["mu"] <- test_muList length(obj) <- 2 expect_equal(length(obj), 2) - obj["mu", 1] <- c(1, 2) - obj["mu", 2] <- c(3, 4) - list_exp <- list(mu = list(c(1,2), c(3, 4)), cov = matrix(0, nrow = 3, ncol = 4) |> list() |> rep(2)) - expect_equal(as.list(obj), list_exp) - - # Make a holder class so we can test a compiled mv returned - # as a base class - + list_exp2 <- list(mu = test_muList[1:2], cov = default_cov3[1:2]) + list_exp2 <- list_exp2[sort(names(list_exp2))] + expect_equal(as.list(obj), list_exp2) + length(obj) <- 3 + list_exp3 <- list(mu = c(list_exp2$mu, default_mu3[3]), cov = c(list_exp2$cov, default_cov3[3])) + list_exp3 <- list_exp3[sort(names(list_exp3))] + expect_equal(as.list(obj), list_exp3) + + # Change length using `resize`, checking for preserved values. + resize(obj, 2) + expect_equal(getsize(obj), 2) + expect_equal(obj$getSize(), 2) + expect_equal(as.list(obj), list_exp2) + resize(obj, 3) + expect_equal(as.list(obj), list_exp3) + expect_equal(obj$getSize(), 3) + + # Test compiling as a type + # resize and getsize are supported "natively" by opDefs. + # single and double bracket operators for now are + # supported for nimble2 via its keyword processing system mvHolder <- nCompiler::nClass( Cpublic = list( - mv = "modelValuesBase_nClass" + mv = "modelValuesBase_nClass", + check1 = nFunction( + function(m = 'integerScalar') { + resize(mv, m) + } + ), + check2 = nFunction( + function() { + return(getsize(mv)) + returnType(integerScalar()) + } + ) ) ) - -# debug(nCompiler:::compile_generateCpp) -# debug(nCompiler:::process_inheritance) comp <- nCompiler::nCompile(mvClass, mvHolder) CmvClass <- comp$mvClass CmvHolder <- comp$mvHolder @@ -55,20 +101,53 @@ test_that("basic modelValues class works", { obj$set_sizeList(sizes) expect_equal(obj$get_sizeList(), sizes) obj$resize(3) - expect_equal(obj$mu |> as.list(), rep(list(numeric(2)), 3)) - expect_equal(obj$cov |> as.list(), matrix(0, nrow = 3, ncol = 4) |> list() |> rep(3)) + default_mu3 <- rep(list(numeric(2)), 3) + default_cov3 <- matrix(0, nrow = 3, ncol = 4) |> list() |> rep(3) + expect_equal(obj$mu |> as.list(), default_mu3) + expect_equal(obj$cov |> as.list(), default_cov3) # S3 interface, compiled expect_equal(length(obj), 3) + # Access for var and row expect_equal(obj["mu", 1], c(0, 0)) + setNimbleModelOption("legacy_nimble", FALSE) + expect_equal(obj["mu"] |> as.list(), default_mu3) + # With legacy_nimble TRUE, `[.modelValues` returns a list instead of an nList + setNimbleModelOption("legacy_nimble", TRUE) + expect_equal(obj["mu"], default_mu3) + setNimbleModelOption("legacy_nimble", FALSE) + # Set all rows for one var + testList <- list(c(1, 2), c(3, 4)) + cat("expected warning about wrong number of items to replace:\n") + expect_warning(obj["mu"] <- testList) # Warning for wrong length + test_muList <- list(c(1, 2), c(3, 4), c(5, 6)) + obj["mu"] <- test_muList + expect_equal(obj["mu"] |> as.list(), test_muList) + obj["mu"] <- default_mu3 + # Set for var and row obj["mu", 1] <- c(1, 2) expect_equal(obj["mu", 1], c(1, 2)) + + # Change length using `length<-`, checking for preserved values. + obj["mu"] <- test_muList length(obj) <- 2 expect_equal(length(obj), 2) - obj["mu", 1] <- c(1, 2) - obj["mu", 2] <- c(3, 4) - list_exp <- list(mu = list(c(1,2), c(3, 4)), cov = matrix(0, nrow = 3, ncol = 4) |> list() |> rep(2)) - expect_equal(as.list(obj), list_exp[sort(names(list_exp)) ] ) + list_exp2 <- list(mu = test_muList[1:2], cov = default_cov3[1:2]) + list_exp2 <- list_exp2[sort(names(list_exp2))] + expect_equal(as.list(obj), list_exp2) + length(obj) <- 3 + list_exp3 <- list(mu = c(list_exp2$mu, default_mu3[3]), cov = c(list_exp2$cov, default_cov3[3])) + list_exp3 <- list_exp3[sort(names(list_exp3))] + expect_equal(as.list(obj), list_exp3) + + # Change length using `resize`, checking for preserved values. + resize(obj, 2) + expect_equal(getsize(obj), 2) + expect_equal(obj$getSize(), 2) + expect_equal(as.list(obj), list_exp2) + resize(obj, 3) + expect_equal(as.list(obj), list_exp3) + expect_equal(obj$getSize(), 3) # Accessed by base class pointer as a member of another class obj <- CmvClass$new() @@ -84,21 +163,64 @@ test_that("basic modelValues class works", { nCompiler::method(obj, "set_sizeList")(sizes) expect_equal(nCompiler::method(obj, "get_sizeList")(), sizes) nCompiler::method(obj, "resize")(3) - expect_equal(nCompiler::value(obj, "mu") |> as.list(), rep(list(numeric(2)), 3)) - expect_equal(nCompiler::value(obj, "cov") |> as.list(), matrix(0, nrow = 3, ncol = 4) |> list() |> rep(3)) + expect_equal(nCompiler::value(obj, "mu") |> as.list(), default_mu3) + expect_equal(nCompiler::value(obj, "cov") |> as.list(), default_cov3) # In S3 interface use, normal syntax should work # because the S3 interface functions use value() and method() expect_equal(length(obj), 3) + # Access for var and row expect_equal(obj["mu", 1], c(0, 0)) + # Access all rows for one var + setNimbleModelOption("legacy_nimble", FALSE) + expect_equal(obj["mu"] |> as.list(), default_mu3) + # With legacy_nimble TRUE, `[.modelValues` returns a list instead of an nList + setNimbleModelOption("legacy_nimble", TRUE) + expect_equal(obj["mu"], default_mu3) + setNimbleModelOption("legacy_nimble", FALSE) + # Set all rows for one var + testList <- list(c(1, 2), c(3, 4)) + cat("expected warning about wrong number of items to replace:\n") + expect_warning(obj["mu"] <- testList) # Warning for wrong length + test_muList <- list(c(1, 2), c(3, 4), c(5, 6)) + obj["mu"] <- test_muList + expect_equal(obj["mu"] |> as.list(), test_muList) + obj["mu"] <- default_mu3 + # Set for var and row obj["mu", 1] <- c(1, 2) expect_equal(obj["mu", 1], c(1, 2)) + + # Change length using `length<-`, checking for preserved values. + obj["mu"] <- test_muList length(obj) <- 2 expect_equal(length(obj), 2) - obj["mu", 1] <- c(1, 2) - obj["mu", 2] <- c(3, 4) - list_exp <- list(mu = list(c(1,2), c(3, 4)), cov = matrix(0, nrow = 3, ncol = 4) |> list() |> rep(2)) - expect_equal(as.list(obj), list_exp[sort(names(list_exp))]) + list_exp2 <- list(mu = test_muList[1:2], cov = default_cov3[1:2]) + list_exp2 <- list_exp2[sort(names(list_exp2))] + expect_equal(as.list(obj), list_exp2) + length(obj) <- 3 + list_exp3 <- list(mu = c(list_exp2$mu, default_mu3[3]), cov = c(list_exp2$cov, default_cov3[3])) + list_exp3 <- list_exp3[sort(names(list_exp3))] + expect_equal(as.list(obj), list_exp3) + + # Change length using `resize`, checking for preserved values. + resize(obj, 2) + expect_equal(getsize(obj), 2) + expect_equal(obj$getSize(), 2) + expect_equal(as.list(obj), list_exp2) + resize(obj, 3) + expect_equal(as.list(obj), list_exp3) + expect_equal(obj$getSize(), 3) + + # Change length using compiled `resize`, check with compiled getsize, checking for preserved values. + mvh$check1(2) + expect_equal(getsize(obj), 2) + expect_equal(obj$getSize(), 2) + expect_equal(mvh$check2(), 2) + expect_equal(as.list(obj), list_exp2) + mvh$check1(3) + expect_equal(as.list(obj), list_exp3) + expect_equal(obj$getSize(), 3) + expect_equal(mvh$check3(), 3) # We can create a new derived interface object with the same underlying C++ object # Then we have the active bindings @@ -250,3 +372,78 @@ test_that("modelValues nClassBuilder types work in nCompiler", { expect_equal(obj$mvBase$getLength(), 2) rm(obj); gc() }) + +test_that("modelValuesConf works", { + mvc <- modelValuesConf(vars = c('d1'), + types = c('double'), + sizes = list( d1 = 5 )) + mv <- mvc(2) + expect_equal(length(mv), 2) + expect_equal(mv["d1", 1], rep(0, 5)) + mvcB <- modelValuesConf(vars = c('d1'), + types = c('double'), + sizes = list( d1 = 5 )) + mvB <- mvcB(2) + # two versions that should be identical end up so. + expect_identical(class(mv), class(mvB)) + + mvc <- modelValuesConf(vars = c('d1', 'd2', 'd3'), + types = c('double', 'double', 'double'), + sizes = list( d1 = 5, d2 = c(3, 5), d3 = c(3, 5, 7))) + mv <- mvc(3) + expect_identical(mv["d2", 2], matrix(0, nrow = 3, ncol = 5)) + expect_identical(mv["d3", 3], array(0, dim = c(3, 5, 7))) + rm(mv); gc() +}) + +test_that("as.matrix(modelValues) and matrix2MV work", { + varInfo <- list( + vars = list( + eta = list(name = "eta", nDim = 0), + mu = list(name = "mu", nDim = 1), + cov = list(name = "cov", nDim = 2) + ) + ) +# debug(nimbleModel:::make_modelValues_nClass) + mvClass <- nimbleModel:::make_modelValues_nClass(varInfo) + obj <- mvClass$new() + sizes <- list(mu = 2, cov = c(3, 4)) + obj$set_sizeList(sizes) + + obj$resize(0) + obj$resize(3) + obj$mu[[2]] <- 5:6 + obj$mu[[3]] <- 10:11 + obj$cov[[2]] <- matrix(1:12, nrow = 3) + obj$cov[[3]] <- obj$cov[[2]] + 100 + mat <- obj |> as.matrix() + obj2 <- mvClass$new() + debug(nimbleModel:::matrix2mv) + junk <- nimbleModel:::matrix2mv(mat, obj2) + + make_mvBase <- nFunction( + function(x = "modelValuesBase_nClass") { + return(x) + returnType(modelValuesBase_nClass()) + } + ) + + junk <- nCompiler::nCompile(mvClass, make_mvBase, returnList = TRUE) + Cobj <- junk$mvClass$new() + length(Cobj) <- 3 + length(Cobj) <- 0 + Cobj$set_sizeList(sizes) + length(Cobj) <- 3 + Cobj$eta |> as.list() + Cobj$cov |> as.list() + + interface_names(Cobj) + baseCobj <- junk$make_mvBase(Cobj) + interface_names(baseCobj) + + debug(as.matrix.modelValues) + as.matrix(Cobj) + + comp <- nCompiler::nCompile(mvClass, mvHolder) + +}) From 46e5b6bdc89e7fb01e5098b3dfd42d498798ed05 Mon Sep 17 00:00:00 2001 From: perrydv Date: Fri, 2 Oct 2026 15:48:11 -0700 Subject: [PATCH 19/27] getParamID added. with getParam and getBound these work from strings. --- nimbleModel/R/declFunBaseClass.R | 17 +++++ nimbleModel/R/modelBaseClass.R | 66 ++++++++++++++----- nimbleModel/R/nimbleModel.R | 60 ++++++++++++++++- .../declFunBase_nClass_cppContent.cpp | 26 +++++--- .../declFunBase_nClass_hContent.h | 21 +++--- .../declFunBase_nClass_manifest.txt | 2 +- .../predef/declFunClass_/declFunClass_.h | 4 ++ .../modelBase_nClass_cppContent.cpp | 30 +++++---- .../modelBase_nC/modelBase_nClass_hContent.h | 25 +++---- .../modelBase_nClass_manifest.txt | 2 +- .../predef/modelClass_/modelClass_.h | 4 ++ .../tests/testthat/test-getParam_getBound.R | 21 ++++-- 12 files changed, 206 insertions(+), 72 deletions(-) diff --git a/nimbleModel/R/declFunBaseClass.R b/nimbleModel/R/declFunBaseClass.R index f51cae7..1aa46e1 100644 --- a/nimbleModel/R/declFunBaseClass.R +++ b/nimbleModel/R/declFunBaseClass.R @@ -11,6 +11,9 @@ declFunBase_nClass <- nClass( getLogProb = function(instr) { calc_op(instr, "getLogProb_one") }, + getParamID = function(param) { + getParamID_one(param) + }, calc_op = function(instr, fn) { if (instr$type == 0) { return(calc_0(instr, fn)) @@ -943,6 +946,20 @@ declFunBase_nClass <- nClass( } ) ), + getParamID_cpp = nFunction( + name = "getParamID_cpp", + function(param) { + stop("Uncompiled version of getParamID_cpp should not be called.") + }, + returnType = "integerScalar", + compileInfo = list( + virtual = TRUE, + C_fun = function(param = "characterScalar") { + cppLiteral('Rprintf("declFunBase_nClass virtual base getParamID_cpp should never be called (something is wrong)\\n");') + return(0) + } + ) + ), getParam_cpp = nFunction( name = "getParam_cpp", function(instr, paramID) { diff --git a/nimbleModel/R/modelBaseClass.R b/nimbleModel/R/modelBaseClass.R index 852b3b4..8eb2de3 100644 --- a/nimbleModel/R/modelBaseClass.R +++ b/nimbleModel/R/modelBaseClass.R @@ -390,43 +390,62 @@ modelBase_nClass <- nClass( } return(invisible(NULL)) }, - # `one_instr` is a single instr_nClass (not a list of them). + # `one_instr` is a single instr_nClass (if an instList is provided, the first one is used). # Within it, one node will be used (see declFunBase_nClass$first_idx). # `param` is an integer paramID or a character param name. + getParamID = function(one_instr, param) { + instrList <- makeInstrList(self, one_instr) + if (is.numeric(param)) { + paramID <- param + } else if (is.character(param)) { + if(isCompiled()) { + if (!instrList$isCompiled()) instr <- makeCompiledInstr(instrList[[1]]) + paramID <- self$getParamID_impl(instr, param) + } else { + paramID <- declFunList[[instrList[[1]]$declID]]$getParamID(param) + } + } else { + stop("getParamID: argument `param` must be a character param name or (redundantly) a numeric paramID.") + } + return(paramID) + }, getParam = function(one_instr, param) { - if (!inherits(one_instr, "instr_nClass")) { - stop("getParam: argument `one_instr` must be an instr_nClass object") + instrList <- makeInstrList(self, one_instr) + if (isCompiled()) { + if (!instrList$isCompiled()) instr <- makeCompiledInstr(instrList[[1]]) } if (is.numeric(param)) { paramID <- param } else if (is.character(param)) { - paramID <- getParamID( - self$modelDef$declInfo[[one_instr$declID]]$distributionName, - param - ) + paramID <- self$getParamID(instrList, param) + #getParamID( + # self$modelDef$declInfo[[one_instr$declID]]$distributionName, + # param + # ) + # FIXME: Upon switching from the general function getParamID to the constructed method, + # I am not sure that we return NA as a failure value. if (is.na(paramID)) stop("getParam: argument `param` is not a valid parameter name for this node.") } else { stop("getParam: argument `param` must be an integer paramID or a character param name.") } if (isCompiled()) { - if (!one_instr$isCompiled()) one_instr <- makeCompiledInstr(one_instr) - return(self$getParam_impl(one_instr, paramID)) + # if (!instrList$isCompiled()) instr <- makeCompiledInstr(instrList[[1]]) + return(self$getParam_impl(instr, paramID)) } - declFunList[[one_instr$declID]]$getParam(one_instr, paramID) + declFunList[[instrList[[1]]$declID]]$getParam(instrList[[1]], paramID) }, getBound = function(one_instr, bound) { - if (!inherits(one_instr, "instr_nClass")) { - stop("getBound: argument `one_instr` must be an instr_nClass object") - } + instrList <- makeInstrList(self, one_instr) if (!bound %in% c("lower", "upper")) { stop("getBound: 'bound' must be either 'lower' or 'upper'") } boundID <- if (bound == "lower") 0 else 1 if (isCompiled()) { - if (!one_instr$isCompiled()) one_instr <- makeCompiledInstr(one_instr) - return(self$getBound_impl(one_instr, boundID)) + if (!instrList$isCompiled()) instr <- makeCompiledInstr(instrList[[1]]) + else instr <- instrList[[1]] + return(self$getBound_impl(instr, boundID)) } - declFunList[[one_instr$declID]]$getBound(one_instr, boundID) + declFunList[[instrList[[1]]$declID]]$getBound(instrList[[1]], boundID) } ), Cpublic = list( @@ -521,6 +540,21 @@ modelBase_nClass <- nClass( virtual = TRUE ) ), + getParamID_impl = nFunction( + name = "getParamID_impl", + function(node, param) { + cat("Uncompiled `getParamID_impl` should never be called.\n") + return(NULL) + }, + # We must return a general object because it may have different nDim + returnType = "integer()", + compileInfo = list( + C_fun = function(node = "instr_nClass", param = "string()") { + cppLiteral('Rprintf("modelBase_nClass getParamID_impl (should not see this)\\n"); return 0;') + }, + virtual = TRUE + ) + ), getParam_impl = nFunction( name = "getParam_impl", function(node, paramID) { diff --git a/nimbleModel/R/nimbleModel.R b/nimbleModel/R/nimbleModel.R index ed306f8..4a8b80e 100644 --- a/nimbleModel/R/nimbleModel.R +++ b/nimbleModel/R/nimbleModel.R @@ -83,7 +83,7 @@ make_modelClass_from_nimbleModel <- function(modelDef, data, inits, name = NULL) lapply(\(x) all.vars(body(x))) |> unlist() |> unique() |> - setdiff(c("idx", "paramID_", "boundID_", "LocalNewLogProb_", "LocalAns_", "model")) %||% character() + setdiff(c("idx", "paramID_", "boundID_", "LocalNewLogProb_", "LocalAns_", "model", "param_name_")) %||% character() declVarInfo <- modelVarInfo$vars[declVars] declID <- as.numeric(declInfo$declRule$ID) # Formerly `sourceLineNumber`, which may not be unique. declFun_membername <- declFunNames[i] @@ -269,7 +269,7 @@ makeModel_nClass <- function(modelVarInfo, lapply(\(x) x$name) |> unlist() # These opDefs are in place but not actually used. They should start from custom_default - # and nCompiler needs to support custom opDefs for calls like obj$method(). + # and nCompiler needs to support custom opDefs for calls like obj$method(). opDefs <- list( base_ping = nCompiler:::getOperatorDef("custom_call"), setup_auto_decl_mgmt = nCompiler:::getOperatorDef("custom_call"), @@ -595,6 +595,7 @@ make_decl_methods_from_declInfo <- function(declInfo) { # Dummy version of getParam_one: getParamMethods <- list(getParam_one = make_getParam_one_nFxn()) getBoundMethods <- list(getBound_one = make_getBound_one_nFxn()) + getParamIDMethod <- make_getParamID_method() } if (type == "stoch") { logProbExpr <- declInfo$genLogProbExpr() @@ -631,8 +632,61 @@ make_decl_methods_from_declInfo <- function(declInfo) { )) getParamMethods <- make_getParam_methods(declInfo, LHSrep, RHSrep) getBoundMethods <- make_getBound_methods(declInfo, LHSrep, RHSrep) + getParamIDMethod <- make_getParamID_method(declInfo) } - c(methodList, getParamMethods, getBoundMethods) + c(methodList, getParamMethods, getBoundMethods, getParamIDMethod) +} + +make_getParamID_method <- function(declInfo) { + if(missing(declInfo)) { + return( + list(getParamID_one = nCompiler::nFunction( + name = "getParamID_one", + fun = function(param_name_) { + stop("getParamID is not valid for a deterministic node.") + }, + returnType = "integer()", + argTypes = list(param_name_ = "string()"), + compileInfo = list( + C_fun = function(param_name_) { + nCpp("Rcpp::stop(\"getParamID is not valid for a deterministic node.\")") + } + ) + )) + ) + } + distName <- declInfo$distributionName + paramIDs <- getDistributionInfo(distName)$paramIDs + paramNames <- names(paramIDs) + if (!length(paramIDs)) { + fun <- function(param_name_) { + return(0) + } + } else { + if_then_lines <- lapply( + seq_along(paramNames), + function(i) { + bquote(if (param_name_ == .(paramNames[i])) return(.(as.numeric(paramIDs[i])))) + } + ) + fun_body <- quote({}) + for(i in seq_along(if_then_lines)) { + fun_body[[i + 1]] <- if_then_lines[[i]] + } + fun_body[[length(if_then_lines) + 2]] <- quote(return(0)) + fun <- bquote( + function(param_name_) + .(fun_body) + ) |> eval() + attr(fun, "srcref") <- NULL + } + nFxn <- nCompiler::nFunction( + name = "getParamID_one", + fun = fun, + returnType = "integer()", + argTypes = list(param_name_ = "characterScalar()") + ) + list(getParamID_one = nFxn) } make_getParam_methods <- function(declInfo, LHSrep, RHSrep) { diff --git a/nimbleModel/inst/include/nimbleModel/predef/declFunBase_nC/declFunBase_nClass_cppContent.cpp b/nimbleModel/inst/include/nimbleModel/predef/declFunBase_nC/declFunBase_nClass_cppContent.cpp index f138e01..3b41185 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/declFunBase_nC/declFunBase_nClass_cppContent.cpp +++ b/nimbleModel/inst/include/nimbleModel/predef/declFunBase_nC/declFunBase_nClass_cppContent.cpp @@ -14,51 +14,56 @@ using namespace Rcpp; // [[Rcpp::depends(Rcereal)]] // [[Rcpp::depends(nimbleModel)]] - bool declFunBase_nClass::ping ( ) { + bool declFunBase_nClass::ping ( ) { RESET_EIGEN_ERRORS return(true); } - double declFunBase_nClass::calculate_cpp ( std::shared_ptr instr ) { + double declFunBase_nClass::calculate_cpp ( std::shared_ptr instr ) { RESET_EIGEN_ERRORS Rprintf("declFunBase_nClass virtual base calculate_cpp should never be called (something is wrong)\n");; return(0.0); } - double declFunBase_nClass::calculateDiff_cpp ( std::shared_ptr instr ) { + double declFunBase_nClass::calculateDiff_cpp ( std::shared_ptr instr ) { RESET_EIGEN_ERRORS Rprintf("declFunBase_nClass virtual base calculateDiff_cpp should never be called (something is wrong)\n");; return(0.0); } - double declFunBase_nClass::getLogProb_cpp ( std::shared_ptr instr ) { + double declFunBase_nClass::getLogProb_cpp ( std::shared_ptr instr ) { RESET_EIGEN_ERRORS Rprintf("declFunBase_nClass virtual base getLogProb_cpp should never be called (something is wrong)\n");; return(0.0); } - void declFunBase_nClass::simulate_cpp ( std::shared_ptr instr ) { + void declFunBase_nClass::simulate_cpp ( std::shared_ptr instr ) { RESET_EIGEN_ERRORS Rprintf("declFunBase_nClass virtual base simulate_cpp should never be called (something is wrong)\n");; } - std::unique_ptr declFunBase_nClass::getParam_cpp ( std::shared_ptr instr, int paramID ) { + int declFunBase_nClass::getParamID_cpp ( std::string param ) { +RESET_EIGEN_ERRORS +Rprintf("declFunBase_nClass virtual base getParamID_cpp should never be called (something is wrong)\n");; +return(0.0); +} + std::unique_ptr declFunBase_nClass::getParam_cpp ( std::shared_ptr instr, int paramID ) { RESET_EIGEN_ERRORS Rprintf("declFunBase_nClass virtual base getParam_cpp should never be called (something is wrong)\n");; return(ETaccessPtr(0.0)); } - double declFunBase_nClass::getBound_cpp ( std::shared_ptr instr, int boundID ) { + double declFunBase_nClass::getBound_cpp ( std::shared_ptr instr, int boundID ) { RESET_EIGEN_ERRORS Rprintf("declFunBase_nClass virtual base getBound_cpp should never be called (something is wrong)\n");; return(0.0); } - declFunBase_nClass::declFunBase_nClass ( ) { + declFunBase_nClass::declFunBase_nClass ( ) { RESET_EIGEN_ERRORS } // [[Rcpp::export(name = "set_CnClass_env_declFunBase_nClass_new")]] - void set_CnClass_env_declFunBase_nClass ( SEXP env ) { + void set_CnClass_env_declFunBase_nClass ( SEXP env ) { RESET_EIGEN_ERRORS SET_CNCLASS_ENV(declFunBase_nClass, env);; } // [[Rcpp::export(name = "get_CnClass_env_declFunBase_nClass_new")]] - Rcpp::Environment get_CnClass_env_declFunBase_nClass ( ) { + Rcpp::Environment get_CnClass_env_declFunBase_nClass ( ) { RESET_EIGEN_ERRORS return GET_CNCLASS_ENV(declFunBase_nClass);; } @@ -72,6 +77,7 @@ method("calculate_cpp", &declFunBase_nClass::calculate_cpp, args({{arg("instr",c method("calculateDiff_cpp", &declFunBase_nClass::calculateDiff_cpp, args({{arg("instr",copy)}})), method("getLogProb_cpp", &declFunBase_nClass::getLogProb_cpp, args({{arg("instr",copy)}})), method("simulate_cpp", &declFunBase_nClass::simulate_cpp, args({{arg("instr",copy)}})), +method("getParamID_cpp", &declFunBase_nClass::getParamID_cpp, args({{arg("param",copy)}})), method("getBound_cpp", &declFunBase_nClass::getBound_cpp, args({{arg("instr",copy)},{arg("boundID",copy)}})) ) ) diff --git a/nimbleModel/inst/include/nimbleModel/predef/declFunBase_nC/declFunBase_nClass_hContent.h b/nimbleModel/inst/include/nimbleModel/predef/declFunBase_nC/declFunBase_nClass_hContent.h index 6cd635d..8521519 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/declFunBase_nC/declFunBase_nClass_hContent.h +++ b/nimbleModel/inst/include/nimbleModel/predef/declFunBase_nC/declFunBase_nClass_hContent.h @@ -11,20 +11,21 @@ class declFunBase_nClass : public interface_resolver< genericInterfaceC >, public loadedObjectHookC { public: - virtual bool ping ( ) ; - virtual double calculate_cpp ( std::shared_ptr instr ) ; - virtual double calculateDiff_cpp ( std::shared_ptr instr ) ; - virtual double getLogProb_cpp ( std::shared_ptr instr ) ; - virtual void simulate_cpp ( std::shared_ptr instr ) ; - virtual std::unique_ptr getParam_cpp ( std::shared_ptr instr, int paramID ) ; - virtual double getBound_cpp ( std::shared_ptr instr, int boundID ) ; - declFunBase_nClass ( ) ; + virtual bool ping ( ) ; + virtual double calculate_cpp ( std::shared_ptr instr ) ; + virtual double calculateDiff_cpp ( std::shared_ptr instr ) ; + virtual double getLogProb_cpp ( std::shared_ptr instr ) ; + virtual void simulate_cpp ( std::shared_ptr instr ) ; + virtual int getParamID_cpp ( std::string param ) ; + virtual std::unique_ptr getParam_cpp ( std::shared_ptr instr, int paramID ) ; + virtual double getBound_cpp ( std::shared_ptr instr, int boundID ) ; + declFunBase_nClass ( ) ; }; - void set_CnClass_env_declFunBase_nClass ( SEXP env ) ; + void set_CnClass_env_declFunBase_nClass ( SEXP env ) ; - Rcpp::Environment get_CnClass_env_declFunBase_nClass ( ) ; + Rcpp::Environment get_CnClass_env_declFunBase_nClass ( ) ; #include diff --git a/nimbleModel/inst/include/nimbleModel/predef/declFunBase_nC/declFunBase_nClass_manifest.txt b/nimbleModel/inst/include/nimbleModel/predef/declFunBase_nC/declFunBase_nClass_manifest.txt index fec5ff5..e4c1fa2 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/declFunBase_nC/declFunBase_nClass_manifest.txt +++ b/nimbleModel/inst/include/nimbleModel/predef/declFunBase_nC/declFunBase_nClass_manifest.txt @@ -1,4 +1,4 @@ -list(saved_at = structure(1787685630.7344, class = c("POSIXct", +list(saved_at = structure(1790963179.1645, class = c("POSIXct", "POSIXt")), packet_name = "declFunBase_nClass", elements = c("preamble", "cppContent", "hContent", "filebase", "post_cpp_compiler", "copyFiles" ), files = list(preamble = "declFunBase_nClass_preamble.cpp", diff --git a/nimbleModel/inst/include/nimbleModel/predef/declFunClass_/declFunClass_.h b/nimbleModel/inst/include/nimbleModel/predef/declFunClass_/declFunClass_.h index c6a3c51..a7648e4 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/declFunClass_/declFunClass_.h +++ b/nimbleModel/inst/include/nimbleModel/predef/declFunClass_/declFunClass_.h @@ -605,6 +605,10 @@ class declFunClass_ : public declFunBase_nClass { // Unpacks the first node from `instr`, warns (does not error) if `instr` // actually represents more than one node, and dispatches to the // per-distribution generated `getParam_one(idx, paramID)`. + int getParamID_cpp(std::string param) override { + RESET_EIGEN_ERRORS; + return static_cast(this)->getParamID_one(param); + } std::unique_ptr getParam_cpp(std::shared_ptr instr, int paramID) override { RESET_EIGEN_ERRORS; bool multiple = false; diff --git a/nimbleModel/inst/include/nimbleModel/predef/modelBase_nC/modelBase_nClass_cppContent.cpp b/nimbleModel/inst/include/nimbleModel/predef/modelBase_nC/modelBase_nClass_cppContent.cpp index 512697c..e3bcaed 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/modelBase_nC/modelBase_nClass_cppContent.cpp +++ b/nimbleModel/inst/include/nimbleModel/predef/modelBase_nC/modelBase_nClass_cppContent.cpp @@ -13,65 +13,68 @@ using namespace Rcpp; // [[Rcpp::depends(nCompiler)]] // [[Rcpp::depends(Rcereal)]] // [[Rcpp::depends(nimbleModel)]] - - bool modelBase_nClass::ping ( ) { + bool modelBase_nClass::ping ( ) { RESET_EIGEN_ERRORS return(true); } - std::shared_ptr modelBase_nClass::makeCompiledInstrList ( SEXP input ) { + std::shared_ptr modelBase_nClass::makeCompiledInstrList ( SEXP input ) { RESET_EIGEN_ERRORS std::shared_ptr ans; ans = nClass_builder()(); ans->set_all_values(input);; return(ans); } - std::shared_ptr modelBase_nClass::makeCompiledInstr ( SEXP input ) { + std::shared_ptr modelBase_nClass::makeCompiledInstr ( SEXP input ) { RESET_EIGEN_ERRORS std::shared_ptr ans; ans = nClass_builder()(); ans->set_all_values(input);; return(ans); } - double modelBase_nClass::calculate_impl ( std::shared_ptr instrList ) { + double modelBase_nClass::calculate_impl ( std::shared_ptr instrList ) { RESET_EIGEN_ERRORS Rprintf("modelBase_nClass calculate_impl (should not see this)\n");; return(0.0); } - double modelBase_nClass::calculateDiff_impl ( std::shared_ptr instrList ) { + double modelBase_nClass::calculateDiff_impl ( std::shared_ptr instrList ) { RESET_EIGEN_ERRORS Rprintf("modelBase_nClass calculateDiff_impl (should not see this)\n");; return(0.0); } - double modelBase_nClass::getLogProb_impl ( std::shared_ptr instrList ) { + double modelBase_nClass::getLogProb_impl ( std::shared_ptr instrList ) { RESET_EIGEN_ERRORS Rprintf("modelBase_nClass getLogProb_impl (should not see this)\n");; return(0.0); } - void modelBase_nClass::simulate_impl ( std::shared_ptr instrList ) { + void modelBase_nClass::simulate_impl ( std::shared_ptr instrList ) { RESET_EIGEN_ERRORS Rprintf("modelBase_nClass simulate_impl (should not see this)\n");; } - SEXP modelBase_nClass::getParam_impl ( std::shared_ptr node, int paramID ) { + int modelBase_nClass::getParamID_impl ( std::shared_ptr node, std::string param ) { +RESET_EIGEN_ERRORS +Rprintf("modelBase_nClass getParamID_impl (should not see this)\n"); return 0;; +} + SEXP modelBase_nClass::getParam_impl ( std::shared_ptr node, int paramID ) { RESET_EIGEN_ERRORS Rprintf("modelBase_nClass getParam_impl (should not see this)\n"); return R_NilValue;; } - double modelBase_nClass::getBound_impl ( std::shared_ptr node, int boundID ) { + double modelBase_nClass::getBound_impl ( std::shared_ptr node, int boundID ) { RESET_EIGEN_ERRORS Rprintf("modelBase_nClass getBound_impl (should not see this)\n");; return(0.0); } - modelBase_nClass::modelBase_nClass ( ) { + modelBase_nClass::modelBase_nClass ( ) { RESET_EIGEN_ERRORS } // [[Rcpp::export(name = "set_CnClass_env_modelBase_nClass_new")]] - void set_CnClass_env_modelBase_nClass ( SEXP env ) { + void set_CnClass_env_modelBase_nClass ( SEXP env ) { RESET_EIGEN_ERRORS SET_CNCLASS_ENV(modelBase_nClass, env);; } // [[Rcpp::export(name = "get_CnClass_env_modelBase_nClass_new")]] - Rcpp::Environment get_CnClass_env_modelBase_nClass ( ) { + Rcpp::Environment get_CnClass_env_modelBase_nClass ( ) { RESET_EIGEN_ERRORS return GET_CNCLASS_ENV(modelBase_nClass);; } @@ -87,6 +90,7 @@ method("calculate_impl", &modelBase_nClass::calculate_impl, args({{arg("instrLis method("calculateDiff_impl", &modelBase_nClass::calculateDiff_impl, args({{arg("instrList",copy)}})), method("getLogProb_impl", &modelBase_nClass::getLogProb_impl, args({{arg("instrList",copy)}})), method("simulate_impl", &modelBase_nClass::simulate_impl, args({{arg("instrList",copy)}})), +method("getParamID_impl", &modelBase_nClass::getParamID_impl, args({{arg("node",copy)},{arg("param",copy)}})), method("getParam_impl", &modelBase_nClass::getParam_impl, args({{arg("node",copy)},{arg("paramID",copy)}})), method("getBound_impl", &modelBase_nClass::getBound_impl, args({{arg("node",copy)},{arg("boundID",copy)}})) ) diff --git a/nimbleModel/inst/include/nimbleModel/predef/modelBase_nC/modelBase_nClass_hContent.h b/nimbleModel/inst/include/nimbleModel/predef/modelBase_nC/modelBase_nClass_hContent.h index aaad758..1d967e7 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/modelBase_nC/modelBase_nClass_hContent.h +++ b/nimbleModel/inst/include/nimbleModel/predef/modelBase_nC/modelBase_nClass_hContent.h @@ -13,22 +13,23 @@ class modelBase_nClass : public interface_resolver< genericInterfaceC >, public loadedObjectHookC { public: - virtual bool ping ( ) ; - std::shared_ptr makeCompiledInstrList ( SEXP input ) ; - std::shared_ptr makeCompiledInstr ( SEXP input ) ; - virtual double calculate_impl ( std::shared_ptr instrList ) ; - virtual double calculateDiff_impl ( std::shared_ptr instrList ) ; - virtual double getLogProb_impl ( std::shared_ptr instrList ) ; - virtual void simulate_impl ( std::shared_ptr instrList ) ; - virtual SEXP getParam_impl ( std::shared_ptr node, int paramID ) ; - virtual double getBound_impl ( std::shared_ptr node, int boundID ) ; - modelBase_nClass ( ) ; + virtual bool ping ( ) ; + std::shared_ptr makeCompiledInstrList ( SEXP input ) ; + std::shared_ptr makeCompiledInstr ( SEXP input ) ; + virtual double calculate_impl ( std::shared_ptr instrList ) ; + virtual double calculateDiff_impl ( std::shared_ptr instrList ) ; + virtual double getLogProb_impl ( std::shared_ptr instrList ) ; + virtual void simulate_impl ( std::shared_ptr instrList ) ; + virtual int getParamID_impl ( std::shared_ptr node, std::string param ) ; + virtual SEXP getParam_impl ( std::shared_ptr node, int paramID ) ; + virtual double getBound_impl ( std::shared_ptr node, int boundID ) ; + modelBase_nClass ( ) ; }; - void set_CnClass_env_modelBase_nClass ( SEXP env ) ; + void set_CnClass_env_modelBase_nClass ( SEXP env ) ; - Rcpp::Environment get_CnClass_env_modelBase_nClass ( ) ; + Rcpp::Environment get_CnClass_env_modelBase_nClass ( ) ; #include diff --git a/nimbleModel/inst/include/nimbleModel/predef/modelBase_nC/modelBase_nClass_manifest.txt b/nimbleModel/inst/include/nimbleModel/predef/modelBase_nC/modelBase_nClass_manifest.txt index 2f1c8e4..36e5c47 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/modelBase_nC/modelBase_nClass_manifest.txt +++ b/nimbleModel/inst/include/nimbleModel/predef/modelBase_nC/modelBase_nClass_manifest.txt @@ -1,4 +1,4 @@ -list(saved_at = structure(1787686089.49483, class = c("POSIXct", +list(saved_at = structure(1790962153.46565, class = c("POSIXct", "POSIXt")), packet_name = "modelBase_nClass", elements = c("preamble", "cppContent", "hContent", "filebase", "post_cpp_compiler", "copyFiles" ), files = list(preamble = "modelBase_nClass_preamble.cpp", cppContent = "modelBase_nClass_cppContent.cpp", diff --git a/nimbleModel/inst/include/nimbleModel/predef/modelClass_/modelClass_.h b/nimbleModel/inst/include/nimbleModel/predef/modelClass_/modelClass_.h index 31eaddf..f03bf11 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/modelClass_/modelClass_.h +++ b/nimbleModel/inst/include/nimbleModel/predef/modelClass_/modelClass_.h @@ -37,6 +37,10 @@ class modelClass_ : public modelBase_nClass { // `node` is a single instr_nClass (not a list): identifies one declaration // (via declID) and (per declFunClass_::first_idx_) one node within it. + int getParamID_impl(std::shared_ptr node, std::string param) override { + return declFunPtrs[node->declID - 1]->getParamID_cpp(param); + } + SEXP getParam_impl(std::shared_ptr node, int paramID) override { return declFunPtrs[node->declID - 1]->getParam_cpp(node, paramID)->get(); } diff --git a/nimbleModel/tests/testthat/test-getParam_getBound.R b/nimbleModel/tests/testthat/test-getParam_getBound.R index 9c57466..646b70d 100644 --- a/nimbleModel/tests/testthat/test-getParam_getBound.R +++ b/nimbleModel/tests/testthat/test-getParam_getBound.R @@ -31,14 +31,23 @@ test_that("basic getParam and getBound works from full interface", { m$calculate() cm$calculate() - vr <- varRangeClass$new('y[3]') - instrList <- makeInstrList(m, vr) - y3 <- instrList[[1]] - vr <- varRangeClass$new("v") - instrList <- makeInstrList(m, vr) - v <- instrList[[1]] + # Commented-out code constructed instrList objects manually + # Now that is supported (and tested) inside the functions + # vr <- varRangeClass$new('y[3]') + # instrList <- makeInstrList(m, vr) + # y3 <- instrList[[1]] + # vr <- varRangeClass$new("v") + # instrList <- makeInstrList(m, vr) + # v <- instrList[[1]] + y3 <- "y[3]" + v <- "v" for(case in c("comp", "uncomp")) { obj <- switch(case, comp = cm, uncomp = m) + + expect_equal(obj$getParamID(y3, "value"), 1) + expect_equal(obj$getParamID(y3, "sd"), 3) + expect_equal(obj$getParamID(v, "max"), 3) + expect_equal(obj$getParam(y3, "value"), y[3]) expect_equal(obj$getParam(y3, "mean"), mu + 1) expect_equal(obj$getParam(y3, "sd"), 2*sd) From 67fda064fe338953b83e4edd72ec0a484e77f67a Mon Sep 17 00:00:00 2001 From: perrydv Date: Sun, 4 Oct 2026 17:48:43 -0700 Subject: [PATCH 20/27] tools for getParam and getBound, including new getParamID methods --- nimbleModel/R/distributions_processInputList.R | 7 +++++++ nimbleModel/R/modelBaseClass.R | 4 ++-- nimbleModel/R/varRules.R | 2 +- .../predef/declFunBase_nC/declFunBase_nClass_manifest.txt | 2 +- .../predef/modelBase_nC/modelBase_nClass_cppContent.cpp | 5 +++-- .../predef/modelBase_nC/modelBase_nClass_hContent.h | 2 +- .../predef/modelBase_nC/modelBase_nClass_manifest.txt | 2 +- .../include/nimbleModel/predef/modelClass_/modelClass_.h | 4 ++-- 8 files changed, 18 insertions(+), 10 deletions(-) diff --git a/nimbleModel/R/distributions_processInputList.R b/nimbleModel/R/distributions_processInputList.R index 89222d1..58550a8 100644 --- a/nimbleModel/R/distributions_processInputList.R +++ b/nimbleModel/R/distributions_processInputList.R @@ -978,6 +978,13 @@ getParamID <- function(dist, params = NULL, valueOnly = is.null(params) && return(out) } +# This is taken from nimble's distribution system. +# It is worth revisiting whether this is needed as is. +# In nimble it is used only a few places, none of which +# seem immediately necessary. One option would be to +# modify this to return the list with the scalar type +# *and* the nDim, which is right there but is not returned +# by this function. #' @rdname distributionInfo #' @export getType <- function(dist, params = NULL, valueOnly = is.null(params) && diff --git a/nimbleModel/R/modelBaseClass.R b/nimbleModel/R/modelBaseClass.R index 8eb2de3..fb4d0de 100644 --- a/nimbleModel/R/modelBaseClass.R +++ b/nimbleModel/R/modelBaseClass.R @@ -562,10 +562,10 @@ modelBase_nClass <- nClass( return(NULL) }, # We must return a general object because it may have different nDim - returnType = "SEXP", + returnType = "ETaccessor()", compileInfo = list( C_fun = function(node = "instr_nClass", paramID = "integerScalar") { - cppLiteral('Rprintf("modelBase_nClass getParam_impl (should not see this)\\n"); return R_NilValue;') + cppLiteral('Rprintf("modelBase_nClass getParam_impl (should not see this)\\n"); return nullptr;') }, virtual = TRUE ) diff --git a/nimbleModel/R/varRules.R b/nimbleModel/R/varRules.R index d0c227d..f29df1f 100644 --- a/nimbleModel/R/varRules.R +++ b/nimbleModel/R/varRules.R @@ -61,7 +61,7 @@ newVarRules <- function(items, varNames = NULL, type = NULL) { applyRules <- function(rules, node) { varName <- getVarName(node) if (varName %in% names(rules)) { - if (!inherits(node, "VarRangeClass") && is.character(node) && + if (!inherits(node, "varRangeClass") && is.character(node) && length(grep("[", node, fixed = TRUE))) { # Avoid repeatedly creating a new varRange for `node` in `graphRule$apply`. # Can't be done if no indexing. diff --git a/nimbleModel/inst/include/nimbleModel/predef/declFunBase_nC/declFunBase_nClass_manifest.txt b/nimbleModel/inst/include/nimbleModel/predef/declFunBase_nC/declFunBase_nClass_manifest.txt index e4c1fa2..a6f304a 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/declFunBase_nC/declFunBase_nClass_manifest.txt +++ b/nimbleModel/inst/include/nimbleModel/predef/declFunBase_nC/declFunBase_nClass_manifest.txt @@ -1,4 +1,4 @@ -list(saved_at = structure(1790963179.1645, class = c("POSIXct", +list(saved_at = structure(1791065393.19579, class = c("POSIXct", "POSIXt")), packet_name = "declFunBase_nClass", elements = c("preamble", "cppContent", "hContent", "filebase", "post_cpp_compiler", "copyFiles" ), files = list(preamble = "declFunBase_nClass_preamble.cpp", diff --git a/nimbleModel/inst/include/nimbleModel/predef/modelBase_nC/modelBase_nClass_cppContent.cpp b/nimbleModel/inst/include/nimbleModel/predef/modelBase_nC/modelBase_nClass_cppContent.cpp index e3bcaed..1078d89 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/modelBase_nC/modelBase_nClass_cppContent.cpp +++ b/nimbleModel/inst/include/nimbleModel/predef/modelBase_nC/modelBase_nClass_cppContent.cpp @@ -13,6 +13,7 @@ using namespace Rcpp; // [[Rcpp::depends(nCompiler)]] // [[Rcpp::depends(Rcereal)]] // [[Rcpp::depends(nimbleModel)]] + bool modelBase_nClass::ping ( ) { RESET_EIGEN_ERRORS return(true); @@ -54,9 +55,9 @@ Rprintf("modelBase_nClass simulate_impl (should not see this)\n");; RESET_EIGEN_ERRORS Rprintf("modelBase_nClass getParamID_impl (should not see this)\n"); return 0;; } - SEXP modelBase_nClass::getParam_impl ( std::shared_ptr node, int paramID ) { + std::unique_ptr modelBase_nClass::getParam_impl ( std::shared_ptr node, int paramID ) { RESET_EIGEN_ERRORS -Rprintf("modelBase_nClass getParam_impl (should not see this)\n"); return R_NilValue;; +Rprintf("modelBase_nClass getParam_impl (should not see this)\n"); return nullptr;; } double modelBase_nClass::getBound_impl ( std::shared_ptr node, int boundID ) { RESET_EIGEN_ERRORS diff --git a/nimbleModel/inst/include/nimbleModel/predef/modelBase_nC/modelBase_nClass_hContent.h b/nimbleModel/inst/include/nimbleModel/predef/modelBase_nC/modelBase_nClass_hContent.h index 1d967e7..3fdcb93 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/modelBase_nC/modelBase_nClass_hContent.h +++ b/nimbleModel/inst/include/nimbleModel/predef/modelBase_nC/modelBase_nClass_hContent.h @@ -21,7 +21,7 @@ class modelBase_nClass : public interface_resolver< genericInterfaceC instrList ) ; virtual void simulate_impl ( std::shared_ptr instrList ) ; virtual int getParamID_impl ( std::shared_ptr node, std::string param ) ; - virtual SEXP getParam_impl ( std::shared_ptr node, int paramID ) ; + virtual std::unique_ptr getParam_impl ( std::shared_ptr node, int paramID ) ; virtual double getBound_impl ( std::shared_ptr node, int boundID ) ; modelBase_nClass ( ) ; diff --git a/nimbleModel/inst/include/nimbleModel/predef/modelBase_nC/modelBase_nClass_manifest.txt b/nimbleModel/inst/include/nimbleModel/predef/modelBase_nC/modelBase_nClass_manifest.txt index 36e5c47..c29889d 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/modelBase_nC/modelBase_nClass_manifest.txt +++ b/nimbleModel/inst/include/nimbleModel/predef/modelBase_nC/modelBase_nClass_manifest.txt @@ -1,4 +1,4 @@ -list(saved_at = structure(1790962153.46565, class = c("POSIXct", +list(saved_at = structure(1791065435.09319, class = c("POSIXct", "POSIXt")), packet_name = "modelBase_nClass", elements = c("preamble", "cppContent", "hContent", "filebase", "post_cpp_compiler", "copyFiles" ), files = list(preamble = "modelBase_nClass_preamble.cpp", cppContent = "modelBase_nClass_cppContent.cpp", diff --git a/nimbleModel/inst/include/nimbleModel/predef/modelClass_/modelClass_.h b/nimbleModel/inst/include/nimbleModel/predef/modelClass_/modelClass_.h index f03bf11..add2a38 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/modelClass_/modelClass_.h +++ b/nimbleModel/inst/include/nimbleModel/predef/modelClass_/modelClass_.h @@ -41,8 +41,8 @@ class modelClass_ : public modelBase_nClass { return declFunPtrs[node->declID - 1]->getParamID_cpp(param); } - SEXP getParam_impl(std::shared_ptr node, int paramID) override { - return declFunPtrs[node->declID - 1]->getParam_cpp(node, paramID)->get(); + std::unique_ptr getParam_impl(std::shared_ptr node, int paramID) override { + return declFunPtrs[node->declID - 1]->getParam_cpp(node, paramID); //->get(); } double getBound_impl(std::shared_ptr node, int boundID) override { From b84482f36fdfe650ce2c45837424d28812ede6e0 Mon Sep 17 00:00:00 2001 From: perrydv Date: Tue, 6 Oct 2026 14:09:57 -0700 Subject: [PATCH 21/27] update predefined classes to include an nc_type_key --- nimbleModel/inst/generate_predefined.R | 15 ++++++++------- .../copier_nClass_cppContent.cpp | 8 ++++---- .../copier_nClass/copier_nClass_hContent.h | 9 +++++---- .../copier_nClass/copier_nClass_manifest.txt | 2 +- .../declFunBase_nClass_hContent.h | 1 + .../declFunBase_nClass_manifest.txt | 2 +- .../instr_nClass/instr_nClass_cppContent.cpp | 8 ++++---- .../instr_nClass/instr_nClass_hContent.h | 11 +++++++---- .../instr_nClass/instr_nClass_manifest.txt | 2 +- .../modelBase_nC/modelBase_nClass_hContent.h | 1 + .../modelBase_nClass_manifest.txt | 2 +- .../modelValuesBase_nClass_cppContent.cpp | 1 - .../modelValuesBase_nClass_hContent.h | 1 + .../modelValuesBase_nClass_manifest.txt | 2 +- .../multiCopierMV_nClass_cppContent.cpp | 16 ++++++++-------- .../multiCopierMV_nClass_hContent.h | 19 +++++++++++-------- .../multiCopierMV_nClass_manifest.txt | 2 +- .../multiCopier_modelValues_nC_base.h | 3 ++- .../multiCopier_nClass_cppContent.cpp | 14 +++++++------- .../multiCopier_nClass_hContent.h | 16 ++++++++-------- .../multiCopier_nClass_manifest.txt | 2 +- 21 files changed, 74 insertions(+), 63 deletions(-) diff --git a/nimbleModel/inst/generate_predefined.R b/nimbleModel/inst/generate_predefined.R index a87aec4..a128af6 100644 --- a/nimbleModel/inst/generate_predefined.R +++ b/nimbleModel/inst/generate_predefined.R @@ -1,8 +1,8 @@ ## # To update the set of predefined nClasses: ## ## # generate new predef/instr_nC. Move that directly to package code inst/nimbleModel/predef/instr_nC -nCompile(instr_nClass = nimbleModel:::instr_nClass, control=list(generate_predefined=TRUE)) -test <- nCompile(instr_nClass = nimbleModel:::instr_nClass) +nCompiler::nCompile(instr_nClass = nimbleModel:::instr_nClass, control=list(generate_predefined=TRUE)) +test <- nCompiler::nCompile(instr_nClass = nimbleModel:::instr_nClass) ## # ## # generate new predef/declFunBase_nC. Move to package and add ## # "#include " in the hContent @@ -19,14 +19,15 @@ nCompiler::nCompile(modelBase_nClass = nimbleModel:::modelBase_nClass, control=l test <- nCompiler::nCompile(nimbleModel:::modelBase_nClass) ## # generate new predef/copier_nC. Move to package and add -## # "#include " to the hContent before the class declaration +## # "#include " to the hContent BEFORE the class declaration ## # And add "// [[Rcpp::depends(nimbleModel)]]" to the cppContent ## # after the declaration of copier_nClass. -nCompile(copier_nClass = nimbleModel:::copier_nClass, control=list(generate_predefined=TRUE)) -test <- nCompile(nimbleModel:::copier_nClass) +## # Note there will be an EXPECTED SET OF ERRORS when re-generating before the #include has been added. +nCompiler::nCompile(copier_nClass = nimbleModel:::copier_nClass, control=list(generate_predefined=TRUE)) +test <- nCompiler::nCompile(nimbleModel:::copier_nClass) ## # generate new predef/multiCopier_nClass. Move to package and add -## # "#include " to the hContent before the class declaration +## # "#include " to the hContent BEFORE the class declaration ## # And add "// [[Rcpp::depends(nimbleModel)]]" to the cppContent ## # after the declaration of copier_nClass. ## # Note there will be an EXPECTED SET OF ERRORS when re-generating before the #include has been added. @@ -34,7 +35,7 @@ nCompiler::nCompile(multiCopier_nClass = nimbleModel:::multiCopier_nClass, contr test <- nCompiler::nCompile(nimbleModel:::multiCopier_nClass) ## # generate new predef/multiCopierMV_nC. Move to package and add -## # "#include " to the hContent before the class declaration +## # "#include " to the hContent BEFORE the class declaration ## # And add "// [[Rcpp::depends(nimbleModel)]]" to the cppContent ## # after the declaration of copier_nClass. ## # Note there will be an EXPECTED SET OF ERRORS when re-generating before the #include has been added. diff --git a/nimbleModel/inst/include/nimbleModel/predef/copier_nClass/copier_nClass_cppContent.cpp b/nimbleModel/inst/include/nimbleModel/predef/copier_nClass/copier_nClass_cppContent.cpp index b533196..8250fc9 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/copier_nClass/copier_nClass_cppContent.cpp +++ b/nimbleModel/inst/include/nimbleModel/predef/copier_nClass/copier_nClass_cppContent.cpp @@ -14,24 +14,24 @@ using namespace Rcpp; // [[Rcpp::depends(Rcereal)]] // [[Rcpp::depends(nimbleModel)]] - copier_nClass::copier_nClass ( ) { + copier_nClass::copier_nClass ( ) { RESET_EIGEN_ERRORS } // [[Rcpp::export(name = "copier_nClass_new")]] - SEXP new_copier_nClass ( ) { + SEXP new_copier_nClass ( ) { RESET_EIGEN_ERRORS return CREATE_NEW_NCOMP_OBJECT(copier_nClass);; } // [[Rcpp::export(name = "set_CnClass_env_copier_nClass_new")]] - void set_CnClass_env_copier_nClass ( SEXP env ) { + void set_CnClass_env_copier_nClass ( SEXP env ) { RESET_EIGEN_ERRORS SET_CNCLASS_ENV(copier_nClass, env);; } // [[Rcpp::export(name = "get_CnClass_env_copier_nClass_new")]] - Rcpp::Environment get_CnClass_env_copier_nClass ( ) { + Rcpp::Environment get_CnClass_env_copier_nClass ( ) { RESET_EIGEN_ERRORS return GET_CNCLASS_ENV(copier_nClass);; } diff --git a/nimbleModel/inst/include/nimbleModel/predef/copier_nClass/copier_nClass_hContent.h b/nimbleModel/inst/include/nimbleModel/predef/copier_nClass/copier_nClass_hContent.h index 3192903..537fdfb 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/copier_nClass/copier_nClass_hContent.h +++ b/nimbleModel/inst/include/nimbleModel/predef/copier_nClass/copier_nClass_hContent.h @@ -12,17 +12,18 @@ class copier_nClass : public interface_resolver< genericInterfaceC, copier_nC_base >, public loadedObjectHookC { public: - copier_nClass ( ) ; + static const char* nc_class_key() {return "copier_nClass";} + copier_nClass ( ) ; std::string varName; std::shared_ptr indsList; }; - SEXP new_copier_nClass ( ) ; + SEXP new_copier_nClass ( ) ; - void set_CnClass_env_copier_nClass ( SEXP env ) ; + void set_CnClass_env_copier_nClass ( SEXP env ) ; - Rcpp::Environment get_CnClass_env_copier_nClass ( ) ; + Rcpp::Environment get_CnClass_env_copier_nClass ( ) ; #endif diff --git a/nimbleModel/inst/include/nimbleModel/predef/copier_nClass/copier_nClass_manifest.txt b/nimbleModel/inst/include/nimbleModel/predef/copier_nClass/copier_nClass_manifest.txt index c12d80d..b354d20 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/copier_nClass/copier_nClass_manifest.txt +++ b/nimbleModel/inst/include/nimbleModel/predef/copier_nClass/copier_nClass_manifest.txt @@ -1,4 +1,4 @@ -list(saved_at = structure(1783029690.54795, class = c("POSIXct", +list(saved_at = structure(1791315464.60865, class = c("POSIXct", "POSIXt")), packet_name = "copier_nClass", elements = c("preamble", "cppContent", "hContent", "filebase", "post_cpp_compiler", "copyFiles" ), files = list(preamble = "copier_nClass_preamble.cpp", cppContent = "copier_nClass_cppContent.cpp", diff --git a/nimbleModel/inst/include/nimbleModel/predef/declFunBase_nC/declFunBase_nClass_hContent.h b/nimbleModel/inst/include/nimbleModel/predef/declFunBase_nC/declFunBase_nClass_hContent.h index 8521519..04453b5 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/declFunBase_nC/declFunBase_nClass_hContent.h +++ b/nimbleModel/inst/include/nimbleModel/predef/declFunBase_nC/declFunBase_nClass_hContent.h @@ -11,6 +11,7 @@ class declFunBase_nClass : public interface_resolver< genericInterfaceC >, public loadedObjectHookC { public: + static const char* nc_class_key() {return "declFunBase_nClass";} virtual bool ping ( ) ; virtual double calculate_cpp ( std::shared_ptr instr ) ; virtual double calculateDiff_cpp ( std::shared_ptr instr ) ; diff --git a/nimbleModel/inst/include/nimbleModel/predef/declFunBase_nC/declFunBase_nClass_manifest.txt b/nimbleModel/inst/include/nimbleModel/predef/declFunBase_nC/declFunBase_nClass_manifest.txt index a6f304a..ee61ded 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/declFunBase_nC/declFunBase_nClass_manifest.txt +++ b/nimbleModel/inst/include/nimbleModel/predef/declFunBase_nC/declFunBase_nClass_manifest.txt @@ -1,4 +1,4 @@ -list(saved_at = structure(1791065393.19579, class = c("POSIXct", +list(saved_at = structure(1791315294.77355, class = c("POSIXct", "POSIXt")), packet_name = "declFunBase_nClass", elements = c("preamble", "cppContent", "hContent", "filebase", "post_cpp_compiler", "copyFiles" ), files = list(preamble = "declFunBase_nClass_preamble.cpp", diff --git a/nimbleModel/inst/include/nimbleModel/predef/instr_nClass/instr_nClass_cppContent.cpp b/nimbleModel/inst/include/nimbleModel/predef/instr_nClass/instr_nClass_cppContent.cpp index 656aa1c..27ea4ef 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/instr_nClass/instr_nClass_cppContent.cpp +++ b/nimbleModel/inst/include/nimbleModel/predef/instr_nClass/instr_nClass_cppContent.cpp @@ -13,25 +13,25 @@ using namespace Rcpp; // [[Rcpp::depends(nCompiler)]] // [[Rcpp::depends(Rcereal)]] - instr_nClass::instr_nClass ( ) { + instr_nClass::instr_nClass ( ) { RESET_EIGEN_ERRORS values = nClass_builder()(); } // [[Rcpp::export(name = "instr_nClass_new")]] - SEXP new_instr_nClass ( ) { + SEXP new_instr_nClass ( ) { RESET_EIGEN_ERRORS return CREATE_NEW_NCOMP_OBJECT(instr_nClass);; } // [[Rcpp::export(name = "set_CnClass_env_instr_nClass_new")]] - void set_CnClass_env_instr_nClass ( SEXP env ) { + void set_CnClass_env_instr_nClass ( SEXP env ) { RESET_EIGEN_ERRORS SET_CNCLASS_ENV(instr_nClass, env);; } // [[Rcpp::export(name = "get_CnClass_env_instr_nClass_new")]] - Rcpp::Environment get_CnClass_env_instr_nClass ( ) { + Rcpp::Environment get_CnClass_env_instr_nClass ( ) { RESET_EIGEN_ERRORS return GET_CNCLASS_ENV(instr_nClass);; } diff --git a/nimbleModel/inst/include/nimbleModel/predef/instr_nClass/instr_nClass_hContent.h b/nimbleModel/inst/include/nimbleModel/predef/instr_nClass/instr_nClass_hContent.h index f964e2c..88cd3de 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/instr_nClass/instr_nClass_hContent.h +++ b/nimbleModel/inst/include/nimbleModel/predef/instr_nClass/instr_nClass_hContent.h @@ -7,10 +7,12 @@ #endif #include #include "nList_I1_c_.h" +#include "instr_nClass_c_.h" class instr_nClass : public interface_resolver< genericInterfaceC >, public loadedObjectHookC { public: - instr_nClass ( ) ; + static const char* nc_class_key() {return "instr_nClass";} + instr_nClass ( ) ; Eigen::Tensor lens; Eigen::Tensor index_types; int nDim; @@ -20,13 +22,14 @@ class instr_nClass : public interface_resolver< genericInterfaceC int type; Eigen::Tensor sortID; int declID; + }; - SEXP new_instr_nClass ( ) ; + SEXP new_instr_nClass ( ) ; - void set_CnClass_env_instr_nClass ( SEXP env ) ; + void set_CnClass_env_instr_nClass ( SEXP env ) ; - Rcpp::Environment get_CnClass_env_instr_nClass ( ) ; + Rcpp::Environment get_CnClass_env_instr_nClass ( ) ; #endif diff --git a/nimbleModel/inst/include/nimbleModel/predef/instr_nClass/instr_nClass_manifest.txt b/nimbleModel/inst/include/nimbleModel/predef/instr_nClass/instr_nClass_manifest.txt index a3aa3c2..f1d4612 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/instr_nClass/instr_nClass_manifest.txt +++ b/nimbleModel/inst/include/nimbleModel/predef/instr_nClass/instr_nClass_manifest.txt @@ -1,4 +1,4 @@ -list(saved_at = structure(1780285129.29081, class = c("POSIXct", +list(saved_at = structure(1791315229.65914, class = c("POSIXct", "POSIXt")), packet_name = "instr_nClass", elements = c("preamble", "cppContent", "hContent", "filebase", "post_cpp_compiler", "copyFiles" ), files = list(preamble = "instr_nClass_preamble.cpp", cppContent = "instr_nClass_cppContent.cpp", diff --git a/nimbleModel/inst/include/nimbleModel/predef/modelBase_nC/modelBase_nClass_hContent.h b/nimbleModel/inst/include/nimbleModel/predef/modelBase_nC/modelBase_nClass_hContent.h index 3fdcb93..11f4c09 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/modelBase_nC/modelBase_nClass_hContent.h +++ b/nimbleModel/inst/include/nimbleModel/predef/modelBase_nC/modelBase_nClass_hContent.h @@ -13,6 +13,7 @@ class modelBase_nClass : public interface_resolver< genericInterfaceC >, public loadedObjectHookC { public: + static const char* nc_class_key() {return "modelBase_nClass";} virtual bool ping ( ) ; std::shared_ptr makeCompiledInstrList ( SEXP input ) ; std::shared_ptr makeCompiledInstr ( SEXP input ) ; diff --git a/nimbleModel/inst/include/nimbleModel/predef/modelBase_nC/modelBase_nClass_manifest.txt b/nimbleModel/inst/include/nimbleModel/predef/modelBase_nC/modelBase_nClass_manifest.txt index c29889d..9433d30 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/modelBase_nC/modelBase_nClass_manifest.txt +++ b/nimbleModel/inst/include/nimbleModel/predef/modelBase_nC/modelBase_nClass_manifest.txt @@ -1,4 +1,4 @@ -list(saved_at = structure(1791065435.09319, class = c("POSIXct", +list(saved_at = structure(1791315387.89179, class = c("POSIXct", "POSIXt")), packet_name = "modelBase_nClass", elements = c("preamble", "cppContent", "hContent", "filebase", "post_cpp_compiler", "copyFiles" ), files = list(preamble = "modelBase_nClass_preamble.cpp", cppContent = "modelBase_nClass_cppContent.cpp", diff --git a/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_cppContent.cpp b/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_cppContent.cpp index aee24a3..4c2b152 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_cppContent.cpp +++ b/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_cppContent.cpp @@ -21,7 +21,6 @@ this->dot_sizeList = Rcpp::List();; } void modelValuesBase_nClass::set_sizeList ( Rcpp::List sizeList ) { RESET_EIGEN_ERRORS -dot_sizeList = sizeList; (this)->dot_sizeList = sizeList; } Rcpp::List modelValuesBase_nClass::get_sizeList ( ) { diff --git a/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_hContent.h b/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_hContent.h index 6a30d5e..766011f 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_hContent.h +++ b/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_hContent.h @@ -10,6 +10,7 @@ class modelValuesBase_nClass : public interface_resolver< genericInterfaceC >, public loadedObjectHookC { public: + static const char* nc_class_key() {return "modelValuesBase_nClass";} modelValuesBase_nClass ( ) ; void set_sizeList ( Rcpp::List sizeList ) ; Rcpp::List get_sizeList ( ) ; diff --git a/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_manifest.txt b/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_manifest.txt index 6e9054a..2ffbe54 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_manifest.txt +++ b/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_manifest.txt @@ -1,4 +1,4 @@ -list(saved_at = structure(1789772169.37104, class = c("POSIXct", +list(saved_at = structure(1791317937.39758, class = c("POSIXct", "POSIXt")), packet_name = "modelValuesBase_nClass", elements = c("preamble", "cppContent", "hContent", "filebase", "post_cpp_compiler", "copyFiles" ), files = list(preamble = "modelValuesBase_nClass_preamble.cpp", diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass/multiCopierMV_nClass_cppContent.cpp b/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass/multiCopierMV_nClass_cppContent.cpp index c7af4c2..a6879b1 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass/multiCopierMV_nClass_cppContent.cpp +++ b/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass/multiCopierMV_nClass_cppContent.cpp @@ -14,40 +14,40 @@ using namespace Rcpp; // [[Rcpp::depends(Rcereal)]] // [[Rcpp::depends(nimbleModel)]] - void multiCopierMV_nClass::init ( std::shared_ptr modelValues ) { + void multiCopierMV_nClass::init ( std::shared_ptr modelValues ) { RESET_EIGEN_ERRORS multiCopier_modelValues_nC_base::init(this->copiers, modelValues); } - void multiCopierMV_nClass::setActiveRow ( int row ) { + void multiCopierMV_nClass::setActiveRow ( int row ) { RESET_EIGEN_ERRORS multiCopier_modelValues_nC_base::setActiveRow(row); } - Eigen::Tensor multiCopierMV_nClass::getValues ( ) { + Eigen::Tensor multiCopierMV_nClass::getValues ( ) { RESET_EIGEN_ERRORS return flatViewGroup.copyIntoVector(); } - void multiCopierMV_nClass::setValues ( Eigen::Tensor v ) { + void multiCopierMV_nClass::setValues ( Eigen::Tensor v ) { RESET_EIGEN_ERRORS flatViewGroup.copyFromVector(v); } - multiCopierMV_nClass::multiCopierMV_nClass ( ) { + multiCopierMV_nClass::multiCopierMV_nClass ( ) { RESET_EIGEN_ERRORS } // [[Rcpp::export(name = "multiCopierMV_nClass_new")]] - SEXP new_multiCopierMV_nClass ( ) { + SEXP new_multiCopierMV_nClass ( ) { RESET_EIGEN_ERRORS return CREATE_NEW_NCOMP_OBJECT(multiCopierMV_nClass);; } // [[Rcpp::export(name = "set_CnClass_env_multiCopierMV_nClass_new")]] - void set_CnClass_env_multiCopierMV_nClass ( SEXP env ) { + void set_CnClass_env_multiCopierMV_nClass ( SEXP env ) { RESET_EIGEN_ERRORS SET_CNCLASS_ENV(multiCopierMV_nClass, env);; } // [[Rcpp::export(name = "get_CnClass_env_multiCopierMV_nClass_new")]] - Rcpp::Environment get_CnClass_env_multiCopierMV_nClass ( ) { + Rcpp::Environment get_CnClass_env_multiCopierMV_nClass ( ) { RESET_EIGEN_ERRORS return GET_CNCLASS_ENV(multiCopierMV_nClass);; } diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass/multiCopierMV_nClass_hContent.h b/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass/multiCopierMV_nClass_hContent.h index cd87ef3..cf4c0ca 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass/multiCopierMV_nClass_hContent.h +++ b/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass/multiCopierMV_nClass_hContent.h @@ -9,23 +9,26 @@ #include "nList_copier_nClass_c_.h" #include "multiCopierMV_nClass_c_.h" #include "modelValuesBase_nClass_c_.h" + #include + class multiCopierMV_nClass : public interface_resolver< genericInterfaceC, multiCopier_modelValues_nC_base >, public loadedObjectHookC { public: - void init ( std::shared_ptr modelValues ) ; - void setActiveRow ( int row ) ; - Eigen::Tensor getValues ( ) ; - void setValues ( Eigen::Tensor v ) ; - multiCopierMV_nClass ( ) ; + static const char* nc_class_key() {return "multiCopierMV_nClass";} + void init ( std::shared_ptr modelValues ) ; + void setActiveRow ( int row ) ; + Eigen::Tensor getValues ( ) ; + void setValues ( Eigen::Tensor v ) ; + multiCopierMV_nClass ( ) ; std::shared_ptr copiers; }; - SEXP new_multiCopierMV_nClass ( ) ; + SEXP new_multiCopierMV_nClass ( ) ; - void set_CnClass_env_multiCopierMV_nClass ( SEXP env ) ; + void set_CnClass_env_multiCopierMV_nClass ( SEXP env ) ; - Rcpp::Environment get_CnClass_env_multiCopierMV_nClass ( ) ; + Rcpp::Environment get_CnClass_env_multiCopierMV_nClass ( ) ; #endif diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass/multiCopierMV_nClass_manifest.txt b/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass/multiCopierMV_nClass_manifest.txt index 1efc875..fc79bdf 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass/multiCopierMV_nClass_manifest.txt +++ b/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass/multiCopierMV_nClass_manifest.txt @@ -1,4 +1,4 @@ -list(saved_at = structure(1786643687.02694, class = c("POSIXct", +list(saved_at = structure(1791317898.26052, class = c("POSIXct", "POSIXt")), packet_name = "multiCopierMV_nClass", elements = c("preamble", "cppContent", "hContent", "filebase", "post_cpp_compiler", "copyFiles" ), files = list(preamble = "multiCopierMV_nClass_preamble.cpp", diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base/multiCopier_modelValues_nC_base.h b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base/multiCopier_modelValues_nC_base.h index efbb914..fd96458 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base/multiCopier_modelValues_nC_base.h +++ b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base/multiCopier_modelValues_nC_base.h @@ -66,8 +66,9 @@ class multiCopier_modelValues_nC_base : public multiCopier_nC_base { std::shared_ptr resolveRowSource(size_t k) { std::shared_ptr ip = fieldAccessors[k]->getInterfacePtr(modelValuesKeepAlive.get()); + // The modelValues object may have been created by a different DLL (see nc_shared_ptr_cast in nCompiler). std::shared_ptr nlPtr = - std::dynamic_pointer_cast(ip); + nc_shared_ptr_cast(ip); if (!nlPtr) Rcpp::stop("multiCopier (modelValues): variable is not an nList."); return nlPtr; diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_cppContent.cpp b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_cppContent.cpp index d9f952b..e23f92f 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_cppContent.cpp +++ b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_cppContent.cpp @@ -14,36 +14,36 @@ using namespace Rcpp; // [[Rcpp::depends(Rcereal)]] // [[Rcpp::depends(nimbleModel)]] - void multiCopier_nClass::init ( std::shared_ptr model ) { + void multiCopier_nClass::init ( std::shared_ptr model ) { RESET_EIGEN_ERRORS multiCopier_model_nC_base::init(this->copiers, model); } - Eigen::Tensor multiCopier_nClass::getValues ( ) { + Eigen::Tensor multiCopier_nClass::getValues ( ) { RESET_EIGEN_ERRORS return flatViewGroup.copyIntoVector(); } - void multiCopier_nClass::setValues ( Eigen::Tensor v ) { + void multiCopier_nClass::setValues ( Eigen::Tensor v ) { RESET_EIGEN_ERRORS flatViewGroup.copyFromVector(v); } - multiCopier_nClass::multiCopier_nClass ( ) { + multiCopier_nClass::multiCopier_nClass ( ) { RESET_EIGEN_ERRORS } // [[Rcpp::export(name = "multiCopier_nClass_new")]] - SEXP new_multiCopier_nClass ( ) { + SEXP new_multiCopier_nClass ( ) { RESET_EIGEN_ERRORS return CREATE_NEW_NCOMP_OBJECT(multiCopier_nClass);; } // [[Rcpp::export(name = "set_CnClass_env_multiCopier_nClass_new")]] - void set_CnClass_env_multiCopier_nClass ( SEXP env ) { + void set_CnClass_env_multiCopier_nClass ( SEXP env ) { RESET_EIGEN_ERRORS SET_CNCLASS_ENV(multiCopier_nClass, env);; } // [[Rcpp::export(name = "get_CnClass_env_multiCopier_nClass_new")]] - Rcpp::Environment get_CnClass_env_multiCopier_nClass ( ) { + Rcpp::Environment get_CnClass_env_multiCopier_nClass ( ) { RESET_EIGEN_ERRORS return GET_CNCLASS_ENV(multiCopier_nClass);; } diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_hContent.h b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_hContent.h index 766d014..1bfaadf 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_hContent.h +++ b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_hContent.h @@ -13,19 +13,19 @@ class multiCopier_nClass : public interface_resolver< genericInterfaceC, multiCopier_model_nC_base >, public loadedObjectHookC { public: - void init ( std::shared_ptr model ) ; - Eigen::Tensor getValues ( ) ; - void setValues ( Eigen::Tensor v ) ; - multiCopier_nClass ( ) ; + static const char* nc_class_key() {return "multiCopier_nClass";} + void init ( std::shared_ptr model ) ; + Eigen::Tensor getValues ( ) ; + void setValues ( Eigen::Tensor v ) ; + multiCopier_nClass ( ) ; std::shared_ptr copiers; }; - SEXP new_multiCopier_nClass ( ) ; + SEXP new_multiCopier_nClass ( ) ; - void set_CnClass_env_multiCopier_nClass ( SEXP env ) ; - - Rcpp::Environment get_CnClass_env_multiCopier_nClass ( ) ; + void set_CnClass_env_multiCopier_nClass ( SEXP env ) ; + Rcpp::Environment get_CnClass_env_multiCopier_nClass ( ) ; #endif diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_manifest.txt b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_manifest.txt index 37bc49b..a7c82ad 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_manifest.txt +++ b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_manifest.txt @@ -1,4 +1,4 @@ -list(saved_at = structure(1786643399.92521, class = c("POSIXct", +list(saved_at = structure(1791315772.0204, class = c("POSIXct", "POSIXt")), packet_name = "multiCopier_nClass", elements = c("preamble", "cppContent", "hContent", "filebase", "post_cpp_compiler", "copyFiles" ), files = list(preamble = "multiCopier_nClass_preamble.cpp", From a190b983a190c0c2590c005d2d2df8d57e32140b Mon Sep 17 00:00:00 2001 From: perrydv Date: Thu, 8 Oct 2026 11:28:37 -0700 Subject: [PATCH 22/27] add package digest to test setup --- .github/workflows/tests.yaml | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/tests.yaml b/.github/workflows/tests.yaml index 2a6f296..4fcb69c 100644 --- a/.github/workflows/tests.yaml +++ b/.github/workflows/tests.yaml @@ -45,6 +45,7 @@ jobs: run: | install.packages(c('testthat', 'remotes')) install.packages('R6') + install.packages('digest') install.packages('nimble') # For now, we use `nimble` for stuff in `miscFunctions.R`. install.packages('inline') # For now, seemingly need for nCompiler. remotes::install_github("https://github.com/nimble-dev/nCompiler", subdir="nCompiler") From c073ff529e6f5efebd739eb1897be70585e5ae2f Mon Sep 17 00:00:00 2001 From: perrydv Date: Thu, 8 Oct 2026 15:40:06 -0700 Subject: [PATCH 23/27] updates fixing disconnects from long diverged branch merging --- nimbleModel/R/declFunBaseClass.R | 4 +- nimbleModel/R/miscFunctions.R | 69 +++++++++---------- nimbleModel/R/modelBaseClass.R | 12 ++-- .../predef/declFunClass_/declFunClass_.h | 4 +- .../tests/testthat/test-getParam_getBound.R | 5 +- 5 files changed, 46 insertions(+), 48 deletions(-) diff --git a/nimbleModel/R/declFunBaseClass.R b/nimbleModel/R/declFunBaseClass.R index f6b550f..cf2478a 100644 --- a/nimbleModel/R/declFunBaseClass.R +++ b/nimbleModel/R/declFunBaseClass.R @@ -780,7 +780,7 @@ declFunBase_nClass <- nClass( }, first_idx = function(instr) { multiple <- FALSE - idx <- switch(as.character(instr$type), + idx <- switch(as.character(instr$instr_type), "0" = { multiple <- FALSE instr$lens @@ -860,7 +860,7 @@ declFunBase_nClass <- nClass( multiple <- prod(instr$lens[1:5]) > 1 first_idx_generic(instr, 5) }, - stop("getParam: unrecognized instr type ", instr$type) + stop("getParam: unrecognized instr type ", instr$instr_type) ) list(idx = idx, multiple = multiple) }, diff --git a/nimbleModel/R/miscFunctions.R b/nimbleModel/R/miscFunctions.R index acd3537..d019d01 100644 --- a/nimbleModel/R/miscFunctions.R +++ b/nimbleModel/R/miscFunctions.R @@ -1,37 +1,34 @@ -# These are commented out to avoid loading the nimble namespace -# # This needs to be sourced after `nimbleFunction` is defined, so can't be done in `distributions_inputList.R`. -calc_dmnormAltParams <- function() stop("Don't call this") -# calc_dmnormAltParams <- nimble::nimbleFunction( -# name = "calc_dmnormAltParams", -# run = function(cholesky = double(2), prec_param = double(), return_prec = double()) { -# if (prec_param == return_prec) { -# ans <- t(cholesky) %*% cholesky -# } else { -# I <- diag(dim(cholesky)[1]) -# ans <- backsolve(cholesky, forwardsolve(t(cholesky), I)) -# # Chris suggests: -# # tmp <- forwardsolve(L, I) -# # ans <- crossprod(tmp) -# } -# returnType(double(2)) -# return(ans) -# } -# ) +# This needs to be sourced after `nimbleFunction` is defined, so can't be done in `distributions_inputList.R`. +calc_dmnormAltParams <- nimble::nimbleFunction( + name = "calc_dmnormAltParams", + run = function(cholesky = double(2), prec_param = double(), return_prec = double()) { + if (prec_param == return_prec) { + ans <- t(cholesky) %*% cholesky + } else { + I <- diag(dim(cholesky)[1]) + ans <- backsolve(cholesky, forwardsolve(t(cholesky), I)) + # Chris suggests: + # tmp <- forwardsolve(L, I) + # ans <- crossprod(tmp) + } + returnType(double(2)) + return(ans) + } +) -calc_dwishAltParams <- function() stop("Don't call this") -# calc_dwishAltParams <- nimble::nimbleFunction( -# name = "calc_dwishAltParams", -# run = function(cholesky = double(2), scale_param = double(), return_scale = double()) { -# if (scale_param == return_scale) { -# ans <- t(cholesky) %*% cholesky -# } else { -# I <- diag(dim(cholesky)[1]) -# ans <- backsolve(cholesky, forwardsolve(t(cholesky), I)) -# # Chris suggests: -# # tmp <- forwardsolve(L, I) -# # ans <- crossprod(tmp) -# } -# returnType(double(2)) -# return(ans) -# } -# ) +calc_dwishAltParams <- nimble::nimbleFunction( + name = "calc_dwishAltParams", + run = function(cholesky = double(2), scale_param = double(), return_scale = double()) { + if (scale_param == return_scale) { + ans <- t(cholesky) %*% cholesky + } else { + I <- diag(dim(cholesky)[1]) + ans <- backsolve(cholesky, forwardsolve(t(cholesky), I)) + # Chris suggests: + # tmp <- forwardsolve(L, I) + # ans <- crossprod(tmp) + } + returnType(double(2)) + return(ans) + } +) \ No newline at end of file diff --git a/nimbleModel/R/modelBaseClass.R b/nimbleModel/R/modelBaseClass.R index 19239bb..782a272 100644 --- a/nimbleModel/R/modelBaseClass.R +++ b/nimbleModel/R/modelBaseClass.R @@ -495,7 +495,7 @@ modelBase_nClass <- nClass( } instrList <- makeInstrList(self, instr) if (isCompiled()) { - if (inherits(instrList, "Rlist_Rinstr") || !instrList$isCompiled()) { + if (inherits(instrList, "Rlist_Rinstr") || !nCompiler:::isCompiled(instrList)) { instrList <- makeCompiledInstrList(instrList) } return(self[[fn_cpp]](instrList)) @@ -527,7 +527,7 @@ modelBase_nClass <- nClass( return(invisible(NULL)) } if (isCompiled()) { - if (inherits(instrList, "Rlist_Rinstr") || !instrList$isCompiled()) { + if (inherits(instrList, "Rlist_Rinstr") || !nCompiler:::isCompiled(instrList)) { instrList <- makeCompiledInstrList(instrList) } self$simulate_impl(instrList) @@ -547,7 +547,7 @@ modelBase_nClass <- nClass( paramID <- param } else if (is.character(param)) { if(isCompiled()) { - if (!instrList$isCompiled()) instr <- makeCompiledInstr(instrList[[1]]) + if (!nCompiler:::isCompiled(instrList)) instr <- makeCompiledInstr(instrList[[1]]) paramID <- self$getParamID_impl(instr, param) } else { paramID <- declFunList[[instrList[[1]]$declID]]$getParamID(param) @@ -560,7 +560,7 @@ modelBase_nClass <- nClass( getParam = function(one_instr, param) { instrList <- makeInstrList(self, one_instr) if (isCompiled()) { - if (!instrList$isCompiled()) instr <- makeCompiledInstr(instrList[[1]]) + if (!nCompiler:::isCompiled(instrList)) instr <- makeCompiledInstr(instrList[[1]]) } if (is.numeric(param)) { paramID <- param @@ -577,7 +577,7 @@ modelBase_nClass <- nClass( stop("getParam: argument `param` must be an integer paramID or a character param name.") } if (isCompiled()) { - # if (!instrList$isCompiled()) instr <- makeCompiledInstr(instrList[[1]]) + # if (!nCompiler:::isCompiled(instrList)) instr <- makeCompiledInstr(instrList[[1]]) return(self$getParam_impl(instr, paramID)) } declFunList[[instrList[[1]]$declID]]$getParam(instrList[[1]], paramID) @@ -589,7 +589,7 @@ modelBase_nClass <- nClass( } boundID <- if (bound == "lower") 0 else 1 if (isCompiled()) { - if (!instrList$isCompiled()) instr <- makeCompiledInstr(instrList[[1]]) + if (!nCompiler:::isCompiled(instrList)) instr <- makeCompiledInstr(instrList[[1]]) else instr <- instrList[[1]] return(self$getBound_impl(instr, boundID)) } diff --git a/nimbleModel/inst/include/nimbleModel/predef/declFunClass_/declFunClass_.h b/nimbleModel/inst/include/nimbleModel/predef/declFunClass_/declFunClass_.h index 985eb04..93cad35 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/declFunClass_/declFunClass_.h +++ b/nimbleModel/inst/include/nimbleModel/predef/declFunClass_/declFunClass_.h @@ -629,7 +629,7 @@ class declFunClass_ : public declFunBase_nClass { } Eigen::Tensor first_idx_(std::shared_ptr instr, bool &multiple) { int nDim = instr->nDim; - switch (instr->type) { + switch (instr->instr_type) { case 0: { // Dummy/unindexed node: `calc_0_` passes `instr->lens` through as a // placeholder idx that generated code for an unindexed decl ignores. @@ -768,7 +768,7 @@ class declFunClass_ : public declFunBase_nClass { } // simulate - void simulate_cpp ( std::shared_ptr instr ) { + void simulate_cpp ( std::shared_ptr instr ) override { RESET_EIGEN_ERRORS; int instr_type = instr->instr_type; if(instr_type == 0) return sim_0_(instr); diff --git a/nimbleModel/tests/testthat/test-getParam_getBound.R b/nimbleModel/tests/testthat/test-getParam_getBound.R index 646b70d..0518e2a 100644 --- a/nimbleModel/tests/testthat/test-getParam_getBound.R +++ b/nimbleModel/tests/testthat/test-getParam_getBound.R @@ -43,11 +43,11 @@ test_that("basic getParam and getBound works from full interface", { v <- "v" for(case in c("comp", "uncomp")) { obj <- switch(case, comp = cm, uncomp = m) - + expect_equal(obj$getParamID(y3, "value"), 1) expect_equal(obj$getParamID(y3, "sd"), 3) expect_equal(obj$getParamID(v, "max"), 3) - + expect_equal(obj$getParam(y3, "value"), y[3]) expect_equal(obj$getParam(y3, "mean"), mu + 1) expect_equal(obj$getParam(y3, "sd"), 2*sd) @@ -62,4 +62,5 @@ test_that("basic getParam and getBound works from full interface", { expect_equal(obj$getBound(v, "lower"), mu + 1) expect_equal(obj$getBound(v, "upper"), mu + 5) } + rm(m, cm); gc() }) From e6972ce6210437083ea8e9cdde465acd04d41d98 Mon Sep 17 00:00:00 2001 From: perrydv Date: Sun, 11 Oct 2026 18:08:25 -0700 Subject: [PATCH 24/27] Ensure replacements (e.g. idx for i) are used for altParamExprs --- nimbleModel/R/nimbleModel.R | 43 +++++--- .../tests/testthat/test-setupMargNodes.R | 98 +++++++++---------- 2 files changed, 78 insertions(+), 63 deletions(-) diff --git a/nimbleModel/R/nimbleModel.R b/nimbleModel/R/nimbleModel.R index 0c85910..4f03920 100644 --- a/nimbleModel/R/nimbleModel.R +++ b/nimbleModel/R/nimbleModel.R @@ -636,15 +636,33 @@ make_decl_methods_from_declInfo <- function(declInfo) { STOCHCALC_DIFF = make_stoch_calc_line(LHSrep, RHSrep, logProbExprRep, diff = TRUE) ) )) - getParamMethods <- make_getParam_methods(declInfo, LHSrep, RHSrep) - getBoundMethods <- make_getBound_methods(declInfo, LHSrep, RHSrep) - getParamIDMethod <- make_getParamID_method(declInfo) + altParamExprs <- declInfo$altParamExprs + if (length(altParamExprs)) { + altParamExprsRep <- lapply( + altParamExprs, + function(expr) eval(substitute(substitute(e, replacements), list(e = expr))) + ) + } else { + altParamExprsRep <- list() + } + getParamMethods <- make_getParam_methods(declInfo$distributionName, LHSrep, RHSrep, altParamExprsRep) + boundExprs <- declInfo$boundExprs + if (length(boundExprs)) { + boundExprsRep <- lapply( + boundExprs, + function(expr) eval(substitute(substitute(e, replacements), list(e = expr))) + ) + } else { + boundExprsRep <- list() + } + getBoundMethods <- make_getBound_methods(declInfo$distributionName, LHSrep, RHSrep, boundExprsRep) + getParamIDMethod <- make_getParamID_method(declInfo$distributionName) } c(methodList, getParamMethods, getBoundMethods, getParamIDMethod) } -make_getParamID_method <- function(declInfo) { - if(missing(declInfo)) { +make_getParamID_method <- function(distName) { + if(missing(distName)) { return( list(getParamID_one = nCompiler::nFunction( name = "getParamID_one", @@ -661,7 +679,6 @@ make_getParamID_method <- function(declInfo) { )) ) } - distName <- declInfo$distributionName paramIDs <- getDistributionInfo(distName)$paramIDs paramNames <- names(paramIDs) if (!length(paramIDs)) { @@ -695,11 +712,12 @@ make_getParamID_method <- function(declInfo) { list(getParamID_one = nFxn) } -make_getParam_methods <- function(declInfo, LHSrep, RHSrep) { - distName <- declInfo$distributionName +make_getParam_methods <- function(distName, LHSrep, RHSrep, altParamExprsRep) { reqdExprs <- if (length(RHSrep) > 1) as.list(RHSrep)[-1] else list() if (length(reqdExprs) > 0) names(reqdExprs) <- names(RHSrep)[-1] - allParamExprs <- c(list(value = LHSrep), reqdExprs, declInfo$altParamExprs) + allParamExprs <- c(list(value = LHSrep), reqdExprs, altParamExprsRep) + paramNamesToUse <- getParamNames(distName) + allParamExprs <- allParamExprs[ names(allParamExprs) %in% paramNamesToUse] paramNames <- names(allParamExprs) paramIDs <- as.integer(getParamID(distName, paramNames)) sort_order <- order(paramIDs) @@ -707,7 +725,6 @@ make_getParam_methods <- function(declInfo, LHSrep, RHSrep) { paramIDs <- paramIDs[sort_order] allParamExprs <- allParamExprs[sort_order] nDims <- as.integer(getDimension(distName, paramNames)) - getParamOne <- make_getParam_one_nFxn(paramIDs, allParamExprs, isRef, computeMethodNames) list(getParam_one = getParamOne) } @@ -769,10 +786,8 @@ make_getParam_one_nFxn <- function(paramIDs = integer(0), exprs = list(), ) } -make_getBound_methods <- function(declInfo, LHSrep, RHSrep) { - distName <- declInfo$distributionName - boundExprs <- declInfo$boundExprs - getBoundOne <- make_getBound_one_nFxn(boundExprs) +make_getBound_methods <- function(distName, LHSrep, RHSrep, boundExprsRep) { + getBoundOne <- make_getBound_one_nFxn(boundExprsRep) list(getBound_one = getBoundOne) } diff --git a/nimbleModel/tests/testthat/test-setupMargNodes.R b/nimbleModel/tests/testthat/test-setupMargNodes.R index 94f422b..198db5b 100644 --- a/nimbleModel/tests/testthat/test-setupMargNodes.R +++ b/nimbleModel/tests/testthat/test-setupMargNodes.R @@ -435,7 +435,7 @@ test_that("setupMargNodes finds correct randomEffectsNodes based on calcNodes in m <- nimbleModel(code, data = list(y = c(1, 2))) # new warning in 1.4.2 and here because randomEffectsNodes now includes s[1:2] # add expect_warning() - SMN <- setupMargNodes(m, calcNodes = c("r", "s")) + SMN <- setupMargNodes(m, calcNodes = c("r", "s")) expect_identical(unlist(lapply(SMN$randomEffectsNodes, \(x) x$toNodeChars())), c("r[1]","r[2]","s[1]","s[2]")) expect_identical(SMN$paramNodes[[1]]$toNodeChars(), c("p[1]","p[2]")) }) @@ -454,11 +454,11 @@ test_that("regression tests that `getConditionallyIndependentSets` works with tr }) m <- nimbleModel(code, data = list(y = rnorm(5))) given <- c('tau','tau2',paste0('y[', 1:5, ']')) - + ## Correct latents <- c('b1','b2',paste0('mu[', 1:5, ']'),paste0('mu2[', 1:5, ']')) expect_length(getConditionallyIndependentSets(m, nodes = latents, givenNodes = given, unknownAsGiven = TRUE), 1) - + ## In issue 1564, incorrect with different order for the latents: `mu2[1]` split out into its own set latents <- c(paste0('mu[', 1:5, ']'),paste0('mu2[', 1:5, ']'),'b1','b2') expect_length(getConditionallyIndependentSets(m, nodes = latents, givenNodes = given, unknownAsGiven = TRUE), 1) @@ -480,18 +480,18 @@ test_that("`setupMargNodes` handling of missing/extra latents", { expect_identical(result$paramNodes[[1]]$toNodeChars(), c("mu")) ## `b[2]` won't be marginalized over, and its dependent `y`s are not in calcNodes. - ## Could be user error, but we simply accept the user choices. + ## Could be user error, but we simply accept the user choices. expect_silent(result <- setupMargNodes(m, randomEffectsNodes = 'b[1]')) expect_identical(result$randomEffectsNodes[[1]]$toNodeChars(), c("b[1]")) expect_identical(result$paramNodes[[1]]$toNodeChars(), c("mu")) - + ## This gives a warning. ## `b[2]` now in `paramNodes`, presumably since its `y`s are in calcNodes. expect_message(result <- setupMargNodes(m, randomEffectsNodes = 'b[1]', calcNodes = c('b[1]','y')), "they should be included") expect_identical(result$randomEffectsNodes[[1]]$toNodeChars(), c("b[1]")) expect_identical(unlist(lapply(result$paramNodes, \(x) x$toNodeChars())), c("mu", "b[2]")) - + expect_message(result <- setupMargNodes(m, randomEffectsNodes = 'b'), "they are not needed for the provided") expect_identical(result$randomEffectsNodes[[1]]$toNodeChars(), c("b[1]", "b[2]")) expect_identical(result$paramNodes[[1]]$toNodeChars(), c("mu")) @@ -516,64 +516,64 @@ test_that("getConditionallyIndependentSets works with grouped data", { mu0 ~ dnorm(0,1) }) m <- nimbleModel(code, data=list(y=rnorm(10)), constants = list(k=c(rep(1,5),rep(2,5)))) - + expect_identical(getConditionallyIndependentSets(m, givenNodes = m$getNodes(c('mu0','sigma','y')), nodes=m$getNodes('mu')), list('mu[1]','mu[2]')) # {mu[1]}, {mu[2]} - + expect_identical(getConditionallyIndependentSets(m, givenNodes = m$getNodes(c('mu0','y')), nodes=m$getNodes(c('sigma','mu'))), list(c("sigma","mu[1]","mu[2]"))) # {sigma,mu[1:2]} - + expect_identical(getConditionallyIndependentSets(m, givenNodes = m$getNodes(c('mu0','sigma')), nodes=m$getNodes(c('y','mu'))), list(c(paste0("y[",1:5,"]"), "mu[1]"), c(paste0("y[",6:10,"]"), "mu[2]"))) # {mu[1],y[1],y[2:5]}, {mu[2],y[6],y[7:10]} - + expect_identical(getConditionallyIndependentSets(m, givenNodes = m$getNodes(c('mu0','sigma')), nodes=m$getNodes(c('mu','y'))), list(c("mu[1]", paste0("y[",1:5,"]")), c("mu[2]", paste0("y[",6:10,"]")))) # {mu[1],y[1:5]}, {mu[2],y[6:10]} - + expect_identical(getConditionallyIndependentSets(m, givenNodes = m$getNodes(c('mu0','sigma')), nodes=m$getNodes(c('mu'))), list('mu[1]','mu[2]')) # unknownAsGiven = T; {mu[1]},{mu[2]} - + expect_identical(getConditionallyIndependentSets(m, givenNodes = m$getNodes(c('mu0','sigma')), nodes=m$getNodes(c('mu')),unknownAsGiven=FALSE), list(c("mu[1]", paste0("y[",1:5,"]")), c("mu[2]", paste0("y[",6:10,"]")))) # {mu[1],y[1:5]}, {mu[2],y[6:10]} - - + + expect_identical(getConditionallyIndependentSets(m, givenNodes = c('mu0','sigma'), nodes=c('mu','y')), list(c("mu[1]", paste0("y[",1:5,"]")), c("mu[2]", paste0("y[",6:10,"]")))) # {mu[1],y[1:5]}, {mu[2],y[6:10]} - + expect_identical(getConditionallyIndependentSets(m, givenNodes = c('mu0','sigma'), nodes=c('mu','y'), returnScalarComponents=TRUE, nodesAsChars=TRUE),list(c("mu[1]", paste0("y[",1:5,"]")), c("mu[2]", paste0("y[",6:10,"]")))) - + # {"mu[1]" "y[1]" "y[2]" "y[3]" "y[4]" "y[5]"} {"mu[2]" "y[6]" "y[7]" "y[8]" "y[9]" "y[10]"} - + expect_identical(getConditionallyIndependentSets(m, givenNodes = c('mu0','sigma')), list()) expect_identical(getConditionallyIndependentSets(m, givenNodes = c('mu0','sigma'), unknownAsGiven = FALSE), list()) - + expect_identical(getConditionallyIndependentSets(m, nodes='mu'), list('mu[1]','mu[2]')) # {mu[1]}, {mu[2]} - + expect_identical(getConditionallyIndependentSets(m, givenNodes = c('mu0','sigma','y')), list('mu[1]','mu[2]')) # {mu[1]}, {mu[2]} - + expect_identical(getConditionallyIndependentSets(m), list('mu[1]','mu[2]')) # {mu[1]}, {mu[2]} - - + + result <- getConditionallyIndependentSets(m, givenNodes = m$getNodes(c('mu0','sigma')), nodes=m$getNodes(c('y','mu'))) expect_identical(result, list(c(paste0("y[",1:5,"]"), "mu[1]"), - c(paste0("y[",6:10,"]"), "mu[2]"))) + c(paste0("y[",6:10,"]"), "mu[2]"))) # {mu[1],y[1],y[2:5]}, {mu[2],y[6],y[7:10]} - + # Now with intermediate deterministic nodes. code <- nimbleCode({ for(i in 1:2) @@ -590,52 +590,52 @@ test_that("getConditionallyIndependentSets works with grouped data", { expect_identical(getConditionallyIndependentSets(m, givenNodes = m$getNodes(c('mu0','sigma','y')), nodes=m$getNodes('mu')), list('mu[1]','mu[2]')) # {mu[1]}, {mu[2]} - + expect_identical(getConditionallyIndependentSets(m, givenNodes = m$getNodes(c('mu0','y')), nodes=m$getNodes(c('sigma','mu'))), list(c("sigma", "mu[1]","mu[2]"))) # {sigma,mu[1:2]} - + expect_identical(getConditionallyIndependentSets(m, givenNodes = m$getNodes(c('mu0','sigma')), nodes=m$getNodes(c('y','mu'))), list(c(paste0("y[",1:5,"]"), "mu[1]"), c(paste0("y[",6:10,"]"), "mu[2]"))) # {mu[1],y[1],y[2:5]}, {mu[2],y[6],y[7:10]} - + expect_identical(getConditionallyIndependentSets(m, givenNodes = m$getNodes(c('mu0','sigma')), nodes=m$getNodes(c('mu','y'))), list(c("mu[1]", paste0("y[",1:5,"]")), c("mu[2]", paste0("y[",6:10,"]")))) # {mu[1],y[1:5]}, {mu[2],y[6:10]} - + expect_identical(getConditionallyIndependentSets(m, givenNodes = m$getNodes(c('mu0','sigma')), nodes=m$getNodes(c('mu'))), list('mu[1]','mu[2]')) # unknownAsGiven = T; {mu[1]},{mu[2]} - + expect_identical(getConditionallyIndependentSets(m, givenNodes = m$getNodes(c('mu0','sigma')), nodes=m$getNodes(c('mu')),unknownAsGiven=FALSE), list(c("mu[1]", paste0("y[",1:5,"]")), c("mu[2]", paste0("y[",6:10,"]")))) # {mu[1],y[1:5]}, {mu[2],y[6:10]} - - + + expect_identical(getConditionallyIndependentSets(m, givenNodes = c('mu0','sigma'), nodes=c('mu','y')), list(c("mu[1]", paste0("y[",1:5,"]")), c("mu[2]", paste0("y[",6:10,"]")))) # {mu[1],y[1:5]}, {mu[2],y[6:10]} - + expect_identical(getConditionallyIndependentSets(m, givenNodes = c('mu0','sigma'), nodes=c('mu','y'), returnScalarComponents=TRUE, nodesAsChars=TRUE),list(c("mu[1]", paste0("y[",1:5,"]")), c("mu[2]", paste0("y[",6:10,"]")))) - + # {"mu[1]" "y[1]" "y[2]" "y[3]" "y[4]" "y[5]"} {"mu[2]" "y[6]" "y[7]" "y[8]" "y[9]" "y[10]"} - + expect_identical(getConditionallyIndependentSets(m, givenNodes = c('mu0','sigma')), list()) expect_identical(getConditionallyIndependentSets(m, givenNodes = c('mu0','sigma'), unknownAsGiven = FALSE), list()) - + expect_identical(getConditionallyIndependentSets(m, nodes='mu'), list('mu[1]','mu[2]')) # {mu[1]}, {mu[2]} - + expect_identical(getConditionallyIndependentSets(m, givenNodes = c('mu0','sigma','y')), list('mu[1]','mu[2]')) # {mu[1]}, {mu[2]} - + expect_identical(getConditionallyIndependentSets(m), list('mu[1]','mu[2]')) # {mu[1]}, {mu[2]} - + # What happens if provide deterministic nodes? expect_identical(getConditionallyIndependentSets(m, givenNodes = c('mu0','sigma','y'), nodes=c('mn','mu')), list('mu[1]','mu[2]')) # {mu[1]}, {mu[2]} @@ -658,7 +658,7 @@ test_that("SSM case" , { }) n <- 10 m <- nimbleModel(code, data=list(y=rnorm(n)), constants = list(n=n)) - + expect_identical(getConditionallyIndependentSets(m, givenNodes = c('tau','sigma','y'), nodes=c('mu')), list(paste0("mu[", c(2:10,1), "]"))) @@ -674,13 +674,13 @@ test_that("SSM case" , { }) n <- 10 m <- nimbleModel(code, data=list(y=rnorm(n)), constants = list(n=n)) - + expect_identical(getConditionallyIndependentSets(m, givenNodes = c('tau','sigma','y'), nodes=c('mu')), list(paste0("mu[", 1:11, "]"))) }) - + setNimbleModelOption('nodesAsChars', FALSE) test_that("{aggregate,intersect,setdiff}_nodes", { @@ -694,10 +694,10 @@ test_that("{aggregate,intersect,setdiff}_nodes", { mu0 ~ dnorm(0,1) }) m <- nimbleModel(code, data=list(y=rnorm(10)), constants = list(k=c(rep(1,5),rep(2,5)))) - + set1 <- m$getNodes(c('mu','y','sigma')) set2 <- m$getNodes(c('y[1:3]','mu0','y[5:6]','mu[1]')) - + expect_identical(sapply(intersect_nodes(set1,set2), \(x) x$toNodeChars()), list('mu[1]',paste0("y[", c(1,2,3,5,6), "]"))) expect_identical(sapply(setdiff_nodes(set1,set2), \(x) x$toNodeChars()), @@ -709,21 +709,21 @@ test_that("{aggregate,intersect,setdiff}_nodes", { paste0("y[", 1:8, "]")) expect_identical(aggregate_nodes(m$getNodes(c('y[1:6]','y[8]', 'y[6:7]')))[[1]]$toNodeChars(), paste0("y[", 1:8, "]")) - + code <- nimbleCode({ for(i in 1:3) y[i,1:2] ~ dmnorm(mu[1:2],pr[1:2,1:2]) }) m <- nimbleModel(code) - - set <- m$getNodes(c('y[1,1:2]','y[3,1:2]')) + + set <- m$getNodes(c('y[1,1:2]','y[3,1:2]')) expect_identical(aggregate_nodes(set)[[1]]$toNodeChars(), c("y[1, 1:2]", "y[3, 1:2]")) # node range for `y[idx1, 1:2]`, for `idx1` in c(1, 3) - set <- m$getNodes(c('y[1,1:2]','y[2,1:2]')) + set <- m$getNodes(c('y[1,1:2]','y[2,1:2]')) expect_identical(aggregate_nodes(set)[[1]]$toNodeChars(), c("y[1, 1:2]", "y[2, 1:2]")) # node range for `y[idx1, 1:2]`, for `idx1` in 1:2 - - set <- m$getNodes(c('y[1,1:2]','y')) + + set <- m$getNodes(c('y[1,1:2]','y')) expect_identical(aggregate_nodes(set)[[1]]$toNodeChars(), c("y[1, 1:2]", "y[2, 1:2]", "y[3, 1:2]")) # node range for `y[idx1, 1:2]`, for `idx1` in 1:2 From 2289b3428a5cfc382d9aa1f5d6e505f4ca879ce5 Mon Sep 17 00:00:00 2001 From: perrydv Date: Mon, 12 Oct 2026 15:19:17 -0700 Subject: [PATCH 25/27] Fix tests. Shorten some predefined names. Pick up updates to nCompiler. --- nimbleModel/R/copier.R | 6 +- nimbleModel/R/modelValues.R | 26 +++- nimbleModel/R/varStore.R | 28 ++-- .../MVBase_nC_copyFiles.txt} | 0 .../predef/MVBase_nC/MVBase_nC_cppContent.cpp | 69 +++++++++ .../predef/MVBase_nC/MVBase_nC_filebase.txt | 1 + .../predef/MVBase_nC/MVBase_nC_hContent.h | 31 ++++ .../predef/MVBase_nC/MVBase_nC_manifest.txt | 6 + .../MVBase_nC_post_cpp_compiler.txt} | 0 .../predef/MVBase_nC/MVBase_nC_preamble.cpp | 6 + .../multiCopierMV_nClass_copyFiles.txt | 0 .../multiCopierMV_nClass_cppContent.cpp | 67 +++++++++ .../multiCopierMV_nClass_filebase.txt | 0 .../multiCopierMV_nClass_hContent.h | 33 +++++ .../multiCopierMV_nClass_manifest.txt | 7 + ...multiCopierMV_nClass_post_cpp_compiler.txt | 0 .../multiCopierMV_nClass_preamble.cpp | 6 + .../mCopy_nC_copyFiles.txt} | 0 .../predef/mCopy_nC/mCopy_nC_cppContent.cpp | 62 ++++++++ .../predef/mCopy_nC/mCopy_nC_filebase.txt | 1 + .../predef/mCopy_nC/mCopy_nC_hContent.h | 32 ++++ .../predef/mCopy_nC/mCopy_nC_manifest.txt | 6 + .../mCopy_nC_post_cpp_compiler.txt} | 0 .../predef/mCopy_nC/mCopy_nC_preamble.cpp | 6 + .../predef/mCopy_nC_base/mCopy_MV_nC_base.h | 103 +++++++++++++ .../mCopy_nC_base/mCopy_model_nC_base.h | 49 +++++++ .../mCopy_nC_base.h} | 0 .../modelValuesBase_nClass_copyFiles.txt | 0 .../modelValuesBase_nClass_cppContent.cpp | 0 .../modelValuesBase_nClass_filebase.txt | 0 .../modelValuesBase_nClass_hContent.h | 0 .../modelValuesBase_nClass_manifest.txt | 0 ...delValuesBase_nClass_post_cpp_compiler.txt | 0 .../modelValuesBase_nClass_preamble.cpp | 0 .../modelValuesClass_/modelValuesClass_.h | 2 +- .../multiCopierMV_nClass_copyFiles.txt | 0 .../multiCopierMV_nClass_cppContent.cpp | 0 .../multiCopierMV_nClass_filebase.txt | 1 + .../multiCopierMV_nClass_hContent.h | 0 .../multiCopierMV_nClass_manifest.txt | 0 ...multiCopierMV_nClass_post_cpp_compiler.txt | 0 .../multiCopierMV_nClass_preamble.cpp | 0 .../multiCopier_modelValues_nC_base.h | 2 +- .../multiCopier_model_nC_base.h | 0 .../multiCopier_nC_base.h | 40 +++++ .../multiCopier_nClass_copyFiles.txt | 0 .../multiCopier_nClass_cppContent.cpp | 0 .../multiCopier_nClass_filebase.txt | 0 .../multiCopier_nClass_hContent.h | 0 .../multiCopier_nClass_manifest.txt | 0 .../multiCopier_nClass_post_cpp_compiler.txt | 0 .../multiCopier_nClass_preamble.cpp | 0 nimbleModel/tests/testthat/test-modelValues.R | 137 ++++++++++++------ nimbleModel/tests/testthat/test-nimbleModel.R | 4 +- 54 files changed, 658 insertions(+), 73 deletions(-) rename nimbleModel/inst/include/nimbleModel/predef/{modelValuesBase_nClass/modelValuesBase_nClass_copyFiles.txt => MVBase_nC/MVBase_nC_copyFiles.txt} (100%) create mode 100644 nimbleModel/inst/include/nimbleModel/predef/MVBase_nC/MVBase_nC_cppContent.cpp create mode 100644 nimbleModel/inst/include/nimbleModel/predef/MVBase_nC/MVBase_nC_filebase.txt create mode 100644 nimbleModel/inst/include/nimbleModel/predef/MVBase_nC/MVBase_nC_hContent.h create mode 100644 nimbleModel/inst/include/nimbleModel/predef/MVBase_nC/MVBase_nC_manifest.txt rename nimbleModel/inst/include/nimbleModel/predef/{modelValuesBase_nClass/modelValuesBase_nClass_post_cpp_compiler.txt => MVBase_nC/MVBase_nC_post_cpp_compiler.txt} (100%) create mode 100644 nimbleModel/inst/include/nimbleModel/predef/MVBase_nC/MVBase_nC_preamble.cpp rename nimbleModel/inst/include/nimbleModel/predef/{multiCopierMV_nClass => mCopyMV_nC}/multiCopierMV_nClass_copyFiles.txt (100%) create mode 100644 nimbleModel/inst/include/nimbleModel/predef/mCopyMV_nC/multiCopierMV_nClass_cppContent.cpp rename nimbleModel/inst/include/nimbleModel/predef/{multiCopierMV_nClass => mCopyMV_nC}/multiCopierMV_nClass_filebase.txt (100%) create mode 100644 nimbleModel/inst/include/nimbleModel/predef/mCopyMV_nC/multiCopierMV_nClass_hContent.h create mode 100644 nimbleModel/inst/include/nimbleModel/predef/mCopyMV_nC/multiCopierMV_nClass_manifest.txt rename nimbleModel/inst/include/nimbleModel/predef/{multiCopierMV_nClass => mCopyMV_nC}/multiCopierMV_nClass_post_cpp_compiler.txt (100%) create mode 100644 nimbleModel/inst/include/nimbleModel/predef/mCopyMV_nC/multiCopierMV_nClass_preamble.cpp rename nimbleModel/inst/include/nimbleModel/predef/{multiCopier_nClass/multiCopier_nClass_copyFiles.txt => mCopy_nC/mCopy_nC_copyFiles.txt} (100%) create mode 100644 nimbleModel/inst/include/nimbleModel/predef/mCopy_nC/mCopy_nC_cppContent.cpp create mode 100644 nimbleModel/inst/include/nimbleModel/predef/mCopy_nC/mCopy_nC_filebase.txt create mode 100644 nimbleModel/inst/include/nimbleModel/predef/mCopy_nC/mCopy_nC_hContent.h create mode 100644 nimbleModel/inst/include/nimbleModel/predef/mCopy_nC/mCopy_nC_manifest.txt rename nimbleModel/inst/include/nimbleModel/predef/{multiCopier_nClass/multiCopier_nClass_post_cpp_compiler.txt => mCopy_nC/mCopy_nC_post_cpp_compiler.txt} (100%) create mode 100644 nimbleModel/inst/include/nimbleModel/predef/mCopy_nC/mCopy_nC_preamble.cpp create mode 100644 nimbleModel/inst/include/nimbleModel/predef/mCopy_nC_base/mCopy_MV_nC_base.h create mode 100644 nimbleModel/inst/include/nimbleModel/predef/mCopy_nC_base/mCopy_model_nC_base.h rename nimbleModel/inst/include/nimbleModel/predef/{multiCopier_nC_base/multiCopier_nC_base.h => mCopy_nC_base/mCopy_nC_base.h} (100%) create mode 100644 nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass_old/modelValuesBase_nClass_copyFiles.txt rename nimbleModel/inst/include/nimbleModel/predef/{modelValuesBase_nClass => modelValuesBase_nClass_old}/modelValuesBase_nClass_cppContent.cpp (100%) rename nimbleModel/inst/include/nimbleModel/predef/{modelValuesBase_nClass => modelValuesBase_nClass_old}/modelValuesBase_nClass_filebase.txt (100%) rename nimbleModel/inst/include/nimbleModel/predef/{modelValuesBase_nClass => modelValuesBase_nClass_old}/modelValuesBase_nClass_hContent.h (100%) rename nimbleModel/inst/include/nimbleModel/predef/{modelValuesBase_nClass => modelValuesBase_nClass_old}/modelValuesBase_nClass_manifest.txt (100%) create mode 100644 nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass_old/modelValuesBase_nClass_post_cpp_compiler.txt rename nimbleModel/inst/include/nimbleModel/predef/{modelValuesBase_nClass => modelValuesBase_nClass_old}/modelValuesBase_nClass_preamble.cpp (100%) create mode 100644 nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass_old/multiCopierMV_nClass_copyFiles.txt rename nimbleModel/inst/include/nimbleModel/predef/{multiCopierMV_nClass => multiCopierMV_nClass_old}/multiCopierMV_nClass_cppContent.cpp (100%) create mode 100644 nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass_old/multiCopierMV_nClass_filebase.txt rename nimbleModel/inst/include/nimbleModel/predef/{multiCopierMV_nClass => multiCopierMV_nClass_old}/multiCopierMV_nClass_hContent.h (100%) rename nimbleModel/inst/include/nimbleModel/predef/{multiCopierMV_nClass => multiCopierMV_nClass_old}/multiCopierMV_nClass_manifest.txt (100%) create mode 100644 nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass_old/multiCopierMV_nClass_post_cpp_compiler.txt rename nimbleModel/inst/include/nimbleModel/predef/{multiCopierMV_nClass => multiCopierMV_nClass_old}/multiCopierMV_nClass_preamble.cpp (100%) rename nimbleModel/inst/include/nimbleModel/predef/{multiCopier_nC_base => multiCopier_nC_base_old}/multiCopier_modelValues_nC_base.h (98%) rename nimbleModel/inst/include/nimbleModel/predef/{multiCopier_nC_base => multiCopier_nC_base_old}/multiCopier_model_nC_base.h (100%) create mode 100644 nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base_old/multiCopier_nC_base.h create mode 100644 nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass_old/multiCopier_nClass_copyFiles.txt rename nimbleModel/inst/include/nimbleModel/predef/{multiCopier_nClass => multiCopier_nClass_old}/multiCopier_nClass_cppContent.cpp (100%) rename nimbleModel/inst/include/nimbleModel/predef/{multiCopier_nClass => multiCopier_nClass_old}/multiCopier_nClass_filebase.txt (100%) rename nimbleModel/inst/include/nimbleModel/predef/{multiCopier_nClass => multiCopier_nClass_old}/multiCopier_nClass_hContent.h (100%) rename nimbleModel/inst/include/nimbleModel/predef/{multiCopier_nClass => multiCopier_nClass_old}/multiCopier_nClass_manifest.txt (100%) create mode 100644 nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass_old/multiCopier_nClass_post_cpp_compiler.txt rename nimbleModel/inst/include/nimbleModel/predef/{multiCopier_nClass => multiCopier_nClass_old}/multiCopier_nClass_preamble.cpp (100%) diff --git a/nimbleModel/R/copier.R b/nimbleModel/R/copier.R index 768c63f..52d57df 100644 --- a/nimbleModel/R/copier.R +++ b/nimbleModel/R/copier.R @@ -83,8 +83,9 @@ multiCopier_nClass <- nCompiler::nClass( ) ) ), - predefined = quote(system.file(file.path("include", "nimbleModel", "predef"), package = "nimbleModel") |> file.path("multiCopier_nClass")), + predefined = quote(system.file(file.path("include", "nimbleModel", "predef"), package = "nimbleModel") |> file.path("mCopy_nC")), compileInfo = list( + cpp_classname = "mCopy_nC", interface = "full", createFromR = TRUE, exportName = "multiCopier_nClass_new", @@ -170,8 +171,9 @@ multiCopierMV_nClass <- nCompiler::nClass( ) ) ), - predefined = quote(system.file(file.path("include", "nimbleModel", "predef"), package = "nimbleModel") |> file.path("multiCopierMV_nClass")), + predefined = quote(system.file(file.path("include", "nimbleModel", "predef"), package = "nimbleModel") |> file.path("mCopyMV_nC")), compileInfo = list( + cpp_classaname = "mCopyMV_nC", interface = "full", createFromR = TRUE, exportName = "multiCopierMV_nClass_new", diff --git a/nimbleModel/R/modelValues.R b/nimbleModel/R/modelValues.R index 6ee226d..181cb75 100644 --- a/nimbleModel/R/modelValues.R +++ b/nimbleModel/R/modelValues.R @@ -10,7 +10,7 @@ modelValuesBase_nClass <- nCompiler::nClass( # Compiled constructor will be called automatically (even without this full interface). # Uncompiled matching steps are done by direct call. if (!isCompiled()) { - modelValuesBase_nClass() + MVBase_nC() } # Initialize for anything with this full interface (uncompiled for full-interface compiled). self$dot_sizeList <- self$defaultSizes @@ -20,7 +20,7 @@ modelValuesBase_nClass <- nCompiler::nClass( Cpublic = list( dot_sizeList = "RcppList", dot_current_nRow = "integerScalar", - modelValuesBase_nClass = nCompiler::nFunction( + MVBase_nC = nCompiler::nFunction( function() { self$dot_current_nRow <<- 0 self$dot_sizeList <<- list() @@ -82,9 +82,9 @@ modelValuesBase_nClass <- nCompiler::nClass( ), predefined = quote(system.file(file.path("include", "nimbleModel", "predef"), package = "nimbleModel" - ) |> file.path("modelValuesBase_nClass")), + ) |> file.path("MVBase_nC")), compileInfo = list( - cpp_classname = "modelValuesBase_nClass", + cpp_classname = "MVBase_nC", interface = "full", createFromR = FALSE, exportName = "modelValuesBase_nClass_new", @@ -139,6 +139,10 @@ make_modelValues_nClass <- function(varInfo, } # All cases get the same classname so that they share the same S3 dispatch for `[`, `[<-`, etc. classname <- cpp_classname + # TODO: Sort varInfo$vars (as make_modelValues_hashID does) before generating the class. + # The hash is order-robust but Cpublic is built in the given order, so when equivalent + # classes are deduped by classID, the member order (interface_names, as.list) comes + # from whichever generator was registered first. e <- environment() CpublicVars <- varInfo$vars |> lapply(\(x) { @@ -462,9 +466,10 @@ as.list.modelValues <- function(x, varNames, stack = TRUE, flatten = FALSE, iter } if(stack) { res <- simplify2array(res, higher = !flatten) - dims <- dim(res) - nDim <- length(dims) + if(is.null(dim(res))) # scalar var: simplify2array returns a plain vector + dim(res) <- c(1, length(res)) if(!iterationAsLastIndex) { + nDim <- length(dim(res)) res <- aperm(res, c(nDim, 1:(nDim-1))) if(flatten) { colnames(res) <- this_colnames @@ -581,6 +586,7 @@ matrix2mv <- function(mat, mv) { colNames <- colnames(mat) colNamesVars <- colNames |> (\(x) sub('\\[.*', '', x))() uniqueColNameVars <- colNamesVars |> unique() + length(mv) <- k for(vN in uniqueColNameVars){ varInds <- colNamesVars == vN numCols <- sum(varInds) @@ -594,18 +600,22 @@ matrix2mv <- function(mat, mv) { if(length(theseSizes) > 1) { res <- apply(mat[, varInds, drop = FALSE], 1, \(x) { dim(x) <- theseSizes + names(x) <- NULL x }, simplify = FALSE) } else { res <- apply(mat[, varInds, drop = FALSE], 1, \(x) { + names(x) <- NULL x }, simplify = FALSE) } # We must use value() in case mv is a base class or generic interface. - nCompiler::value(mv, vN) <- res - # mv[[vN]] <- res + if(nCompiler::isCompiled(mv)) + nCompiler::value(mv, vN) <- res + else + mv[[vN]][] <- res } mv } diff --git a/nimbleModel/R/varStore.R b/nimbleModel/R/varStore.R index 1229e81..076bf71 100644 --- a/nimbleModel/R/varStore.R +++ b/nimbleModel/R/varStore.R @@ -49,18 +49,22 @@ varStoreClass <- R6Class( # helper functions -# FIXME: remove when we pull this in from current nimble -dimOrLength <- function(obj, scalarize = FALSE) { - if (scalarize) { - if (length(obj) == 1) { - return(numeric(0)) - } - } - if (is.null(dim(obj))) { - return(length(obj)) - } - return(dim(obj)) -} +# This is replaced in all_utils.R +# The only difference is that uses integer(0) as a default +# for scalarize = TRUE. +# +# # FIXME: remove when we pull this in from current nimble +# dimOrLength <- function(obj, scalarize = FALSE) { +# if (scalarize) { +# if (length(obj) == 1) { +# return(numeric(0)) +# } +# } +# if (is.null(dim(obj))) { +# return(length(obj)) +# } +# return(dim(obj)) +# } getLength <- function(index) { # find the number of values represented by a single index diff --git a/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_copyFiles.txt b/nimbleModel/inst/include/nimbleModel/predef/MVBase_nC/MVBase_nC_copyFiles.txt similarity index 100% rename from nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_copyFiles.txt rename to nimbleModel/inst/include/nimbleModel/predef/MVBase_nC/MVBase_nC_copyFiles.txt diff --git a/nimbleModel/inst/include/nimbleModel/predef/MVBase_nC/MVBase_nC_cppContent.cpp b/nimbleModel/inst/include/nimbleModel/predef/MVBase_nC/MVBase_nC_cppContent.cpp new file mode 100644 index 0000000..23aa46e --- /dev/null +++ b/nimbleModel/inst/include/nimbleModel/predef/MVBase_nC/MVBase_nC_cppContent.cpp @@ -0,0 +1,69 @@ +/* OPENER (Do not edit this comment) */ +#ifndef __MVBase_nC_CPP +#define __MVBase_nC_CPP +/* BODY (Do not edit this comment) */ +#ifndef R_NO_REMAP +#define R_NO_REMAP +#endif +#include +#include "MVBase_nC_c_.h" +using namespace Rcpp; +// [[Rcpp::plugins(nCompiler_Eigen_plugin)]] +// [[Rcpp::depends(RcppParallel)]] +// [[Rcpp::depends(nCompiler)]] +// [[Rcpp::depends(Rcereal)]] +// [[Rcpp::depends(nimbleModel)]] + + MVBase_nC::MVBase_nC ( ) { +RESET_EIGEN_ERRORS +flex_((this)->dot_current_nRow) = 0.0; +this->dot_sizeList = Rcpp::List();; +} + void MVBase_nC::set_sizeList ( Rcpp::List sizeList ) { +RESET_EIGEN_ERRORS +(this)->dot_sizeList = sizeList; +} + Rcpp::List MVBase_nC::get_sizeList ( ) { +RESET_EIGEN_ERRORS +return((this)->dot_sizeList); +} + void MVBase_nC::resize ( int m ) { +RESET_EIGEN_ERRORS +Rcpp::stop("Should not be calling compiled modelValuesBase_nClass resize().");; +} + int MVBase_nC::getLength ( ) { +RESET_EIGEN_ERRORS +return((this)->dot_current_nRow); +} + int MVBase_nC::getSize ( ) { +RESET_EIGEN_ERRORS +return((this)->getLength()); +} + +// [[Rcpp::export(name = "set_CnClass_env_modelValuesBase_nClass_new")]] + void set_CnClass_env_MVBase_nC ( SEXP env ) { +RESET_EIGEN_ERRORS +SET_CNCLASS_ENV(MVBase_nC, env);; +} + +// [[Rcpp::export(name = "get_CnClass_env_modelValuesBase_nClass_new")]] + Rcpp::Environment get_CnClass_env_MVBase_nC ( ) { +RESET_EIGEN_ERRORS +return GET_CNCLASS_ENV(MVBase_nC);; +} + +NCOMPILER_INTERFACE( +MVBase_nC, +NCOMPILER_FIELDS( +field("dot_sizeList", &MVBase_nC::dot_sizeList), +field("dot_current_nRow", &MVBase_nC::dot_current_nRow) +), +NCOMPILER_METHODS( +method("set_sizeList", &MVBase_nC::set_sizeList, args({{arg("sizeList",copy)}})), +method("get_sizeList", &MVBase_nC::get_sizeList, args({{}})), +method("resize", &MVBase_nC::resize, args({{arg("m",copy)}})), +method("getLength", &MVBase_nC::getLength, args({{}})), +method("getSize", &MVBase_nC::getSize, args({{}})) +) +) +#endif diff --git a/nimbleModel/inst/include/nimbleModel/predef/MVBase_nC/MVBase_nC_filebase.txt b/nimbleModel/inst/include/nimbleModel/predef/MVBase_nC/MVBase_nC_filebase.txt new file mode 100644 index 0000000..9d5b2f9 --- /dev/null +++ b/nimbleModel/inst/include/nimbleModel/predef/MVBase_nC/MVBase_nC_filebase.txt @@ -0,0 +1 @@ +MVBase_nC_c_ diff --git a/nimbleModel/inst/include/nimbleModel/predef/MVBase_nC/MVBase_nC_hContent.h b/nimbleModel/inst/include/nimbleModel/predef/MVBase_nC/MVBase_nC_hContent.h new file mode 100644 index 0000000..e1327be --- /dev/null +++ b/nimbleModel/inst/include/nimbleModel/predef/MVBase_nC/MVBase_nC_hContent.h @@ -0,0 +1,31 @@ +/* OPENER (Do not edit this comment) */ +#ifndef __MVBase_nC_H +#define __MVBase_nC_H +/* BODY (Do not edit this comment) */ +#ifndef R_NO_REMAP +#define R_NO_REMAP +#endif +#include +#include "MVBase_nC_c_.h" + +class MVBase_nC : public interface_resolver< genericInterfaceC >, public loadedObjectHookC { +public: + static const char* nc_class_key() {return "MVBase_nC";} + MVBase_nC ( ) ; + void set_sizeList ( Rcpp::List sizeList ) ; + Rcpp::List get_sizeList ( ) ; + virtual void resize ( int m ) ; + virtual int getLength ( ) ; + virtual int getSize ( ) ; + Rcpp::List dot_sizeList; + int dot_current_nRow; + +}; + + void set_CnClass_env_MVBase_nC ( SEXP env ) ; + + Rcpp::Environment get_CnClass_env_MVBase_nC ( ) ; + +#include + +#endif diff --git a/nimbleModel/inst/include/nimbleModel/predef/MVBase_nC/MVBase_nC_manifest.txt b/nimbleModel/inst/include/nimbleModel/predef/MVBase_nC/MVBase_nC_manifest.txt new file mode 100644 index 0000000..84d71fa --- /dev/null +++ b/nimbleModel/inst/include/nimbleModel/predef/MVBase_nC/MVBase_nC_manifest.txt @@ -0,0 +1,6 @@ +list(saved_at = structure(1791834500.24101, class = c("POSIXct", +"POSIXt")), packet_name = "MVBase_nC", elements = c("preamble", +"cppContent", "hContent", "filebase", "post_cpp_compiler", "copyFiles" +), files = list(preamble = "MVBase_nC_preamble.cpp", cppContent = "MVBase_nC_cppContent.cpp", + hContent = "MVBase_nC_hContent.h", filebase = "MVBase_nC_filebase.txt", + post_cpp_compiler = "MVBase_nC_post_cpp_compiler.txt", copyFiles = "MVBase_nC_copyFiles.txt")) diff --git a/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_post_cpp_compiler.txt b/nimbleModel/inst/include/nimbleModel/predef/MVBase_nC/MVBase_nC_post_cpp_compiler.txt similarity index 100% rename from nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_post_cpp_compiler.txt rename to nimbleModel/inst/include/nimbleModel/predef/MVBase_nC/MVBase_nC_post_cpp_compiler.txt diff --git a/nimbleModel/inst/include/nimbleModel/predef/MVBase_nC/MVBase_nC_preamble.cpp b/nimbleModel/inst/include/nimbleModel/predef/MVBase_nC/MVBase_nC_preamble.cpp new file mode 100644 index 0000000..0c6b4c1 --- /dev/null +++ b/nimbleModel/inst/include/nimbleModel/predef/MVBase_nC/MVBase_nC_preamble.cpp @@ -0,0 +1,6 @@ +#define NCOMPILER_HANDLE_EIGEN_ERRORS +#define NCOMPILER_USES_EIGEN +#define NCOMPILER_USES_NCPPVEC +#define NCOMPILER_USES_MVDISTS +#define USES_NCOMPILER +#define NCOMPILER_USES_NCLASS_INTERFACE diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass/multiCopierMV_nClass_copyFiles.txt b/nimbleModel/inst/include/nimbleModel/predef/mCopyMV_nC/multiCopierMV_nClass_copyFiles.txt similarity index 100% rename from nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass/multiCopierMV_nClass_copyFiles.txt rename to nimbleModel/inst/include/nimbleModel/predef/mCopyMV_nC/multiCopierMV_nClass_copyFiles.txt diff --git a/nimbleModel/inst/include/nimbleModel/predef/mCopyMV_nC/multiCopierMV_nClass_cppContent.cpp b/nimbleModel/inst/include/nimbleModel/predef/mCopyMV_nC/multiCopierMV_nClass_cppContent.cpp new file mode 100644 index 0000000..701cce2 --- /dev/null +++ b/nimbleModel/inst/include/nimbleModel/predef/mCopyMV_nC/multiCopierMV_nClass_cppContent.cpp @@ -0,0 +1,67 @@ +/* OPENER (Do not edit this comment) */ +#ifndef __multiCopierMV_nClass_CPP +#define __multiCopierMV_nClass_CPP +/* BODY (Do not edit this comment) */ +#ifndef R_NO_REMAP +#define R_NO_REMAP +#endif +#include +#include "multiCopierMV_nClass_c_.h" +using namespace Rcpp; +// [[Rcpp::plugins(nCompiler_Eigen_plugin)]] +// [[Rcpp::depends(RcppParallel)]] +// [[Rcpp::depends(nCompiler)]] +// [[Rcpp::depends(Rcereal)]] +// [[Rcpp::depends(nimbleModel)]] + + void multiCopierMV_nClass::init ( std::shared_ptr modelValues ) { +RESET_EIGEN_ERRORS +multiCopier_modelValues_nC_base::init(this->copiers, modelValues); +} + void multiCopierMV_nClass::setActiveRow ( int row ) { +RESET_EIGEN_ERRORS +multiCopier_modelValues_nC_base::setActiveRow(row); +} + Eigen::Tensor multiCopierMV_nClass::getValues ( ) { +RESET_EIGEN_ERRORS +return flatViewGroup.copyIntoVector(); +} + void multiCopierMV_nClass::setValues ( Eigen::Tensor v ) { +RESET_EIGEN_ERRORS +flatViewGroup.copyFromVector(v); +} + multiCopierMV_nClass::multiCopierMV_nClass ( ) { +RESET_EIGEN_ERRORS +} + +// [[Rcpp::export(name = "multiCopierMV_nClass_new")]] + SEXP new_multiCopierMV_nClass ( ) { +RESET_EIGEN_ERRORS +return CREATE_NEW_NCOMP_OBJECT(multiCopierMV_nClass);; +} + +// [[Rcpp::export(name = "set_CnClass_env_multiCopierMV_nClass_new")]] + void set_CnClass_env_multiCopierMV_nClass ( SEXP env ) { +RESET_EIGEN_ERRORS +SET_CNCLASS_ENV(multiCopierMV_nClass, env);; +} + +// [[Rcpp::export(name = "get_CnClass_env_multiCopierMV_nClass_new")]] + Rcpp::Environment get_CnClass_env_multiCopierMV_nClass ( ) { +RESET_EIGEN_ERRORS +return GET_CNCLASS_ENV(multiCopierMV_nClass);; +} + +NCOMPILER_INTERFACE( +multiCopierMV_nClass, +NCOMPILER_FIELDS( +field("copiers", &multiCopierMV_nClass::copiers) +), +NCOMPILER_METHODS( +method("init", &multiCopierMV_nClass::init, args({{arg("modelValues",copy)}})), +method("setActiveRow", &multiCopierMV_nClass::setActiveRow, args({{arg("row",copy)}})), +method("getValues", &multiCopierMV_nClass::getValues, args({{}})), +method("setValues", &multiCopierMV_nClass::setValues, args({{arg("v",copy)}})) +) +) +#endif diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass/multiCopierMV_nClass_filebase.txt b/nimbleModel/inst/include/nimbleModel/predef/mCopyMV_nC/multiCopierMV_nClass_filebase.txt similarity index 100% rename from nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass/multiCopierMV_nClass_filebase.txt rename to nimbleModel/inst/include/nimbleModel/predef/mCopyMV_nC/multiCopierMV_nClass_filebase.txt diff --git a/nimbleModel/inst/include/nimbleModel/predef/mCopyMV_nC/multiCopierMV_nClass_hContent.h b/nimbleModel/inst/include/nimbleModel/predef/mCopyMV_nC/multiCopierMV_nClass_hContent.h new file mode 100644 index 0000000..46b816b --- /dev/null +++ b/nimbleModel/inst/include/nimbleModel/predef/mCopyMV_nC/multiCopierMV_nClass_hContent.h @@ -0,0 +1,33 @@ +/* OPENER (Do not edit this comment) */ +#ifndef __multiCopierMV_nClass_H +#define __multiCopierMV_nClass_H +/* BODY (Do not edit this comment) */ +#ifndef R_NO_REMAP +#define R_NO_REMAP +#endif +#include +#include "nList_copier_nClass_c_.h" +#include "multiCopierMV_nClass_c_.h" +#include "MVBase_nC_c_.h" +#include + +class multiCopierMV_nClass : public interface_resolver< genericInterfaceC, multiCopier_modelValues_nC_base >, public loadedObjectHookC { +public: + static const char* nc_class_key() {return "multiCopierMV_nClass";} + void init ( std::shared_ptr modelValues ) ; + void setActiveRow ( int row ) ; + Eigen::Tensor getValues ( ) ; + void setValues ( Eigen::Tensor v ) ; + multiCopierMV_nClass ( ) ; + std::shared_ptr copiers; + +}; + + SEXP new_multiCopierMV_nClass ( ) ; + + void set_CnClass_env_multiCopierMV_nClass ( SEXP env ) ; + + Rcpp::Environment get_CnClass_env_multiCopierMV_nClass ( ) ; + + +#endif diff --git a/nimbleModel/inst/include/nimbleModel/predef/mCopyMV_nC/multiCopierMV_nClass_manifest.txt b/nimbleModel/inst/include/nimbleModel/predef/mCopyMV_nC/multiCopierMV_nClass_manifest.txt new file mode 100644 index 0000000..7fe14fd --- /dev/null +++ b/nimbleModel/inst/include/nimbleModel/predef/mCopyMV_nC/multiCopierMV_nClass_manifest.txt @@ -0,0 +1,7 @@ +list(saved_at = structure(1791834920.56051, class = c("POSIXct", +"POSIXt")), packet_name = "multiCopierMV_nClass", elements = c("preamble", +"cppContent", "hContent", "filebase", "post_cpp_compiler", "copyFiles" +), files = list(preamble = "multiCopierMV_nClass_preamble.cpp", + cppContent = "multiCopierMV_nClass_cppContent.cpp", hContent = "multiCopierMV_nClass_hContent.h", + filebase = "multiCopierMV_nClass_filebase.txt", post_cpp_compiler = "multiCopierMV_nClass_post_cpp_compiler.txt", + copyFiles = "multiCopierMV_nClass_copyFiles.txt")) diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass/multiCopierMV_nClass_post_cpp_compiler.txt b/nimbleModel/inst/include/nimbleModel/predef/mCopyMV_nC/multiCopierMV_nClass_post_cpp_compiler.txt similarity index 100% rename from nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass/multiCopierMV_nClass_post_cpp_compiler.txt rename to nimbleModel/inst/include/nimbleModel/predef/mCopyMV_nC/multiCopierMV_nClass_post_cpp_compiler.txt diff --git a/nimbleModel/inst/include/nimbleModel/predef/mCopyMV_nC/multiCopierMV_nClass_preamble.cpp b/nimbleModel/inst/include/nimbleModel/predef/mCopyMV_nC/multiCopierMV_nClass_preamble.cpp new file mode 100644 index 0000000..0c6b4c1 --- /dev/null +++ b/nimbleModel/inst/include/nimbleModel/predef/mCopyMV_nC/multiCopierMV_nClass_preamble.cpp @@ -0,0 +1,6 @@ +#define NCOMPILER_HANDLE_EIGEN_ERRORS +#define NCOMPILER_USES_EIGEN +#define NCOMPILER_USES_NCPPVEC +#define NCOMPILER_USES_MVDISTS +#define USES_NCOMPILER +#define NCOMPILER_USES_NCLASS_INTERFACE diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_copyFiles.txt b/nimbleModel/inst/include/nimbleModel/predef/mCopy_nC/mCopy_nC_copyFiles.txt similarity index 100% rename from nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_copyFiles.txt rename to nimbleModel/inst/include/nimbleModel/predef/mCopy_nC/mCopy_nC_copyFiles.txt diff --git a/nimbleModel/inst/include/nimbleModel/predef/mCopy_nC/mCopy_nC_cppContent.cpp b/nimbleModel/inst/include/nimbleModel/predef/mCopy_nC/mCopy_nC_cppContent.cpp new file mode 100644 index 0000000..2c4ed20 --- /dev/null +++ b/nimbleModel/inst/include/nimbleModel/predef/mCopy_nC/mCopy_nC_cppContent.cpp @@ -0,0 +1,62 @@ +/* OPENER (Do not edit this comment) */ +#ifndef __mCopy_nC_CPP +#define __mCopy_nC_CPP +/* BODY (Do not edit this comment) */ +#ifndef R_NO_REMAP +#define R_NO_REMAP +#endif +#include +#include "mCopy_nC_c_.h" +using namespace Rcpp; +// [[Rcpp::plugins(nCompiler_Eigen_plugin)]] +// [[Rcpp::depends(RcppParallel)]] +// [[Rcpp::depends(nCompiler)]] +// [[Rcpp::depends(Rcereal)]] +// [[Rcpp::depends(nimbleModel)]] + + void mCopy_nC::init ( std::shared_ptr model ) { +RESET_EIGEN_ERRORS +multiCopier_model_nC_base::init(this->copiers, model); +} + Eigen::Tensor mCopy_nC::getValues ( ) { +RESET_EIGEN_ERRORS +return flatViewGroup.copyIntoVector(); +} + void mCopy_nC::setValues ( Eigen::Tensor v ) { +RESET_EIGEN_ERRORS +flatViewGroup.copyFromVector(v); +} + mCopy_nC::mCopy_nC ( ) { +RESET_EIGEN_ERRORS +} + +// [[Rcpp::export(name = "multiCopier_nClass_new")]] + SEXP new_mCopy_nC ( ) { +RESET_EIGEN_ERRORS +return CREATE_NEW_NCOMP_OBJECT(mCopy_nC);; +} + +// [[Rcpp::export(name = "set_CnClass_env_multiCopier_nClass_new")]] + void set_CnClass_env_mCopy_nC ( SEXP env ) { +RESET_EIGEN_ERRORS +SET_CNCLASS_ENV(mCopy_nC, env);; +} + +// [[Rcpp::export(name = "get_CnClass_env_multiCopier_nClass_new")]] + Rcpp::Environment get_CnClass_env_mCopy_nC ( ) { +RESET_EIGEN_ERRORS +return GET_CNCLASS_ENV(mCopy_nC);; +} + +NCOMPILER_INTERFACE( +mCopy_nC, +NCOMPILER_FIELDS( +field("copiers", &mCopy_nC::copiers) +), +NCOMPILER_METHODS( +method("init", &mCopy_nC::init, args({{arg("model",copy)}})), +method("getValues", &mCopy_nC::getValues, args({{}})), +method("setValues", &mCopy_nC::setValues, args({{arg("v",copy)}})) +) +) +#endif diff --git a/nimbleModel/inst/include/nimbleModel/predef/mCopy_nC/mCopy_nC_filebase.txt b/nimbleModel/inst/include/nimbleModel/predef/mCopy_nC/mCopy_nC_filebase.txt new file mode 100644 index 0000000..3aebbfb --- /dev/null +++ b/nimbleModel/inst/include/nimbleModel/predef/mCopy_nC/mCopy_nC_filebase.txt @@ -0,0 +1 @@ +mCopy_nC_c_ diff --git a/nimbleModel/inst/include/nimbleModel/predef/mCopy_nC/mCopy_nC_hContent.h b/nimbleModel/inst/include/nimbleModel/predef/mCopy_nC/mCopy_nC_hContent.h new file mode 100644 index 0000000..4b5c95d --- /dev/null +++ b/nimbleModel/inst/include/nimbleModel/predef/mCopy_nC/mCopy_nC_hContent.h @@ -0,0 +1,32 @@ +/* OPENER (Do not edit this comment) */ +#ifndef __mCopy_nC_H +#define __mCopy_nC_H +/* BODY (Do not edit this comment) */ +#ifndef R_NO_REMAP +#define R_NO_REMAP +#endif +#include +#include "nList_copier_nClass_c_.h" +#include "mCopy_nC_c_.h" +#include "modelBase_nClass_c_.h" +#include + +class mCopy_nC : public interface_resolver< genericInterfaceC, multiCopier_model_nC_base >, public loadedObjectHookC { +public: + static const char* nc_class_key() {return "mCopy_nC";} + void init ( std::shared_ptr model ) ; + Eigen::Tensor getValues ( ) ; + void setValues ( Eigen::Tensor v ) ; + mCopy_nC ( ) ; + std::shared_ptr copiers; + +}; + + SEXP new_mCopy_nC ( ) ; + + void set_CnClass_env_mCopy_nC ( SEXP env ) ; + + Rcpp::Environment get_CnClass_env_mCopy_nC ( ) ; + + +#endif diff --git a/nimbleModel/inst/include/nimbleModel/predef/mCopy_nC/mCopy_nC_manifest.txt b/nimbleModel/inst/include/nimbleModel/predef/mCopy_nC/mCopy_nC_manifest.txt new file mode 100644 index 0000000..964bd95 --- /dev/null +++ b/nimbleModel/inst/include/nimbleModel/predef/mCopy_nC/mCopy_nC_manifest.txt @@ -0,0 +1,6 @@ +list(saved_at = structure(1791834659.55193, class = c("POSIXct", +"POSIXt")), packet_name = "mCopy_nC", elements = c("preamble", +"cppContent", "hContent", "filebase", "post_cpp_compiler", "copyFiles" +), files = list(preamble = "mCopy_nC_preamble.cpp", cppContent = "mCopy_nC_cppContent.cpp", + hContent = "mCopy_nC_hContent.h", filebase = "mCopy_nC_filebase.txt", + post_cpp_compiler = "mCopy_nC_post_cpp_compiler.txt", copyFiles = "mCopy_nC_copyFiles.txt")) diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_post_cpp_compiler.txt b/nimbleModel/inst/include/nimbleModel/predef/mCopy_nC/mCopy_nC_post_cpp_compiler.txt similarity index 100% rename from nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_post_cpp_compiler.txt rename to nimbleModel/inst/include/nimbleModel/predef/mCopy_nC/mCopy_nC_post_cpp_compiler.txt diff --git a/nimbleModel/inst/include/nimbleModel/predef/mCopy_nC/mCopy_nC_preamble.cpp b/nimbleModel/inst/include/nimbleModel/predef/mCopy_nC/mCopy_nC_preamble.cpp new file mode 100644 index 0000000..0c6b4c1 --- /dev/null +++ b/nimbleModel/inst/include/nimbleModel/predef/mCopy_nC/mCopy_nC_preamble.cpp @@ -0,0 +1,6 @@ +#define NCOMPILER_HANDLE_EIGEN_ERRORS +#define NCOMPILER_USES_EIGEN +#define NCOMPILER_USES_NCPPVEC +#define NCOMPILER_USES_MVDISTS +#define USES_NCOMPILER +#define NCOMPILER_USES_NCLASS_INTERFACE diff --git a/nimbleModel/inst/include/nimbleModel/predef/mCopy_nC_base/mCopy_MV_nC_base.h b/nimbleModel/inst/include/nimbleModel/predef/mCopy_nC_base/mCopy_MV_nC_base.h new file mode 100644 index 0000000..8c1fef2 --- /dev/null +++ b/nimbleModel/inst/include/nimbleModel/predef/mCopy_nC_base/mCopy_MV_nC_base.h @@ -0,0 +1,103 @@ +#ifndef __MULTICOPIER_MODELVALUES_NC_BASE +#define __MULTICOPIER_MODELVALUES_NC_BASE + +#include + +// modelValues-backed multiCopier setup: each copier's varName resolves to an +// nList (one element per row) rather than directly to a value, so getting an +// ETaccessorBase for a variable additionally requires picking a row via +// nListBase_nClass::access_at(row). setActiveRow(row) is how that row gets +// (re)selected, and it can be called repeatedly to retarget the same +// flatViewGroup at a different row without re-resolving variable names. +// +// Unlike the model-backed sibling class, the nList a variable currently +// resolves to cannot be cached across calls: modelValues variables are +// exposed to R via genericInterfaceC, and an R-level assignment onto a +// compiled-nList-typed field (accessor_class::set(), P_is_shared_ptr +// branch) reassigns the member outright rather than mutating it in place. +// A cached std::shared_ptr copy would not see that -- it +// would keep pointing at the old (now orphaned but still valid, since our +// copy owns a reference to it) nList, silently disconnected from whatever +// the field now holds. There is no safe way to hold a live "pointer to the +// member slot" through the type-erased genericInterfaceBaseC interface +// either (that would need a reinterpret_cast between unrelated shared_ptr +// instantiations). So instead, only the name -> accessor_base resolution is +// cached (fieldAccessors, resolved once in init()); the nList itself is +// re-derived from the live modelValues object via accessor_base:: +// getInterfacePtr() on every use (see resolveRowSource) -- no map lookup by +// name, but always a fresh read, so a reassignment is never missed. +class multiCopier_modelValues_nC_base : public multiCopier_nC_base { +public: + // The accessor_base here is the base class for the generic interface scheme + // for name-based lookup. (This is not related to ETaccessors). + // E.g. for a variable "mu", we can cache the accessor for "mu" without + // repeating the name-based lookup, but that's as close as we can get. + // For safety we need to re-obtain the nList for "mu" on each copy usage. + std::vector> fieldAccessors; + // Ensure the modelValues stays alive. This shouldn't be needed in + // nimble2's design but is here for safety and is cheap. + std::shared_ptr modelValuesKeepAlive; + // Saved index-block information for deferring (lazy) setup of the RuntimeFlatViews. + std::vector> ssList; + bool built = false; + + // When init is called, there is no guarantee that the variables will be + // initialized so we can't count on reading their sizes. + // Hence we defer that step until the first actual copy (via setActiveRow). + template + void init(std::shared_ptr copiers, + std::shared_ptr modelValues) { + flatViewGroup.clear(); + fieldAccessors.clear(); + ssList.clear(); + built = false; + modelValuesKeepAlive = modelValues; + const auto& name2access = modelValues->get_name2access(); + for (const auto& copier : copiers->contents()) { + auto it = name2access.find(copier->varName); + if (it == name2access.end()) + Rcpp::stop("multiCopier (modelValues): variable not found: " + copier->varName); + fieldAccessors.push_back(it->second); + ssList.push_back(vec_2_vecB__(copier->indsList->contents())); + } + } + + // Get an nList base class pointer from the accessor_base for the k-th variable. + std::shared_ptr resolveRowSource(size_t k) { + std::shared_ptr ip = + fieldAccessors[k]->getInterfacePtr(modelValuesKeepAlive.get()); + // The modelValues object may have been created by a different DLL (see nc_shared_ptr_cast in nCompiler). + std::shared_ptr nlPtr = + nc_shared_ptr_cast(ip); + if (!nlPtr) + Rcpp::stop("multiCopier (modelValues): variable is not an nList."); + return nlPtr; + } + + // On the first call, we assume we can obtain size information + // that will be constant thereafter (based on whichever row was chosen first!) + void setActiveRow(int newRow) { + if (!built) { + flatViewGroup.clear(); + for (size_t k = 0; k < fieldAccessors.size(); ++k) { + auto acc = resolveRowSource(k)->access_at(newRow); + // makeRuntimeFlatView does initialize the data pointer, so the + // prepare_for_setData and setNextData steps are not necessary. + flatViewGroup.add(makeRuntimeFlatView(acc, ssList[k])); + } + built = true; + } else { + // See comment in multiCopier_model_nC_base. + // Performance note for the modelValues case: + // the nListBase_nClass::access_at(row) allocates a new ETaccessor + // every time. Future optimization could re-use a single ETaccessor, + // but that would take a small extension of ETaccessor. + flatViewGroup.prepare_for_setData(); // reset the counter. + for (size_t k = 0; k < fieldAccessors.size(); ++k) { + auto acc = resolveRowSource(k)->access_at(newRow); // Get an ETaccessor. + flatViewGroup.setNextData(acc->template S().data()); // reset the data pointer. + } + } + } +}; +#endif diff --git a/nimbleModel/inst/include/nimbleModel/predef/mCopy_nC_base/mCopy_model_nC_base.h b/nimbleModel/inst/include/nimbleModel/predef/mCopy_nC_base/mCopy_model_nC_base.h new file mode 100644 index 0000000..ba22213 --- /dev/null +++ b/nimbleModel/inst/include/nimbleModel/predef/mCopy_nC_base/mCopy_model_nC_base.h @@ -0,0 +1,49 @@ +#ifndef __MULTICOPIER_MODEL_NC_BASE +#define __MULTICOPIER_MODEL_NC_BASE + +#include + +// model version of a multiCopier. +// +// When an Eigen::Tensor is reallocated (e.g. resized), its allocated +// memory (its data pointer) changes, but the Eigen::Tensor object +// itself does not. So we hold a reference to the Eigen::Tensor +// (via an ETaccessorBase that is an ETaccessor for that Tensor). +class multiCopier_model_nC_base : public multiCopier_nC_base { +public: + // ETaccessors (for a non-scalar) hold a reference to an Eigen::Tensor. + // The allows us to check the data pointer on each use, in case the + // Eigen::Tensor has been reallocated since the last call. + std::vector> accessors; + // Hold a shared_ptr to the model to keep it alive. + // In normal nimble usage, this should not be necessary, but it is safer and cheap. + std::shared_ptr modelKeepAlive; + + // init sets the vectors of ETaccessors and RuntimeFlatView. + template + void init(std::shared_ptr copiers, std::shared_ptr model) { + flatViewGroup.clear(); + accessors.clear(); + modelKeepAlive = model; + for (const auto& copier : copiers->contents()) { + auto acc = model->access(copier->varName); // acc will be std::unique_ptr + flatViewGroup.add(makeRuntimeFlatView(acc, + copier->indsList->contents())); + accessors.push_back(std::move(acc)); + } + } + + // RuntimeFlatViewGroup and RuntimeFlatView have a system of updating + // all the data pointers to be used (with the precomputed and cached + // indexing and striding, which [along with the sizes of the variables themselves] + // are assumed to be constant after initialization). + // The system assumes the data pointers will always be provided in the same order, + // i.e. the order of the ETaccessors. + // The argument is ignored (it is used for rows of the modelValues case). + void setActiveRow(int /*row*/) { + flatViewGroup.prepare_for_setData(); // reset counter to 0 + for (auto& acc : accessors) + flatViewGroup.setNextData(acc->template S().data()); // update each one's data pointer. + } +}; +#endif diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base/multiCopier_nC_base.h b/nimbleModel/inst/include/nimbleModel/predef/mCopy_nC_base/mCopy_nC_base.h similarity index 100% rename from nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base/multiCopier_nC_base.h rename to nimbleModel/inst/include/nimbleModel/predef/mCopy_nC_base/mCopy_nC_base.h diff --git a/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass_old/modelValuesBase_nClass_copyFiles.txt b/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass_old/modelValuesBase_nClass_copyFiles.txt new file mode 100644 index 0000000..e69de29 diff --git a/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_cppContent.cpp b/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass_old/modelValuesBase_nClass_cppContent.cpp similarity index 100% rename from nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_cppContent.cpp rename to nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass_old/modelValuesBase_nClass_cppContent.cpp diff --git a/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_filebase.txt b/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass_old/modelValuesBase_nClass_filebase.txt similarity index 100% rename from nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_filebase.txt rename to nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass_old/modelValuesBase_nClass_filebase.txt diff --git a/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_hContent.h b/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass_old/modelValuesBase_nClass_hContent.h similarity index 100% rename from nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_hContent.h rename to nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass_old/modelValuesBase_nClass_hContent.h diff --git a/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_manifest.txt b/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass_old/modelValuesBase_nClass_manifest.txt similarity index 100% rename from nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_manifest.txt rename to nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass_old/modelValuesBase_nClass_manifest.txt diff --git a/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass_old/modelValuesBase_nClass_post_cpp_compiler.txt b/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass_old/modelValuesBase_nClass_post_cpp_compiler.txt new file mode 100644 index 0000000..e69de29 diff --git a/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_preamble.cpp b/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass_old/modelValuesBase_nClass_preamble.cpp similarity index 100% rename from nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass/modelValuesBase_nClass_preamble.cpp rename to nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass_old/modelValuesBase_nClass_preamble.cpp diff --git a/nimbleModel/inst/include/nimbleModel/predef/modelValuesClass_/modelValuesClass_.h b/nimbleModel/inst/include/nimbleModel/predef/modelValuesClass_/modelValuesClass_.h index 53aeec8..5ea3e9c 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/modelValuesClass_/modelValuesClass_.h +++ b/nimbleModel/inst/include/nimbleModel/predef/modelValuesClass_/modelValuesClass_.h @@ -1,7 +1,7 @@ #ifndef __MODELVALUESCLASS__ #define __MODELVALUESCLASS__ -class modelValuesClass_ : public modelValuesBase_nClass { +class modelValuesClass_ : public MVBase_nC { public: int stuff; // resize_one could move to the base class diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass_old/multiCopierMV_nClass_copyFiles.txt b/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass_old/multiCopierMV_nClass_copyFiles.txt new file mode 100644 index 0000000..e69de29 diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass/multiCopierMV_nClass_cppContent.cpp b/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass_old/multiCopierMV_nClass_cppContent.cpp similarity index 100% rename from nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass/multiCopierMV_nClass_cppContent.cpp rename to nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass_old/multiCopierMV_nClass_cppContent.cpp diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass_old/multiCopierMV_nClass_filebase.txt b/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass_old/multiCopierMV_nClass_filebase.txt new file mode 100644 index 0000000..e9ce114 --- /dev/null +++ b/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass_old/multiCopierMV_nClass_filebase.txt @@ -0,0 +1 @@ +multiCopierMV_nClass_c_ diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass/multiCopierMV_nClass_hContent.h b/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass_old/multiCopierMV_nClass_hContent.h similarity index 100% rename from nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass/multiCopierMV_nClass_hContent.h rename to nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass_old/multiCopierMV_nClass_hContent.h diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass/multiCopierMV_nClass_manifest.txt b/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass_old/multiCopierMV_nClass_manifest.txt similarity index 100% rename from nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass/multiCopierMV_nClass_manifest.txt rename to nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass_old/multiCopierMV_nClass_manifest.txt diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass_old/multiCopierMV_nClass_post_cpp_compiler.txt b/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass_old/multiCopierMV_nClass_post_cpp_compiler.txt new file mode 100644 index 0000000..e69de29 diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass/multiCopierMV_nClass_preamble.cpp b/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass_old/multiCopierMV_nClass_preamble.cpp similarity index 100% rename from nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass/multiCopierMV_nClass_preamble.cpp rename to nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass_old/multiCopierMV_nClass_preamble.cpp diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base/multiCopier_modelValues_nC_base.h b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base_old/multiCopier_modelValues_nC_base.h similarity index 98% rename from nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base/multiCopier_modelValues_nC_base.h rename to nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base_old/multiCopier_modelValues_nC_base.h index fd96458..a36aeac 100644 --- a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base/multiCopier_modelValues_nC_base.h +++ b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base_old/multiCopier_modelValues_nC_base.h @@ -46,7 +46,7 @@ class multiCopier_modelValues_nC_base : public multiCopier_nC_base { // Hence we defer that step until the first actual copy (via setActiveRow). template void init(std::shared_ptr copiers, - std::shared_ptr modelValues) { + std::shared_ptr modelValues) { flatViewGroup.clear(); fieldAccessors.clear(); ssList.clear(); diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base/multiCopier_model_nC_base.h b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base_old/multiCopier_model_nC_base.h similarity index 100% rename from nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base/multiCopier_model_nC_base.h rename to nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base_old/multiCopier_model_nC_base.h diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base_old/multiCopier_nC_base.h b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base_old/multiCopier_nC_base.h new file mode 100644 index 0000000..9a59b71 --- /dev/null +++ b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base_old/multiCopier_nC_base.h @@ -0,0 +1,40 @@ +#ifndef __MULTICOPIER_NC_BASE +#define __MULTICOPIER_NC_BASE + +// multiCopier is used for nimble2's implementations of values() and nimCopy(). +// It represents access to a set of variables and index ranges for each variable. +// It use's nCompiler's RuntimeFlatViewGroup for the actual copying (including indexing and striding). +// +// Here is the base class for model and modelValues versions of multiCopies +// and the universal nimCopy_ implementation between any two multiCopiers. +// +// The trick is that we want to look up named variables only once, but hold +// access to each member variable (e.g. an Eigen::Tensor for a model or an +// nList > for a modelValues), not the data +// it points to. That way if the member variable is reset, we don't point to +// stale data. For a model, we hold a reference to the Eigen::Tensor. For +// a modelValues, it is harder: we hold the generic accessor object (accessor +// of the generic interface scheme, not to be confused with ETaccessor for +// type-flexible access to Eigen::Tensors). +// A second trick is that we want to precompute and cache indexing and striding +// info for each copiers, but we need to update the data pointer every time +// in case it has changed. setActiveRow() does that, with the row concept +// relevant only for modelValue. +// +// All copying machinery assumes that the sizes of variables, and the +// selection of indexed blocks of variables, will not change after initialization. +class multiCopier_nC_base { +public: + RuntimeFlatViewGroup flatViewGroup; + void setActiveRow(int row) {} +}; + +template +void nimCopy_(const std::shared_ptr &src, int srcRow, + const std::shared_ptr &dst, int dstRow) { + src->setActiveRow(srcRow); + dst->setActiveRow(dstRow); + src->flatViewGroup.copyTo(dst->flatViewGroup); +} + +#endif diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass_old/multiCopier_nClass_copyFiles.txt b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass_old/multiCopier_nClass_copyFiles.txt new file mode 100644 index 0000000..e69de29 diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_cppContent.cpp b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass_old/multiCopier_nClass_cppContent.cpp similarity index 100% rename from nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_cppContent.cpp rename to nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass_old/multiCopier_nClass_cppContent.cpp diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_filebase.txt b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass_old/multiCopier_nClass_filebase.txt similarity index 100% rename from nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_filebase.txt rename to nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass_old/multiCopier_nClass_filebase.txt diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_hContent.h b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass_old/multiCopier_nClass_hContent.h similarity index 100% rename from nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_hContent.h rename to nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass_old/multiCopier_nClass_hContent.h diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_manifest.txt b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass_old/multiCopier_nClass_manifest.txt similarity index 100% rename from nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_manifest.txt rename to nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass_old/multiCopier_nClass_manifest.txt diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass_old/multiCopier_nClass_post_cpp_compiler.txt b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass_old/multiCopier_nClass_post_cpp_compiler.txt new file mode 100644 index 0000000..e69de29 diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_preamble.cpp b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass_old/multiCopier_nClass_preamble.cpp similarity index 100% rename from nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass/multiCopier_nClass_preamble.cpp rename to nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass_old/multiCopier_nClass_preamble.cpp diff --git a/nimbleModel/tests/testthat/test-modelValues.R b/nimbleModel/tests/testthat/test-modelValues.R index 52b74e7..55e7b79 100644 --- a/nimbleModel/tests/testthat/test-modelValues.R +++ b/nimbleModel/tests/testthat/test-modelValues.R @@ -1,6 +1,8 @@ # library(nCompiler) # library(nimbleModel) +message("Add scalar elements to all modelValues testing cases.") + test_that("basic modelValues class works", { varInfo <- list( vars = list( @@ -54,20 +56,24 @@ test_that("basic modelValues class works", { length(obj) <- 2 expect_equal(length(obj), 2) list_exp2 <- list(mu = test_muList[1:2], cov = default_cov3[1:2]) - list_exp2 <- list_exp2[sort(names(list_exp2))] - expect_equal(as.list(obj), list_exp2) + list_exp2_stacked <- lapply(list_exp2, simplify2array) + # list_exp2 <- list_exp2[sort(names(list_exp2))] + expect_equal(as.list(obj, stack=FALSE), list_exp2) + expect_equal(as.list(obj, iterationAsLastIndex = TRUE), list_exp2_stacked) length(obj) <- 3 list_exp3 <- list(mu = c(list_exp2$mu, default_mu3[3]), cov = c(list_exp2$cov, default_cov3[3])) - list_exp3 <- list_exp3[sort(names(list_exp3))] - expect_equal(as.list(obj), list_exp3) + list_exp3_stacked <- lapply(list_exp3, simplify2array) + #list_exp3 <- list_exp3[sort(names(list_exp3))] + expect_equal(as.list(obj, stack=FALSE), list_exp3) + expect_equal(as.list(obj, iterationAsLastIndex = TRUE), list_exp3_stacked) # Change length using `resize`, checking for preserved values. resize(obj, 2) expect_equal(getsize(obj), 2) expect_equal(obj$getSize(), 2) - expect_equal(as.list(obj), list_exp2) + expect_equal(as.list(obj, stack=FALSE), list_exp2) resize(obj, 3) - expect_equal(as.list(obj), list_exp3) + expect_equal(as.list(obj, stack=FALSE), list_exp3) expect_equal(obj$getSize(), 3) # Test compiling as a type @@ -76,13 +82,13 @@ test_that("basic modelValues class works", { # supported for nimble2 via its keyword processing system mvHolder <- nCompiler::nClass( Cpublic = list( - mv = "modelValuesBase_nClass", - check1 = nFunction( + mv = "nimbleModel:::modelValuesBase_nClass()", + check1 = nCompiler::nFunction( function(m = 'integerScalar') { resize(mv, m) } ), - check2 = nFunction( + check2 = nCompiler::nFunction( function() { return(getsize(mv)) returnType(integerScalar()) @@ -133,20 +139,22 @@ test_that("basic modelValues class works", { length(obj) <- 2 expect_equal(length(obj), 2) list_exp2 <- list(mu = test_muList[1:2], cov = default_cov3[1:2]) - list_exp2 <- list_exp2[sort(names(list_exp2))] - expect_equal(as.list(obj), list_exp2) + list_exp2_stacked <- lapply(list_exp2, simplify2array) + # list_exp2 <- list_exp2[sort(names(list_exp2))] + expect_equal(as.list(obj, stack=FALSE), list_exp2) + expect_equal(as.list(obj, iterationAsLastIndex = TRUE), list_exp2_stacked) length(obj) <- 3 list_exp3 <- list(mu = c(list_exp2$mu, default_mu3[3]), cov = c(list_exp2$cov, default_cov3[3])) - list_exp3 <- list_exp3[sort(names(list_exp3))] - expect_equal(as.list(obj), list_exp3) + #list_exp3 <- list_exp3[sort(names(list_exp3))] + expect_equal(as.list(obj, stack=FALSE), list_exp3) # Change length using `resize`, checking for preserved values. resize(obj, 2) expect_equal(getsize(obj), 2) expect_equal(obj$getSize(), 2) - expect_equal(as.list(obj), list_exp2) + expect_equal(as.list(obj, stack=FALSE), list_exp2) resize(obj, 3) - expect_equal(as.list(obj), list_exp3) + expect_equal(as.list(obj, stack=FALSE), list_exp3) expect_equal(obj$getSize(), 3) # Accessed by base class pointer as a member of another class @@ -195,20 +203,20 @@ test_that("basic modelValues class works", { length(obj) <- 2 expect_equal(length(obj), 2) list_exp2 <- list(mu = test_muList[1:2], cov = default_cov3[1:2]) - list_exp2 <- list_exp2[sort(names(list_exp2))] - expect_equal(as.list(obj), list_exp2) + #list_exp2 <- list_exp2[sort(names(list_exp2))] + expect_equal(as.list(obj, stack=FALSE), list_exp2) length(obj) <- 3 list_exp3 <- list(mu = c(list_exp2$mu, default_mu3[3]), cov = c(list_exp2$cov, default_cov3[3])) - list_exp3 <- list_exp3[sort(names(list_exp3))] - expect_equal(as.list(obj), list_exp3) + # list_exp3 <- list_exp3[sort(names(list_exp3))] + expect_equal(as.list(obj, stack=FALSE), list_exp3) # Change length using `resize`, checking for preserved values. resize(obj, 2) expect_equal(getsize(obj), 2) expect_equal(obj$getSize(), 2) - expect_equal(as.list(obj), list_exp2) + expect_equal(as.list(obj, stack=FALSE), list_exp2) resize(obj, 3) - expect_equal(as.list(obj), list_exp3) + expect_equal(as.list(obj, stack=FALSE), list_exp3) expect_equal(obj$getSize(), 3) # Change length using compiled `resize`, check with compiled getsize, checking for preserved values. @@ -216,11 +224,11 @@ test_that("basic modelValues class works", { expect_equal(getsize(obj), 2) expect_equal(obj$getSize(), 2) expect_equal(mvh$check2(), 2) - expect_equal(as.list(obj), list_exp2) + expect_equal(as.list(obj, stack=FALSE), list_exp2) mvh$check1(3) - expect_equal(as.list(obj), list_exp3) + expect_equal(as.list(obj, stack=FALSE), list_exp3) expect_equal(obj$getSize(), 3) - expect_equal(mvh$check3(), 3) + expect_equal(mvh$check2(), 3) # We can create a new derived interface object with the same underlying C++ object # Then we have the active bindings @@ -404,12 +412,15 @@ test_that("as.matrix(modelValues) and matrix2MV work", { cov = list(name = "cov", nDim = 2) ) ) -# debug(nimbleModel:::make_modelValues_nClass) + mvClass <- nimbleModel:::make_modelValues_nClass(varInfo) obj <- mvClass$new() sizes <- list(mu = 2, cov = c(3, 4)) obj$set_sizeList(sizes) + # Make an uncompiled object, + # convert it to a matrix with as.matrix() + # and invert that back to a new uncompiled object obj$resize(0) obj$resize(3) obj$mu[[2]] <- 5:6 @@ -418,32 +429,64 @@ test_that("as.matrix(modelValues) and matrix2MV work", { obj$cov[[3]] <- obj$cov[[2]] + 100 mat <- obj |> as.matrix() obj2 <- mvClass$new() - debug(nimbleModel:::matrix2mv) - junk <- nimbleModel:::matrix2mv(mat, obj2) - make_mvBase <- nFunction( - function(x = "modelValuesBase_nClass") { + junk <- nimbleModel:::matrix2mv(mat, obj2) + expect_identical(junk, obj2) + expect_identical(mat, obj2 |> as.matrix()) + expect_equal(obj$mu |> as.list(), obj2$mu |> as.list()) + + # provide a way to get base class pointers + # since this is how we'll want many algos to + # use modelValues + make_mvBase <- nCompiler::nFunction( + function(x = "nimbleModel:::modelValuesBase_nClass()") { return(x) - returnType(modelValuesBase_nClass()) + returnType("nimbleModel:::modelValuesBase_nClass()") } ) - junk <- nCompiler::nCompile(mvClass, make_mvBase, returnList = TRUE) - Cobj <- junk$mvClass$new() - length(Cobj) <- 3 - length(Cobj) <- 0 - Cobj$set_sizeList(sizes) - length(Cobj) <- 3 - Cobj$eta |> as.list() - Cobj$cov |> as.list() - - interface_names(Cobj) - baseCobj <- junk$make_mvBase(Cobj) - interface_names(baseCobj) - - debug(as.matrix.modelValues) - as.matrix(Cobj) - - comp <- nCompiler::nCompile(mvClass, mvHolder) + comp <- nCompiler::nCompile(mvClass, make_mvBase, returnList = TRUE) + # Check that the compiled, specialized modelValues type works + # as above for uncompiled. + Cobj <- comp$mvClass$new() + Cobj$set_sizeList(sizes) + Cobj$resize(0) + Cobj$resize(3) + Cobj$mu[[2]] <- 5:6 + Cobj$mu[[3]] <- 10:11 + Cobj$cov[[2]] <- matrix(1:12, nrow = 3) + Cobj$cov[[3]] <- obj$cov[[2]] + 100 + Cmat <- Cobj |> as.matrix() + expect_identical(mat, Cmat) + # to compiled + Cobj2 <- comp$mvClass$new() + Cjunk <- nimbleModel:::matrix2mv(Cmat, Cobj2) + expect_identical(Cjunk, Cobj2) + expect_identical(Cmat, Cobj2 |> as.matrix()) + expect_equal(Cobj$mu |> as.list(), Cobj2$mu |> as.list()) + # to uncompiled + length(obj2) <- 0 + junk <- nimbleModel:::matrix2mv(Cmat, obj2) + expect_identical(junk, obj2) + expect_identical(Cmat, obj2 |> as.matrix()) + expect_equal(Cobj$mu |> as.list(), obj2$mu |> as.list()) + + + # Check that use via base class works + CbaseObj <- comp$make_mvBase(Cobj) + expect_true(inherits(Cobj, "modelValues")) + expect_true(inherits(CbaseObj, "modelValues")) + expect_false(inherits(CbaseObj, class(Cobj)[1])) + expect_identical(nCompiler::value(CbaseObj, "mu") |> as.list(), Cobj$mu |> as.list()) + CbaseMat <- CbaseObj |> as.matrix() + expect_identical(CbaseMat, Cmat) + Cobj_temp <- comp$mvClass$new() + CbaseObj2 <- comp$make_mvBase(Cobj_temp) + CbaseJunk <- nimbleModel:::matrix2mv(CbaseMat, CbaseObj2) + expect_identical(CbaseJunk, CbaseObj2) + expect_identical(Cmat, CbaseObj2 |> as.matrix()) + expect_equal(CbaseObj$mu |> as.list(), CbaseObj2$mu |> as.list()) + + rm(Cobj, Cobj2, Cjunk, CbaseObj, CbaseObj2, Cobj_temp); gc() }) diff --git a/nimbleModel/tests/testthat/test-nimbleModel.R b/nimbleModel/tests/testthat/test-nimbleModel.R index 05224a7..8845aeb 100644 --- a/nimbleModel/tests/testthat/test-nimbleModel.R +++ b/nimbleModel/tests/testthat/test-nimbleModel.R @@ -422,8 +422,8 @@ test_that("three index slots (plus different index variable ordering)", { for(k in 1:3) y[k,j,i] ~ dnorm(0,1) # This changes order of use of indices to [idx[3],idx[2],idx[1]]. }) - data <- list(y = array(rnorm(60),c(3,4,5))) - mclass <- nimbleModel(code, data = data, returnClass = TRUE) + inits <- list(y = array(rnorm(60),c(3,4,5))) + mclass <- nimbleModel(code, inits = inits, returnClass = TRUE) m <- mclass$new() cmclass <- nCompile(mclass) cm <- cmclass$new() From 57ee4f06a6ba581573186e530c7bf4c059ecfc61 Mon Sep 17 00:00:00 2001 From: perrydv Date: Mon, 12 Oct 2026 17:47:22 -0700 Subject: [PATCH 26/27] replace expect_identical with expect_equal in some modelValues tests --- nimbleModel/tests/testthat/test-modelValues.R | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/nimbleModel/tests/testthat/test-modelValues.R b/nimbleModel/tests/testthat/test-modelValues.R index 55e7b79..98ec777 100644 --- a/nimbleModel/tests/testthat/test-modelValues.R +++ b/nimbleModel/tests/testthat/test-modelValues.R @@ -432,7 +432,7 @@ test_that("as.matrix(modelValues) and matrix2MV work", { junk <- nimbleModel:::matrix2mv(mat, obj2) expect_identical(junk, obj2) - expect_identical(mat, obj2 |> as.matrix()) + expect_equal(mat, obj2 |> as.matrix()) expect_equal(obj$mu |> as.list(), obj2$mu |> as.list()) # provide a way to get base class pointers @@ -458,18 +458,18 @@ test_that("as.matrix(modelValues) and matrix2MV work", { Cobj$cov[[2]] <- matrix(1:12, nrow = 3) Cobj$cov[[3]] <- obj$cov[[2]] + 100 Cmat <- Cobj |> as.matrix() - expect_identical(mat, Cmat) + expect_equal(mat, Cmat) # to compiled Cobj2 <- comp$mvClass$new() Cjunk <- nimbleModel:::matrix2mv(Cmat, Cobj2) expect_identical(Cjunk, Cobj2) - expect_identical(Cmat, Cobj2 |> as.matrix()) + expect_equal(Cmat, Cobj2 |> as.matrix()) expect_equal(Cobj$mu |> as.list(), Cobj2$mu |> as.list()) # to uncompiled length(obj2) <- 0 junk <- nimbleModel:::matrix2mv(Cmat, obj2) expect_identical(junk, obj2) - expect_identical(Cmat, obj2 |> as.matrix()) + expect_equal(Cmat, obj2 |> as.matrix()) expect_equal(Cobj$mu |> as.list(), obj2$mu |> as.list()) @@ -478,14 +478,14 @@ test_that("as.matrix(modelValues) and matrix2MV work", { expect_true(inherits(Cobj, "modelValues")) expect_true(inherits(CbaseObj, "modelValues")) expect_false(inherits(CbaseObj, class(Cobj)[1])) - expect_identical(nCompiler::value(CbaseObj, "mu") |> as.list(), Cobj$mu |> as.list()) + expect_equal(nCompiler::value(CbaseObj, "mu") |> as.list(), Cobj$mu |> as.list()) CbaseMat <- CbaseObj |> as.matrix() - expect_identical(CbaseMat, Cmat) + expect_equal(CbaseMat, Cmat) Cobj_temp <- comp$mvClass$new() CbaseObj2 <- comp$make_mvBase(Cobj_temp) CbaseJunk <- nimbleModel:::matrix2mv(CbaseMat, CbaseObj2) expect_identical(CbaseJunk, CbaseObj2) - expect_identical(Cmat, CbaseObj2 |> as.matrix()) + expect_equal(Cmat, CbaseObj2 |> as.matrix()) expect_equal(CbaseObj$mu |> as.list(), CbaseObj2$mu |> as.list()) rm(Cobj, Cobj2, Cjunk, CbaseObj, CbaseObj2, Cobj_temp); gc() From 61b7faa642cfe0e9e2d687c34b4fc9ab59911c54 Mon Sep 17 00:00:00 2001 From: perrydv Date: Mon, 12 Oct 2026 18:18:40 -0700 Subject: [PATCH 27/27] remove old predefined folders that have been replaced --- .../modelValuesBase_nClass_copyFiles.txt | 0 .../modelValuesBase_nClass_cppContent.cpp | 69 ------------ .../modelValuesBase_nClass_filebase.txt | 1 - .../modelValuesBase_nClass_hContent.h | 31 ------ .../modelValuesBase_nClass_manifest.txt | 7 -- ...delValuesBase_nClass_post_cpp_compiler.txt | 0 .../modelValuesBase_nClass_preamble.cpp | 5 - .../multiCopierMV_nClass_copyFiles.txt | 0 .../multiCopierMV_nClass_cppContent.cpp | 67 ------------ .../multiCopierMV_nClass_filebase.txt | 1 - .../multiCopierMV_nClass_hContent.h | 34 ------ .../multiCopierMV_nClass_manifest.txt | 7 -- ...multiCopierMV_nClass_post_cpp_compiler.txt | 0 .../multiCopierMV_nClass_preamble.cpp | 5 - .../multiCopier_modelValues_nC_base.h | 103 ------------------ .../multiCopier_model_nC_base.h | 49 --------- .../multiCopier_nC_base.h | 40 ------- .../multiCopier_nClass_copyFiles.txt | 0 .../multiCopier_nClass_cppContent.cpp | 62 ----------- .../multiCopier_nClass_filebase.txt | 1 - .../multiCopier_nClass_hContent.h | 31 ------ .../multiCopier_nClass_manifest.txt | 7 -- .../multiCopier_nClass_post_cpp_compiler.txt | 0 .../multiCopier_nClass_preamble.cpp | 5 - 24 files changed, 525 deletions(-) delete mode 100644 nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass_old/modelValuesBase_nClass_copyFiles.txt delete mode 100644 nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass_old/modelValuesBase_nClass_cppContent.cpp delete mode 100644 nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass_old/modelValuesBase_nClass_filebase.txt delete mode 100644 nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass_old/modelValuesBase_nClass_hContent.h delete mode 100644 nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass_old/modelValuesBase_nClass_manifest.txt delete mode 100644 nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass_old/modelValuesBase_nClass_post_cpp_compiler.txt delete mode 100644 nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass_old/modelValuesBase_nClass_preamble.cpp delete mode 100644 nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass_old/multiCopierMV_nClass_copyFiles.txt delete mode 100644 nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass_old/multiCopierMV_nClass_cppContent.cpp delete mode 100644 nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass_old/multiCopierMV_nClass_filebase.txt delete mode 100644 nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass_old/multiCopierMV_nClass_hContent.h delete mode 100644 nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass_old/multiCopierMV_nClass_manifest.txt delete mode 100644 nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass_old/multiCopierMV_nClass_post_cpp_compiler.txt delete mode 100644 nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass_old/multiCopierMV_nClass_preamble.cpp delete mode 100644 nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base_old/multiCopier_modelValues_nC_base.h delete mode 100644 nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base_old/multiCopier_model_nC_base.h delete mode 100644 nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base_old/multiCopier_nC_base.h delete mode 100644 nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass_old/multiCopier_nClass_copyFiles.txt delete mode 100644 nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass_old/multiCopier_nClass_cppContent.cpp delete mode 100644 nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass_old/multiCopier_nClass_filebase.txt delete mode 100644 nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass_old/multiCopier_nClass_hContent.h delete mode 100644 nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass_old/multiCopier_nClass_manifest.txt delete mode 100644 nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass_old/multiCopier_nClass_post_cpp_compiler.txt delete mode 100644 nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass_old/multiCopier_nClass_preamble.cpp diff --git a/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass_old/modelValuesBase_nClass_copyFiles.txt b/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass_old/modelValuesBase_nClass_copyFiles.txt deleted file mode 100644 index e69de29..0000000 diff --git a/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass_old/modelValuesBase_nClass_cppContent.cpp b/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass_old/modelValuesBase_nClass_cppContent.cpp deleted file mode 100644 index 4c2b152..0000000 --- a/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass_old/modelValuesBase_nClass_cppContent.cpp +++ /dev/null @@ -1,69 +0,0 @@ -/* OPENER (Do not edit this comment) */ -#ifndef __modelValuesBase_nClass_CPP -#define __modelValuesBase_nClass_CPP -/* BODY (Do not edit this comment) */ -#ifndef R_NO_REMAP -#define R_NO_REMAP -#endif -#include -#include "modelValuesBase_nClass_c_.h" -using namespace Rcpp; -// [[Rcpp::plugins(nCompiler_Eigen_plugin)]] -// [[Rcpp::depends(RcppParallel)]] -// [[Rcpp::depends(nCompiler)]] -// [[Rcpp::depends(Rcereal)]] -// [[Rcpp::depends(nimbleModel)]] - - modelValuesBase_nClass::modelValuesBase_nClass ( ) { -RESET_EIGEN_ERRORS -flex_((this)->dot_current_nRow) = 0.0; -this->dot_sizeList = Rcpp::List();; -} - void modelValuesBase_nClass::set_sizeList ( Rcpp::List sizeList ) { -RESET_EIGEN_ERRORS -(this)->dot_sizeList = sizeList; -} - Rcpp::List modelValuesBase_nClass::get_sizeList ( ) { -RESET_EIGEN_ERRORS -return((this)->dot_sizeList); -} - void modelValuesBase_nClass::resize ( int m ) { -RESET_EIGEN_ERRORS -Rcpp::stop("Should not be calling compiled modelValuesBase_nClass resize().");; -} - int modelValuesBase_nClass::getLength ( ) { -RESET_EIGEN_ERRORS -return((this)->dot_current_nRow); -} - int modelValuesBase_nClass::getSize ( ) { -RESET_EIGEN_ERRORS -return((this)->getLength()); -} - -// [[Rcpp::export(name = "set_CnClass_env_modelValuesBase_nClass_new")]] - void set_CnClass_env_modelValuesBase_nClass ( SEXP env ) { -RESET_EIGEN_ERRORS -SET_CNCLASS_ENV(modelValuesBase_nClass, env);; -} - -// [[Rcpp::export(name = "get_CnClass_env_modelValuesBase_nClass_new")]] - Rcpp::Environment get_CnClass_env_modelValuesBase_nClass ( ) { -RESET_EIGEN_ERRORS -return GET_CNCLASS_ENV(modelValuesBase_nClass);; -} - -NCOMPILER_INTERFACE( -modelValuesBase_nClass, -NCOMPILER_FIELDS( -field("dot_sizeList", &modelValuesBase_nClass::dot_sizeList), -field("dot_current_nRow", &modelValuesBase_nClass::dot_current_nRow) -), -NCOMPILER_METHODS( -method("set_sizeList", &modelValuesBase_nClass::set_sizeList, args({{arg("sizeList",copy)}})), -method("get_sizeList", &modelValuesBase_nClass::get_sizeList, args({{}})), -method("resize", &modelValuesBase_nClass::resize, args({{arg("m",copy)}})), -method("getLength", &modelValuesBase_nClass::getLength, args({{}})), -method("getSize", &modelValuesBase_nClass::getSize, args({{}})) -) -) -#endif diff --git a/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass_old/modelValuesBase_nClass_filebase.txt b/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass_old/modelValuesBase_nClass_filebase.txt deleted file mode 100644 index e248f58..0000000 --- a/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass_old/modelValuesBase_nClass_filebase.txt +++ /dev/null @@ -1 +0,0 @@ -modelValuesBase_nClass_c_ diff --git a/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass_old/modelValuesBase_nClass_hContent.h b/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass_old/modelValuesBase_nClass_hContent.h deleted file mode 100644 index 766011f..0000000 --- a/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass_old/modelValuesBase_nClass_hContent.h +++ /dev/null @@ -1,31 +0,0 @@ -/* OPENER (Do not edit this comment) */ -#ifndef __modelValuesBase_nClass_H -#define __modelValuesBase_nClass_H -/* BODY (Do not edit this comment) */ -#ifndef R_NO_REMAP -#define R_NO_REMAP -#endif -#include -#include "modelValuesBase_nClass_c_.h" - -class modelValuesBase_nClass : public interface_resolver< genericInterfaceC >, public loadedObjectHookC { -public: - static const char* nc_class_key() {return "modelValuesBase_nClass";} - modelValuesBase_nClass ( ) ; - void set_sizeList ( Rcpp::List sizeList ) ; - Rcpp::List get_sizeList ( ) ; - virtual void resize ( int m ) ; - virtual int getLength ( ) ; - virtual int getSize ( ) ; - Rcpp::List dot_sizeList; - int dot_current_nRow; - -}; - - void set_CnClass_env_modelValuesBase_nClass ( SEXP env ) ; - - Rcpp::Environment get_CnClass_env_modelValuesBase_nClass ( ) ; - -#include - -#endif diff --git a/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass_old/modelValuesBase_nClass_manifest.txt b/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass_old/modelValuesBase_nClass_manifest.txt deleted file mode 100644 index 2ffbe54..0000000 --- a/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass_old/modelValuesBase_nClass_manifest.txt +++ /dev/null @@ -1,7 +0,0 @@ -list(saved_at = structure(1791317937.39758, class = c("POSIXct", -"POSIXt")), packet_name = "modelValuesBase_nClass", elements = c("preamble", -"cppContent", "hContent", "filebase", "post_cpp_compiler", "copyFiles" -), files = list(preamble = "modelValuesBase_nClass_preamble.cpp", - cppContent = "modelValuesBase_nClass_cppContent.cpp", hContent = "modelValuesBase_nClass_hContent.h", - filebase = "modelValuesBase_nClass_filebase.txt", post_cpp_compiler = "modelValuesBase_nClass_post_cpp_compiler.txt", - copyFiles = "modelValuesBase_nClass_copyFiles.txt")) diff --git a/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass_old/modelValuesBase_nClass_post_cpp_compiler.txt b/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass_old/modelValuesBase_nClass_post_cpp_compiler.txt deleted file mode 100644 index e69de29..0000000 diff --git a/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass_old/modelValuesBase_nClass_preamble.cpp b/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass_old/modelValuesBase_nClass_preamble.cpp deleted file mode 100644 index 1a92ce3..0000000 --- a/nimbleModel/inst/include/nimbleModel/predef/modelValuesBase_nClass_old/modelValuesBase_nClass_preamble.cpp +++ /dev/null @@ -1,5 +0,0 @@ -#define NCOMPILER_HANDLE_EIGEN_ERRORS -#define NCOMPILER_USES_EIGEN -#define NCOMPILER_USES_NCPPVEC -#define USES_NCOMPILER -#define NCOMPILER_USES_NCLASS_INTERFACE diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass_old/multiCopierMV_nClass_copyFiles.txt b/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass_old/multiCopierMV_nClass_copyFiles.txt deleted file mode 100644 index e69de29..0000000 diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass_old/multiCopierMV_nClass_cppContent.cpp b/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass_old/multiCopierMV_nClass_cppContent.cpp deleted file mode 100644 index a6879b1..0000000 --- a/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass_old/multiCopierMV_nClass_cppContent.cpp +++ /dev/null @@ -1,67 +0,0 @@ -/* OPENER (Do not edit this comment) */ -#ifndef __multiCopierMV_nClass_CPP -#define __multiCopierMV_nClass_CPP -/* BODY (Do not edit this comment) */ -#ifndef R_NO_REMAP -#define R_NO_REMAP -#endif -#include -#include "multiCopierMV_nClass_c_.h" -using namespace Rcpp; -// [[Rcpp::plugins(nCompiler_Eigen_plugin)]] -// [[Rcpp::depends(RcppParallel)]] -// [[Rcpp::depends(nCompiler)]] -// [[Rcpp::depends(Rcereal)]] -// [[Rcpp::depends(nimbleModel)]] - - void multiCopierMV_nClass::init ( std::shared_ptr modelValues ) { -RESET_EIGEN_ERRORS -multiCopier_modelValues_nC_base::init(this->copiers, modelValues); -} - void multiCopierMV_nClass::setActiveRow ( int row ) { -RESET_EIGEN_ERRORS -multiCopier_modelValues_nC_base::setActiveRow(row); -} - Eigen::Tensor multiCopierMV_nClass::getValues ( ) { -RESET_EIGEN_ERRORS -return flatViewGroup.copyIntoVector(); -} - void multiCopierMV_nClass::setValues ( Eigen::Tensor v ) { -RESET_EIGEN_ERRORS -flatViewGroup.copyFromVector(v); -} - multiCopierMV_nClass::multiCopierMV_nClass ( ) { -RESET_EIGEN_ERRORS -} - -// [[Rcpp::export(name = "multiCopierMV_nClass_new")]] - SEXP new_multiCopierMV_nClass ( ) { -RESET_EIGEN_ERRORS -return CREATE_NEW_NCOMP_OBJECT(multiCopierMV_nClass);; -} - -// [[Rcpp::export(name = "set_CnClass_env_multiCopierMV_nClass_new")]] - void set_CnClass_env_multiCopierMV_nClass ( SEXP env ) { -RESET_EIGEN_ERRORS -SET_CNCLASS_ENV(multiCopierMV_nClass, env);; -} - -// [[Rcpp::export(name = "get_CnClass_env_multiCopierMV_nClass_new")]] - Rcpp::Environment get_CnClass_env_multiCopierMV_nClass ( ) { -RESET_EIGEN_ERRORS -return GET_CNCLASS_ENV(multiCopierMV_nClass);; -} - -NCOMPILER_INTERFACE( -multiCopierMV_nClass, -NCOMPILER_FIELDS( -field("copiers", &multiCopierMV_nClass::copiers) -), -NCOMPILER_METHODS( -method("init", &multiCopierMV_nClass::init, args({{arg("modelValues",copy)}})), -method("setActiveRow", &multiCopierMV_nClass::setActiveRow, args({{arg("row",copy)}})), -method("getValues", &multiCopierMV_nClass::getValues, args({{}})), -method("setValues", &multiCopierMV_nClass::setValues, args({{arg("v",copy)}})) -) -) -#endif diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass_old/multiCopierMV_nClass_filebase.txt b/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass_old/multiCopierMV_nClass_filebase.txt deleted file mode 100644 index e9ce114..0000000 --- a/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass_old/multiCopierMV_nClass_filebase.txt +++ /dev/null @@ -1 +0,0 @@ -multiCopierMV_nClass_c_ diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass_old/multiCopierMV_nClass_hContent.h b/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass_old/multiCopierMV_nClass_hContent.h deleted file mode 100644 index cf4c0ca..0000000 --- a/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass_old/multiCopierMV_nClass_hContent.h +++ /dev/null @@ -1,34 +0,0 @@ -/* OPENER (Do not edit this comment) */ -#ifndef __multiCopierMV_nClass_H -#define __multiCopierMV_nClass_H -/* BODY (Do not edit this comment) */ -#ifndef R_NO_REMAP -#define R_NO_REMAP -#endif -#include -#include "nList_copier_nClass_c_.h" -#include "multiCopierMV_nClass_c_.h" -#include "modelValuesBase_nClass_c_.h" - -#include - -class multiCopierMV_nClass : public interface_resolver< genericInterfaceC, multiCopier_modelValues_nC_base >, public loadedObjectHookC { -public: - static const char* nc_class_key() {return "multiCopierMV_nClass";} - void init ( std::shared_ptr modelValues ) ; - void setActiveRow ( int row ) ; - Eigen::Tensor getValues ( ) ; - void setValues ( Eigen::Tensor v ) ; - multiCopierMV_nClass ( ) ; - std::shared_ptr copiers; - -}; - - SEXP new_multiCopierMV_nClass ( ) ; - - void set_CnClass_env_multiCopierMV_nClass ( SEXP env ) ; - - Rcpp::Environment get_CnClass_env_multiCopierMV_nClass ( ) ; - - -#endif diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass_old/multiCopierMV_nClass_manifest.txt b/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass_old/multiCopierMV_nClass_manifest.txt deleted file mode 100644 index fc79bdf..0000000 --- a/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass_old/multiCopierMV_nClass_manifest.txt +++ /dev/null @@ -1,7 +0,0 @@ -list(saved_at = structure(1791317898.26052, class = c("POSIXct", -"POSIXt")), packet_name = "multiCopierMV_nClass", elements = c("preamble", -"cppContent", "hContent", "filebase", "post_cpp_compiler", "copyFiles" -), files = list(preamble = "multiCopierMV_nClass_preamble.cpp", - cppContent = "multiCopierMV_nClass_cppContent.cpp", hContent = "multiCopierMV_nClass_hContent.h", - filebase = "multiCopierMV_nClass_filebase.txt", post_cpp_compiler = "multiCopierMV_nClass_post_cpp_compiler.txt", - copyFiles = "multiCopierMV_nClass_copyFiles.txt")) diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass_old/multiCopierMV_nClass_post_cpp_compiler.txt b/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass_old/multiCopierMV_nClass_post_cpp_compiler.txt deleted file mode 100644 index e69de29..0000000 diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass_old/multiCopierMV_nClass_preamble.cpp b/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass_old/multiCopierMV_nClass_preamble.cpp deleted file mode 100644 index 1a92ce3..0000000 --- a/nimbleModel/inst/include/nimbleModel/predef/multiCopierMV_nClass_old/multiCopierMV_nClass_preamble.cpp +++ /dev/null @@ -1,5 +0,0 @@ -#define NCOMPILER_HANDLE_EIGEN_ERRORS -#define NCOMPILER_USES_EIGEN -#define NCOMPILER_USES_NCPPVEC -#define USES_NCOMPILER -#define NCOMPILER_USES_NCLASS_INTERFACE diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base_old/multiCopier_modelValues_nC_base.h b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base_old/multiCopier_modelValues_nC_base.h deleted file mode 100644 index a36aeac..0000000 --- a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base_old/multiCopier_modelValues_nC_base.h +++ /dev/null @@ -1,103 +0,0 @@ -#ifndef __MULTICOPIER_MODELVALUES_NC_BASE -#define __MULTICOPIER_MODELVALUES_NC_BASE - -#include - -// modelValues-backed multiCopier setup: each copier's varName resolves to an -// nList (one element per row) rather than directly to a value, so getting an -// ETaccessorBase for a variable additionally requires picking a row via -// nListBase_nClass::access_at(row). setActiveRow(row) is how that row gets -// (re)selected, and it can be called repeatedly to retarget the same -// flatViewGroup at a different row without re-resolving variable names. -// -// Unlike the model-backed sibling class, the nList a variable currently -// resolves to cannot be cached across calls: modelValues variables are -// exposed to R via genericInterfaceC, and an R-level assignment onto a -// compiled-nList-typed field (accessor_class::set(), P_is_shared_ptr -// branch) reassigns the member outright rather than mutating it in place. -// A cached std::shared_ptr copy would not see that -- it -// would keep pointing at the old (now orphaned but still valid, since our -// copy owns a reference to it) nList, silently disconnected from whatever -// the field now holds. There is no safe way to hold a live "pointer to the -// member slot" through the type-erased genericInterfaceBaseC interface -// either (that would need a reinterpret_cast between unrelated shared_ptr -// instantiations). So instead, only the name -> accessor_base resolution is -// cached (fieldAccessors, resolved once in init()); the nList itself is -// re-derived from the live modelValues object via accessor_base:: -// getInterfacePtr() on every use (see resolveRowSource) -- no map lookup by -// name, but always a fresh read, so a reassignment is never missed. -class multiCopier_modelValues_nC_base : public multiCopier_nC_base { -public: - // The accessor_base here is the base class for the generic interface scheme - // for name-based lookup. (This is not related to ETaccessors). - // E.g. for a variable "mu", we can cache the accessor for "mu" without - // repeating the name-based lookup, but that's as close as we can get. - // For safety we need to re-obtain the nList for "mu" on each copy usage. - std::vector> fieldAccessors; - // Ensure the modelValues stays alive. This shouldn't be needed in - // nimble2's design but is here for safety and is cheap. - std::shared_ptr modelValuesKeepAlive; - // Saved index-block information for deferring (lazy) setup of the RuntimeFlatViews. - std::vector> ssList; - bool built = false; - - // When init is called, there is no guarantee that the variables will be - // initialized so we can't count on reading their sizes. - // Hence we defer that step until the first actual copy (via setActiveRow). - template - void init(std::shared_ptr copiers, - std::shared_ptr modelValues) { - flatViewGroup.clear(); - fieldAccessors.clear(); - ssList.clear(); - built = false; - modelValuesKeepAlive = modelValues; - const auto& name2access = modelValues->get_name2access(); - for (const auto& copier : copiers->contents()) { - auto it = name2access.find(copier->varName); - if (it == name2access.end()) - Rcpp::stop("multiCopier (modelValues): variable not found: " + copier->varName); - fieldAccessors.push_back(it->second); - ssList.push_back(vec_2_vecB__(copier->indsList->contents())); - } - } - - // Get an nList base class pointer from the accessor_base for the k-th variable. - std::shared_ptr resolveRowSource(size_t k) { - std::shared_ptr ip = - fieldAccessors[k]->getInterfacePtr(modelValuesKeepAlive.get()); - // The modelValues object may have been created by a different DLL (see nc_shared_ptr_cast in nCompiler). - std::shared_ptr nlPtr = - nc_shared_ptr_cast(ip); - if (!nlPtr) - Rcpp::stop("multiCopier (modelValues): variable is not an nList."); - return nlPtr; - } - - // On the first call, we assume we can obtain size information - // that will be constant thereafter (based on whichever row was chosen first!) - void setActiveRow(int newRow) { - if (!built) { - flatViewGroup.clear(); - for (size_t k = 0; k < fieldAccessors.size(); ++k) { - auto acc = resolveRowSource(k)->access_at(newRow); - // makeRuntimeFlatView does initialize the data pointer, so the - // prepare_for_setData and setNextData steps are not necessary. - flatViewGroup.add(makeRuntimeFlatView(acc, ssList[k])); - } - built = true; - } else { - // See comment in multiCopier_model_nC_base. - // Performance note for the modelValues case: - // the nListBase_nClass::access_at(row) allocates a new ETaccessor - // every time. Future optimization could re-use a single ETaccessor, - // but that would take a small extension of ETaccessor. - flatViewGroup.prepare_for_setData(); // reset the counter. - for (size_t k = 0; k < fieldAccessors.size(); ++k) { - auto acc = resolveRowSource(k)->access_at(newRow); // Get an ETaccessor. - flatViewGroup.setNextData(acc->template S().data()); // reset the data pointer. - } - } - } -}; -#endif diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base_old/multiCopier_model_nC_base.h b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base_old/multiCopier_model_nC_base.h deleted file mode 100644 index 62afc4b..0000000 --- a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base_old/multiCopier_model_nC_base.h +++ /dev/null @@ -1,49 +0,0 @@ -#ifndef __MULTICOPIER_MODEL_NC_BASE -#define __MULTICOPIER_MODEL_NC_BASE - -#include - -// model version of a multiCopier. -// -// When an Eigen::Tensor is reallocated (e.g. resized), its allocated -// memory (its data pointer) changes, but the Eigen::Tensor object -// itself does not. So we hold a reference to the Eigen::Tensor -// (via an ETaccessorBase that is an ETaccessor for that Tensor). -class multiCopier_model_nC_base : public multiCopier_nC_base { -public: - // ETaccessors (for a non-scalar) hold a reference to an Eigen::Tensor. - // The allows us to check the data pointer on each use, in case the - // Eigen::Tensor has been reallocated since the last call. - std::vector> accessors; - // Hold a shared_ptr to the model to keep it alive. - // In normal nimble usage, this should not be necessary, but it is safer and cheap. - std::shared_ptr modelKeepAlive; - - // init sets the vectors of ETaccessors and RuntimeFlatView. - template - void init(std::shared_ptr copiers, std::shared_ptr model) { - flatViewGroup.clear(); - accessors.clear(); - modelKeepAlive = model; - for (const auto& copier : copiers->contents()) { - auto acc = model->access(copier->varName); // acc will be std::unique_ptr - flatViewGroup.add(makeRuntimeFlatView(acc, - copier->indsList->contents())); - accessors.push_back(std::move(acc)); - } - } - - // RuntimeFlatViewGroup and RuntimeFlatView have a system of updating - // all the data pointers to be used (with the precomputed and cached - // indexing and striding, which [along with the sizes of the variables themselves] - // are assumed to be constant after initialization). - // The system assumes the data pointers will always be provided in the same order, - // i.e. the order of the ETaccessors. - // The argument is ignored (it is used for rows of the modelValues case). - void setActiveRow(int /*row*/) { - flatViewGroup.prepare_for_setData(); // reset counter to 0 - for (auto& acc : accessors) - flatViewGroup.setNextData(acc->template S().data()); // update each one's data pointer. - } -}; -#endif diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base_old/multiCopier_nC_base.h b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base_old/multiCopier_nC_base.h deleted file mode 100644 index 9a59b71..0000000 --- a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nC_base_old/multiCopier_nC_base.h +++ /dev/null @@ -1,40 +0,0 @@ -#ifndef __MULTICOPIER_NC_BASE -#define __MULTICOPIER_NC_BASE - -// multiCopier is used for nimble2's implementations of values() and nimCopy(). -// It represents access to a set of variables and index ranges for each variable. -// It use's nCompiler's RuntimeFlatViewGroup for the actual copying (including indexing and striding). -// -// Here is the base class for model and modelValues versions of multiCopies -// and the universal nimCopy_ implementation between any two multiCopiers. -// -// The trick is that we want to look up named variables only once, but hold -// access to each member variable (e.g. an Eigen::Tensor for a model or an -// nList > for a modelValues), not the data -// it points to. That way if the member variable is reset, we don't point to -// stale data. For a model, we hold a reference to the Eigen::Tensor. For -// a modelValues, it is harder: we hold the generic accessor object (accessor -// of the generic interface scheme, not to be confused with ETaccessor for -// type-flexible access to Eigen::Tensors). -// A second trick is that we want to precompute and cache indexing and striding -// info for each copiers, but we need to update the data pointer every time -// in case it has changed. setActiveRow() does that, with the row concept -// relevant only for modelValue. -// -// All copying machinery assumes that the sizes of variables, and the -// selection of indexed blocks of variables, will not change after initialization. -class multiCopier_nC_base { -public: - RuntimeFlatViewGroup flatViewGroup; - void setActiveRow(int row) {} -}; - -template -void nimCopy_(const std::shared_ptr &src, int srcRow, - const std::shared_ptr &dst, int dstRow) { - src->setActiveRow(srcRow); - dst->setActiveRow(dstRow); - src->flatViewGroup.copyTo(dst->flatViewGroup); -} - -#endif diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass_old/multiCopier_nClass_copyFiles.txt b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass_old/multiCopier_nClass_copyFiles.txt deleted file mode 100644 index e69de29..0000000 diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass_old/multiCopier_nClass_cppContent.cpp b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass_old/multiCopier_nClass_cppContent.cpp deleted file mode 100644 index e23f92f..0000000 --- a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass_old/multiCopier_nClass_cppContent.cpp +++ /dev/null @@ -1,62 +0,0 @@ -/* OPENER (Do not edit this comment) */ -#ifndef __multiCopier_nClass_CPP -#define __multiCopier_nClass_CPP -/* BODY (Do not edit this comment) */ -#ifndef R_NO_REMAP -#define R_NO_REMAP -#endif -#include -#include "multiCopier_nClass_c_.h" -using namespace Rcpp; -// [[Rcpp::plugins(nCompiler_Eigen_plugin)]] -// [[Rcpp::depends(RcppParallel)]] -// [[Rcpp::depends(nCompiler)]] -// [[Rcpp::depends(Rcereal)]] -// [[Rcpp::depends(nimbleModel)]] - - void multiCopier_nClass::init ( std::shared_ptr model ) { -RESET_EIGEN_ERRORS -multiCopier_model_nC_base::init(this->copiers, model); -} - Eigen::Tensor multiCopier_nClass::getValues ( ) { -RESET_EIGEN_ERRORS -return flatViewGroup.copyIntoVector(); -} - void multiCopier_nClass::setValues ( Eigen::Tensor v ) { -RESET_EIGEN_ERRORS -flatViewGroup.copyFromVector(v); -} - multiCopier_nClass::multiCopier_nClass ( ) { -RESET_EIGEN_ERRORS -} - -// [[Rcpp::export(name = "multiCopier_nClass_new")]] - SEXP new_multiCopier_nClass ( ) { -RESET_EIGEN_ERRORS -return CREATE_NEW_NCOMP_OBJECT(multiCopier_nClass);; -} - -// [[Rcpp::export(name = "set_CnClass_env_multiCopier_nClass_new")]] - void set_CnClass_env_multiCopier_nClass ( SEXP env ) { -RESET_EIGEN_ERRORS -SET_CNCLASS_ENV(multiCopier_nClass, env);; -} - -// [[Rcpp::export(name = "get_CnClass_env_multiCopier_nClass_new")]] - Rcpp::Environment get_CnClass_env_multiCopier_nClass ( ) { -RESET_EIGEN_ERRORS -return GET_CNCLASS_ENV(multiCopier_nClass);; -} - -NCOMPILER_INTERFACE( -multiCopier_nClass, -NCOMPILER_FIELDS( -field("copiers", &multiCopier_nClass::copiers) -), -NCOMPILER_METHODS( -method("init", &multiCopier_nClass::init, args({{arg("model",copy)}})), -method("getValues", &multiCopier_nClass::getValues, args({{}})), -method("setValues", &multiCopier_nClass::setValues, args({{arg("v",copy)}})) -) -) -#endif diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass_old/multiCopier_nClass_filebase.txt b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass_old/multiCopier_nClass_filebase.txt deleted file mode 100644 index c138443..0000000 --- a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass_old/multiCopier_nClass_filebase.txt +++ /dev/null @@ -1 +0,0 @@ -multiCopier_nClass_c_ diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass_old/multiCopier_nClass_hContent.h b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass_old/multiCopier_nClass_hContent.h deleted file mode 100644 index 1bfaadf..0000000 --- a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass_old/multiCopier_nClass_hContent.h +++ /dev/null @@ -1,31 +0,0 @@ -/* OPENER (Do not edit this comment) */ -#ifndef __multiCopier_nClass_H -#define __multiCopier_nClass_H -/* BODY (Do not edit this comment) */ -#ifndef R_NO_REMAP -#define R_NO_REMAP -#endif -#include -#include "nList_copier_nClass_c_.h" -#include "multiCopier_nClass_c_.h" -#include "modelBase_nClass_c_.h" -#include - -class multiCopier_nClass : public interface_resolver< genericInterfaceC, multiCopier_model_nC_base >, public loadedObjectHookC { -public: - static const char* nc_class_key() {return "multiCopier_nClass";} - void init ( std::shared_ptr model ) ; - Eigen::Tensor getValues ( ) ; - void setValues ( Eigen::Tensor v ) ; - multiCopier_nClass ( ) ; - std::shared_ptr copiers; - -}; - - SEXP new_multiCopier_nClass ( ) ; - - void set_CnClass_env_multiCopier_nClass ( SEXP env ) ; - - Rcpp::Environment get_CnClass_env_multiCopier_nClass ( ) ; - -#endif diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass_old/multiCopier_nClass_manifest.txt b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass_old/multiCopier_nClass_manifest.txt deleted file mode 100644 index a7c82ad..0000000 --- a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass_old/multiCopier_nClass_manifest.txt +++ /dev/null @@ -1,7 +0,0 @@ -list(saved_at = structure(1791315772.0204, class = c("POSIXct", -"POSIXt")), packet_name = "multiCopier_nClass", elements = c("preamble", -"cppContent", "hContent", "filebase", "post_cpp_compiler", "copyFiles" -), files = list(preamble = "multiCopier_nClass_preamble.cpp", - cppContent = "multiCopier_nClass_cppContent.cpp", hContent = "multiCopier_nClass_hContent.h", - filebase = "multiCopier_nClass_filebase.txt", post_cpp_compiler = "multiCopier_nClass_post_cpp_compiler.txt", - copyFiles = "multiCopier_nClass_copyFiles.txt")) diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass_old/multiCopier_nClass_post_cpp_compiler.txt b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass_old/multiCopier_nClass_post_cpp_compiler.txt deleted file mode 100644 index e69de29..0000000 diff --git a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass_old/multiCopier_nClass_preamble.cpp b/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass_old/multiCopier_nClass_preamble.cpp deleted file mode 100644 index 1a92ce3..0000000 --- a/nimbleModel/inst/include/nimbleModel/predef/multiCopier_nClass_old/multiCopier_nClass_preamble.cpp +++ /dev/null @@ -1,5 +0,0 @@ -#define NCOMPILER_HANDLE_EIGEN_ERRORS -#define NCOMPILER_USES_EIGEN -#define NCOMPILER_USES_NCPPVEC -#define USES_NCOMPILER -#define NCOMPILER_USES_NCLASS_INTERFACE