From 82f894074b5d5c93b794507f94fe472ca76ee747 Mon Sep 17 00:00:00 2001 From: perrydv Date: Sat, 6 Dec 2025 13:21:02 +0100 Subject: [PATCH 1/5] add model dollar sign to uncompiled version of calculate methods --- nCompiler/R/nimbleModels.R | 104 ++++++++++++++---- .../testthat/nimble_tests/test-nimbleModel.R | 56 ++++++---- 2 files changed, 118 insertions(+), 42 deletions(-) diff --git a/nCompiler/R/nimbleModels.R b/nCompiler/R/nimbleModels.R index efee3c2a..36f30e3c 100644 --- a/nCompiler/R/nimbleModels.R +++ b/nCompiler/R/nimbleModels.R @@ -107,6 +107,32 @@ modelBase_nClass <- nClass( # nCompile(modelBase_nClass, control=list(generate_predefined=TRUE)) +## The two "addModelDollarSign" functions are borrowed directly from nimble. +## This should add model$ in front of any names that are not already part of a '$' expression +nm_addModelDollarSign <- function(expr, exceptionNames = character(0)) { + if(is.numeric(expr)) return(expr) + if(is(expr, 'srcref')) return(expr) + if(is.name(expr)) { + if((as.character(expr) %in% exceptionNames) || (as.character(expr) == '')) return(expr) + proto <- quote(model$a) + proto[[3]] <- expr + return(proto) + } + if(is.call(expr)) { + if(expr[[1]] == '$'){ + expr[2] <- lapply(expr[2], function(listElement) nm_addModelDollarSign(listElement, exceptionNames)) + return(expr) + } + if(expr[[1]] == 'returnType') + return(expr) + if(length(expr) > 1) { + expr[2:length(expr)] <- lapply(expr[-1], function(listElement) nm_addModelDollarSign(listElement, exceptionNames)) + return(expr) + } + } + return(expr) +} + ## test <- nClass( ## inherit = modelBase_nClass, ## classname = "my_model", @@ -146,25 +172,36 @@ make_node_fun <- function(varInfo = list(), baseclass <- paste0("nodeFxnClass_<", classname, ">") + setModel <- function(model) { + if(!isCompiled()) + self$model <- model + else + warning("setModel called on compiled object; no action taken") + } + # This was a prototype node_nClass <- substitute( nClass( classname = CLASSNAME, + Rpublic = RPUBLIC, Cpublic = CPUBLIC, compileInfo = list( createFromR = FALSE, # Without a default constructor (which we've disabled here), createFromR is impossible nClass_inherit = list(base = BASECLASS)) # Ideally this line would be obtained from a base nClass, but we insert it directly for now ), - list(CPUBLIC = c( - list( - nFunction( - initFun, - compileInfo = list(constructor=TRUE, initializers = initializersList) - ) - ) |> structure(names = classname), - CpublicVars, - methods + list( + CPUBLIC = c( + list( + nFunction( + initFun, + compileInfo = list(constructor=TRUE, initializers = initializersList) + ) + ) |> structure(names = classname), + CpublicVars, + methods ), + RPUBLIC = list(model = NULL, + setModel = setModel), CLASSNAME = classname, BASECLASS = baseclass )) @@ -246,8 +283,8 @@ makeModel_nClass <- function(varInfo, init_string = init_string, membername = x$membername) }) - membernames <- node_pieces |> lapply(\(x) x$membername) |> unlist() - CpublicNodeFuns <- node_pieces |> lapply(\(x) x$nClass_type) |> setNames(membernames) + nodeObjNames <- node_pieces |> lapply(\(x) x$membername) |> unlist() + CpublicNodeFuns <- node_pieces |> lapply(\(x) x$nClass_type) |> setNames(nodeObjNames) # CpublicNodeFuns <- list( # beta_node = 'node_dnorm()' # ) @@ -259,7 +296,22 @@ makeModel_nClass <- function(varInfo, initializers = node_pieces |> lapply(\(x) x$init_string) |> unlist()) ) ) |> structure(names = classname) + initialize <- function(sizes, inits) { + browser() + if(isCompiled()) + self$do_setup_node_mgmt() + if(!isCompiled()) { + for(nodeObj in self$nodeObjNames) { + self[[nodeObj]] <- CpublicNodeFuns[[nodeObj]]$new() + self[[nodeObj]]$setModel(self) + } + } + if(length(inits)) init_from_list(inits) + else if(length(sizes)) resize_from_list(sizes) + } baseclass <- paste0("modelClass_<", classname, ">") + env <- new.env(parent = parent.frame()) + env$CpublicNodeFuns <- CpublicNodeFuns ans <- substitute( nClass( classname = CLASSNAME, @@ -269,14 +321,17 @@ makeModel_nClass <- function(varInfo, #inherit = list(base = "public modelClass_"), #Hincludes = "" ), - Cpublic = CPUBLIC + Rpublic = RPUBLIC, + Cpublic = CPUBLIC, + env = env ), list(OPDEFS = opDefs, + RPUBLIC = list(initialize=initialize, nodeObjNames = nodeObjNames), CPUBLIC = c(CpublicNodeFuns, CpublicModelVars, CpublicCtor, CpublicMethods), CLASSNAME = classname, BASECLASS = baseclass) ) - eval(ans, envir = parent.frame()) + eval(ans) } ## Get varInfo from new nimbleModel @@ -318,26 +373,29 @@ make_nodeFxn_from_declInfo <- function(declInfo) { names(RHSrep)[2] <- "" RHSrep[[lenRHS+2]] <- 1 names(RHSrep)[lenRHS+2] <- "log" - calc1fun <- substitute( + calc1Cfun <- substitute( function(idx) {LHS <- RHS; return(LHS)}, list(LHS = logProbExprRep, RHS = RHSrep) ) |> eval() + calc1Rfun <- calc1Cfun + body(calc1Rfun) <- nm_addModelDollarSign(body(calc1Cfun), exceptionNames = c("idx")) calc_one <- nFunction( name = "calc_one", - fun = calc1fun, - compileInfo=list(C_fun=calc1fun), + fun = calc1Rfun, + compileInfo=list(C_fun=calc1Cfun), argTypes = list(idx = 'integerVector'), returnType = 'numericScalar') - nodeVars <- all.vars(body(calc1fun)) |> setdiff("idx") + nodeVars <- all.vars(body(calc1Cfun)) |> setdiff("idx") list(calc_one = calc_one, nodeVars = nodeVars) } -make_model_from_nimbleModel <- function(m) { +make_model_from_nimbleModel <- function(m, compile=TRUE) { mDef <- m$modelDef allVarInfo <- get_varInfo_from_nimbleModel(m) modelVarInfo <- allVarInfo$vars nodeFxnNames <- character() nodeInfoList <- list() + nodeFxnList <- list() for(i in seq_along(mDef$declInfo)) { declInfo <- mDef$declInfo[[i]] nodeFxn <- make_nodeFxn_from_declInfo(declInfo) @@ -349,17 +407,21 @@ make_model_from_nimbleModel <- function(m) { node_membername <- paste0("node_", SLN) nodeVarInfo <- modelVarInfo[nodeVars] # Currently, we can't just make a list of these but need them as named objects in the environment + nodeFxnList[[nodeFxnName]] <- make_node_fun(nodeVarInfo, list(calc_one=calc_one), node_classname) assign(nodeFxnName, - make_node_fun(nodeVarInfo, list(calc_one=calc_one), node_classname) + nodeFxnList[[nodeFxnName]] ) nodeInfoList[[i]] <- nCompiler:::make_node_info(node_membername, nodeFxnName, node_classname, nodeVarInfo) - nodeFxnNames <- c(nodeFxnNames, nodeFxnName) +# nodeFxnNames <- c(nodeFxnNames, nodeFxnName) + } model <- makeModel_nClass(modelVarInfo, nodeInfoList, classname = "my_model") # Currently we must compile from here because here is where we know the nodeFxnName[s]. # We have a situation where order matters: model needs to come after the utility classes. Fix me. + if(!compile) + return(model) argList <- list("modelBase_nClass", "nodeFxnBase_nClass", "calcInstrList_nC", "calcInstr_nClass", "nodeInstr_nClass", "model") - argList <- c(argList, as.list(nodeFxnNames)) + argList <- c(argList, "nodeFxnList") argList <- argList |> lapply(as.name) Cmodel <- do.call("nCompile", argList) #Cncm1 <- nCompile(modelBase_nClass, nodeFxnBase_nClass, calcInstr_nClass, nodeInstr_nClass, ncm1, nodeFxn_3) diff --git a/nCompiler/tests/testthat/nimble_tests/test-nimbleModel.R b/nCompiler/tests/testthat/nimble_tests/test-nimbleModel.R index 64815a8b..da4e743f 100644 --- a/nCompiler/tests/testthat/nimble_tests/test-nimbleModel.R +++ b/nCompiler/tests/testthat/nimble_tests/test-nimbleModel.R @@ -78,28 +78,27 @@ test_that("nodeInstr_nClass and calcInstr_nClass basics work", { ###### -## This test works but is disabled b/c we don't have nimbleModel ## in the testing setup yet. -if(FALSE) { -library(nimbleModel) -code <- quote({ - sd ~ dunif(0, 10) - for(i in 1:5) { - y[i] ~ dnorm(x[i+1], sd = sd) - } +test_that("nimble model variables are set up", { + library(nimbleModel) + code <- quote({ + sd ~ dunif(0, 10) + for(i in 1:5) { + y[i] ~ dnorm(x[i+1], sd = sd) + } + }) + m <- modelClass$new(code) + varInfo <- nCompiler:::get_varInfo_from_nimbleModel(m) + modelVars <- varInfo$vars + # Try making a model with no nodeFxns + ncm1 <- makeModel_nClass(modelVars, list(), classname = "my_model") + Cncm1 <- nCompile(modelBase_nClass, nodeFxnBase_nClass, calcInstrList_nC, calcInstr_nClass, nodeInstr_nClass, ncm1) + obj <- Cncm1$ncm1$new() + obj$resize_from_list(varInfo$sizes) + expect_equal(length(obj$x), 6) + expect_equal(length(obj$y), 5) + expect_equal(length(obj$logProb_y), 5) }) -m <- modelClass$new(code) -varInfo <- nCompiler:::get_varInfo_from_nimbleModel(m) -modelVars <- varInfo$vars -# Try making a model with no nodeFxns -ncm1 <- makeModel_nClass(modelVars, list(), classname = "my_model") -Cncm1 <- nCompile(modelBase_nClass, nodeFxnBase_nClass, calcInstrList_nC, calcInstr_nClass, nodeInstr_nClass, ncm1) -obj <- Cncm1$ncm1$new() -obj$resize_from_list(varInfo$sizes) -expect_equal(length(obj$x), 6) -expect_equal(length(obj$y), 5) -expect_equal(length(obj$logProb_y), 5) -} ######## # nOptions(pause_after_writing_files=TRUE) # Try automating the whole model creation including nodeFxns @@ -113,7 +112,22 @@ if(FALSE) { } }) m <- modelClass$new(code) -test <- nCompiler:::make_model_from_nimbleModel(m) + + ## Check that a separate R implementation was created + mDef_ <- m$modelDef + dI <- mDef_$declInfo[[2]] + nFxn <- nCompiler:::make_nodeFxn_from_declInfo(dI) + expect_true(!is.null(NFinternals(nFxn[[1]])$R_fun)) + + # uncompiled + test <- nCompiler:::make_model_from_nimbleModel(m, compile=FALSE) + Robj <- test$new() + + NULL + ## Compile + debugonce(nCompiler:::make_model_from_nimbleModel) + test <- nCompiler:::make_model_from_nimbleModel(m) + obj <- test$model$new() obj$do_setup_node_mgmt() From 55726b3ccd51c66614919b90f924e2ebccf0fdbd Mon Sep 17 00:00:00 2001 From: perrydv Date: Wed, 10 Dec 2025 18:38:45 +0100 Subject: [PATCH 2/5] update predefined nClasses used for models --- nCompiler/NAMESPACE | 5 +- nCompiler/R/NC_LoadedObjectEnv.R | 2 +- nCompiler/R/nimbleModels.R | 152 ++++++++++++------ .../inst/include/nCompiler/predef/.DS_Store | Bin 0 -> 6148 bytes .../inst/include/nCompiler/predef/README.txt | 4 - .../predef/calcInstrList_nC/.DS_Store | Bin 0 -> 6148 bytes .../calcInstrList_nC_cppContent.cpp | 45 ------ .../calcInstrList_nC_filebase.txt | 1 - .../calcInstrList_nC_hContent.h | 24 --- .../calcInstrList_nC_manifest.txt | 7 - ...txt => calcInstrList_nClass_copyFiles.txt} | 0 .../calcInstrList_nClass_cppContent.cpp | 45 ++++++ .../calcInstrList_nClass_filebase.txt | 1 + .../calcInstrList_nClass_hContent.h | 24 +++ .../calcInstrList_nClass_manifest.txt | 7 + ...alcInstrList_nClass_post_cpp_compiler.txt} | 0 ....cpp => calcInstrList_nClass_preamble.cpp} | 0 .../calcInstr_nClass_copyFiles.txt | 0 .../calcInstr_nClass_cppContent.cpp | 0 .../calcInstr_nClass_filebase.txt | 0 .../calcInstr_nClass_hContent.h | 0 .../calcInstr_nClass_manifest.txt | 2 +- .../calcInstr_nClass_post_cpp_compiler.txt | 0 .../calcInstr_nClass_preamble.cpp | 0 .../modelBase_nClass_copyFiles.txt | 0 .../modelBase_nClass_cppContent.cpp | 8 +- .../modelBase_nClass_filebase.txt | 0 .../modelBase_nC/modelBase_nClass_hContent.h | 26 +++ .../modelBase_nClass_manifest.txt | 2 +- .../modelBase_nClass_post_cpp_compiler.txt | 0 .../modelBase_nClass_preamble.cpp | 0 .../modelClass_.h} | 70 +++++--- .../nodeFxnBase_nClass_copyFiles.txt | 0 .../nodeFxnBase_nClass_cppContent.cpp | 3 - .../nodeFxnBase_nClass_filebase.txt | 0 .../nodeFxnBase_nClass_hContent.h | 21 +-- .../nodeFxnBase_nClass_manifest.txt | 2 +- .../nodeFxnBase_nClass_post_cpp_compiler.txt | 0 .../nodeFxnBase_nClass_preamble.cpp | 0 .../predef/nodeFxnClass_/nodeFxnClass_.h | 21 +++ .../nodeInstr_nClass_copyFiles.txt | 0 .../nodeInstr_nClass_cppContent.cpp | 0 .../nodeInstr_nClass_filebase.txt | 0 .../nodeInstr_nClass_hContent.h | 0 .../nodeInstr_nClass_manifest.txt | 2 +- .../nodeInstr_nClass_post_cpp_compiler.txt | 0 .../nodeInstr_nClass_preamble.cpp | 0 .../testthat/nimble_tests/test-nimbleModel.R | 51 ++++-- 48 files changed, 322 insertions(+), 203 deletions(-) create mode 100644 nCompiler/inst/include/nCompiler/predef/.DS_Store delete mode 100644 nCompiler/inst/include/nCompiler/predef/README.txt create mode 100644 nCompiler/inst/include/nCompiler/predef/calcInstrList_nC/.DS_Store delete mode 100644 nCompiler/inst/include/nCompiler/predef/calcInstrList_nC/calcInstrList_nC_cppContent.cpp delete mode 100644 nCompiler/inst/include/nCompiler/predef/calcInstrList_nC/calcInstrList_nC_filebase.txt delete mode 100644 nCompiler/inst/include/nCompiler/predef/calcInstrList_nC/calcInstrList_nC_hContent.h delete mode 100644 nCompiler/inst/include/nCompiler/predef/calcInstrList_nC/calcInstrList_nC_manifest.txt rename nCompiler/inst/include/nCompiler/predef/calcInstrList_nC/{calcInstrList_nC_copyFiles.txt => calcInstrList_nClass_copyFiles.txt} (100%) create mode 100644 nCompiler/inst/include/nCompiler/predef/calcInstrList_nC/calcInstrList_nClass_cppContent.cpp create mode 100644 nCompiler/inst/include/nCompiler/predef/calcInstrList_nC/calcInstrList_nClass_filebase.txt create mode 100644 nCompiler/inst/include/nCompiler/predef/calcInstrList_nC/calcInstrList_nClass_hContent.h create mode 100644 nCompiler/inst/include/nCompiler/predef/calcInstrList_nC/calcInstrList_nClass_manifest.txt rename nCompiler/inst/include/nCompiler/predef/calcInstrList_nC/{calcInstrList_nC_post_cpp_compiler.txt => calcInstrList_nClass_post_cpp_compiler.txt} (100%) rename nCompiler/inst/include/nCompiler/predef/calcInstrList_nC/{calcInstrList_nC_preamble.cpp => calcInstrList_nClass_preamble.cpp} (100%) rename nCompiler/inst/include/nCompiler/predef/{calcInstr_nClass => calcInstr_nC}/calcInstr_nClass_copyFiles.txt (100%) rename nCompiler/inst/include/nCompiler/predef/{calcInstr_nClass => calcInstr_nC}/calcInstr_nClass_cppContent.cpp (100%) rename nCompiler/inst/include/nCompiler/predef/{calcInstr_nClass => calcInstr_nC}/calcInstr_nClass_filebase.txt (100%) rename nCompiler/inst/include/nCompiler/predef/{calcInstr_nClass => calcInstr_nC}/calcInstr_nClass_hContent.h (100%) rename nCompiler/inst/include/nCompiler/predef/{calcInstr_nClass => calcInstr_nC}/calcInstr_nClass_manifest.txt (87%) rename nCompiler/inst/include/nCompiler/predef/{calcInstr_nClass => calcInstr_nC}/calcInstr_nClass_post_cpp_compiler.txt (100%) rename nCompiler/inst/include/nCompiler/predef/{calcInstr_nClass => calcInstr_nC}/calcInstr_nClass_preamble.cpp (100%) rename nCompiler/inst/include/nCompiler/predef/{modelBase_nClass => modelBase_nC}/modelBase_nClass_copyFiles.txt (100%) rename nCompiler/inst/include/nCompiler/predef/{modelBase_nClass => modelBase_nC}/modelBase_nClass_cppContent.cpp (93%) rename nCompiler/inst/include/nCompiler/predef/{modelBase_nClass => modelBase_nC}/modelBase_nClass_filebase.txt (100%) create mode 100644 nCompiler/inst/include/nCompiler/predef/modelBase_nC/modelBase_nClass_hContent.h rename nCompiler/inst/include/nCompiler/predef/{modelBase_nClass => modelBase_nC}/modelBase_nClass_manifest.txt (87%) rename nCompiler/inst/include/nCompiler/predef/{modelBase_nClass => modelBase_nC}/modelBase_nClass_post_cpp_compiler.txt (100%) rename nCompiler/inst/include/nCompiler/predef/{modelBase_nClass => modelBase_nC}/modelBase_nClass_preamble.cpp (100%) rename nCompiler/inst/include/nCompiler/predef/{modelBase_nClass/modelBase_nClass_hContent.h => modelClass_/modelClass_.h} (65%) rename nCompiler/inst/include/nCompiler/predef/{nodeFxnBase_nClass => nodeFxnBase_nC}/nodeFxnBase_nClass_copyFiles.txt (100%) rename nCompiler/inst/include/nCompiler/predef/{nodeFxnBase_nClass => nodeFxnBase_nC}/nodeFxnBase_nClass_cppContent.cpp (96%) rename nCompiler/inst/include/nCompiler/predef/{nodeFxnBase_nClass => nodeFxnBase_nC}/nodeFxnBase_nClass_filebase.txt (100%) rename nCompiler/inst/include/nCompiler/predef/{nodeFxnBase_nClass => nodeFxnBase_nC}/nodeFxnBase_nClass_hContent.h (57%) rename nCompiler/inst/include/nCompiler/predef/{nodeFxnBase_nClass => nodeFxnBase_nC}/nodeFxnBase_nClass_manifest.txt (87%) rename nCompiler/inst/include/nCompiler/predef/{nodeFxnBase_nClass => nodeFxnBase_nC}/nodeFxnBase_nClass_post_cpp_compiler.txt (100%) rename nCompiler/inst/include/nCompiler/predef/{nodeFxnBase_nClass => nodeFxnBase_nC}/nodeFxnBase_nClass_preamble.cpp (100%) create mode 100644 nCompiler/inst/include/nCompiler/predef/nodeFxnClass_/nodeFxnClass_.h rename nCompiler/inst/include/nCompiler/predef/{nodeInstr_nClass => nodeInstr_nC}/nodeInstr_nClass_copyFiles.txt (100%) rename nCompiler/inst/include/nCompiler/predef/{nodeInstr_nClass => nodeInstr_nC}/nodeInstr_nClass_cppContent.cpp (100%) rename nCompiler/inst/include/nCompiler/predef/{nodeInstr_nClass => nodeInstr_nC}/nodeInstr_nClass_filebase.txt (100%) rename nCompiler/inst/include/nCompiler/predef/{nodeInstr_nClass => nodeInstr_nC}/nodeInstr_nClass_hContent.h (100%) rename nCompiler/inst/include/nCompiler/predef/{nodeInstr_nClass => nodeInstr_nC}/nodeInstr_nClass_manifest.txt (87%) rename nCompiler/inst/include/nCompiler/predef/{nodeInstr_nClass => nodeInstr_nC}/nodeInstr_nClass_post_cpp_compiler.txt (100%) rename nCompiler/inst/include/nCompiler/predef/{nodeInstr_nClass => nodeInstr_nC}/nodeInstr_nClass_preamble.cpp (100%) diff --git a/nCompiler/NAMESPACE b/nCompiler/NAMESPACE index 5f02e92b..f499d123 100644 --- a/nCompiler/NAMESPACE +++ b/nCompiler/NAMESPACE @@ -9,7 +9,7 @@ export(argType2Cpp) export(build_compiled_nClass) export(calcInputList_to_calcInstrList) export(calcInstr_nClass) -export(calcInstrList_nC) +export(calcInstrList_nClass) export(cloglog) export(check_Rcpp_for_nCompiler) export(compileNimble) @@ -59,7 +59,8 @@ export(logfact) export(loggam) export(logit) export(makeModel_nClass) -export(make_node_fun) +export(make_model_from_nimbleModel) +export(make_node_nClass) export(method) export(modelBase_nClass) export(new.loadedObjectEnv) ## needed for Rcpp::Function access in loadedObjectEnv.h diff --git a/nCompiler/R/NC_LoadedObjectEnv.R b/nCompiler/R/NC_LoadedObjectEnv.R index 29cad65f..c11ae62b 100644 --- a/nCompiler/R/NC_LoadedObjectEnv.R +++ b/nCompiler/R/NC_LoadedObjectEnv.R @@ -266,7 +266,7 @@ setup_DLLenv <- function(compiledFuns, move_funs_from_list_to_env <- function(funNames, funList, env) { keep <- rep(TRUE, length(funList)) for(funName in funNames) { - found <- grepl(funName, names(funList)) + found <- funName == names(funList) #grepl(funName, names(funList)) if(any(found)) { i <- which(found) if(length(i) != 1) diff --git a/nCompiler/R/nimbleModels.R b/nCompiler/R/nimbleModels.R index 2d01ab27..9fd3dfff 100644 --- a/nCompiler/R/nimbleModels.R +++ b/nCompiler/R/nimbleModels.R @@ -21,10 +21,10 @@ nodeInstr_nClass <- nClass( indsInstrVec = "nList('integerVector')" ), predefined = quote(system.file(file.path("include","nCompiler", "predef"), package="nCompiler") |> - file.path("nodeInstr_nClass")), + file.path("nodeInstr_nC")), compileInfo=list(interface="full", - createFromR = TRUE#, - #predefined_output_dir = "nodeInstr_nClass" + createFromR = TRUE, + exportName = "nodeInstr_nClass" ) ) @@ -35,20 +35,20 @@ calcInstr_nClass <- nClass( nodeInstrVec = "nList('nodeInstr_nClass')" ), predefined = quote(system.file(file.path("include","nCompiler", "predef"), package="nCompiler") |> - file.path("calcInstr_nClass")), + file.path("calcInstr_nC")), compileInfo=list(interface="full", createFromR = TRUE, Hincludes = "", # In the format here, needed_units is a list with either objects (nFunction or nClass (generators), # or names. If names, we will use scoping to look them up and decide what they are. # The list can mix objects and names of nClasses and nFunctions. - needed_units = list("nodeInstr_nClass") - #predefined_output_dir = "calcInstr_nClass" + needed_units = list("nodeInstr_nClass"), + exportName = "calcInstr_nClass" ) ) -calcInstrList_nC <- nClass( - classname = "calcInstrList_nC", +calcInstrList_nClass <- nClass( + classname = "calcInstrList_nClass", Cpublic = list( calcInstrList = "nList('calcInstr_nClass')" ), @@ -56,7 +56,10 @@ calcInstrList_nC <- nClass( file.path("calcInstrList_nC")), compileInfo=list(interface="full", createFromR = TRUE, - Hincludes = "") + Hincludes = "", + exportName = "calcInstrList_nClass", + needed_units = list("calcInstr_nClass") + ) ) nodeFxnBase_nClass <- nClass( @@ -76,9 +79,10 @@ nodeFxnBase_nClass <- nClass( # We haven't dealt with ensuring a virtual destructor when any method is virtual # For now I did it manually by editing the .h and .cpp predefined = quote(system.file(file.path("include","nCompiler", "predef"), package="nCompiler") |> - file.path("nodeFxnBase_nClass")), + file.path("nodeFxnBase_nC")), compileInfo=list(interface="full", - createFromR = FALSE) + createFromR = FALSE, + exportName = "nodeFxnBase_nClass") ) # nCompile(nodeFxnBase_nClass, control=list(generate_predefined=TRUE)) @@ -93,20 +97,34 @@ modelBase_nClass <- nClass( ), calculate = nFunction( name = "calculate", - function(calcInstrList) {cat("In uncompiled calculate\n")}, + function(calcInstrList) { + cat("In uncompiled calculate\n") + # This is where uncompiled stepping through the calcInstrList happens. + for(calcInstr in calcInstrList$calcInstrList) { + nodeIdx <- calcInstr$nodeIndex + nodemember_name <- self$get_nodeObjNames()[nodeIdx] + for(nodeInstr in calcInstr$nodeInstrVec) { + self[[nodemember_name]]$calculate(nodeInstr) + } + } + return(0) + }, returnType = 'numericScalar', compileInfo = list( - C_fun = function(calcInstrList='calcInstrList_nC') { + C_fun = function(calcInstrList='calcInstrList_nClass') { cppLiteral('Rprintf("modelBase_nClass calculate (should not see this)\\n");'); return(0)}, virtual=TRUE ) ) ), # See comment above about needing to ensure a virtual destructor - predefined = quote(system.file(file.path("include","nCompiler", "predef"), package="nCompiler") |> file.path("modelBase_nClass")), + predefined = quote(system.file(file.path("include","nCompiler", "predef"), package="nCompiler") |> file.path("modelBase_nC")), compileInfo=list(interface="full", createFromR = FALSE, - Hincludes = c("", "")) + Hincludes = c("", ""), # do we need "" too? + needed_units = list("nodeFxnBase_nClass","calcInstrList_nClass"), #do we need nodeFxnBase_nClass here too? + exportName = "modelBase_nClass" + ) ) # nCompile(modelBase_nClass, control=list(generate_predefined=TRUE)) @@ -153,21 +171,24 @@ nm_addModelDollarSign <- function(expr, exceptionNames = character(0)) { ## obj$calculate(NULL) # Turn variables and methods into a nodeFxn nClass -make_node_fun <- function(varInfo = list(), - methods = list(), - classname) { +make_node_nClass <- function(varInfo = list(), + methods = list(), + classname) { # varInfo will be a list (names not used) of name, nDim, sizes. - varInfo_2_cppVar <- \(x) nCompiler:::symbolBasic$new( + # These are the model member variables to be used by the nodeFxn. + # They will be used in a constructor to set up C++ references to model variables. + varInfo_2_symbol <- \(x) nCompiler:::symbolBasic$new( type="double", nDim=x$nDim, name="", isRef=TRUE, isConst=FALSE, interface=FALSE) # In future maybe isConst=TRUE, but it might not matter much - typeList <- varInfo |> lapply(varInfo_2_cppVar) - names(typeList) <- varInfo |> lapply(\(x) x$name) |> unlist() + symbolList <- varInfo |> lapply(varInfo_2_symbol) + names(symbolList) <- varInfo |> lapply(\(x) x$name) |> unlist() - CpublicVars <- names(typeList) |> lapply(\(x) eval(substitute(quote(T(typeList$NAME)), + CpublicVars <- names(symbolList) |> lapply(\(x) eval(substitute(quote(T(symbolList$NAME)), list(NAME=as.name(x))))) - names(CpublicVars) <- names(typeList) + names(CpublicVars) <- names(symbolList) - ctorArgNames <- paste0(names(typeList), '_') - initializersList <- paste0(names(typeList), '(', ctorArgNames ,')') + ctorArgNames <- paste0(names(symbolList), '_') + # List used when generating C++ constructor code to allow direct initializers, necessary for references. + initializersList <- paste0(names(symbolList), '(', ctorArgNames ,')') initFun <- function(){} formals(initFun) <- structure(as.pairlist(CpublicVars), names = ctorArgNames) @@ -176,6 +197,7 @@ make_node_fun <- function(varInfo = list(), baseclass <- paste0("nodeFxnClass_<", classname, ">") + # Rpublic method to set the model pointer/reference. setModel <- function(model) { if(!isCompiled()) self$model <- model @@ -186,6 +208,7 @@ make_node_fun <- function(varInfo = list(), # This was a prototype node_nClass <- substitute( nClass( + inherit = nodeFxnBase_nClass, classname = CLASSNAME, Rpublic = RPUBLIC, Cpublic = CPUBLIC, @@ -218,7 +241,7 @@ make_node_fun <- function(varInfo = list(), # Currently it needs to have a name to include in nCompile(). Later we might be able to pass the object itself # At first drafting this is fairly trivial but could grow in complexity. -make_node_info <- function(membername, +make_node_info_for_model_nClass <- function(membername, nodeFxnName, classname, varInfo = list() @@ -240,12 +263,15 @@ makeModel_nClass <- function(varInfo, names(CpublicModelVars) <- varInfo |> lapply(\(x) x$name) |> unlist() opDefs <- list( base_ping = getOperatorDef("custom_call"), - setup_node_mgmt = getOperatorDef("custom_call") + setup_node_mgmt = getOperatorDef("custom_call"), + do_setup_node_mgmt_from_names = getOperatorDef("custom_call") ) opDefs$base_ping$returnType <- nCompiler:::argType2symbol(quote(void())) opDefs$base_ping$labelAbstractTypes$recurse <- FALSE opDefs$setup_node_mgmt$returnType <- nCompiler:::argType2symbol(quote(void())) opDefs$setup_node_mgmt$labelAbstractTypes$recurse <- FALSE + opDefs$do_setup_node_mgmt_from_names$returnType <- nCompiler:::argType2symbol(quote(void())) + opDefs$do_setup_node_mgmt_from_names$labelAbstractTypes$recurse <- FALSE if(missing(classname)) classname <- modelLabelCreator() @@ -257,6 +283,12 @@ makeModel_nClass <- function(varInfo, compileInfo=list( C_fun = function() {setup_node_mgmt()}) ), + setup_node_mgmt_from_names = nFunction( + name = "call_setup_node_mgmt_from_names", + function(nodeNames) {}, + compileInfo=list( + C_fun = function(nodeNames="RcppCharacterVector") {do_setup_node_mgmt_from_names(nodeNames)}) + ), print_nodes = nFunction( name = "print_nodes", function() {}, @@ -280,14 +312,18 @@ makeModel_nClass <- function(varInfo, ) # nodes will be a list of membername, nodeFxnName, (node) classname, ctorArgs (list) node_pieces <- nodes |> lapply(\(x) { - nClass_type <- paste0(x$nodeFxnName, "()") + #nClass_type <- paste0(x$nodeFxnName, "()") init_string <- paste0('nCpp("', x$membername, '( new ', x$classname, '(', paste0(x$ctorArgs, collapse=","), '))")') - list(nClass_type = nClass_type, + list(nClass_type = x$nodeFxnName, init_string = init_string, membername = x$membername) }) nodeObjNames <- node_pieces |> lapply(\(x) x$membername) |> unlist() + # nodeObjNames also serves for canonical lookup of names by index. + # e.g. nodeObjNames[i] gives the member name of the index=i node member. + nodeObjName_2_nodeIndex <- (1:length(nodeObjNames)) |> structure(names=nodeObjNames) + # Inversely, nodeobjName_2_nodeIndex["node_3"] gives the index of that node. CpublicNodeFuns <- node_pieces |> lapply(\(x) x$nClass_type) |> setNames(nodeObjNames) # CpublicNodeFuns <- list( # beta_node = 'node_dnorm()' @@ -300,21 +336,33 @@ makeModel_nClass <- function(varInfo, initializers = node_pieces |> lapply(\(x) x$init_string) |> unlist()) ) ) |> structure(names = classname) - initialize <- function(sizes, inits) { + initialize <- function(sizes = list(), inits = list()) { browser() if(isCompiled()) - self$do_setup_node_mgmt() + self$setup_node_mgmt_from_names(nodeObjNames) if(!isCompiled()) { - for(nodeObj in self$nodeObjNames) { - self[[nodeObj]] <- CpublicNodeFuns[[nodeObj]]$new() + for(nodeObj in nodeObjNames) { + self[[nodeObj]] <- eval(as.name(CpublicNodeFuns[[nodeObj]]))$new() self[[nodeObj]]$setModel(self) } } if(length(inits)) init_from_list(inits) else if(length(sizes)) resize_from_list(sizes) } + get_nodeObjNames <- function() { + return(nodeObjNames) + } + Rvars <- list( + # default_inits = list(), + # default_sizes = list() + ) baseclass <- paste0("modelClass_<", classname, ">") env <- new.env(parent = parent.frame()) + # CpublicNodeFuns has elements like "node_1 = quote(nodeFxn_1())" + # We provide it in Cpublic to declare C++ member variables with types. + # We also place it in env 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. env$CpublicNodeFuns <- CpublicNodeFuns ans <- substitute( nClass( @@ -330,7 +378,7 @@ makeModel_nClass <- function(varInfo, env = env ), list(OPDEFS = opDefs, - RPUBLIC = list(initialize=initialize, nodeObjNames = nodeObjNames), + RPUBLIC = list(initialize=initialize, get_nodeObjNames = get_nodeObjNames, Rvars = Rvars), CPUBLIC = c(CpublicNodeFuns, CpublicModelVars, CpublicCtor, CpublicMethods), CLASSNAME = classname, BASECLASS = baseclass) @@ -356,6 +404,11 @@ get_varInfo_from_nimbleModel <- function(model) { } make_nodeFxn_from_declInfo <- function(declInfo) { + # pieces are adapted from Chris' code in nimbleModel and/or old nimble. + # + # This function creates a calc_one nFunction that calculates single index case. + # This will then be used by generic iterator over indices. + # Vectorized cases can be added in this basic framework later. modelCode <- declInfo$calculateCode LHS <- modelCode[[2]] RHS <- modelCode[[3]] @@ -377,6 +430,7 @@ make_nodeFxn_from_declInfo <- function(declInfo) { names(RHSrep)[2] <- "" RHSrep[[lenRHS+2]] <- 1 names(RHSrep)[lenRHS+2] <- "log" + # We create separate code for R and C execution. calc1Cfun <- substitute( function(idx) {LHS <- RHS; return(LHS)}, list(LHS = logProbExprRep, RHS = RHSrep) @@ -393,29 +447,31 @@ make_nodeFxn_from_declInfo <- function(declInfo) { list(calc_one = calc_one, nodeVars = nodeVars) } -make_model_from_nimbleModel <- function(m, compile=TRUE) { +make_model_from_nimbleModel <- function(m, compile=FALSE) { mDef <- m$modelDef allVarInfo <- get_varInfo_from_nimbleModel(m) modelVarInfo <- allVarInfo$vars nodeFxnNames <- character() nodeInfoList <- list() nodeFxnList <- list() + # two vectors for canonical use for calculation instructions + # to move between names and indices of nodeFxns: for(i in seq_along(mDef$declInfo)) { declInfo <- mDef$declInfo[[i]] nodeFxn <- make_nodeFxn_from_declInfo(declInfo) nodeVars <- nodeFxn$nodeVars calc_one <- nodeFxn$calc_one SLN <- declInfo$sourceLineNumber - node_classname <- paste0("nodeClass_", SLN) - nodeFxnName <- paste0("nodeFxn_", SLN) - node_membername <- paste0("node_", SLN) + node_classname <- paste0("nodeClass_", SLN) # name of an nClass generator + node_RvarName <- paste0("nodeFxn_", SLN) # name of an R variable holding the nClass generator + node_membername <- paste0("node_", SLN) # name of model member variable holding an instance of the nClass nodeVarInfo <- modelVarInfo[nodeVars] # Currently, we can't just make a list of these but need them as named objects in the environment - nodeFxnList[[nodeFxnName]] <- make_node_fun(nodeVarInfo, list(calc_one=calc_one), node_classname) - assign(nodeFxnName, - nodeFxnList[[nodeFxnName]] + nodeFxnList[[node_RvarName]] <- make_node_nClass(nodeVarInfo, list(calc_one=calc_one), node_classname) + assign(node_RvarName, + nodeFxnList[[node_RvarName]] ) - nodeInfoList[[i]] <- nCompiler:::make_node_info(node_membername, nodeFxnName, node_classname, nodeVarInfo) + nodeInfoList[[i]] <- nCompiler:::make_node_info_for_model_nClass(node_membername, node_RvarName, node_classname, nodeVarInfo) # nodeFxnNames <- c(nodeFxnNames, nodeFxnName) } @@ -424,10 +480,12 @@ make_model_from_nimbleModel <- function(m, compile=TRUE) { # We have a situation where order matters: model needs to come after the utility classes. Fix me. if(!compile) return(model) - argList <- list("modelBase_nClass", "nodeFxnBase_nClass", "calcInstrList_nC", "calcInstr_nClass", "nodeInstr_nClass", "model") - argList <- c(argList, "nodeFxnList") - argList <- argList |> lapply(as.name) - Cmodel <- do.call("nCompile", argList) + Cmodel <- nCompile(model) + return(Cmodel) +# argList <- list("modelBase_nClass", "nodeFxnBase_nClass", "calcInstrList_nClass", "calcInstr_nClass", "nodeInstr_nClass", "model") +# argList <- c(argList, "nodeFxnList") +# argList <- argList |> lapply(as.name) +# Cmodel <- do.call("nCompile", argList) #Cncm1 <- nCompile(modelBase_nClass, nodeFxnBase_nClass, calcInstr_nClass, nodeInstr_nClass, ncm1, nodeFxn_3) } @@ -452,7 +510,7 @@ calcInputList_to_calcInstrList <- function(calcInputList, comp) { calcInstr$nodeInstrVec <- nodeInstrVec calcInstrList[[iCalc]] <- calcInstr } - calcInstrListObj <- comp$calcInstrList_nC$new() + calcInstrListObj <- comp$calcInstrList_nClass$new() calcInstrListObj$calcInstrList <- calcInstrList return(calcInstrListObj) } diff --git a/nCompiler/inst/include/nCompiler/predef/.DS_Store b/nCompiler/inst/include/nCompiler/predef/.DS_Store new file mode 100644 index 0000000000000000000000000000000000000000..15fc022b14decaf90795edb17b237a97189a2587 GIT binary patch literal 6148 zcmeHKyG{c^3>-s>NTf(fxxc_4tU@TL^8ru<(V&YI9`#jx7oV2#LrA9!1qBTnOZMz~ zJ$t$-&SwC&dEegvYXD2SBR)OM&ClIuc2OB4(s{={2E5`8M?B1`&nKL_BI|%Xo+kVO zw;#LX@NyWQ^ZxS}C@Te|fE17dQa}p)N&)Y^wB=Qzq7;wR+`j)_T!)$n2UWUC3q;_1A)Zd?zS7gQuWr^%XzPD^hdhae9_&w4hloG lV`8*pZoC~|M^V-_U-P^dj)_5MKIlaK47e^bDe%_{oB*5V7AXJ# literal 0 HcmV?d00001 diff --git a/nCompiler/inst/include/nCompiler/predef/README.txt b/nCompiler/inst/include/nCompiler/predef/README.txt deleted file mode 100644 index 57ee5e59..00000000 --- a/nCompiler/inst/include/nCompiler/predef/README.txt +++ /dev/null @@ -1,4 +0,0 @@ -This is placeholder for possibly moving predefined nClass code into -a clearly organized location like this. However, for now, the machinery -to use predefined nClasses expects it to be in the include/nCompiler directory -so we leave it all there. diff --git a/nCompiler/inst/include/nCompiler/predef/calcInstrList_nC/.DS_Store b/nCompiler/inst/include/nCompiler/predef/calcInstrList_nC/.DS_Store new file mode 100644 index 0000000000000000000000000000000000000000..5008ddfcf53c02e82d7eee2e57c38e5672ef89f6 GIT binary patch literal 6148 zcmeH~Jr2S!425mzP>H1@V-^m;4Wg<&0T*E43hX&L&p$$qDprKhvt+--jT7}7np#A3 zem<@ulZcFPQ@L2!n>{z**++&mCkOWA81W14cNZlEfg7;MkzE(HCqgga^y>{tEnwC%0;vJ&^%eQ zLs35+`xjp>T0 -#include "calcInstrList_nC_c_.h" -using namespace Rcpp; -// [[Rcpp::plugins(nCompiler_Eigen_plugin)]] -// [[Rcpp::depends(RcppParallel)]] -// [[Rcpp::depends(nCompiler)]] -// [[Rcpp::depends(Rcereal)]] - - calcInstrList_nC::calcInstrList_nC ( ) { -RESET_EIGEN_ERRORS -} - -// [[Rcpp::export(name = "new_calcInstrList_nC")]] - SEXP new_calcInstrList_nC ( ) { -RESET_EIGEN_ERRORS -return CREATE_NEW_NCOMP_OBJECT(calcInstrList_nC);; -} - -// [[Rcpp::export(name = "set_CnClass_env_new_calcInstrList_nC")]] - void set_CnClass_env_calcInstrList_nC ( SEXP env ) { -RESET_EIGEN_ERRORS -SET_CNCLASS_ENV(calcInstrList_nC, env);; -} - -// [[Rcpp::export(name = "get_CnClass_env_new_calcInstrList_nC")]] - Rcpp::Environment get_CnClass_env_calcInstrList_nC ( ) { -RESET_EIGEN_ERRORS -return GET_CNCLASS_ENV(calcInstrList_nC);; -} - -NCOMPILER_INTERFACE( -calcInstrList_nC, -NCOMPILER_FIELDS( -field("calcInstrList", &calcInstrList_nC::calcInstrList) -), -NCOMPILER_METHODS() -) -#endif diff --git a/nCompiler/inst/include/nCompiler/predef/calcInstrList_nC/calcInstrList_nC_filebase.txt b/nCompiler/inst/include/nCompiler/predef/calcInstrList_nC/calcInstrList_nC_filebase.txt deleted file mode 100644 index 1ca677eb..00000000 --- a/nCompiler/inst/include/nCompiler/predef/calcInstrList_nC/calcInstrList_nC_filebase.txt +++ /dev/null @@ -1 +0,0 @@ -calcInstrList_nC_c_ diff --git a/nCompiler/inst/include/nCompiler/predef/calcInstrList_nC/calcInstrList_nC_hContent.h b/nCompiler/inst/include/nCompiler/predef/calcInstrList_nC/calcInstrList_nC_hContent.h deleted file mode 100644 index e7a0b972..00000000 --- a/nCompiler/inst/include/nCompiler/predef/calcInstrList_nC/calcInstrList_nC_hContent.h +++ /dev/null @@ -1,24 +0,0 @@ -/* OPENER (Do not edit this comment) */ -#ifndef __calcInstrList_nC_H -#define __calcInstrList_nC_H -/* BODY (Do not edit this comment) */ -#ifndef R_NO_REMAP -#define R_NO_REMAP -#endif -#include -#include - -class calcInstrList_nC : public interface_resolver< genericInterfaceC >, public loadedObjectHookC { -public: - calcInstrList_nC ( ) ; - nList > calcInstrList; -}; - - SEXP new_calcInstrList_nC ( ) ; - - void set_CnClass_env_calcInstrList_nC ( SEXP env ) ; - - Rcpp::Environment get_CnClass_env_calcInstrList_nC ( ) ; - - -#endif diff --git a/nCompiler/inst/include/nCompiler/predef/calcInstrList_nC/calcInstrList_nC_manifest.txt b/nCompiler/inst/include/nCompiler/predef/calcInstrList_nC/calcInstrList_nC_manifest.txt deleted file mode 100644 index 190fc787..00000000 --- a/nCompiler/inst/include/nCompiler/predef/calcInstrList_nC/calcInstrList_nC_manifest.txt +++ /dev/null @@ -1,7 +0,0 @@ -list(saved_at = structure(1762608220.96116, class = c("POSIXct", -"POSIXt")), packet_name = "calcInstrList_nC", elements = c("preamble", -"cppContent", "hContent", "filebase", "post_cpp_compiler", "copyFiles" -), files = list(preamble = "calcInstrList_nC_preamble.cpp", - cppContent = "calcInstrList_nC_cppContent.cpp", hContent = "calcInstrList_nC_hContent.h", - filebase = "calcInstrList_nC_filebase.txt", post_cpp_compiler = "calcInstrList_nC_post_cpp_compiler.txt", - copyFiles = "calcInstrList_nC_copyFiles.txt")) diff --git a/nCompiler/inst/include/nCompiler/predef/calcInstrList_nC/calcInstrList_nC_copyFiles.txt b/nCompiler/inst/include/nCompiler/predef/calcInstrList_nC/calcInstrList_nClass_copyFiles.txt similarity index 100% rename from nCompiler/inst/include/nCompiler/predef/calcInstrList_nC/calcInstrList_nC_copyFiles.txt rename to nCompiler/inst/include/nCompiler/predef/calcInstrList_nC/calcInstrList_nClass_copyFiles.txt diff --git a/nCompiler/inst/include/nCompiler/predef/calcInstrList_nC/calcInstrList_nClass_cppContent.cpp b/nCompiler/inst/include/nCompiler/predef/calcInstrList_nC/calcInstrList_nClass_cppContent.cpp new file mode 100644 index 00000000..c7309d21 --- /dev/null +++ b/nCompiler/inst/include/nCompiler/predef/calcInstrList_nC/calcInstrList_nClass_cppContent.cpp @@ -0,0 +1,45 @@ +/* OPENER (Do not edit this comment) */ +#ifndef __calcInstrList_nClass_CPP +#define __calcInstrList_nClass_CPP +/* BODY (Do not edit this comment) */ +#ifndef R_NO_REMAP +#define R_NO_REMAP +#endif +#include +#include "calcInstrList_nClass_c_.h" +using namespace Rcpp; +// [[Rcpp::plugins(nCompiler_Eigen_plugin)]] +// [[Rcpp::depends(RcppParallel)]] +// [[Rcpp::depends(nCompiler)]] +// [[Rcpp::depends(Rcereal)]] + + calcInstrList_nClass::calcInstrList_nClass ( ) { +RESET_EIGEN_ERRORS +} + +// [[Rcpp::export(name = "new_calcInstrList_nClass")]] + SEXP new_calcInstrList_nClass ( ) { +RESET_EIGEN_ERRORS +return CREATE_NEW_NCOMP_OBJECT(calcInstrList_nClass);; +} + +// [[Rcpp::export(name = "set_CnClass_env_new_calcInstrList_nClass")]] + void set_CnClass_env_calcInstrList_nClass ( SEXP env ) { +RESET_EIGEN_ERRORS +SET_CNCLASS_ENV(calcInstrList_nClass, env);; +} + +// [[Rcpp::export(name = "get_CnClass_env_new_calcInstrList_nClass")]] + Rcpp::Environment get_CnClass_env_calcInstrList_nClass ( ) { +RESET_EIGEN_ERRORS +return GET_CNCLASS_ENV(calcInstrList_nClass);; +} + +NCOMPILER_INTERFACE( +calcInstrList_nClass, +NCOMPILER_FIELDS( +field("calcInstrList", &calcInstrList_nClass::calcInstrList) +), +NCOMPILER_METHODS() +) +#endif diff --git a/nCompiler/inst/include/nCompiler/predef/calcInstrList_nC/calcInstrList_nClass_filebase.txt b/nCompiler/inst/include/nCompiler/predef/calcInstrList_nC/calcInstrList_nClass_filebase.txt new file mode 100644 index 00000000..6b2e8b13 --- /dev/null +++ b/nCompiler/inst/include/nCompiler/predef/calcInstrList_nC/calcInstrList_nClass_filebase.txt @@ -0,0 +1 @@ +calcInstrList_nClass_c_ diff --git a/nCompiler/inst/include/nCompiler/predef/calcInstrList_nC/calcInstrList_nClass_hContent.h b/nCompiler/inst/include/nCompiler/predef/calcInstrList_nC/calcInstrList_nClass_hContent.h new file mode 100644 index 00000000..47fdf85a --- /dev/null +++ b/nCompiler/inst/include/nCompiler/predef/calcInstrList_nC/calcInstrList_nClass_hContent.h @@ -0,0 +1,24 @@ +/* OPENER (Do not edit this comment) */ +#ifndef __calcInstrList_nClass_H +#define __calcInstrList_nClass_H +/* BODY (Do not edit this comment) */ +#ifndef R_NO_REMAP +#define R_NO_REMAP +#endif +#include +#include + +class calcInstrList_nClass : public interface_resolver< genericInterfaceC >, public loadedObjectHookC { +public: + calcInstrList_nClass ( ) ; + nList > calcInstrList; +}; + + SEXP new_calcInstrList_nClass ( ) ; + + void set_CnClass_env_calcInstrList_nClass ( SEXP env ) ; + + Rcpp::Environment get_CnClass_env_calcInstrList_nClass ( ) ; + + +#endif diff --git a/nCompiler/inst/include/nCompiler/predef/calcInstrList_nC/calcInstrList_nClass_manifest.txt b/nCompiler/inst/include/nCompiler/predef/calcInstrList_nC/calcInstrList_nClass_manifest.txt new file mode 100644 index 00000000..75bb4e0c --- /dev/null +++ b/nCompiler/inst/include/nCompiler/predef/calcInstrList_nC/calcInstrList_nClass_manifest.txt @@ -0,0 +1,7 @@ +list(saved_at = structure(1765363827.01894, class = c("POSIXct", +"POSIXt")), packet_name = "calcInstrList_nClass", elements = c("preamble", +"cppContent", "hContent", "filebase", "post_cpp_compiler", "copyFiles" +), files = list(preamble = "calcInstrList_nClass_preamble.cpp", + cppContent = "calcInstrList_nClass_cppContent.cpp", hContent = "calcInstrList_nClass_hContent.h", + filebase = "calcInstrList_nClass_filebase.txt", post_cpp_compiler = "calcInstrList_nClass_post_cpp_compiler.txt", + copyFiles = "calcInstrList_nClass_copyFiles.txt")) diff --git a/nCompiler/inst/include/nCompiler/predef/calcInstrList_nC/calcInstrList_nC_post_cpp_compiler.txt b/nCompiler/inst/include/nCompiler/predef/calcInstrList_nC/calcInstrList_nClass_post_cpp_compiler.txt similarity index 100% rename from nCompiler/inst/include/nCompiler/predef/calcInstrList_nC/calcInstrList_nC_post_cpp_compiler.txt rename to nCompiler/inst/include/nCompiler/predef/calcInstrList_nC/calcInstrList_nClass_post_cpp_compiler.txt diff --git a/nCompiler/inst/include/nCompiler/predef/calcInstrList_nC/calcInstrList_nC_preamble.cpp b/nCompiler/inst/include/nCompiler/predef/calcInstrList_nC/calcInstrList_nClass_preamble.cpp similarity index 100% rename from nCompiler/inst/include/nCompiler/predef/calcInstrList_nC/calcInstrList_nC_preamble.cpp rename to nCompiler/inst/include/nCompiler/predef/calcInstrList_nC/calcInstrList_nClass_preamble.cpp diff --git a/nCompiler/inst/include/nCompiler/predef/calcInstr_nClass/calcInstr_nClass_copyFiles.txt b/nCompiler/inst/include/nCompiler/predef/calcInstr_nC/calcInstr_nClass_copyFiles.txt similarity index 100% rename from nCompiler/inst/include/nCompiler/predef/calcInstr_nClass/calcInstr_nClass_copyFiles.txt rename to nCompiler/inst/include/nCompiler/predef/calcInstr_nC/calcInstr_nClass_copyFiles.txt diff --git a/nCompiler/inst/include/nCompiler/predef/calcInstr_nClass/calcInstr_nClass_cppContent.cpp b/nCompiler/inst/include/nCompiler/predef/calcInstr_nC/calcInstr_nClass_cppContent.cpp similarity index 100% rename from nCompiler/inst/include/nCompiler/predef/calcInstr_nClass/calcInstr_nClass_cppContent.cpp rename to nCompiler/inst/include/nCompiler/predef/calcInstr_nC/calcInstr_nClass_cppContent.cpp diff --git a/nCompiler/inst/include/nCompiler/predef/calcInstr_nClass/calcInstr_nClass_filebase.txt b/nCompiler/inst/include/nCompiler/predef/calcInstr_nC/calcInstr_nClass_filebase.txt similarity index 100% rename from nCompiler/inst/include/nCompiler/predef/calcInstr_nClass/calcInstr_nClass_filebase.txt rename to nCompiler/inst/include/nCompiler/predef/calcInstr_nC/calcInstr_nClass_filebase.txt diff --git a/nCompiler/inst/include/nCompiler/predef/calcInstr_nClass/calcInstr_nClass_hContent.h b/nCompiler/inst/include/nCompiler/predef/calcInstr_nC/calcInstr_nClass_hContent.h similarity index 100% rename from nCompiler/inst/include/nCompiler/predef/calcInstr_nClass/calcInstr_nClass_hContent.h rename to nCompiler/inst/include/nCompiler/predef/calcInstr_nC/calcInstr_nClass_hContent.h diff --git a/nCompiler/inst/include/nCompiler/predef/calcInstr_nClass/calcInstr_nClass_manifest.txt b/nCompiler/inst/include/nCompiler/predef/calcInstr_nC/calcInstr_nClass_manifest.txt similarity index 87% rename from nCompiler/inst/include/nCompiler/predef/calcInstr_nClass/calcInstr_nClass_manifest.txt rename to nCompiler/inst/include/nCompiler/predef/calcInstr_nC/calcInstr_nClass_manifest.txt index 5ca9a4ed..c6c8c72b 100644 --- a/nCompiler/inst/include/nCompiler/predef/calcInstr_nClass/calcInstr_nClass_manifest.txt +++ b/nCompiler/inst/include/nCompiler/predef/calcInstr_nC/calcInstr_nClass_manifest.txt @@ -1,4 +1,4 @@ -list(saved_at = structure(1762351302.27482, class = c("POSIXct", +list(saved_at = structure(1765361967.54755, class = c("POSIXct", "POSIXt")), packet_name = "calcInstr_nClass", elements = c("preamble", "cppContent", "hContent", "filebase", "post_cpp_compiler", "copyFiles" ), files = list(preamble = "calcInstr_nClass_preamble.cpp", cppContent = "calcInstr_nClass_cppContent.cpp", diff --git a/nCompiler/inst/include/nCompiler/predef/calcInstr_nClass/calcInstr_nClass_post_cpp_compiler.txt b/nCompiler/inst/include/nCompiler/predef/calcInstr_nC/calcInstr_nClass_post_cpp_compiler.txt similarity index 100% rename from nCompiler/inst/include/nCompiler/predef/calcInstr_nClass/calcInstr_nClass_post_cpp_compiler.txt rename to nCompiler/inst/include/nCompiler/predef/calcInstr_nC/calcInstr_nClass_post_cpp_compiler.txt diff --git a/nCompiler/inst/include/nCompiler/predef/calcInstr_nClass/calcInstr_nClass_preamble.cpp b/nCompiler/inst/include/nCompiler/predef/calcInstr_nC/calcInstr_nClass_preamble.cpp similarity index 100% rename from nCompiler/inst/include/nCompiler/predef/calcInstr_nClass/calcInstr_nClass_preamble.cpp rename to nCompiler/inst/include/nCompiler/predef/calcInstr_nC/calcInstr_nClass_preamble.cpp diff --git a/nCompiler/inst/include/nCompiler/predef/modelBase_nClass/modelBase_nClass_copyFiles.txt b/nCompiler/inst/include/nCompiler/predef/modelBase_nC/modelBase_nClass_copyFiles.txt similarity index 100% rename from nCompiler/inst/include/nCompiler/predef/modelBase_nClass/modelBase_nClass_copyFiles.txt rename to nCompiler/inst/include/nCompiler/predef/modelBase_nC/modelBase_nClass_copyFiles.txt diff --git a/nCompiler/inst/include/nCompiler/predef/modelBase_nClass/modelBase_nClass_cppContent.cpp b/nCompiler/inst/include/nCompiler/predef/modelBase_nC/modelBase_nClass_cppContent.cpp similarity index 93% rename from nCompiler/inst/include/nCompiler/predef/modelBase_nClass/modelBase_nClass_cppContent.cpp rename to nCompiler/inst/include/nCompiler/predef/modelBase_nC/modelBase_nClass_cppContent.cpp index 58c04011..2e00bd80 100644 --- a/nCompiler/inst/include/nCompiler/predef/modelBase_nClass/modelBase_nClass_cppContent.cpp +++ b/nCompiler/inst/include/nCompiler/predef/modelBase_nC/modelBase_nClass_cppContent.cpp @@ -17,7 +17,7 @@ using namespace Rcpp; RESET_EIGEN_ERRORS return(true); } - double modelBase_nClass::calculate ( std::shared_ptr calcInstr ) { + double modelBase_nClass::calculate ( std::shared_ptr calcInstrList ) { RESET_EIGEN_ERRORS Rprintf("modelBase_nClass calculate (should not see this)\n");; return(0.0); @@ -26,8 +26,6 @@ return(0.0); RESET_EIGEN_ERRORS } -modelBase_nClass::~modelBase_nClass () {}; - // [[Rcpp::export(name = "set_CnClass_env_new_modelBase_nClass")]] void set_CnClass_env_modelBase_nClass ( SEXP env ) { RESET_EIGEN_ERRORS @@ -45,9 +43,7 @@ modelBase_nClass, NCOMPILER_FIELDS(), NCOMPILER_METHODS( method("ping", &modelBase_nClass::ping, args({{}})), -method("calculate", &modelBase_nClass::calculate, args({{arg("calcInstr",copy)}})) +method("calculate", &modelBase_nClass::calculate, args({{arg("calcInstrList",copy)}})) ) ) - - #endif diff --git a/nCompiler/inst/include/nCompiler/predef/modelBase_nClass/modelBase_nClass_filebase.txt b/nCompiler/inst/include/nCompiler/predef/modelBase_nC/modelBase_nClass_filebase.txt similarity index 100% rename from nCompiler/inst/include/nCompiler/predef/modelBase_nClass/modelBase_nClass_filebase.txt rename to nCompiler/inst/include/nCompiler/predef/modelBase_nC/modelBase_nClass_filebase.txt diff --git a/nCompiler/inst/include/nCompiler/predef/modelBase_nC/modelBase_nClass_hContent.h b/nCompiler/inst/include/nCompiler/predef/modelBase_nC/modelBase_nClass_hContent.h new file mode 100644 index 00000000..20ff8c79 --- /dev/null +++ b/nCompiler/inst/include/nCompiler/predef/modelBase_nC/modelBase_nClass_hContent.h @@ -0,0 +1,26 @@ +/* OPENER (Do not edit this comment) */ +#ifndef __modelBase_nClass_H +#define __modelBase_nClass_H +/* BODY (Do not edit this comment) */ +#ifndef R_NO_REMAP +#define R_NO_REMAP +#endif +#include +#include +#include +#include "calcInstrList_nClass_c_.h" + +class modelBase_nClass : public interface_resolver< genericInterfaceC >, public loadedObjectHookC { +public: + virtual bool ping ( ) ; + virtual double calculate ( std::shared_ptr calcInstrList ) ; + modelBase_nClass ( ) ; +}; + + void set_CnClass_env_modelBase_nClass ( SEXP env ) ; + + Rcpp::Environment get_CnClass_env_modelBase_nClass ( ) ; + +#include + +#endif diff --git a/nCompiler/inst/include/nCompiler/predef/modelBase_nClass/modelBase_nClass_manifest.txt b/nCompiler/inst/include/nCompiler/predef/modelBase_nC/modelBase_nClass_manifest.txt similarity index 87% rename from nCompiler/inst/include/nCompiler/predef/modelBase_nClass/modelBase_nClass_manifest.txt rename to nCompiler/inst/include/nCompiler/predef/modelBase_nC/modelBase_nClass_manifest.txt index ef22a3e0..d0ed2d9b 100644 --- a/nCompiler/inst/include/nCompiler/predef/modelBase_nClass/modelBase_nClass_manifest.txt +++ b/nCompiler/inst/include/nCompiler/predef/modelBase_nC/modelBase_nClass_manifest.txt @@ -1,4 +1,4 @@ -list(saved_at = structure(1759839433.48825, class = c("POSIXct", +list(saved_at = structure(1765369346.14219, 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/nCompiler/inst/include/nCompiler/predef/modelBase_nClass/modelBase_nClass_post_cpp_compiler.txt b/nCompiler/inst/include/nCompiler/predef/modelBase_nC/modelBase_nClass_post_cpp_compiler.txt similarity index 100% rename from nCompiler/inst/include/nCompiler/predef/modelBase_nClass/modelBase_nClass_post_cpp_compiler.txt rename to nCompiler/inst/include/nCompiler/predef/modelBase_nC/modelBase_nClass_post_cpp_compiler.txt diff --git a/nCompiler/inst/include/nCompiler/predef/modelBase_nClass/modelBase_nClass_preamble.cpp b/nCompiler/inst/include/nCompiler/predef/modelBase_nC/modelBase_nClass_preamble.cpp similarity index 100% rename from nCompiler/inst/include/nCompiler/predef/modelBase_nClass/modelBase_nClass_preamble.cpp rename to nCompiler/inst/include/nCompiler/predef/modelBase_nC/modelBase_nClass_preamble.cpp diff --git a/nCompiler/inst/include/nCompiler/predef/modelBase_nClass/modelBase_nClass_hContent.h b/nCompiler/inst/include/nCompiler/predef/modelClass_/modelClass_.h similarity index 65% rename from nCompiler/inst/include/nCompiler/predef/modelBase_nClass/modelBase_nClass_hContent.h rename to nCompiler/inst/include/nCompiler/predef/modelClass_/modelClass_.h index 814b128f..487a2bc5 100644 --- a/nCompiler/inst/include/nCompiler/predef/modelBase_nClass/modelBase_nClass_hContent.h +++ b/nCompiler/inst/include/nCompiler/predef/modelClass_/modelClass_.h @@ -1,25 +1,6 @@ -/* OPENER (Do not edit this comment) */ -#ifndef __modelBase_nClass_H -#define __modelBase_nClass_H -/* BODY (Do not edit this comment) */ -#ifndef R_NO_REMAP -#define R_NO_REMAP -#endif -#include -#include -#include "calcInstrList_nC_c_.h" - -class modelBase_nClass : public interface_resolver< genericInterfaceC >, public loadedObjectHookC { -public: - virtual bool ping ( ) ; - virtual double calculate ( std::shared_ptr calcInstr ) ; - modelBase_nClass ( ) ; - virtual ~modelBase_nClass(); -}; - - void set_CnClass_env_modelBase_nClass ( SEXP env ) ; - - Rcpp::Environment get_CnClass_env_modelBase_nClass ( ) ; +// to be included from the predefined modelBase_nClass. +// Add "#include " to that file, +// after the declaration of modelBase_nClass. template @@ -28,7 +9,7 @@ class modelClass_ : public modelBase_nClass { modelClass_() {}; std::vector< std::shared_ptr > nodeFxnPtrs; std::map name2index_map; - double calculate(std::shared_ptr calcInstrList) override { + double calculate(std::shared_ptr calcInstrList) override { double logProb(0.0); const auto& calcInstrVec = calcInstrList->calcInstrList.get(); auto calcInstr = calcInstrVec.cbegin(); @@ -44,6 +25,46 @@ class modelClass_ : public modelBase_nClass { } return(logProb); } + + // This version takes a character vector of names from R so that + // the ordering of nodeFxns matches that in R, which is important for + // the calculation instructions. + void do_setup_node_mgmt_from_names(Rcpp::CharacterVector names) { + Rprintf("Attempting setup_node_mgmt_from_names with %d names\n", (int)names.length()); + Derived *self = static_cast(this); + const auto& name2access = self->get_name2access(); + nodeFxnPtrs.clear(); + name2index_map.clear(); + size_t n = names.length(); + for(size_t i = 0; i < n; ++i) { + std::string name = Rcpp::as(names[i]); + auto it = name2access.find(name); + if(it != name2access.end()) { + std::shared_ptr ptr = it->second->getInterfacePtr(dynamic_cast(self)); + // When looking up this way, we do expect always to find objects (ptr valid) and that they are nodeFxn ptrs (ptr2 valid). + // So we can turn these messages into errors once things are working. + bool got_one = (ptr != nullptr); + if(got_one) { + Rprintf("HOORAY: field %s is genericInterfaceBaseC\n", name.c_str()); + std::shared_ptr ptr2 = std::dynamic_pointer_cast(ptr); + bool step_two = (ptr2 != nullptr); + if(step_two) { + Rprintf("AND IT IS A NODEFXN PTR!\n"); + name2index_map.emplace(name, nodeFxnPtrs.size()); + nodeFxnPtrs.push_back(ptr2); + } else { + Rprintf("but it is not a nodefxn ptr\n"); + } + } else { + Rprintf("field %s is NOT a genericInterfaceBaseC\n", name.c_str()); + } + } + } + } + + // This version scans all members to find nodeFxns. + // The resulting ordering comes from the order of the name2access map, + // and so may not match R. This was written first but may fall out of common use. void setup_node_mgmt() { Derived *self = static_cast(this); const auto& name2access = self->get_name2access(); @@ -129,5 +150,4 @@ class modelClass_ : public modelBase_nClass { } } } -}; -#endif +}; \ No newline at end of file diff --git a/nCompiler/inst/include/nCompiler/predef/nodeFxnBase_nClass/nodeFxnBase_nClass_copyFiles.txt b/nCompiler/inst/include/nCompiler/predef/nodeFxnBase_nC/nodeFxnBase_nClass_copyFiles.txt similarity index 100% rename from nCompiler/inst/include/nCompiler/predef/nodeFxnBase_nClass/nodeFxnBase_nClass_copyFiles.txt rename to nCompiler/inst/include/nCompiler/predef/nodeFxnBase_nC/nodeFxnBase_nClass_copyFiles.txt diff --git a/nCompiler/inst/include/nCompiler/predef/nodeFxnBase_nClass/nodeFxnBase_nClass_cppContent.cpp b/nCompiler/inst/include/nCompiler/predef/nodeFxnBase_nC/nodeFxnBase_nClass_cppContent.cpp similarity index 96% rename from nCompiler/inst/include/nCompiler/predef/nodeFxnBase_nClass/nodeFxnBase_nClass_cppContent.cpp rename to nCompiler/inst/include/nCompiler/predef/nodeFxnBase_nC/nodeFxnBase_nClass_cppContent.cpp index 86299aef..27e2bae7 100644 --- a/nCompiler/inst/include/nCompiler/predef/nodeFxnBase_nClass/nodeFxnBase_nClass_cppContent.cpp +++ b/nCompiler/inst/include/nCompiler/predef/nodeFxnBase_nC/nodeFxnBase_nClass_cppContent.cpp @@ -25,9 +25,6 @@ return(0.0); RESET_EIGEN_ERRORS } -nodeFxnBase_nClass::~nodeFxnBase_nClass() {}; - - // [[Rcpp::export(name = "set_CnClass_env_new_nodeFxnBase_nClass")]] void set_CnClass_env_nodeFxnBase_nClass ( SEXP env ) { RESET_EIGEN_ERRORS diff --git a/nCompiler/inst/include/nCompiler/predef/nodeFxnBase_nClass/nodeFxnBase_nClass_filebase.txt b/nCompiler/inst/include/nCompiler/predef/nodeFxnBase_nC/nodeFxnBase_nClass_filebase.txt similarity index 100% rename from nCompiler/inst/include/nCompiler/predef/nodeFxnBase_nClass/nodeFxnBase_nClass_filebase.txt rename to nCompiler/inst/include/nCompiler/predef/nodeFxnBase_nC/nodeFxnBase_nClass_filebase.txt diff --git a/nCompiler/inst/include/nCompiler/predef/nodeFxnBase_nClass/nodeFxnBase_nClass_hContent.h b/nCompiler/inst/include/nCompiler/predef/nodeFxnBase_nC/nodeFxnBase_nClass_hContent.h similarity index 57% rename from nCompiler/inst/include/nCompiler/predef/nodeFxnBase_nClass/nodeFxnBase_nClass_hContent.h rename to nCompiler/inst/include/nCompiler/predef/nodeFxnBase_nC/nodeFxnBase_nClass_hContent.h index bfd355ba..828ee435 100644 --- a/nCompiler/inst/include/nCompiler/predef/nodeFxnBase_nClass/nodeFxnBase_nClass_hContent.h +++ b/nCompiler/inst/include/nCompiler/predef/nodeFxnBase_nC/nodeFxnBase_nClass_hContent.h @@ -13,31 +13,12 @@ class nodeFxnBase_nClass : public interface_resolver< genericInterfaceC nodeInstr ) ; nodeFxnBase_nClass ( ) ; - virtual ~nodeFxnBase_nClass(); }; void set_CnClass_env_nodeFxnBase_nClass ( SEXP env ) ; Rcpp::Environment get_CnClass_env_nodeFxnBase_nClass ( ) ; - -template -class nodeFxnClass_ : public nodeFxnBase_nClass { -public: - double v; - nodeFxnClass_() {}; - - double calculate ( std::shared_ptr nodeInstr ) override { -RESET_EIGEN_ERRORS -double logProb(0.0); -const auto& methodInstr = nodeInstr->methodInstr; -const auto& indsInstrVec = nodeInstr->indsInstrVec; -logProb += static_cast(this)->calc_one(indsInstrVec[0]); -return(logProb); - } - - virtual ~nodeFxnClass_() {}; -}; - +#include #endif diff --git a/nCompiler/inst/include/nCompiler/predef/nodeFxnBase_nClass/nodeFxnBase_nClass_manifest.txt b/nCompiler/inst/include/nCompiler/predef/nodeFxnBase_nC/nodeFxnBase_nClass_manifest.txt similarity index 87% rename from nCompiler/inst/include/nCompiler/predef/nodeFxnBase_nClass/nodeFxnBase_nClass_manifest.txt rename to nCompiler/inst/include/nCompiler/predef/nodeFxnBase_nC/nodeFxnBase_nClass_manifest.txt index 97221ec1..5f1198c3 100644 --- a/nCompiler/inst/include/nCompiler/predef/nodeFxnBase_nClass/nodeFxnBase_nClass_manifest.txt +++ b/nCompiler/inst/include/nCompiler/predef/nodeFxnBase_nC/nodeFxnBase_nClass_manifest.txt @@ -1,4 +1,4 @@ -list(saved_at = structure(1759839377.88016, class = c("POSIXct", +list(saved_at = structure(1765362650.7249, class = c("POSIXct", "POSIXt")), packet_name = "nodeFxnBase_nClass", elements = c("preamble", "cppContent", "hContent", "filebase", "post_cpp_compiler", "copyFiles" ), files = list(preamble = "nodeFxnBase_nClass_preamble.cpp", diff --git a/nCompiler/inst/include/nCompiler/predef/nodeFxnBase_nClass/nodeFxnBase_nClass_post_cpp_compiler.txt b/nCompiler/inst/include/nCompiler/predef/nodeFxnBase_nC/nodeFxnBase_nClass_post_cpp_compiler.txt similarity index 100% rename from nCompiler/inst/include/nCompiler/predef/nodeFxnBase_nClass/nodeFxnBase_nClass_post_cpp_compiler.txt rename to nCompiler/inst/include/nCompiler/predef/nodeFxnBase_nC/nodeFxnBase_nClass_post_cpp_compiler.txt diff --git a/nCompiler/inst/include/nCompiler/predef/nodeFxnBase_nClass/nodeFxnBase_nClass_preamble.cpp b/nCompiler/inst/include/nCompiler/predef/nodeFxnBase_nC/nodeFxnBase_nClass_preamble.cpp similarity index 100% rename from nCompiler/inst/include/nCompiler/predef/nodeFxnBase_nClass/nodeFxnBase_nClass_preamble.cpp rename to nCompiler/inst/include/nCompiler/predef/nodeFxnBase_nC/nodeFxnBase_nClass_preamble.cpp diff --git a/nCompiler/inst/include/nCompiler/predef/nodeFxnClass_/nodeFxnClass_.h b/nCompiler/inst/include/nCompiler/predef/nodeFxnClass_/nodeFxnClass_.h new file mode 100644 index 00000000..eeb10965 --- /dev/null +++ b/nCompiler/inst/include/nCompiler/predef/nodeFxnClass_/nodeFxnClass_.h @@ -0,0 +1,21 @@ +// to be included from the predefined nodeFxnBase_nClass. +// Add "#include " to that file, +// after the declaration of nodeFxnBase_nClass. + +template +class nodeFxnClass_ : public nodeFxnBase_nClass { +public: + double v; + nodeFxnClass_() {}; + + double calculate ( std::shared_ptr nodeInstr ) override { +RESET_EIGEN_ERRORS +double logProb(0.0); +const auto& methodInstr = nodeInstr->methodInstr; +const auto& indsInstrVec = nodeInstr->indsInstrVec; +logProb += static_cast(this)->calc_one(indsInstrVec[0]); +return(logProb); + } + + virtual ~nodeFxnClass_() {}; +}; diff --git a/nCompiler/inst/include/nCompiler/predef/nodeInstr_nClass/nodeInstr_nClass_copyFiles.txt b/nCompiler/inst/include/nCompiler/predef/nodeInstr_nC/nodeInstr_nClass_copyFiles.txt similarity index 100% rename from nCompiler/inst/include/nCompiler/predef/nodeInstr_nClass/nodeInstr_nClass_copyFiles.txt rename to nCompiler/inst/include/nCompiler/predef/nodeInstr_nC/nodeInstr_nClass_copyFiles.txt diff --git a/nCompiler/inst/include/nCompiler/predef/nodeInstr_nClass/nodeInstr_nClass_cppContent.cpp b/nCompiler/inst/include/nCompiler/predef/nodeInstr_nC/nodeInstr_nClass_cppContent.cpp similarity index 100% rename from nCompiler/inst/include/nCompiler/predef/nodeInstr_nClass/nodeInstr_nClass_cppContent.cpp rename to nCompiler/inst/include/nCompiler/predef/nodeInstr_nC/nodeInstr_nClass_cppContent.cpp diff --git a/nCompiler/inst/include/nCompiler/predef/nodeInstr_nClass/nodeInstr_nClass_filebase.txt b/nCompiler/inst/include/nCompiler/predef/nodeInstr_nC/nodeInstr_nClass_filebase.txt similarity index 100% rename from nCompiler/inst/include/nCompiler/predef/nodeInstr_nClass/nodeInstr_nClass_filebase.txt rename to nCompiler/inst/include/nCompiler/predef/nodeInstr_nC/nodeInstr_nClass_filebase.txt diff --git a/nCompiler/inst/include/nCompiler/predef/nodeInstr_nClass/nodeInstr_nClass_hContent.h b/nCompiler/inst/include/nCompiler/predef/nodeInstr_nC/nodeInstr_nClass_hContent.h similarity index 100% rename from nCompiler/inst/include/nCompiler/predef/nodeInstr_nClass/nodeInstr_nClass_hContent.h rename to nCompiler/inst/include/nCompiler/predef/nodeInstr_nC/nodeInstr_nClass_hContent.h diff --git a/nCompiler/inst/include/nCompiler/predef/nodeInstr_nClass/nodeInstr_nClass_manifest.txt b/nCompiler/inst/include/nCompiler/predef/nodeInstr_nC/nodeInstr_nClass_manifest.txt similarity index 87% rename from nCompiler/inst/include/nCompiler/predef/nodeInstr_nClass/nodeInstr_nClass_manifest.txt rename to nCompiler/inst/include/nCompiler/predef/nodeInstr_nC/nodeInstr_nClass_manifest.txt index 82792478..9ac5273f 100644 --- a/nCompiler/inst/include/nCompiler/predef/nodeInstr_nClass/nodeInstr_nClass_manifest.txt +++ b/nCompiler/inst/include/nCompiler/predef/nodeInstr_nC/nodeInstr_nClass_manifest.txt @@ -1,4 +1,4 @@ -list(saved_at = structure(1762351302.257, class = c("POSIXct", +list(saved_at = structure(1765361912.27661, class = c("POSIXct", "POSIXt")), packet_name = "nodeInstr_nClass", elements = c("preamble", "cppContent", "hContent", "filebase", "post_cpp_compiler", "copyFiles" ), files = list(preamble = "nodeInstr_nClass_preamble.cpp", cppContent = "nodeInstr_nClass_cppContent.cpp", diff --git a/nCompiler/inst/include/nCompiler/predef/nodeInstr_nClass/nodeInstr_nClass_post_cpp_compiler.txt b/nCompiler/inst/include/nCompiler/predef/nodeInstr_nC/nodeInstr_nClass_post_cpp_compiler.txt similarity index 100% rename from nCompiler/inst/include/nCompiler/predef/nodeInstr_nClass/nodeInstr_nClass_post_cpp_compiler.txt rename to nCompiler/inst/include/nCompiler/predef/nodeInstr_nC/nodeInstr_nClass_post_cpp_compiler.txt diff --git a/nCompiler/inst/include/nCompiler/predef/nodeInstr_nClass/nodeInstr_nClass_preamble.cpp b/nCompiler/inst/include/nCompiler/predef/nodeInstr_nC/nodeInstr_nClass_preamble.cpp similarity index 100% rename from nCompiler/inst/include/nCompiler/predef/nodeInstr_nClass/nodeInstr_nClass_preamble.cpp rename to nCompiler/inst/include/nCompiler/predef/nodeInstr_nC/nodeInstr_nClass_preamble.cpp diff --git a/nCompiler/tests/testthat/nimble_tests/test-nimbleModel.R b/nCompiler/tests/testthat/nimble_tests/test-nimbleModel.R index da4e743f..a99e3f26 100644 --- a/nCompiler/tests/testthat/nimble_tests/test-nimbleModel.R +++ b/nCompiler/tests/testthat/nimble_tests/test-nimbleModel.R @@ -4,8 +4,27 @@ library(nCompiler) library(testthat) +# To update the set of predefined nClasses +# generate new predef/nodeInstr_nC. Move that directly to package code inst/nCompiler/predef/nodeInstr_nC +nCompile(nodeInstr_nClass, control=list(generate_predefined=TRUE)) +# +# generate new predef/calcInstr_nC. Ditto: move directly to package code +nCompile(calcInstr_nClass, control=list(generate_predefined=TRUE)) +# +# generate new predef/calcInstrList_nC. Ditto: move directly to package code +nCompile(calcInstrList_nClass, control=list(generate_predefined=TRUE)) +# +# generate new predef/nodeFxnBase_nC. Move to package and add +# "#include " in the hContent +# after declaration of newFxnBase_nClass +nCompile(nodeFxnBase_nClass, control=list(generate_predefined=TRUE)) +# +# generate new predef/modelBase_nC. Move to package and add +# "#include " to that file, +# after the declaration of modelBase_nClass. +nCompile(modelBase_nClass, control=list(generate_predefined=TRUE)) #nCompile(nodeFxnBase_nClass, nodeInstr_nClass, control=list(generate_predefined=TRUE)) -#nCompile(nodeInstr_nClass, calcInstr_nClass, modelBase_nClass, nodeFxnBase_nClass, calcInstrList_nC, control=list(generate_predefined=TRUE)) +#nCompile(nodeInstr_nClass, calcInstr_nClass, modelBase_nClass, nodeFxnBase_nClass, calcInstrList_nClass, control=list(generate_predefined=TRUE)) test_that("nimble model prototype works", { nodeVarInfo <- list(list(name = "x", nDim = 1), list(name = "mu", nDim = 1), @@ -18,8 +37,8 @@ test_that("nimble model prototype works", { return(ans) } ) - my_nodeFxn <- make_node_fun(nodeVarInfo, list(calc_one=calc_one), "test_node") - my_nodeInfo <- nCompiler:::make_node_info("beta_NF1", "my_nodeFxn", "test_node", nodeVarInfo) + my_nodeFxn <- make_node_nClass(nodeVarInfo, list(calc_one=calc_one), "test_node") + my_nodeInfo <- nCompiler:::make_node_info_for_model_nClass("beta_NF1", "my_nodeFxn", "test_node", nodeVarInfo) modelVarInfo <- list(list(name="x", nDim = 1), list(name = "mu", nDim = 1), @@ -29,7 +48,8 @@ test_that("nimble model prototype works", { ncm1 <- makeModel_nClass(modelVarInfo, list(my_nodeInfo), classname = "my_model") #undebug(nCompiler:::addGenericInterface_impl) #undebug(nCompiler:::nCompile_finish_nonpackage) - Cncm1 <- nCompile(modelBase_nClass, nodeFxnBase_nClass, calcInstrList_nC, calcInstr_nClass, nodeInstr_nClass, ncm1, my_nodeFxn) + Cncm1 <- nCompile(ncm1, returnList=TRUE) + #Cncm1 <- nCompile(modelBase_nClass, nodeFxnBase_nClass, calcInstrList_nClass, calcInstr_nClass, nodeInstr_nClass, ncm1, my_nodeFxn) obj <- Cncm1$ncm1$new() obj$do_setup_node_mgmt() @@ -57,8 +77,8 @@ test_that("nimble model prototype works", { }) test_that("nodeInstr_nClass and calcInstr_nClass basics work", { - test <- nCompile(nodeInstr_nClass, calcInstr_nClass, calcInstrList_nC, control=list(generate_predefined=TRUE)) - calcInstrList <- test$calcInstrList_nC$new() + test <- nCompile(nodeInstr_nClass, calcInstr_nClass, calcInstrList_nClass, control=list(generate_predefined=TRUE)) + calcInstrList <- test$calcInstrList_nClass$new() calcInstr <- test$calcInstr_nClass$new() expect_equal(calcInstr$nodeInstrVec, list()) ni1 <- test$nodeInstr_nClass$new() @@ -92,7 +112,8 @@ test_that("nimble model variables are set up", { modelVars <- varInfo$vars # Try making a model with no nodeFxns ncm1 <- makeModel_nClass(modelVars, list(), classname = "my_model") - Cncm1 <- nCompile(modelBase_nClass, nodeFxnBase_nClass, calcInstrList_nC, calcInstr_nClass, nodeInstr_nClass, ncm1) + Cncm1 <- nCompile(ncm1, returnList=TRUE) + #Cncm1 <- nCompile(modelBase_nClass, nodeFxnBase_nClass, calcInstrList_nClass, calcInstr_nClass, nodeInstr_nClass, ncm1) obj <- Cncm1$ncm1$new() obj$resize_from_list(varInfo$sizes) expect_equal(length(obj$x), 6) @@ -120,23 +141,25 @@ if(FALSE) { expect_true(!is.null(NFinternals(nFxn[[1]])$R_fun)) # uncompiled + Ctest <- nCompiler:::make_model_from_nimbleModel(m, compile=TRUE) + debugonce(nCompiler:::makeModel_nClass) test <- nCompiler:::make_model_from_nimbleModel(m, compile=FALSE) Robj <- test$new() NULL ## Compile - debugonce(nCompiler:::make_model_from_nimbleModel) + #debugonce(nCompiler:::make_model_from_nimbleModel) test <- nCompiler:::make_model_from_nimbleModel(m) -obj <- test$model$new() -obj$do_setup_node_mgmt() -vals <- list(x = 2:7, y = 11:15, sd = 8) -obj$set_from_list(vals) + obj <- test$model$new() + obj$do_setup_node_mgmt() + vals <- list(x = 2:7, y = 11:15, sd = 8) + obj$set_from_list(vals) -nodeFxn_2_nodeIndex <- c(nodeFxn_1 = 1, nodeFxn_3 = 2) + nodeFxn_2_nodeIndex <- c(nodeFxn_1 = 1, nodeFxn_3 = 2) -calcInputList <- list(list(nodeFxn="nodeFxn_1", # which declaration (nodeFxn) + calcInputList <- list(list(nodeFxn="nodeFxn_1", # which declaration (nodeFxn) nodeInputVec = list(list(methodInput=1, # which index iteration method indsInputVec=list(1))))) # input(s) to index iterations From f4719d36c6a45d67a13c22d6ccaad67a1956906c Mon Sep 17 00:00:00 2001 From: perrydv Date: Thu, 11 Dec 2025 09:30:26 +0100 Subject: [PATCH 3/5] clean up predefined Hincludes and some testing --- nCompiler/R/nimbleModels.R | 50 +++--- .../predef/calcInstrList_nC/.DS_Store | Bin 6148 -> 0 bytes .../calcInstrList_nClass_hContent.h | 2 +- .../calcInstrList_nClass_manifest.txt | 2 +- .../calcInstr_nC/calcInstr_nClass_hContent.h | 2 +- .../calcInstr_nClass_manifest.txt | 2 +- .../modelBase_nC/modelBase_nClass_hContent.h | 3 +- .../modelBase_nClass_manifest.txt | 2 +- .../nodeFxnBase_nClass_manifest.txt | 2 +- .../nodeInstr_nClass_manifest.txt | 2 +- .../testthat/nimble_tests/test-nimbleModel.R | 161 ++++++++++-------- 11 files changed, 126 insertions(+), 102 deletions(-) delete mode 100644 nCompiler/inst/include/nCompiler/predef/calcInstrList_nC/.DS_Store diff --git a/nCompiler/R/nimbleModels.R b/nCompiler/R/nimbleModels.R index 9fd3dfff..310290ff 100644 --- a/nCompiler/R/nimbleModels.R +++ b/nCompiler/R/nimbleModels.R @@ -38,7 +38,10 @@ calcInstr_nClass <- nClass( file.path("calcInstr_nC")), compileInfo=list(interface="full", createFromR = TRUE, - Hincludes = "", + # The Hincludes should be picked up automatically but I think it's not + # because it is in the nList type and that is not being scanned for needed nClasses. + # These do need to be in "" not <>, for case of nCompile(...., package=TRUE) + Hincludes = '"nodeInstr_nClass_c_.h"', # In the format here, needed_units is a list with either objects (nFunction or nClass (generators), # or names. If names, we will use scoping to look them up and decide what they are. # The list can mix objects and names of nClasses and nFunctions. @@ -56,7 +59,7 @@ calcInstrList_nClass <- nClass( file.path("calcInstrList_nC")), compileInfo=list(interface="full", createFromR = TRUE, - Hincludes = "", + Hincludes = '"calcInstr_nClass_c_.h"', exportName = "calcInstrList_nClass", needed_units = list("calcInstr_nClass") ) @@ -102,7 +105,7 @@ modelBase_nClass <- nClass( # This is where uncompiled stepping through the calcInstrList happens. for(calcInstr in calcInstrList$calcInstrList) { nodeIdx <- calcInstr$nodeIndex - nodemember_name <- self$get_nodeObjNames()[nodeIdx] + nodemember_name <- self$nodeObjNames[nodeIdx] # nodeObjNames is found in the derived class for(nodeInstr in calcInstr$nodeInstrVec) { self[[nodemember_name]]$calculate(nodeInstr) } @@ -121,7 +124,7 @@ modelBase_nClass <- nClass( predefined = quote(system.file(file.path("include","nCompiler", "predef"), package="nCompiler") |> file.path("modelBase_nC")), compileInfo=list(interface="full", createFromR = FALSE, - Hincludes = c("", ""), # do we need "" too? + Hincludes = c('"nodeFxnBase_nClass_c_.h"', '"calcInstrList_nClass_c_.h"'), # do we need "" too? needed_units = list("nodeFxnBase_nClass","calcInstrList_nClass"), #do we need nodeFxnBase_nClass here too? exportName = "modelBase_nClass" ) @@ -256,7 +259,8 @@ make_node_info_for_model_nClass <- function(membername, makeModel_nClass <- function(varInfo, nodes = list(), - classname + classname, + env = parent.frame() ) { # varInfo will be a list (names not used) of name, nDim, sizes. CpublicModelVars <- varInfo |> lapply(\(x) paste0("numericArray(nDim=",x$nDim,")")) @@ -319,10 +323,10 @@ makeModel_nClass <- function(varInfo, init_string = init_string, membername = x$membername) }) - nodeObjNames <- node_pieces |> lapply(\(x) x$membername) |> unlist() + nodeObjNames <- (node_pieces |> lapply(\(x) x$membername) |> unlist()) %||% character() # nodeObjNames also serves for canonical lookup of names by index. # e.g. nodeObjNames[i] gives the member name of the index=i node member. - nodeObjName_2_nodeIndex <- (1:length(nodeObjNames)) |> structure(names=nodeObjNames) + nodeObjName_2_nodeIndex <- seq_along(nodeObjNames) |> structure(names=nodeObjNames) # Inversely, nodeobjName_2_nodeIndex["node_3"] gives the index of that node. CpublicNodeFuns <- node_pieces |> lapply(\(x) x$nClass_type) |> setNames(nodeObjNames) # CpublicNodeFuns <- list( @@ -337,33 +341,26 @@ makeModel_nClass <- function(varInfo, ) ) |> structure(names = classname) initialize <- function(sizes = list(), inits = list()) { - browser() + # It is not very easy to set debug onto the initialize function, so + # here is a magic flag. + if(isTRUE(.GlobalEnv$.debugModelInit)) browser() if(isCompiled()) - self$setup_node_mgmt_from_names(nodeObjNames) + self$setup_node_mgmt_from_names(self$nodeObjNames) if(!isCompiled()) { - for(nodeObj in nodeObjNames) { - self[[nodeObj]] <- eval(as.name(CpublicNodeFuns[[nodeObj]]))$new() + for(nodeObj in self$nodeObjNames) { + self[[nodeObj]] <- eval(as.name(self$CpublicNodeFuns[[nodeObj]]))$new() self[[nodeObj]]$setModel(self) } } if(length(inits)) init_from_list(inits) else if(length(sizes)) resize_from_list(sizes) } - get_nodeObjNames <- function() { - return(nodeObjNames) - } - Rvars <- list( - # default_inits = list(), - # default_sizes = list() - ) baseclass <- paste0("modelClass_<", classname, ">") - env <- new.env(parent = parent.frame()) # CpublicNodeFuns has elements like "node_1 = quote(nodeFxn_1())" # We provide it in Cpublic to declare C++ member variables with types. - # We also place it in env so that we can look up for uncompiled execution + # 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. - env$CpublicNodeFuns <- CpublicNodeFuns ans <- substitute( nClass( classname = CLASSNAME, @@ -378,7 +375,12 @@ makeModel_nClass <- function(varInfo, env = env ), list(OPDEFS = opDefs, - RPUBLIC = list(initialize=initialize, get_nodeObjNames = get_nodeObjNames, Rvars = Rvars), + # A list of individual elements + RPUBLIC = list(initialize=initialize, + nodeObjNames = nodeObjNames, + nodeObjName_2_nodeIndex = nodeObjName_2_nodeIndex, + CpublicNodeFuns = CpublicNodeFuns), + # A concatenation of lists CPUBLIC = c(CpublicNodeFuns, CpublicModelVars, CpublicCtor, CpublicMethods), CLASSNAME = classname, BASECLASS = baseclass) @@ -388,7 +390,7 @@ makeModel_nClass <- function(varInfo, ## Get varInfo from new nimbleModel get_varInfo_from_nimbleModel <- function(model) { - mDef <- m$modelDef + mDef <- model$modelDef extract <- \(x) x |> lapply(\(x) list(name = x$varName, nDim = x$nDim)) vars <- mDef$varInfo |> extract() logProbVars <- mDef$logProbVarInfo |> extract() @@ -475,7 +477,7 @@ make_model_from_nimbleModel <- function(m, compile=FALSE) { # nodeFxnNames <- c(nodeFxnNames, nodeFxnName) } - model <- makeModel_nClass(modelVarInfo, nodeInfoList, classname = "my_model") + model <- makeModel_nClass(modelVarInfo, nodeInfoList, classname = "my_model", env = environment()) # Currently we must compile from here because here is where we know the nodeFxnName[s]. # We have a situation where order matters: model needs to come after the utility classes. Fix me. if(!compile) diff --git a/nCompiler/inst/include/nCompiler/predef/calcInstrList_nC/.DS_Store b/nCompiler/inst/include/nCompiler/predef/calcInstrList_nC/.DS_Store deleted file mode 100644 index 5008ddfcf53c02e82d7eee2e57c38e5672ef89f6..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 6148 zcmeH~Jr2S!425mzP>H1@V-^m;4Wg<&0T*E43hX&L&p$$qDprKhvt+--jT7}7np#A3 zem<@ulZcFPQ@L2!n>{z**++&mCkOWA81W14cNZlEfg7;MkzE(HCqgga^y>{tEnwC%0;vJ&^%eQ zLs35+`xjp>T0 -#include +#include "calcInstr_nClass_c_.h" class calcInstrList_nClass : public interface_resolver< genericInterfaceC >, public loadedObjectHookC { public: diff --git a/nCompiler/inst/include/nCompiler/predef/calcInstrList_nC/calcInstrList_nClass_manifest.txt b/nCompiler/inst/include/nCompiler/predef/calcInstrList_nC/calcInstrList_nClass_manifest.txt index 75bb4e0c..386bb12f 100644 --- a/nCompiler/inst/include/nCompiler/predef/calcInstrList_nC/calcInstrList_nClass_manifest.txt +++ b/nCompiler/inst/include/nCompiler/predef/calcInstrList_nC/calcInstrList_nClass_manifest.txt @@ -1,4 +1,4 @@ -list(saved_at = structure(1765363827.01894, class = c("POSIXct", +list(saved_at = structure(1765437409.8481, class = c("POSIXct", "POSIXt")), packet_name = "calcInstrList_nClass", elements = c("preamble", "cppContent", "hContent", "filebase", "post_cpp_compiler", "copyFiles" ), files = list(preamble = "calcInstrList_nClass_preamble.cpp", diff --git a/nCompiler/inst/include/nCompiler/predef/calcInstr_nC/calcInstr_nClass_hContent.h b/nCompiler/inst/include/nCompiler/predef/calcInstr_nC/calcInstr_nClass_hContent.h index 775b8639..01882273 100644 --- a/nCompiler/inst/include/nCompiler/predef/calcInstr_nC/calcInstr_nClass_hContent.h +++ b/nCompiler/inst/include/nCompiler/predef/calcInstr_nC/calcInstr_nClass_hContent.h @@ -6,7 +6,7 @@ #define R_NO_REMAP #endif #include -#include +#include "nodeInstr_nClass_c_.h" class calcInstr_nClass : public interface_resolver< genericInterfaceC >, public loadedObjectHookC { public: diff --git a/nCompiler/inst/include/nCompiler/predef/calcInstr_nC/calcInstr_nClass_manifest.txt b/nCompiler/inst/include/nCompiler/predef/calcInstr_nC/calcInstr_nClass_manifest.txt index c6c8c72b..7301701f 100644 --- a/nCompiler/inst/include/nCompiler/predef/calcInstr_nC/calcInstr_nClass_manifest.txt +++ b/nCompiler/inst/include/nCompiler/predef/calcInstr_nC/calcInstr_nClass_manifest.txt @@ -1,4 +1,4 @@ -list(saved_at = structure(1765361967.54755, class = c("POSIXct", +list(saved_at = structure(1765437403.89444, class = c("POSIXct", "POSIXt")), packet_name = "calcInstr_nClass", elements = c("preamble", "cppContent", "hContent", "filebase", "post_cpp_compiler", "copyFiles" ), files = list(preamble = "calcInstr_nClass_preamble.cpp", cppContent = "calcInstr_nClass_cppContent.cpp", diff --git a/nCompiler/inst/include/nCompiler/predef/modelBase_nC/modelBase_nClass_hContent.h b/nCompiler/inst/include/nCompiler/predef/modelBase_nC/modelBase_nClass_hContent.h index 20ff8c79..7ed58df4 100644 --- a/nCompiler/inst/include/nCompiler/predef/modelBase_nC/modelBase_nClass_hContent.h +++ b/nCompiler/inst/include/nCompiler/predef/modelBase_nC/modelBase_nClass_hContent.h @@ -6,8 +6,7 @@ #define R_NO_REMAP #endif #include -#include -#include +#include "nodeFxnBase_nClass_c_.h" #include "calcInstrList_nClass_c_.h" class modelBase_nClass : public interface_resolver< genericInterfaceC >, public loadedObjectHookC { diff --git a/nCompiler/inst/include/nCompiler/predef/modelBase_nC/modelBase_nClass_manifest.txt b/nCompiler/inst/include/nCompiler/predef/modelBase_nC/modelBase_nClass_manifest.txt index d0ed2d9b..11652f46 100644 --- a/nCompiler/inst/include/nCompiler/predef/modelBase_nC/modelBase_nClass_manifest.txt +++ b/nCompiler/inst/include/nCompiler/predef/modelBase_nC/modelBase_nClass_manifest.txt @@ -1,4 +1,4 @@ -list(saved_at = structure(1765369346.14219, class = c("POSIXct", +list(saved_at = structure(1765437502.8499, 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/nCompiler/inst/include/nCompiler/predef/nodeFxnBase_nC/nodeFxnBase_nClass_manifest.txt b/nCompiler/inst/include/nCompiler/predef/nodeFxnBase_nC/nodeFxnBase_nClass_manifest.txt index 5f1198c3..bc74c3a8 100644 --- a/nCompiler/inst/include/nCompiler/predef/nodeFxnBase_nC/nodeFxnBase_nClass_manifest.txt +++ b/nCompiler/inst/include/nCompiler/predef/nodeFxnBase_nC/nodeFxnBase_nClass_manifest.txt @@ -1,4 +1,4 @@ -list(saved_at = structure(1765362650.7249, class = c("POSIXct", +list(saved_at = structure(1765437416.01603, class = c("POSIXct", "POSIXt")), packet_name = "nodeFxnBase_nClass", elements = c("preamble", "cppContent", "hContent", "filebase", "post_cpp_compiler", "copyFiles" ), files = list(preamble = "nodeFxnBase_nClass_preamble.cpp", diff --git a/nCompiler/inst/include/nCompiler/predef/nodeInstr_nC/nodeInstr_nClass_manifest.txt b/nCompiler/inst/include/nCompiler/predef/nodeInstr_nC/nodeInstr_nClass_manifest.txt index 9ac5273f..3feecfbc 100644 --- a/nCompiler/inst/include/nCompiler/predef/nodeInstr_nC/nodeInstr_nClass_manifest.txt +++ b/nCompiler/inst/include/nCompiler/predef/nodeInstr_nC/nodeInstr_nClass_manifest.txt @@ -1,4 +1,4 @@ -list(saved_at = structure(1765361912.27661, class = c("POSIXct", +list(saved_at = structure(1765437397.73714, class = c("POSIXct", "POSIXt")), packet_name = "nodeInstr_nClass", elements = c("preamble", "cppContent", "hContent", "filebase", "post_cpp_compiler", "copyFiles" ), files = list(preamble = "nodeInstr_nClass_preamble.cpp", cppContent = "nodeInstr_nClass_cppContent.cpp", diff --git a/nCompiler/tests/testthat/nimble_tests/test-nimbleModel.R b/nCompiler/tests/testthat/nimble_tests/test-nimbleModel.R index a99e3f26..05be1500 100644 --- a/nCompiler/tests/testthat/nimble_tests/test-nimbleModel.R +++ b/nCompiler/tests/testthat/nimble_tests/test-nimbleModel.R @@ -6,36 +6,42 @@ library(testthat) # To update the set of predefined nClasses # generate new predef/nodeInstr_nC. Move that directly to package code inst/nCompiler/predef/nodeInstr_nC -nCompile(nodeInstr_nClass, control=list(generate_predefined=TRUE)) -# -# generate new predef/calcInstr_nC. Ditto: move directly to package code -nCompile(calcInstr_nClass, control=list(generate_predefined=TRUE)) -# -# generate new predef/calcInstrList_nC. Ditto: move directly to package code -nCompile(calcInstrList_nClass, control=list(generate_predefined=TRUE)) -# -# generate new predef/nodeFxnBase_nC. Move to package and add -# "#include " in the hContent -# after declaration of newFxnBase_nClass -nCompile(nodeFxnBase_nClass, control=list(generate_predefined=TRUE)) -# -# generate new predef/modelBase_nC. Move to package and add -# "#include " to that file, -# after the declaration of modelBase_nClass. -nCompile(modelBase_nClass, control=list(generate_predefined=TRUE)) -#nCompile(nodeFxnBase_nClass, nodeInstr_nClass, control=list(generate_predefined=TRUE)) -#nCompile(nodeInstr_nClass, calcInstr_nClass, modelBase_nClass, nodeFxnBase_nClass, calcInstrList_nClass, control=list(generate_predefined=TRUE)) +## nCompile(nodeInstr_nClass, control=list(generate_predefined=TRUE)) +## # +## # generate new predef/calcInstr_nC. Ditto: move directly to package code +## nCompile(calcInstr_nClass, control=list(generate_predefined=TRUE)) +## # +## # generate new predef/calcInstrList_nC. Ditto: move directly to package code +## nCompile(calcInstrList_nClass, control=list(generate_predefined=TRUE)) +## # +## # generate new predef/nodeFxnBase_nC. Move to package and add +## # "#include " in the hContent +## # after declaration of newFxnBase_nClass +## nCompile(nodeFxnBase_nClass, control=list(generate_predefined=TRUE)) +## # +## # generate new predef/modelBase_nC. Move to package and add +## # "#include " to that file, +## # after the declaration of modelBase_nClass. +## nCompile(modelBase_nClass, control=list(generate_predefined=TRUE)) +## #nCompile(nodeFxnBase_nClass, nodeInstr_nClass, control=list(generate_predefined=TRUE)) +## #nCompile(nodeInstr_nClass, calcInstr_nClass, modelBase_nClass, nodeFxnBase_nClass, calcInstrList_nClass, control=list(generate_predefined=TRUE)) test_that("nimble model prototype works", { nodeVarInfo <- list(list(name = "x", nDim = 1), list(name = "mu", nDim = 1), list(name = "sd", nDim = 0)) calc_one <- nFunction( name = "calc_one", - fun = function(inds = 'integerVector') { - returnType('numericScalar') - ans <- x[inds[1]] + fun = function(inds) { + ans <- model$x[inds[1]] return(ans) - } + }, + compileInfo = list( + C_fun = function(inds = 'integerVector') { + returnType('numericScalar') + ans <- x[inds[1]] + return(ans) + } + ) ) my_nodeFxn <- make_node_nClass(nodeVarInfo, list(calc_one=calc_one), "test_node") my_nodeInfo <- nCompiler:::make_node_info_for_model_nClass("beta_NF1", "my_nodeFxn", "test_node", nodeVarInfo) @@ -45,60 +51,69 @@ test_that("nimble model prototype works", { list(name = "sd", nDim = 0), list(name = "gamma", nDim = 2)) #debug(makeModel_nClass) - ncm1 <- makeModel_nClass(modelVarInfo, list(my_nodeInfo), classname = "my_model") + ncm1 <- makeModel_nClass(modelVarInfo, list(my_nodeInfo), classname = "my_model", env=environment()) #undebug(nCompiler:::addGenericInterface_impl) #undebug(nCompiler:::nCompile_finish_nonpackage) - Cncm1 <- nCompile(ncm1, returnList=TRUE) - #Cncm1 <- nCompile(modelBase_nClass, nodeFxnBase_nClass, calcInstrList_nClass, calcInstr_nClass, nodeInstr_nClass, ncm1, my_nodeFxn) - obj <- Cncm1$ncm1$new() - - obj$do_setup_node_mgmt() - nodeObj <- obj$beta_NF1 - obj$x <- 1:3 - expect_equal(obj$x, 1:3) - - obj$set_from_list(list(x = 10:11)) - # expect Problem msg: (alpha is not a field in the class) - obj$set_from_list(list(mu = 110, x = 11:20, alpha = 101)) - obj$mu - - obj$resize_from_list(list(x = 7)) - # expect Problem msg: - obj$resize_from_list(list(alpha = 5, mu = 3, gamma = c(2, 4))) - expect_equal(length(obj$mu), 3) - expect_equal(dim(obj$gamma), c(2, 4)) - obj$resize_from_list(list(x = 5, gamma = c(3, 5))) - expect_equal(length(obj$x), 5) - expect_equal(dim(obj$gamma), c(3, 5)) - - obj$x <- 11:15 - expect_equal(nodeObj$calc_one(c(3)), 13) - rm(obj, nodeObj); gc() + for(package in c(FALSE, TRUE)) { + Cncm1 <- nCompile(ncm1, returnList=TRUE, package=package) + #Cncm1 <- nCompile(modelBase_nClass, nodeFxnBase_nClass, calcInstrList_nClass, calcInstr_nClass, nodeInstr_nClass, ncm1, my_nodeFxn) + for(mode in c("uncompiled", "compiled")) { + if(mode=="compiled") { + obj <- Cncm1$ncm1$new() + } else { + obj <- ncm1$new() + } + # obj$do_setup_node_mgmt() + nodeObj <- obj$beta_NF1 + obj$x <- 1:3 + expect_equal(obj$x, 1:3) + + obj$set_from_list(list(x = 10:11)) + # expect Problem msg: (alpha is not a field in the class) + obj$set_from_list(list(mu = 110, x = 11:20, alpha = 101)) + obj$mu + + obj$resize_from_list(list(x = 7)) + # expect Problem msg: + obj$resize_from_list(list(alpha = 5, mu = 3, gamma = c(2, 4))) + expect_equal(length(obj$mu), 3) + expect_equal(dim(obj$gamma), c(2, 4)) + obj$resize_from_list(list(x = 5, gamma = c(3, 5))) + expect_equal(length(obj$x), 5) + expect_equal(dim(obj$gamma), c(3, 5)) + + obj$x <- 11:15 + expect_equal(nodeObj$calc_one(c(3)), 13) + rm(obj, nodeObj); gc() + } + } }) test_that("nodeInstr_nClass and calcInstr_nClass basics work", { - test <- nCompile(nodeInstr_nClass, calcInstr_nClass, calcInstrList_nClass, control=list(generate_predefined=TRUE)) - calcInstrList <- test$calcInstrList_nClass$new() - calcInstr <- test$calcInstr_nClass$new() - expect_equal(calcInstr$nodeInstrVec, list()) - ni1 <- test$nodeInstr_nClass$new() - ni2 <- test$nodeInstr_nClass$new() - ni1$methodInstr <- 1 - ni2$methodInstr <- 2 - ni1$indsInstrVec <- list(1:2, 3:4) - ni2$indsInstrVec <- list(11:12, 13:14) - calcInstr$nodeInstrVec <- list(ni1, ni2) - expect_true(length(calcInstr$nodeInstrVec)==2) - expect_identical(calcInstr$nodeInstrVec[[1]]$indsInstrVec, list(1:2, 3:4)) - expect_identical(calcInstr$nodeInstrVec[[2]]$indsInstrVec, list(11:12, 13:14)) - calcInstrList$calcInstrList <- list(calcInstr) - expect_equal(calcInstrList$calcInstrList, list(calcInstr)) - rm(calcInstrList, calcInstr, ni1, ni2); gc() + for(package in c(FALSE, TRUE)) { + test <- nCompile(nodeInstr_nClass, calcInstr_nClass, calcInstrList_nClass, control=list(generate_predefined=FALSE), package = package) + calcInstrList <- test$calcInstrList_nClass$new() + calcInstr <- test$calcInstr_nClass$new() + expect_equal(calcInstr$nodeInstrVec, list()) + ni1 <- test$nodeInstr_nClass$new() + ni2 <- test$nodeInstr_nClass$new() + ni1$methodInstr <- 1 + ni2$methodInstr <- 2 + ni1$indsInstrVec <- list(1:2, 3:4) + ni2$indsInstrVec <- list(11:12, 13:14) + calcInstr$nodeInstrVec <- list(ni1, ni2) + expect_true(length(calcInstr$nodeInstrVec)==2) + expect_identical(calcInstr$nodeInstrVec[[1]]$indsInstrVec, list(1:2, 3:4)) + expect_identical(calcInstr$nodeInstrVec[[2]]$indsInstrVec, list(11:12, 13:14)) + calcInstrList$calcInstrList <- list(calcInstr) + expect_equal(calcInstrList$calcInstrList, list(calcInstr)) + rm(calcInstrList, calcInstr, ni1, ni2); gc() + } }) ###### -## in the testing setup yet. +## This is somewhat redundant with the first test test_that("nimble model variables are set up", { library(nimbleModel) code <- quote({ @@ -111,7 +126,7 @@ test_that("nimble model variables are set up", { varInfo <- nCompiler:::get_varInfo_from_nimbleModel(m) modelVars <- varInfo$vars # Try making a model with no nodeFxns - ncm1 <- makeModel_nClass(modelVars, list(), classname = "my_model") + ncm1 <- makeModel_nClass(modelVars, list(), classname = "my_model", env = environment()) Cncm1 <- nCompile(ncm1, returnList=TRUE) #Cncm1 <- nCompile(modelBase_nClass, nodeFxnBase_nClass, calcInstrList_nClass, calcInstr_nClass, nodeInstr_nClass, ncm1) obj <- Cncm1$ncm1$new() @@ -120,6 +135,7 @@ test_that("nimble model variables are set up", { expect_equal(length(obj$y), 5) expect_equal(length(obj$logProb_y), 5) }) + ######## # nOptions(pause_after_writing_files=TRUE) # Try automating the whole model creation including nodeFxns @@ -145,6 +161,13 @@ if(FALSE) { debugonce(nCompiler:::makeModel_nClass) test <- nCompiler:::make_model_from_nimbleModel(m, compile=FALSE) Robj <- test$new() + Ctest <- nCompile(test) + Cobj <- Ctest$new() + rm(Cobj); gc() + + nOptions(showCompilerOutput=TRUE) + Ctest <- nCompile(test, package=TRUE) + Cobj <- Ctest$new() NULL ## Compile From b2de9e6984a90b5035caf2795dc4684820fa8ded Mon Sep 17 00:00:00 2001 From: perrydv Date: Thu, 11 Dec 2025 15:15:11 +0100 Subject: [PATCH 4/5] generate full set of calc_one, sim_one, calcDiff_one, getLogProb_one for both stochastic and deterministic --- nCompiler/R/all_utils.R | 47 +++- nCompiler/R/compile_aaa_operatorLists.R | 9 + nCompiler/R/compile_simpleTransformations.R | 7 + nCompiler/R/nimbleModels.R | 209 ++++++++++++++---- nCompiler/R/options.R | 3 +- .../testthat/nimble_tests/test-nimbleModel.R | 13 +- 6 files changed, 227 insertions(+), 61 deletions(-) diff --git a/nCompiler/R/all_utils.R b/nCompiler/R/all_utils.R index 64e18fd2..66c59d0a 100644 --- a/nCompiler/R/all_utils.R +++ b/nCompiler/R/all_utils.R @@ -3,7 +3,7 @@ ## labelFunctionMetaCreator is only called once, immediately below, to create labelFunctionCreator ## The outer layer allows allLabelFunctionCreators to be in the closure of every function returned ## by labelFunctionCreator. Each of those functions is registered as an element of allLableFunctionCreators. -## +## ## This scheme allows the function resetLabelFunctionCreators below to work simply, ## resetting the count to 1 for all of the label generators. ## @@ -48,9 +48,9 @@ modelLabelCreator <- labelFunctionCreator("model") # no longer documented in Rd # Generates a valid C++ name from an R Name -# +# # replaces [ ( $ and a few other symbols with underscores, and removes ] ) and spaces in a string -# +# # @param rName A String # @return returns a string representing the modified rName # @author Jagadish Babu @@ -74,9 +74,9 @@ Rname2CppName <- function(rName, colonsOK = TRUE) { paste(rName[grepl(':', rName)], collapse=', '))) } rName <- gsub(' ', '', rName) - rName <- gsub('\\.', '_dot_', rName) + rName <- gsub('\\.', '_dot_', rName) rName <- gsub("\"", "_quote_", rName) - rName <- gsub(',', '_comma_', rName) + rName <- gsub(',', '_comma_', rName) rName <- gsub("`", "_backtick_" , rName) rName <- gsub('\\[', '_oB', rName) rName <- gsub('\\]', '_cB', rName) @@ -105,7 +105,7 @@ Rname2CppName <- function(rName, colonsOK = TRUE) { rName <- gsub('\\^', '_tothe_', rName) rName <- gsub('^_+', '', rName) # remove leading underscores. can arise from (a+b), for example rName <- gsub('^([[:digit:]])', 'd\\1', rName) # if begins with a digit, add 'd' in front - rName + rName } ## This takes a character vector as the first argument and length-1 @@ -138,7 +138,7 @@ pasteSemicolon <- function(x, indent = '') { stop(paste0('Error, pasteSemicolon called for object of class ', class(x), '. Must be character or list.'), - call. = FALSE) + call. = FALSE) } #' Write unlisted code generated from.nCompiler cpp definitions. @@ -183,3 +183,36 @@ is.blank <- function(arg) { if(is.null(arg)) return(FALSE) return(identical(arg, quote(x[])[[3]])) } + + +# Modified from nimble, including comments +# simply adds width.cutoff = 500 as the default to deal with creation of long variable names from expressions +# The control list is the default plus "digits17", which is the only one done in nimble. +# We need to deparse lists (e.g. in build_compiled_nClass) and have the names in the deparsed result. +# I think "niceNames" does that, possibly "showAttributes" too. +deparse <- function(...) { + control <- c("keepNA", "keepInteger", "niceNames", "showAttributes", "digits17") + if("width.cutoff" %in% names(list(...))) { + base::deparse(..., control = control) + } else { + base::deparse(..., width.cutoff = 500L, control = control) + } +} + +## This version of deparse avoids splitting into multiple lines, which generally would lead to +## problems. We keep the original nimble:::deparse above as deparse is widely used and there +## are cases where not modifying the nlines behavior may be best. +safeDeparse <- function(..., warn = FALSE) { + out <- deparse(...) + if(isTRUE(get_nOption('useSafeDeparse'))) { + dotArgs <- list(...) + if("nlines" %in% names(dotArgs)) + nlines <- dotArgs$nlines else nlines <- 1L + if(nlines != -1L && length(out) > nlines) { + if(warn) + message(" [Note] safeDeparse: truncating deparse output to ", nlines, " line", if(nlines>1) "s" else "") + out <- out[1:nlines] + } + } + return(out) +} diff --git a/nCompiler/R/compile_aaa_operatorLists.R b/nCompiler/R/compile_aaa_operatorLists.R index b819e3e8..0cac8c90 100644 --- a/nCompiler/R/compile_aaa_operatorLists.R +++ b/nCompiler/R/compile_aaa_operatorLists.R @@ -507,6 +507,15 @@ assignOperatorDef( updateOperatorDef('max', 'cppOutput', 'cppString', 'maximum') updateOperatorDef('min', 'cppOutput', 'cppString', 'minimum') +assignOperatorDef( + 'invisible', + list( + simpleTransformations = list( + handler = 'RemoveLayer' + ) + ) +) + assignOperatorDef( c('pairmin', 'pairmax'), list( diff --git a/nCompiler/R/compile_simpleTransformations.R b/nCompiler/R/compile_simpleTransformations.R index 2598bfa6..e6be1a75 100644 --- a/nCompiler/R/compile_simpleTransformations.R +++ b/nCompiler/R/compile_simpleTransformations.R @@ -55,6 +55,13 @@ simpleTransformationsEnv$minMax <- if(length(code$args) == 2) code$name <- paste0('pair',code$name) } +## Used e.g. for invisible(foo(x)) --> foo(x) +simpleTransformationsEnv$RemoveLayer <- + function(code, symTab, auxEnv, info) { + removeExprClassLayer(code) + } + + simpleTransformationsEnv$replace <- function(code, symTab, auxEnv, info) { repl <- info$replacement diff --git a/nCompiler/R/nimbleModels.R b/nCompiler/R/nimbleModels.R index 310290ff..173b879b 100644 --- a/nCompiler/R/nimbleModels.R +++ b/nCompiler/R/nimbleModels.R @@ -184,17 +184,21 @@ make_node_nClass <- function(varInfo = list(), type="double", nDim=x$nDim, name="", isRef=TRUE, isConst=FALSE, interface=FALSE) # In future maybe isConst=TRUE, but it might not matter much symbolList <- varInfo |> lapply(varInfo_2_symbol) names(symbolList) <- varInfo |> lapply(\(x) x$name) |> unlist() + numVars <- length(varInfo) CpublicVars <- names(symbolList) |> lapply(\(x) eval(substitute(quote(T(symbolList$NAME)), list(NAME=as.name(x))))) names(CpublicVars) <- names(symbolList) - - ctorArgNames <- paste0(names(symbolList), '_') - # List used when generating C++ constructor code to allow direct initializers, necessary for references. - initializersList <- paste0(names(symbolList), '(', ctorArgNames ,')') initFun <- function(){} - formals(initFun) <- structure(as.pairlist(CpublicVars), names = ctorArgNames) - + + if(numVars > 0) { + ctorArgNames <- paste0(names(symbolList), '_') + # List used when generating C++ constructor code to allow direct initializers, necessary for references. + initializersList <- paste0(names(symbolList), '(', ctorArgNames ,')') + formals(initFun) <- structure(as.pairlist(CpublicVars), names = ctorArgNames) + } else { + initializersList <- character() + } if(missing(classname)) classname <- nodeFxnLabelCreator() @@ -260,6 +264,8 @@ make_node_info_for_model_nClass <- function(membername, makeModel_nClass <- function(varInfo, nodes = list(), classname, + sizes = list(), + inits = list(), env = parent.frame() ) { # varInfo will be a list (names not used) of name, nDim, sizes. @@ -352,8 +358,16 @@ makeModel_nClass <- function(varInfo, self[[nodeObj]]$setModel(self) } } + + # First expand any provided or default sizes + # To-Do possibly merge the argument sizes and defaultSizes by element. + if(missing(sizes)) sizes <- self$defaultSizes + if(length(sizes)) resize_from_list(sizes) + + # Then any provided inits over-ride any provided sizes + # To-Do: Ditto + if(missing(inits)) inits <- self$defaultInits if(length(inits)) init_from_list(inits) - else if(length(sizes)) resize_from_list(sizes) } baseclass <- paste0("modelClass_<", classname, ">") # CpublicNodeFuns has elements like "node_1 = quote(nodeFxn_1())" @@ -379,6 +393,8 @@ makeModel_nClass <- function(varInfo, RPUBLIC = list(initialize=initialize, nodeObjNames = nodeObjNames, nodeObjName_2_nodeIndex = nodeObjName_2_nodeIndex, + defaultSizes = sizes, + defaultInits = inits, CpublicNodeFuns = CpublicNodeFuns), # A concatenation of lists CPUBLIC = c(CpublicNodeFuns, CpublicModelVars, CpublicCtor, CpublicMethods), @@ -405,7 +421,104 @@ get_varInfo_from_nimbleModel <- function(model) { ) } -make_nodeFxn_from_declInfo <- function(declInfo) { +# make_stoch_calculate <- function(LHSrep, RHSrep, logProbExprRep) { +# lenRHS <- length(RHSrep) +# if(length(RHS) > 1) { +# RHSrep[3:(lenRHS+1)] <- RHSrep[2:lenRHS] +# names(RHSrep)[3:(lenRHS+1)] <- names(RHSrep)[2:lenRHS] +# } +# RHSrep[[2]] <- LHSrep +# names(RHSrep)[2] <- "" +# RHSrep[[lenRHS+2]] <- 1 +# names(RHSrep)[lenRHS+2] <- "log" +# # We create separate code for R and C execution. +# calc1Cfun <- substitute( +# function(idx) {LHS <- RHS; return(LHS)}, +# list(LHS = logProbExprRep, RHS = RHSrep) +# ) |> eval() +# make_calculate_from_Cfun(calc1Cfun) +# } + +make_stoch_sim_line <- function(LHSrep, RHSrep) { + BUGSdistName <- safeDeparse(RHSrep[[1]]) + distInfo <- getDistributionInfo(BUGSdistName) + sim_code <- as.name(distInfo$simulateName) + if(is.null(sim_code)) stop("Could not find simulation ('r') function for ", BUGSdistName) + RHSrep[[1]] <- sim_code + # scoot all named arguments right 1 position + if(length(RHSrep) > 1) { + for(i in (length(RHSrep)+1):3) { + RHSrep[i] <- RHSrep[i-1] + names(RHSrep)[i] <- names(RHSrep)[i-1] + } + } + RHSrep[[2]] <- 1 + names(RHSrep)[2] <- '' + sim_line <- substitute( + LHS <- RHS, + list(LHS = LHSrep, RHS = RHSrep)) + sim_line +} + +make_stoch_calc_line <- function(LHSrep, RHSrep, logProbExprRep, diff = FALSE) { + lenRHS <- length(RHSrep) + if(length(RHSrep) > 1) { + RHSrep[3:(lenRHS+1)] <- RHSrep[2:lenRHS] + names(RHSrep)[3:(lenRHS+1)] <- names(RHSrep)[2:lenRHS] + } + RHSrep[[2]] <- LHSrep + names(RHSrep)[2] <- "" + RHSrep[[lenRHS+2]] <- 1 + names(RHSrep)[lenRHS+2] <- "log" + # We create separate code for R and C execution. + if(!diff) { + calc_line <- substitute( + LHS <- RHS, + list(LHS = logProbExprRep, RHS = RHSrep)) + } else { + calc_line <- substitute( + LocalNewLogProb_ <- RHS, + list(RHS = RHSrep)) + } + calc_line +} + +make_determ_calc_line <- function(LHSrep, RHSrep) { + calc_line <- substitute( + LHS <- RHS, + list(LHS = LHSrep, RHS = RHSrep)) + calc_line +} + +make_nFxn_from_Cfun <- function(Cfun) { + Rfun <- Cfun + body(calc1Rfun) <- nm_addModelDollarSign(body(Cfun), exceptionNames = c("idx")) + nFxn <- nFunction( + name = "calc_one", + fun = Rfun, + compileInfo=list(C_fun=Cfun), + argTypes = list(idx = 'integerVector'), + returnType = 'numericScalar') + #nodeVars <- all.vars(body(calc1Cfun)) |> setdiff("idx") + nFxn +} + +make_node_method_nFxn <- function(f, name, returnType='numericScalar') { + Cfun <- f + Rfun <- f + body(Rfun) <- nm_addModelDollarSign(body(f), exceptionNames = c("idx", "LocalNewLogProb_", "LocalAns_")) + if(is.null(returnType)) returnType <- 'void' + nFxn <- nFunction( + name = name, + fun = Rfun, + argTypes = list(idx = 'integerVector'), + returnType = returnType, + compileInfo=list(C_fun=Cfun), + ) + nFxn +} + +make_node_methods_from_declInfo <- function(declInfo) { # pieces are adapted from Chris' code in nimbleModel and/or old nimble. # # This function creates a calc_one nFunction that calculates single index case. @@ -415,38 +528,50 @@ make_nodeFxn_from_declInfo <- function(declInfo) { LHS <- modelCode[[2]] RHS <- modelCode[[3]] type <- if(modelCode[[1]]=="~") "stoch" else "determ" # or use declInfo$stoch (logical) - logProbExpr <- declInfo$genLogProbExpr() context <- declInfo$declRule$context replacements <- sapply(seq_along(context$singleContexts), function(i) parse(text = paste0('idx[',i,']'))[[1]]) names(replacements) <- context$indexVarNames LHSrep <- eval(substitute(substitute(e, replacements), list(e = LHS))) RHSrep <- eval(substitute(substitute(e, replacements), list(e = RHS))) - logProbExprRep <- eval(substitute(substitute(e, replacements), list(e = logProbExpr))) - lenRHS <- length(RHSrep) - if(length(RHS) > 1) { - RHSrep[3:(lenRHS+1)] <- RHSrep[2:lenRHS] - names(RHSrep)[3:(lenRHS+1)] <- names(RHSrep)[2:lenRHS] + + if(type == 'determ') { + methodList <- eval(substitute( + list( + sim_one = (function(idx) {calc_one(idx)}) |> + make_node_method_nFxn("sim_one", NULL), + calc_one = (function(idx) {DETERMCALC; return(invisible(0))}) |> + make_node_method_nFxn("calc_one"), + calcDiff_one = (function(idx) {calc_one(idx);return(invisible(0))}) |> + make_node_method_nFxn("calcDiff_one"), + getLogProb_one = (function(idx) {return(0)}) |> + make_node_method_nFxn("getLogProb_one") + ), + list(DETERMCALC = make_determ_calc_line(LHSrep, RHSrep)) + )) + } + if(type == 'stoch') { + logProbExpr <- declInfo$genLogProbExpr() + logProbExprRep <- eval(substitute(substitute(e, replacements), list(e = logProbExpr))) + methodList <- eval(substitute( + list( + sim_one = (function(idx) { STOCHSIM }) |> + make_node_method_nFxn("sim_one", NULL), + calc_one = (function(idx) { STOCHCALC; return(invisible(LOGPROB)) }) |> + make_node_method_nFxn("calc_one"), + calcDiff_one = (function(idx) {STOCHCALC_DIFF; LocalAns_ <- LocalNewLogProb_ - LOGPROB; + LOGPROB <- LocalNewLogProb_; return(invisible(LocalAns_))}) |> + make_node_method_nFxn("calcDiff_one"), + getLogProb_one = (function(idx) { return(LOGPROB) }) |> + make_node_method_nFxn("getLogProb_one") + ), + list( LOGPROB = logProbExprRep, + STOCHSIM = make_stoch_sim_line(LHSrep, RHSrep), + STOCHCALC = make_stoch_calc_line(LHSrep, RHSrep, logProbExprRep), + STOCHCALC_DIFF = make_stoch_calc_line(LHSrep, RHSrep, logProbExprRep, diff=TRUE)) + )) } - RHSrep[[2]] <- LHSrep - names(RHSrep)[2] <- "" - RHSrep[[lenRHS+2]] <- 1 - names(RHSrep)[lenRHS+2] <- "log" - # We create separate code for R and C execution. - calc1Cfun <- substitute( - function(idx) {LHS <- RHS; return(LHS)}, - list(LHS = logProbExprRep, RHS = RHSrep) - ) |> eval() - calc1Rfun <- calc1Cfun - body(calc1Rfun) <- nm_addModelDollarSign(body(calc1Cfun), exceptionNames = c("idx")) - calc_one <- nFunction( - name = "calc_one", - fun = calc1Rfun, - compileInfo=list(C_fun=calc1Cfun), - argTypes = list(idx = 'integerVector'), - returnType = 'numericScalar') - nodeVars <- all.vars(body(calc1Cfun)) |> setdiff("idx") - list(calc_one = calc_one, nodeVars = nodeVars) + methodList } make_model_from_nimbleModel <- function(m, compile=FALSE) { @@ -460,35 +585,25 @@ make_model_from_nimbleModel <- function(m, compile=FALSE) { # to move between names and indices of nodeFxns: for(i in seq_along(mDef$declInfo)) { declInfo <- mDef$declInfo[[i]] - nodeFxn <- make_nodeFxn_from_declInfo(declInfo) - nodeVars <- nodeFxn$nodeVars - calc_one <- nodeFxn$calc_one + node_methods <- make_node_methods_from_declInfo(declInfo) + nodeVars <- node_methods |> lapply(\(x) all.vars(body(x))) |> unlist() |> unique() |> setdiff(c("idx", "LocalNewLogProb_", "LocalAns_", "model")) %||% character() + nodeVarInfo <- modelVarInfo[nodeVars] SLN <- declInfo$sourceLineNumber node_classname <- paste0("nodeClass_", SLN) # name of an nClass generator node_RvarName <- paste0("nodeFxn_", SLN) # name of an R variable holding the nClass generator node_membername <- paste0("node_", SLN) # name of model member variable holding an instance of the nClass - nodeVarInfo <- modelVarInfo[nodeVars] # Currently, we can't just make a list of these but need them as named objects in the environment - nodeFxnList[[node_RvarName]] <- make_node_nClass(nodeVarInfo, list(calc_one=calc_one), node_classname) + nodeFxnList[[node_RvarName]] <- make_node_nClass(nodeVarInfo, node_methods, node_classname) assign(node_RvarName, nodeFxnList[[node_RvarName]] ) nodeInfoList[[i]] <- nCompiler:::make_node_info_for_model_nClass(node_membername, node_RvarName, node_classname, nodeVarInfo) -# nodeFxnNames <- c(nodeFxnNames, nodeFxnName) - } model <- makeModel_nClass(modelVarInfo, nodeInfoList, classname = "my_model", env = environment()) - # Currently we must compile from here because here is where we know the nodeFxnName[s]. - # We have a situation where order matters: model needs to come after the utility classes. Fix me. if(!compile) return(model) Cmodel <- nCompile(model) return(Cmodel) -# argList <- list("modelBase_nClass", "nodeFxnBase_nClass", "calcInstrList_nClass", "calcInstr_nClass", "nodeInstr_nClass", "model") -# argList <- c(argList, "nodeFxnList") -# argList <- argList |> lapply(as.name) -# Cmodel <- do.call("nCompile", argList) - #Cncm1 <- nCompile(modelBase_nClass, nodeFxnBase_nClass, calcInstr_nClass, nodeInstr_nClass, ncm1, nodeFxn_3) } calcInputList_to_calcInstrList <- function(calcInputList, comp) { diff --git a/nCompiler/R/options.R b/nCompiler/R/options.R index 18e4ad05..8f3cbefc 100644 --- a/nCompiler/R/options.R +++ b/nCompiler/R/options.R @@ -51,7 +51,8 @@ updateDefaults <- function(defaults, control) { verbose = FALSE, sourceCpp_verbose = FALSE, nimble = FALSE, ## ensure all backward compatibility - dropSingleSizes = FALSE ## backward compatibility + dropSingleSizes = FALSE, ## backward compatibility + useSafeDeparse = TRUE ) ) diff --git a/nCompiler/tests/testthat/nimble_tests/test-nimbleModel.R b/nCompiler/tests/testthat/nimble_tests/test-nimbleModel.R index 05be1500..e49b4c85 100644 --- a/nCompiler/tests/testthat/nimble_tests/test-nimbleModel.R +++ b/nCompiler/tests/testthat/nimble_tests/test-nimbleModel.R @@ -145,6 +145,7 @@ if(FALSE) { code <- quote({ sd ~ dunif(0, 10) for(i in 1:5) { + z[i] <- x[i+1] + 10 y[i] ~ dnorm(x[i+1], sd = sd) } }) @@ -153,22 +154,22 @@ if(FALSE) { ## Check that a separate R implementation was created mDef_ <- m$modelDef dI <- mDef_$declInfo[[2]] - nFxn <- nCompiler:::make_nodeFxn_from_declInfo(dI) + nFxn <- nCompiler:::make_node_methods_from_declInfo(dI) + expect_true(!is.null(NFinternals(nFxn[[1]])$R_fun)) + dI <- mDef_$declInfo[[3]] + nFxn <- nCompiler:::make_node_methods_from_declInfo(dI) expect_true(!is.null(NFinternals(nFxn[[1]])$R_fun)) # uncompiled +# debugonce(nCompiler:::make_model_from_nimbleModel) Ctest <- nCompiler:::make_model_from_nimbleModel(m, compile=TRUE) - debugonce(nCompiler:::makeModel_nClass) +# debugonce(nCompiler:::makeModel_nClass) test <- nCompiler:::make_model_from_nimbleModel(m, compile=FALSE) Robj <- test$new() Ctest <- nCompile(test) Cobj <- Ctest$new() rm(Cobj); gc() - nOptions(showCompilerOutput=TRUE) - Ctest <- nCompile(test, package=TRUE) - Cobj <- Ctest$new() - NULL ## Compile #debugonce(nCompiler:::make_model_from_nimbleModel) From a760443bea30755e406febc6c10b53693474c29b Mon Sep 17 00:00:00 2001 From: perrydv Date: Fri, 12 Dec 2025 10:19:53 +0100 Subject: [PATCH 5/5] clean up test-nimbleModel for current status --- nCompiler/inst/include/nCompiler/.DS_Store | Bin 6148 -> 6148 bytes .../testthat/nimble_tests/test-nimbleModel.R | 51 +++++++++--------- .../test-nList.R | 0 3 files changed, 26 insertions(+), 25 deletions(-) rename nCompiler/tests/testthat/{nCompile_tests => specificOp_tests}/test-nList.R (100%) diff --git a/nCompiler/inst/include/nCompiler/.DS_Store b/nCompiler/inst/include/nCompiler/.DS_Store index 05966eb2d53c314563c92a26776a79da17d468a6..d96ea5aea431a89692a097693d2bb0eec518e3bb 100644 GIT binary patch delta 316 zcmZoMXfc=|#>B`mu~2NHo}wrd0|Nsi1A_nqLn=dBQh9MfQcix-#EZ)(8;G#fvoRDf z6aghtkR^c{wkH+jWEPhg7+hmyVrF4wW9MM!;O2-8&d4thE=epYEp|#QiU#pQ^7C_& zVC=-Cu*}r*cmWaT{JfIH%)Hbhu!hW(RG^ZW@XWlF{Bo!K(!7*nu-@RzT(ArWCkJP| zfOvJaxv`Fdp>eH_Lbai(xuuSRsgY%EEhmSlvc7dte0EN5UVbOgZ9u>X^bi>ELTMP) z1!SQ3sVulCFDE}Q9VpJY@gfh~W_AvK4q)JHy!f4YGQWr+2gsxbAl~dDvWFP}eI`-4 delta 136 zcmZoMXfc=|#>CJ*u~2NHo}wrt0|NsP3otO`F@!Lr0?A^A{E3C?mLLf+23LkmhIFtn zT#})PAs#4F!B7HKp2?68(w0)3oRgHFpR<{fiH&Wu0Fy1_W_AvK4xm*)k?+it`9%yF P87ABCNN