diff --git a/nCompiler/NAMESPACE b/nCompiler/NAMESPACE index 664cb3ec..9eddedec 100644 --- a/nCompiler/NAMESPACE +++ b/nCompiler/NAMESPACE @@ -7,6 +7,9 @@ export(NCinternals) export(NFinternals) export(argType2Cpp) export(build_compiled_nClass) +export(calcInputList_to_calcInstrList) +export(calcInstr_nClass) +export(calcInstrList_nClass) export(cloglog) export(check_Rcpp_for_nCompiler) export(compileNimble) @@ -80,6 +83,8 @@ export(nInteger) export(nList) export(nLogical) export(nMatrix) +export(nodeFxnBase_nClass) +export(nodeInstr_nClass) export(nArray) export(nOptions) export(nParse) diff --git a/nCompiler/R/NC_Compile.R b/nCompiler/R/NC_Compile.R index ac8ad828..1af62743 100644 --- a/nCompiler/R/NC_Compile.R +++ b/nCompiler/R/NC_Compile.R @@ -48,8 +48,18 @@ nCompile_nClass <- function(NC, is_predefined <- !isFALSE(NCinternals(NC)$predefined) if(is_predefined) { predefined_dir <- NCinternals(NC)$predefined + # predefined can be character, quoted expression, or function. + # The latter two allow delayed evaluation, useful if an nClass is defined + # in an R package and the predefined argument should not get build-system + # paths baked in but rather delay until evaluation on the when running. + if(is.call(predefined_dir)) { + predefined_dir <- eval(predefined_dir, envir = NCinternals(NC)$env) + } + if(is.function(predefined_dir)) { + predefined_dir <- predefined_dir() + } if(!is.character(predefined_dir)) - stop("There is a predefined nClass whose predefined field is not character. ", + stop("There is a predefined nClass whose predefined field is not (and does not evaluate to) character. ", "It should give the directory path of the predefined nClass. ", "The classname argument to nClass gives the base for filenames in that directory.") regular_filename <- NCinternals(NC)$cpp_classname @@ -71,8 +81,11 @@ nCompile_nClass <- function(NC, ## Get the cppDef cppDef <- NC_Compiler$cppDef if(is_predefined) { + predefined_gen_dir <- NCinternals(NC)$compileInfo$predefined_output_dir + if(is.null(predefined_gen_dir)) + predefined_gen_dir <- predefined_dir RcppPacket <- cppDefs_2_RcppPacket(cppDef) - saveRcppPacket(RcppPacket, predefined_dir, regular_filename) + saveRcppPacket(RcppPacket, predefined_gen_dir, regular_filename) # Now add interface calls if necessary for this live compilation, having # kept them out of the written packet code. cppDef$buildGenericInterface(interfaceCalls=TRUE, interface=FALSE) diff --git a/nCompiler/R/NC_InternalsClass.R b/nCompiler/R/NC_InternalsClass.R index 885d22c8..f5e64371 100644 --- a/nCompiler/R/NC_InternalsClass.R +++ b/nCompiler/R/NC_InternalsClass.R @@ -24,7 +24,7 @@ NC_InternalsClass <- R6::R6Class( isOnlyC = FALSE, ## somewhat redundant but perhaps convenient - TBD. enableDerivs = NULL, enableSaving = NULL, - predefined = FALSE, + predefined = FALSE, # directory for reading and (default) writing predefined nClass saved RcppPacket. Writing location can be over-ridden by compileInfo$predefined_output_dir inheritNCinternals = NULL, env = NULL, inheritQ = NULL, diff --git a/nCompiler/R/NF_Compile.R b/nCompiler/R/NF_Compile.R index 7b414643..75e83006 100644 --- a/nCompiler/R/NF_Compile.R +++ b/nCompiler/R/NF_Compile.R @@ -60,8 +60,18 @@ nCompile_nFunction <- function(NF, is_predefined <- !isFALSE(NFinternals(NF)$predefined) if(is_predefined) { predefined_dir <- NFinternals(NF)$predefined + # predefined can be character, quoted expression, or function. + # The latter two allow delayed evaluation, useful if an nClass is defined + # in an R package and the predefined argument should not get build-system + # paths baked in but rather delay until evaluation on the when running. + if(is.call(predefined_dir)) { + predefined_dir <- eval(predefined_dir, envir = NFinternals(NF)$where) + } + if(is.function(predefined_dir)) { + predefined_dir <- predefined_dir() + } if(!is.character(predefined_dir)) - stop("There is a predefined nFunction whose predefined field is not character. ", + stop("There is a predefined nFunction whose predefined field is not (and does not evaluate to) character. ", "It should give the directory path of the predefined nFunction. ", "The name argument to nFunction gives the base for filenames in that directory.") regular_filename <- NFinternals(NF)$cpp_code_name @@ -83,6 +93,9 @@ nCompile_nFunction <- function(NF, return(NF_Compiler) } if(is_predefined) { + predefined_gen_dir <- NFinternals(NF)$compileInfo$predefined_output_dir + if(is.null(predefined_gen_dir)) + predefined_gen_dir <- predefined_dir RcppPacket <- cppDefs_2_RcppPacket(NF_Compiler$cppDef) saveRcppPacket(RcppPacket, predefined_dir, regular_filename) } diff --git a/nCompiler/R/NF_InternalsClass.R b/nCompiler/R/NF_InternalsClass.R index b6f8ef5a..bb99c33d 100644 --- a/nCompiler/R/NF_InternalsClass.R +++ b/nCompiler/R/NF_InternalsClass.R @@ -26,7 +26,7 @@ NF_InternalsClass <- R6::R6Class( # needed_nFunctions = list(), ## formerly neededRCfuns ADcontent = NULL, isAD = FALSE, - predefined = FALSE, + predefined = FALSE, # Location for reading and (default) writing predefined nFunction saved RcppPacket. Writing location can be over-ridden by compileInfo$predefined_output_dir compileInfo = list(), R_fun = NULL, #used only if compileInfo$C_fun is provided. ## Next two "includes" were only needed for making external calls: diff --git a/nCompiler/R/Rcpp_nCompiler.R b/nCompiler/R/Rcpp_nCompiler.R index 7ac73934..78b7ed54 100644 --- a/nCompiler/R/Rcpp_nCompiler.R +++ b/nCompiler/R/Rcpp_nCompiler.R @@ -489,11 +489,11 @@ saveRcppPacket <- function(RcppPacket, dir, name = NULL) { if (all(c("opener", "body") %in% names(content))) { # Write as separate sections con <- file(filepath, "w") - writeLines("### OPENER ###", con) + writeLines("/* OPENER (Do not edit this comment) */", con) if (length(content$opener) > 0) { writeLines(content$opener, con) } - writeLines("### BODY ###", con) + writeLines("/* BODY (Do not edit this comment) */", con) if (length(content$body) > 0) { writeLines(content$body, con) } @@ -509,9 +509,9 @@ saveRcppPacket <- function(RcppPacket, dir, name = NULL) { } # Write each element to its own file - writePacketElement(RcppPacket$preamble, paste0(name, "_preamble.txt")) - writePacketElement(RcppPacket$cppContent, paste0(name, "_cppContent.txt")) - writePacketElement(RcppPacket$hContent, paste0(name, "_hContent.txt")) + writePacketElement(RcppPacket$preamble, paste0(name, "_preamble.cpp")) + writePacketElement(RcppPacket$cppContent, paste0(name, "_cppContent.cpp")) + writePacketElement(RcppPacket$hContent, paste0(name, "_hContent.h")) writePacketElement(RcppPacket$filebase, paste0(name, "_filebase.txt")) writePacketElement(RcppPacket$post_cpp_compiler, paste0(name, "_post_cpp_compiler.txt")) writePacketElement(RcppPacket$copyFiles, paste0(name, "_copyFiles.txt")) @@ -522,9 +522,9 @@ saveRcppPacket <- function(RcppPacket, dir, name = NULL) { packet_name = name, elements = names(RcppPacket), files = list( - preamble = paste0(name, "_preamble.txt"), - cppContent = paste0(name, "_cppContent.txt"), - hContent = paste0(name, "_hContent.txt"), + preamble = paste0(name, "_preamble.cpp"), + cppContent = paste0(name, "_cppContent.cpp"), + hContent = paste0(name, "_hContent.h"), filebase = paste0(name, "_filebase.txt"), post_cpp_compiler = paste0(name, "_post_cpp_compiler.txt"), copyFiles = paste0(name, "_copyFiles.txt") @@ -568,9 +568,9 @@ loadRcppPacket <- function(dir, name) { } else { warning("No manifest file found. Attempting to load standard files.") manifest <- list(files = list( - preamble = paste0(name, "_preamble.txt"), - cppContent = paste0(name, "_cppContent.txt"), - hContent = paste0(name, "_hContent.txt"), + preamble = paste0(name, "_preamble.cpp"), + cppContent = paste0(name, "_cppContent.cpp"), + hContent = paste0(name, "_hContent.h"), filebase = paste0(name, "_filebase.txt"), post_cpp_compiler = paste0(name, "_post_cpp_compiler.txt"), copyFiles = paste0(name, "_copyFiles.txt") @@ -597,10 +597,10 @@ loadRcppPacket <- function(dir, name) { } # Check if it's a structured file (cppContent/hContent) - if (first_line == "### OPENER ###") { + if (first_line == "/* OPENER (Do not edit this comment) */") { lines <- readLines(filepath, warn = FALSE) - opener_start <- which(lines == "### OPENER ###") - body_start <- which(lines == "### BODY ###") + opener_start <- which(lines == "/* OPENER (Do not edit this comment) */") + body_start <- which(lines == "/* BODY (Do not edit this comment) */") if (length(opener_start) == 1 && length(body_start) == 1) { opener_lines <- if (body_start > opener_start + 1) { diff --git a/nCompiler/R/all_utils.R b/nCompiler/R/all_utils.R index 5c22f540..64e18fd2 100644 --- a/nCompiler/R/all_utils.R +++ b/nCompiler/R/all_utils.R @@ -43,6 +43,8 @@ resetLabelFunctionCreators <- function() { } ADtapeMgrLabelCreator <- labelFunctionCreator("ADtapeMgr") +nodeFxnLabelCreator <- labelFunctionCreator("nodeFxn") +modelLabelCreator <- labelFunctionCreator("model") # no longer documented in Rd # Generates a valid C++ name from an R Name diff --git a/nCompiler/R/cppDefs_utils.R b/nCompiler/R/cppDefs_utils.R index 7495b2ee..a2a224d8 100644 --- a/nCompiler/R/cppDefs_utils.R +++ b/nCompiler/R/cppDefs_utils.R @@ -29,7 +29,7 @@ putCodeLinesInBrackets <- function(codeLines) { # This is the location of the RcppUtils.cpp, etc. files. IncludeCodeDir <- character() -NimbleCodeDir <- system.file("CppCode", package = "nCompiler") +# NimbleCodeDir <- system.file("CppCode", package = "nCompiler") nCompilerIncludeFile <- function(file, path = IncludeCodeDir) { diff --git a/nCompiler/R/nimbleModels.R b/nCompiler/R/nimbleModels.R index f207d62f..71f0b267 100644 --- a/nCompiler/R/nimbleModels.R +++ b/nCompiler/R/nimbleModels.R @@ -5,7 +5,7 @@ ## modelBase_nClass will be a base class with methods that ## have separate Rfun and Cfun contents and are predefined. -## +## ## model_nClass will inherit from modelBase_nClass and in C++ will ## use CRTP for a derived model. ## It will also split Rfun and Cfun and provide a custom inheritance statement @@ -14,130 +14,382 @@ ## a model will inherit from model_nClass +nodeInstr_nClass <- nClass( + classname = "nodeInstr_nClass", + Cpublic = list( + methodInstr = 'integerVector', + indsInstrVec = "nList('integerVector')" + ), + predefined = quote(system.file(file.path("include","nCompiler", "predefined_nClasses"), package="nCompiler") |> + file.path("nodeInstr_nClass")), + compileInfo=list(interface="full", + createFromR = TRUE#, + #predefined_output_dir = "nodeInstr_nClass" + ) +) + +calcInstr_nClass <- nClass( + classname = "calcInstr_nClass", + Cpublic = list( + nodeIndex = 'integerScalar', + nodeInstrVec = "nList('nodeInstr_nClass')" + ), + predefined = quote(system.file(file.path("include","nCompiler", "predefined_nClasses"), package="nCompiler") |> + file.path("calcInstr_nClass")), + compileInfo=list(interface="full", + createFromR = TRUE, + Hincludes = "" + #predefined_output_dir = "calcInstr_nClass" + ) +) + +calcInstrList_nClass <- nClass( + classname = "calcInstrList_nClass", + Cpublic = list( + calcInstrList = "nList('calcInstr_nClass')" + ), + predefined = quote(system.file(file.path("include","nCompiler", "predefined_nClasses"), package="nCompiler") |> + file.path("calcInstrList_nClass")), + compileInfo=list(interface="full", + createFromR = TRUE, + Hincludes = "") +) + +nodeFxnBase_nClass <- nClass( + classname = "nodeFxnBase_nClass", + Cpublic = list( + ping = nFunction( + name = "ping", + function() {return(TRUE); returnType(logical())}, + compileInfo = list(virtual=TRUE) + ), + calculate = nFunction( + name = "calculate", + function(nodeInstr = 'nodeInstr_nClass') {return(0); returnType(double())}, + compileInfo = list(virtual=TRUE) + ) + ), + # 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", "predefined_nClasses"), package="nCompiler") |> + file.path("nodeFxnBase_nClass")), + compileInfo=list(interface="full", + createFromR = FALSE) +) + +# nCompile(nodeFxnBase_nClass, control=list(generate_predefined=TRUE)) + modelBase_nClass <- nClass( classname = "modelBase_nClass", Cpublic = list( - hw = nFunction( - name = "hw", - function() {cppLiteral('Rprintf("modelBase_nClass hw (should not see this)\\n");')}, + ping = nFunction( + name = "ping", + function() {return(TRUE); returnType(logical())}, compileInfo = list(virtual=TRUE) ), - bye = nFunction( - name = "bye", - function() {cppLiteral('Rprintf("modelBase_nClass hw (should not see this)\\n");')}, - compileInfo = list(virtual=TRUE) - ) + calculate = nFunction( + name = "calculate", + function(calcInstrList) {cat("In uncompiled calculate\n")}, + returnType = 'numericScalar', + compileInfo = list( + 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", "predefined_nClasses"), package="nCompiler") |> file.path("modelBase_nClass")), compileInfo=list(interface="full", - createFromR = FALSE) + createFromR = FALSE, + Hincludes = c("", "")) ) -makeModel_nClass <- function(varInfo) { +# nCompile(modelBase_nClass, control=list(generate_predefined=TRUE)) + +## test <- nClass( +## inherit = modelBase_nClass, +## classname = "my_model", +## Cpublic = list( +## simulate = nFunction(function(nodes=SEXP()) {cppLiteral('Rprintf("In Derived simulate")')}) +## ), +## compileInfo = list( +## nClass_inherit = list(base="modelClass_") +## ) +## ) + +## comp <- nCompile(test, modelBase_nClass, nodeFxnBase_nClass) +## obj <- comp$test$new() +## obj$calculate(NULL) + +# Turn variables and methods into a nodeFxn nClass +make_node_fun <- 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( + type="double", nDim=x$nDim, name="", isRef=TRUE, isConst=FALSE, interface=FALSE) # We could in future make some isConst=TRUE, but it might not matter much + # varInfo_2_cppVar <- \(x) nCompiler:::symbolCppVar$new( + # baseType = nCompiler:::symbolBasic$new(type="double", nDim=x$nDim, name="")$genCppVar()$generate(), + # ref=TRUE, const=TRUE) + typeList <- varInfo |> lapply(varInfo_2_cppVar) + names(typeList) <- varInfo |> lapply(\(x) x$name) |> unlist() + + CpublicVars <- names(typeList) |> lapply(\(x) eval(substitute(quote(T(typeList$NAME)), + list(NAME=as.name(x))))) + names(CpublicVars) <- names(typeList) + + ctorArgNames <- paste0(names(typeList), '_') + initializersList <- paste0(names(typeList), '(', ctorArgNames ,')') + initFun <- function(){} + formals(initFun) <- structure(as.pairlist(CpublicVars), names = ctorArgNames) + + if(missing(classname)) + classname <- nodeFxnLabelCreator() + + baseclass <- paste0("nodeFxnClass_<", classname, ">") + +# This was a prototype + node_nClass <- substitute( + nClass( + classname = CLASSNAME, + 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 + ), + CLASSNAME = classname, + BASECLASS = baseclass + )) + eval(node_nClass) +} +#test <- nCompiler:::argType2symbol('CppVar(baseType = argType2Cpp("numericVector"), ref=TRUE, const=TRUE)') + +# Make all the info needed to include a node in a model class. +# The nodeFxn_nClass should be created first. +# 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, + nodeFxnName, + classname, + varInfo = list() + ) { + ctorArgs <- varInfo |> lapply(\(x) x$name) |> unlist() + + list(nodeFxnName = nodeFxnName, + membername = membername, + classname = classname, + ctorArgs = ctorArgs) +} + +makeModel_nClass <- function(varInfo, + nodes = list(), + classname + ) { # varInfo will be a list (names not used) of name, nDim, sizes. CpublicModelVars <- varInfo |> lapply(\(x) paste0("numericArray(nDim=",x$nDim,")")) names(CpublicModelVars) <- varInfo |> lapply(\(x) x$name) |> unlist() opDefs <- list( - base_hw = getOperatorDef("custom_call"), + base_ping = getOperatorDef("custom_call"), setup_node_mgmt = getOperatorDef("custom_call") ) - opDefs$base_hw$returnType <- nCompiler:::argType2symbol(quote(void())) - opDefs$base_hw$labelAbstractTypes$recurse <- FALSE + 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 + if(missing(classname)) + classname <- modelLabelCreator() + CpublicMethods <- list( - hw = nFunction( - name = "hw", - function() {cppLiteral('Rprintf("hw\\n");')} - ), - # base_hw = nFunction( - # name = "base_hw", - # function() {cppLiteral('modelBaseClass::base_hw();')} - # ), - call_base_hw = nFunction( - name = "call_base_hw", - function() {base_hw()} - ), - call_setup_node_mgmt = nFunction( + do_setup_node_mgmt = nFunction( name = "call_setup_node_mgmt", - function() {setup_node_mgmt()} + function() {}, + compileInfo=list( + C_fun = function() {setup_node_mgmt()}) + ), + print_nodes = nFunction( + name = "print_nodes", + function() {}, + compileInfo=list( + C_fun = function() {cppLiteral('modelClass_::c_print_nodes();')}) ), set_from_list = nFunction( name = "set_from_list", - function(Rlist = 'RcppList') {cppLiteral('modelClass_::set_from_list(Rlist);')} + function(Rlist) {for(v in names(Rlist)) + if(exists(v, self, inherits=FALSE)) self[[v]] <- Rlist[[v]]}, + compileInfo=list( + C_fun=function(Rlist = 'RcppList') {cppLiteral('modelClass_::set_from_list(Rlist);')}) ), resize_from_list = nFunction( name = "resize_from_list", - function(Rlist = 'RcppList') {cppLiteral('modelClass_::resize_from_list(Rlist);')} + function(Rlist) {for(v in names(Rlist)) + if(exists(v, self, inherits=FALSE)) self[[v]] <- nArray(dim=Rlist[[v]])}, + compileInfo = list( + C_fun=function(Rlist = 'RcppList') {cppLiteral('modelClass_::resize_from_list(Rlist);')}) ) ) - CpublicNodeFuns <- list( - beta_node = 'node_dnorm()' - ) + # nodes will be a list of membername, nodeFxnName, (node) classname, ctorArgs (list) + node_pieces <- nodes |> lapply(\(x) { + nClass_type <- paste0(x$nodeFxnName, "()") + init_string <- paste0('nCpp("', x$membername, '( new ', x$classname, '(', + paste0(x$ctorArgs, collapse=","), '))")') + list(nClass_type = nClass_type, + 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) + # CpublicNodeFuns <- list( + # beta_node = 'node_dnorm()' + # ) CpublicCtor <- list( - mymodel = nFunction( + nFunction( function(){}, compileInfo = list(constructor=TRUE, - initializers = c('nCpp("beta_node(new node_dnorm(mu, beta, 1))")')) + #initializers = c('nCpp("beta_node(new node_dnorm(mu, beta, 1))")')) + initializers = node_pieces |> lapply(\(x) x$init_string) |> unlist()) ) - ) + ) |> structure(names = classname) + baseclass <- paste0("modelClass_<", classname, ">") ans <- substitute( nClass( - classname = "mymodel", - # inherit = modelBase_nClass, + classname = CLASSNAME, + inherit = modelBase_nClass, compileInfo = list(opDefs = OPDEFS, - inherit = list(base = "public modelClass_"), - Hincludes = ""), + nClass_inherit = list(base=BASECLASS) + #inherit = list(base = "public modelClass_"), + #Hincludes = "" + ), Cpublic = CPUBLIC ), list(OPDEFS = opDefs, - CPUBLIC = c(CpublicNodeFuns, CpublicModelVars, CpublicCtor, CpublicMethods)) + CPUBLIC = c(CpublicNodeFuns, CpublicModelVars, CpublicCtor, CpublicMethods), + CLASSNAME = classname, + BASECLASS = baseclass) ) eval(ans, envir = parent.frame()) } -make_node_fun <- function(varInfo) { - # varInfo will be a list (names not used) of name, nDim, sizes. - foo <- \(x) nCompiler:::symbolCppVar$new(baseType = nCompiler:::symbolBasic$new(type="double", nDim=x$nDim, name="")$genCppVar()$generate(), - ref=TRUE, const=TRUE) - typeList <- varInfo |> lapply(foo) - names(typeList) <- varInfo |> lapply(\(x) x$name) |> unlist() +## Get varInfo from new nimbleModel +get_varInfo_from_nimbleModel <- function(model) { + mDef <- m$modelDef + extract <- \(x) x |> lapply(\(x) list(name = x$varName, nDim = x$nDim)) + vars <- mDef$varInfo |> extract() + logProbVars <- mDef$logProbVarInfo |> extract() + # The resize_from_list method will error out if a scalar is included. + # The maxs is empty for scalars, so they are automatically omitted from the sizes result here. + extract_sizes <- \(x) x|> lapply(\(x) x$maxs) + sizes <- mDef$varInfo |> extract_sizes() + logProb_sizes <- mDef$logProbVarInfo |> extract_sizes() + list( + vars = c(vars, logProbVars), + sizes = c(sizes, logProb_sizes) + ) +} -# baseTypeStrings <- varInfo |> lapply(\(x) paste0("numericArray(nDim=",x$nDim,")")) |> unlist() -# typeStrings <- paste0('CppVar(baseType=argType2Cpp("',baseTypeStrings,'"),ref=TRUE,const=TRUE)') -# typeList <- typeStrings |> lapply(nMakeType) -# names(typeList) <- names(varInfo) - #names(Cpublic) <- varInfo |> lapply(\(x) x$name) |> unlist() - CpublicVars <- names(typeList) |> lapply(\(x) eval(substitute(quote(T(typeList$NAME)), - list(NAME=as.name(x))))) - names(CpublicVars) <- names(typeList) +make_nodeFxn_from_declInfo <- function(declInfo) { + modelCode <- declInfo$calculateCode + 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] + } + RHSrep[[2]] <- LHSrep + names(RHSrep)[2] <- "" + RHSrep[[lenRHS+2]] <- 1 + names(RHSrep)[lenRHS+2] <- "log" + calc1fun <- substitute( + function(idx) {LHS <- RHS; return(LHS)}, + list(LHS = logProbExprRep, RHS = RHSrep) + ) |> eval() + calc_one <- nFunction( + name = "calc_one", + fun = calc1fun, + compileInfo=list(C_fun=calc1fun), + argTypes = list(idx = 'integerVector'), + returnType = 'numericScalar') + nodeVars <- all.vars(body(calc1fun)) |> setdiff("idx") + list(calc_one = calc_one, nodeVars = nodeVars) +} - ctorArgNames <- paste0(names(typeList), '_') - initializersList <- paste0(names(typeList), '(', ctorArgNames ,')') - initFun <- function(){} - formals(initFun) <- structure(as.pairlist(CpublicVars), names = ctorArgNames) +make_model_from_nimbleModel <- function(m) { + mDef <- m$modelDef + allVarInfo <- get_varInfo_from_nimbleModel(m) + modelVarInfo <- allVarInfo$vars + nodeFxnNames <- character() + nodeInfoList <- list() + 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) + nodeVarInfo <- modelVarInfo[nodeVars] + # Currently, we can't just make a list of these but need them as named objects in the environment + assign(nodeFxnName, + make_node_fun(nodeVarInfo, list(calc_one=calc_one), node_classname) + ) + nodeInfoList[[i]] <- nCompiler:::make_node_info(node_membername, nodeFxnName, node_classname, nodeVarInfo) + 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. + argList <- list("modelBase_nClass", "nodeFxnBase_nClass", "calcInstrList_nClass", "calcInstr_nClass", "nodeInstr_nClass", "model") + argList <- c(argList, as.list(nodeFxnNames)) + argList <- argList |> lapply(as.name) + Cmodel <- do.call("nCompile", argList) + #Cncm1 <- nCompile(modelBase_nClass, nodeFxnBase_nClass, calcInstr_nClass, nodeInstr_nClass, ncm1, nodeFxn_3) +} -# This was a prototype -# mu_type <- list(a = nMakeType('CppVar(baseType = argType2Cpp("numericVector"), ref=TRUE, const=TRUE)')) - node_dnorm <- substitute( - nClass( - classname = "node_dnorm", - Cpublic = CPUBLIC, - compileInfo = list(createFromR = FALSE, - inherit = list(base = "public nodeFunctionClass_"), - Hincludes = "") - ), - list(CPUBLIC = c( - list( -# mu2 = quote(T(mu_type$a)), -# mean = quote(ref('numericScalar')), - node_dnorm = nFunction( - initFun, #function(mu_ = T(mu_type$a)) {}, - compileInfo = list(constructor=TRUE, initializers = initializersList) #list('mu2(mu_)')) - ) - ), - CpublicVars - ))) - eval(node_dnorm) +calcInputList_to_calcInstrList <- function(calcInputList, comp) { + message("need to set up nodeFxn_2_nodeIndex") + if(missing(comp)) + stop("comp should be a list returned from nCompile including calcInstr_nClass and nodeInstr_nClass") + calcInstrList <- vector(length = length(calcInputList), mode='list') + for(iCalc in seq_along(calcInputList)) { + calcInstr <- comp$calcInstr_nClass$new() + calcInput <- calcInputList[[iCalc]] + calcInstr$nodeIndex <- nodeFxn_2_nodeIndex[ calcInput[[1]] ] #$nodeFxn] + nodeInputVec <- calcInput[[2]]#$nodeInputVec + nodeInstrVec <- vector(length=length(nodeInputVec), mode='list') + for(iMethod in seq_along(nodeInputVec)) { + nodeInstr <- comp$nodeInstr_nClass$new() + nodeInput <- nodeInputVec[[iMethod]] + nodeInstr$methodInstr <- nodeInput[[1]]#$methodInput + nodeInstr$indsInstrVec <- nodeInput[[2]]#$indsInputVec + nodeInstrVec[[iMethod]] <- nodeInstr + } + calcInstr$nodeInstrVec <- nodeInstrVec + calcInstrList[[iCalc]] <- calcInstr + } + calcInstrListObj <- comp$calcInstrList_nClass$new() + calcInstrListObj$calcInstrList <- calcInstrList + return(calcInstrListObj) } -#test <- nCompiler:::argType2symbol('CppVar(baseType = argType2Cpp("numericVector"), ref=TRUE, const=TRUE)') diff --git a/nCompiler/R/symbolTable.R b/nCompiler/R/symbolTable.R index fb0f04e4..5d22de7f 100644 --- a/nCompiler/R/symbolTable.R +++ b/nCompiler/R/symbolTable.R @@ -46,14 +46,17 @@ symbolBasic <- size = NULL, knownSize = NULL, isBlockRef = FALSE, + isConst = FALSE, initialize = function(..., nDim = 0, size = if(nDim == 0) 1 else NA, - isBlockRef = FALSE) { + isBlockRef = FALSE, + isConst = FALSE) { super$initialize(...) self$nDim <- nDim self$size <- size self$isBlockRef <- isBlockRef + self$isConst <- isConst self }, shortPrint = function() { @@ -93,32 +96,40 @@ symbolBasic <- "type", type,"unrecognized\n"), FALSE) if(self$nDim == 0) { - return(if(!(identical(self$name, "pi"))) - cppVarClass$new(baseType = cType, - name = self$name, - ptr = 0, - ref = FALSE) - else - cppVarFullClass$new(baseType = cType, + if(identical(self$name, "pi")) + return(cppVarFullClass$new(baseType = cType, name = self$name, ptr = 0, ref = FALSE, - constructor = "(M_PI)") - ) + constructor = "(M_PI)")) + if(isTRUE(self$isConst)) + return(cppVarFullClass$new(baseType = cType, + name = self$name, + ptr = FALSE, + ref = self$isRef, + const = self$isConst)) + return(cppVarClass$new(baseType = cType, + name = self$name, + ptr = 0, + ref = self$isRef)) } if(self$isBlockRef) { - return(cppStridedTensorMapRef(name = self$name, - nDim = self$nDim, - scalarType = cType)) + ans <- cppStridedTensorMapRef(name = self$name, + nDim = self$nDim, + scalarType = cType) } else if(self$isRef) { - return(cppEigenTensorRef(name = self$name, + ans <- cppEigenTensorRef(name = self$name, nDim = self$nDim, - scalarType = cType)) + scalarType = cType) } else { - return(cppEigenTensor(name = self$name, + ans <- cppEigenTensor(name = self$name, nDim = self$nDim, - scalarType = cType)) + scalarType = cType) + } + if(self$isConst) { + ans$const <- TRUE } + ans } ) ) @@ -178,7 +189,7 @@ symbolTBD <- R6::R6Class( stop("Trying to generate a C++ type from a TBD type ('", self$name, "' of type '", - self$type, "'.") + self$type, "').") } ) ) diff --git a/nCompiler/R/typeDeclarations.R b/nCompiler/R/typeDeclarations.R index ce60f121..6bec7b98 100644 --- a/nCompiler/R/typeDeclarations.R +++ b/nCompiler/R/typeDeclarations.R @@ -1,4 +1,3 @@ - ## each entry in the typeDeclarationList ## gives a function to convert the arguments of a ## type declaration into a symbol object. @@ -237,7 +236,7 @@ typeDeclarationList <- list( RcppFunction = function(...) { symbolRcppType$new(RcppType = "Rcpp::Function", ...) }, - + ## RcppEigen RcppTypes RcppEigenMatrixXd = function(...) { symbolRcppType$new(RcppType = "Eigen::MatrixXd", ...) @@ -257,7 +256,7 @@ typeDeclarationList <- list( RcppEigenVectorXcd = function(...) { symbolRcppType$new(RcppType = "Eigen::VectorXcd", ...) }, - + ## Sparse types nSparseMatrix = function(value, ..., @@ -290,7 +289,7 @@ typeDeclarationList <- list( nDim <= 6)) stop(paste0("Invalid number of dimensions used to declare a.nCompiler ", "argument. Dimensions from 0-6 are allowed."), - call. = FALSE) + call. = FALSE) nType(scalarType, nDim) }, CppVar = function(...) { # symbolBaseArgs will be passed to symbolBase$initialize @@ -351,12 +350,12 @@ argType2symbol <- function(argType, ## allow e.g. 'scalarInteger' to become scalarInteger() if(is.name(typeToUse)) typeToUse <- as.call(list(typeToUse)) - + ## argType could be a blank if(is.name(argType)) if(as.character(argType)=="") argType <- NULL - + ans <- try({ ## TO-DO: Case 1: It is a nType object ## To be implemented @@ -427,8 +426,8 @@ argType2symbol <- function(argType, ## Case 3: It is a nClass type or possibly other "to-be-determined" type. ## We defer type lookup until compiler stage labelAbstractTypes if(inputAsCharacter) { - symbol <- symbolTBD$new(name = name, - type = funName, + symbol <- symbolTBD$new(name = name, + type = funName, isArg = isArg) } else { ## Case 4: Type can be determined by evaluating the default @@ -461,7 +460,7 @@ argType2symbol <- function(argType, call.=FALSE) } if(isTRUE(symbol$isRef)) { - + } nErrorEnv$.isRef_has_been_set <- FALSE nErrorEnv$.isBlockRef_has_been_set <- FALSE @@ -515,7 +514,7 @@ argTypeList2symbolTable <- function(argTypeList, } if(is.null(names(isArg))) names(isArg) <- names(argTypeList) - + ## Check that isRef is valid if(!is.list(isRef)) { ok <- FALSE @@ -617,11 +616,19 @@ resolveOneTBDsymbol <- function(symbol, env = parent.frame()) { NCgenerator = candidate) return(newSym) } + } else if(inherits(symbol, "symbolNlist")) { + elementSym <- symbol$elementSym + if(inherits(elementSym, "symbolTBD")) { + elementSym <- resolveOneTBDsymbol(elementSym, env) + newSym <- symbol$clone(deep=TRUE) + newSym$elementSym <- elementSym + return(newSym) + } } symbol #return unmodified symbol if nothing to do } -resolveTBDsymbols <- function(symTab, +resolveTBDsymbols <- function(symTab, env = parent.frame()) { for(i in seq_along(symTab$symbols)) { symTab$symbols[[i]] <- resolveOneTBDsymbol(symTab$symbols[[i]], env) diff --git a/nCompiler/inst/include/nCompiler/nClass_interface/generic_class_interface.h b/nCompiler/inst/include/nCompiler/nClass_interface/generic_class_interface.h index ef91ce94..7fd79b81 100644 --- a/nCompiler/inst/include/nCompiler/nClass_interface/generic_class_interface.h +++ b/nCompiler/inst/include/nCompiler/nClass_interface/generic_class_interface.h @@ -60,6 +60,11 @@ class genericInterfaceBaseC { return dummy; }; + virtual std::unique_ptr access(const std::string &name) { + std::cout<<"Error: you should be in a derived genericInterfaceC class for access"<(nullptr); + } + // return a named member converted to a SEXP. // Derived classes should provide valid implementations. virtual SEXP get_value(const std::string &name) const { @@ -129,7 +134,7 @@ struct FirstGenericDerived { }; template -class interface_resolver : public Bases..., virtual public genericInterfaceBaseC +class interface_resolver : public Bases..., virtual public genericInterfaceBaseC { private: using FirstFound = typename FirstGenericDerived::type; @@ -138,6 +143,9 @@ class interface_resolver : public Bases..., virtual public genericInterfaceBaseC const name2access_type& get_name2access() const override { return FirstFound::get_name2access(); } + std::unique_ptr access(const std::string &name) override { + return FirstFound::access(name); + } SEXP get_value(const std::string &name) const override { return FirstFound::get_value(name); } @@ -153,7 +161,7 @@ class interface_resolver : public Bases..., virtual public genericInterfaceBaseC }; template<> -class interface_resolver<> : virtual public genericInterfaceBaseC +class interface_resolver<> : virtual public genericInterfaceBaseC { private: using FirstFound = genericInterfaceBaseC; diff --git a/nCompiler/inst/include/nCompiler/nClass_interface/post_Rcpp/generic_class_interface_Rcpp_steps.h b/nCompiler/inst/include/nCompiler/nClass_interface/post_Rcpp/generic_class_interface_Rcpp_steps.h index 1276aa1b..79780e0e 100644 --- a/nCompiler/inst/include/nCompiler/nClass_interface/post_Rcpp/generic_class_interface_Rcpp_steps.h +++ b/nCompiler/inst/include/nCompiler/nClass_interface/post_Rcpp/generic_class_interface_Rcpp_steps.h @@ -411,6 +411,7 @@ class genericInterfaceC : virtual public genericInterfaceBaseC { name2access_type::iterator access = name2access.find(name); if(access == name2access.end()) { std::cout<<"Problem: \""<second->ETaccess(this)); } diff --git a/nCompiler/inst/include/nCompiler/nList/post_Rcpp/nList.h b/nCompiler/inst/include/nCompiler/nList/post_Rcpp/nList.h index ce71ac77..233cff51 100644 --- a/nCompiler/inst/include/nCompiler/nList/post_Rcpp/nList.h +++ b/nCompiler/inst/include/nCompiler/nList/post_Rcpp/nList.h @@ -8,6 +8,11 @@ class nList { // : public genericInterfaceC > { private: std::vector< T > contents; public: + std::vector< T > &get() {return contents;} + typename std::vector< T >::iterator begin() {return contents.begin();} + typename std::vector< T >::const_iterator cbegin() {return contents.cbegin();} + typename std::vector< T >::iterator end() {return contents.end();} + typename std::vector< T >::const_iterator cend() {return contents.cend();} T get(size_t i) const {return contents[i];} T set(size_t i, const T& value) {return contents[i] = value;} void resize(size_t m) {contents.resize(m);} diff --git a/nCompiler/inst/include/nCompiler/predefined_nClasses/calcInstrList_nClass/calcInstrList_nClass_copyFiles.txt b/nCompiler/inst/include/nCompiler/predefined_nClasses/calcInstrList_nClass/calcInstrList_nClass_copyFiles.txt new file mode 100644 index 00000000..e69de29b diff --git a/nCompiler/inst/include/nCompiler/predefined_nClasses/calcInstrList_nClass/calcInstrList_nClass_cppContent.cpp b/nCompiler/inst/include/nCompiler/predefined_nClasses/calcInstrList_nClass/calcInstrList_nClass_cppContent.cpp new file mode 100644 index 00000000..c7309d21 --- /dev/null +++ b/nCompiler/inst/include/nCompiler/predefined_nClasses/calcInstrList_nClass/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/predefined_nClasses/calcInstrList_nClass/calcInstrList_nClass_filebase.txt b/nCompiler/inst/include/nCompiler/predefined_nClasses/calcInstrList_nClass/calcInstrList_nClass_filebase.txt new file mode 100644 index 00000000..6b2e8b13 --- /dev/null +++ b/nCompiler/inst/include/nCompiler/predefined_nClasses/calcInstrList_nClass/calcInstrList_nClass_filebase.txt @@ -0,0 +1 @@ +calcInstrList_nClass_c_ diff --git a/nCompiler/inst/include/nCompiler/predefined_nClasses/calcInstrList_nClass/calcInstrList_nClass_hContent.h b/nCompiler/inst/include/nCompiler/predefined_nClasses/calcInstrList_nClass/calcInstrList_nClass_hContent.h new file mode 100644 index 00000000..47fdf85a --- /dev/null +++ b/nCompiler/inst/include/nCompiler/predefined_nClasses/calcInstrList_nClass/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/predefined_nClasses/calcInstrList_nClass/calcInstrList_nClass_manifest.txt b/nCompiler/inst/include/nCompiler/predefined_nClasses/calcInstrList_nClass/calcInstrList_nClass_manifest.txt new file mode 100644 index 00000000..eada98df --- /dev/null +++ b/nCompiler/inst/include/nCompiler/predefined_nClasses/calcInstrList_nClass/calcInstrList_nClass_manifest.txt @@ -0,0 +1,7 @@ +list(saved_at = structure(1762608220.96116, 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/predefined_nClasses/calcInstrList_nClass/calcInstrList_nClass_post_cpp_compiler.txt b/nCompiler/inst/include/nCompiler/predefined_nClasses/calcInstrList_nClass/calcInstrList_nClass_post_cpp_compiler.txt new file mode 100644 index 00000000..e69de29b diff --git a/nCompiler/inst/include/nCompiler/predefined_nClasses/calcInstrList_nClass/calcInstrList_nClass_preamble.cpp b/nCompiler/inst/include/nCompiler/predefined_nClasses/calcInstrList_nClass/calcInstrList_nClass_preamble.cpp new file mode 100644 index 00000000..61410333 --- /dev/null +++ b/nCompiler/inst/include/nCompiler/predefined_nClasses/calcInstrList_nClass/calcInstrList_nClass_preamble.cpp @@ -0,0 +1,6 @@ +#define NCOMPILER_HANDLE_EIGEN_ERRORS +#define NCOMPILER_USES_EIGEN +// #define NCOMPILER_USES_TBB +#define NCOMPILER_USES_NLIST +#define USES_NCOMPILER +#define NCOMPILER_USES_NCLASS_INTERFACE diff --git a/nCompiler/inst/include/nCompiler/predefined_nClasses/calcInstr_nClass/calcInstr_nClass_copyFiles.txt b/nCompiler/inst/include/nCompiler/predefined_nClasses/calcInstr_nClass/calcInstr_nClass_copyFiles.txt new file mode 100644 index 00000000..e69de29b diff --git a/nCompiler/inst/include/nCompiler/predefined_nClasses/calcInstr_nClass/calcInstr_nClass_cppContent.cpp b/nCompiler/inst/include/nCompiler/predefined_nClasses/calcInstr_nClass/calcInstr_nClass_cppContent.cpp new file mode 100644 index 00000000..b94c8e71 --- /dev/null +++ b/nCompiler/inst/include/nCompiler/predefined_nClasses/calcInstr_nClass/calcInstr_nClass_cppContent.cpp @@ -0,0 +1,46 @@ +/* OPENER (Do not edit this comment) */ +#ifndef __calcInstr_nClass_CPP +#define __calcInstr_nClass_CPP +/* BODY (Do not edit this comment) */ +#ifndef R_NO_REMAP +#define R_NO_REMAP +#endif +#include +#include "calcInstr_nClass_c_.h" +using namespace Rcpp; +// [[Rcpp::plugins(nCompiler_Eigen_plugin)]] +// [[Rcpp::depends(RcppParallel)]] +// [[Rcpp::depends(nCompiler)]] +// [[Rcpp::depends(Rcereal)]] + + calcInstr_nClass::calcInstr_nClass ( ) { +RESET_EIGEN_ERRORS +} + +// [[Rcpp::export(name = "new_calcInstr_nClass")]] + SEXP new_calcInstr_nClass ( ) { +RESET_EIGEN_ERRORS +return CREATE_NEW_NCOMP_OBJECT(calcInstr_nClass);; +} + +// [[Rcpp::export(name = "set_CnClass_env_new_calcInstr_nClass")]] + void set_CnClass_env_calcInstr_nClass ( SEXP env ) { +RESET_EIGEN_ERRORS +SET_CNCLASS_ENV(calcInstr_nClass, env);; +} + +// [[Rcpp::export(name = "get_CnClass_env_new_calcInstr_nClass")]] + Rcpp::Environment get_CnClass_env_calcInstr_nClass ( ) { +RESET_EIGEN_ERRORS +return GET_CNCLASS_ENV(calcInstr_nClass);; +} + +NCOMPILER_INTERFACE( +calcInstr_nClass, +NCOMPILER_FIELDS( +field("nodeIndex", &calcInstr_nClass::nodeIndex), +field("nodeInstrVec", &calcInstr_nClass::nodeInstrVec) +), +NCOMPILER_METHODS() +) +#endif diff --git a/nCompiler/inst/include/nCompiler/predefined_nClasses/calcInstr_nClass/calcInstr_nClass_filebase.txt b/nCompiler/inst/include/nCompiler/predefined_nClasses/calcInstr_nClass/calcInstr_nClass_filebase.txt new file mode 100644 index 00000000..d7176de5 --- /dev/null +++ b/nCompiler/inst/include/nCompiler/predefined_nClasses/calcInstr_nClass/calcInstr_nClass_filebase.txt @@ -0,0 +1 @@ +calcInstr_nClass_c_ diff --git a/nCompiler/inst/include/nCompiler/predefined_nClasses/calcInstr_nClass/calcInstr_nClass_hContent.h b/nCompiler/inst/include/nCompiler/predefined_nClasses/calcInstr_nClass/calcInstr_nClass_hContent.h new file mode 100644 index 00000000..775b8639 --- /dev/null +++ b/nCompiler/inst/include/nCompiler/predefined_nClasses/calcInstr_nClass/calcInstr_nClass_hContent.h @@ -0,0 +1,25 @@ +/* OPENER (Do not edit this comment) */ +#ifndef __calcInstr_nClass_H +#define __calcInstr_nClass_H +/* BODY (Do not edit this comment) */ +#ifndef R_NO_REMAP +#define R_NO_REMAP +#endif +#include +#include + +class calcInstr_nClass : public interface_resolver< genericInterfaceC >, public loadedObjectHookC { +public: + calcInstr_nClass ( ) ; + int nodeIndex; + nList > nodeInstrVec; +}; + + SEXP new_calcInstr_nClass ( ) ; + + void set_CnClass_env_calcInstr_nClass ( SEXP env ) ; + + Rcpp::Environment get_CnClass_env_calcInstr_nClass ( ) ; + + +#endif diff --git a/nCompiler/inst/include/nCompiler/predefined_nClasses/calcInstr_nClass/calcInstr_nClass_manifest.txt b/nCompiler/inst/include/nCompiler/predefined_nClasses/calcInstr_nClass/calcInstr_nClass_manifest.txt new file mode 100644 index 00000000..5ca9a4ed --- /dev/null +++ b/nCompiler/inst/include/nCompiler/predefined_nClasses/calcInstr_nClass/calcInstr_nClass_manifest.txt @@ -0,0 +1,7 @@ +list(saved_at = structure(1762351302.27482, 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", + hContent = "calcInstr_nClass_hContent.h", filebase = "calcInstr_nClass_filebase.txt", + post_cpp_compiler = "calcInstr_nClass_post_cpp_compiler.txt", + copyFiles = "calcInstr_nClass_copyFiles.txt")) diff --git a/nCompiler/inst/include/nCompiler/predefined_nClasses/calcInstr_nClass/calcInstr_nClass_post_cpp_compiler.txt b/nCompiler/inst/include/nCompiler/predefined_nClasses/calcInstr_nClass/calcInstr_nClass_post_cpp_compiler.txt new file mode 100644 index 00000000..e69de29b diff --git a/nCompiler/inst/include/nCompiler/predefined_nClasses/calcInstr_nClass/calcInstr_nClass_preamble.cpp b/nCompiler/inst/include/nCompiler/predefined_nClasses/calcInstr_nClass/calcInstr_nClass_preamble.cpp new file mode 100644 index 00000000..61410333 --- /dev/null +++ b/nCompiler/inst/include/nCompiler/predefined_nClasses/calcInstr_nClass/calcInstr_nClass_preamble.cpp @@ -0,0 +1,6 @@ +#define NCOMPILER_HANDLE_EIGEN_ERRORS +#define NCOMPILER_USES_EIGEN +// #define NCOMPILER_USES_TBB +#define NCOMPILER_USES_NLIST +#define USES_NCOMPILER +#define NCOMPILER_USES_NCLASS_INTERFACE diff --git a/nCompiler/inst/include/nCompiler/predefined_nClasses/modelBase_nClass/modelBase_nClass_copyFiles.txt b/nCompiler/inst/include/nCompiler/predefined_nClasses/modelBase_nClass/modelBase_nClass_copyFiles.txt new file mode 100644 index 00000000..e69de29b diff --git a/nCompiler/inst/include/nCompiler/predefined_nClasses/modelBase_nClass/modelBase_nClass_cppContent.cpp b/nCompiler/inst/include/nCompiler/predefined_nClasses/modelBase_nClass/modelBase_nClass_cppContent.cpp new file mode 100644 index 00000000..1adef45d --- /dev/null +++ b/nCompiler/inst/include/nCompiler/predefined_nClasses/modelBase_nClass/modelBase_nClass_cppContent.cpp @@ -0,0 +1,53 @@ +/* OPENER (Do not edit this comment) */ +#ifndef __modelBase_nClass_CPP +#define __modelBase_nClass_CPP +/* BODY (Do not edit this comment) */ +#ifndef R_NO_REMAP +#define R_NO_REMAP +#endif +#include +#include "modelBase_nClass_c_.h" +using namespace Rcpp; +// [[Rcpp::plugins(nCompiler_Eigen_plugin)]] +// [[Rcpp::depends(RcppParallel)]] +// [[Rcpp::depends(nCompiler)]] +// [[Rcpp::depends(Rcereal)]] + + bool modelBase_nClass::ping ( ) { +RESET_EIGEN_ERRORS +return(true); +} + double modelBase_nClass::calculate ( std::shared_ptr calcInstr ) { +RESET_EIGEN_ERRORS +Rprintf("modelBase_nClass calculate (should not see this)\n");; +return(0.0); +} + modelBase_nClass::modelBase_nClass ( ) { +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 +SET_CNCLASS_ENV(modelBase_nClass, env);; +} + +// [[Rcpp::export(name = "get_CnClass_env_new_modelBase_nClass")]] + Rcpp::Environment get_CnClass_env_modelBase_nClass ( ) { +RESET_EIGEN_ERRORS +return GET_CNCLASS_ENV(modelBase_nClass);; +} + +NCOMPILER_INTERFACE( +modelBase_nClass, +NCOMPILER_FIELDS(), +NCOMPILER_METHODS( +method("ping", &modelBase_nClass::ping, args({{}})), +method("calculate", &modelBase_nClass::calculate, args({{arg("calcInstr",copy)}})) +) +) + + +#endif diff --git a/nCompiler/inst/include/nCompiler/predefined_nClasses/modelBase_nClass/modelBase_nClass_filebase.txt b/nCompiler/inst/include/nCompiler/predefined_nClasses/modelBase_nClass/modelBase_nClass_filebase.txt new file mode 100644 index 00000000..e8994f83 --- /dev/null +++ b/nCompiler/inst/include/nCompiler/predefined_nClasses/modelBase_nClass/modelBase_nClass_filebase.txt @@ -0,0 +1 @@ +modelBase_nClass_c_ diff --git a/nCompiler/inst/include/nCompiler/predefined_nClasses/modelBase_nClass/modelBase_nClass_hContent.h b/nCompiler/inst/include/nCompiler/predefined_nClasses/modelBase_nClass/modelBase_nClass_hContent.h new file mode 100644 index 00000000..c5e87de6 --- /dev/null +++ b/nCompiler/inst/include/nCompiler/predefined_nClasses/modelBase_nClass/modelBase_nClass_hContent.h @@ -0,0 +1,133 @@ +/* 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_nClass_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 ( ) ; + + +template +class modelClass_ : public modelBase_nClass { +public: + modelClass_() {}; + std::vector< std::shared_ptr > nodeFxnPtrs; + std::map name2index_map; + double calculate(std::shared_ptr calcInstrList) override { + double logProb(0.0); + const auto& calcInstrVec = calcInstrList->calcInstrList.get(); + auto calcInstr = calcInstrVec.cbegin(); + auto calcInstrEnd = calcInstrVec.cend(); + for( ; calcInstr != calcInstrEnd; ++calcInstr) { + auto nodeFxnPtr = nodeFxnPtrs[(*calcInstr)->nodeIndex-1]; + const auto& nodeInstrVec = (*calcInstr)->nodeInstrVec.get(); + auto nodeInstr = nodeInstrVec.cbegin(); + auto nodeInstrEnd = nodeInstrVec.cend(); + for( ; nodeInstr != nodeInstrEnd; ) { + logProb += nodeFxnPtr->calculate(*nodeInstr++); + } + } + return(logProb); + } + void setup_node_mgmt() { + Derived *self = static_cast(this); + const auto& name2access = self->get_name2access(); + size_t n = name2access.size(); + Rprintf("There are %d member variables indexed:\n", (int)n); + auto i_n2a = name2access.begin(); + auto end_n2a = name2access.end(); + nodeFxnPtrs.clear(); + name2index_map.clear(); + size_t index = 0; + for(; i_n2a != end_n2a; ++i_n2a) { + std::shared_ptr ptr = i_n2a->second->getInterfacePtr(dynamic_cast(self)); + bool got_one = (ptr != nullptr); + if(got_one) { + Rprintf("HOORAY: field %s is genericInterfaceBaseC\n", i_n2a->first.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"); + nodeFxnPtrs.push_back(ptr2); + name2index_map.emplace(i_n2a->first, index++); + } else { + Rprintf("but it is not a nodefxn ptr\n"); + } + } + else + Rprintf("field %s is NOT a genericInterfaceBaseC\n", i_n2a->first.c_str()); + } + } + void c_print_nodes() { + auto i_n2i = name2index_map.begin(); + auto end_n2i = name2index_map.end(); + Rprintf("0-based index: name\n"); + for(; i_n2i != end_n2i; ++i_n2i) { + Rprintf("%d: %s\n", i_n2i->first.c_str(), (int)i_n2i->second); + } + } + void set_from_list(Rcpp::List Rlist) { + Rcpp::CharacterVector Rnames = Rlist.names(); + size_t len = Rnames.length(); + for(size_t i = 0; i < len; ++i) { + // explicit cast is needed because even though Rnames[i] can cast to a string, + // set_value takes a const string& so we need an object in place here. + // set_value fails safely if a name is not found. + static_cast(this)->set_value(std::string(Rnames[i]), Rlist[i]); + } + } + void resize_from_list(Rcpp::List Rlist) { + Rcpp::CharacterVector Rnames = Rlist.names(); + size_t len = Rnames.length(); + size_t vec_len; + Rcpp::IntegerVector vs; + for(size_t i = 0; i < len; ++i) { + // explicit cast is needed because even though Rnames[i] can cast to a string, + // set_value takes a const string& so we need an object in place here. + vs = Rlist[i]; + vec_len = vs.length(); + std::unique_ptr ETA = static_cast(this)->access(std::string(Rnames[i])); + // if the name was not found, a "Problem:" message was emitted, and we skip using it here. + if(ETA) { + switch(vec_len) { + case 0 : + break; + case 1 : + ETA->template ref<1>().resize(vs[0]); + break; + case 2 : + ETA->template ref<2>().resize(vs[0], vs[1]); + break; + case 3 : + ETA->template ref<3>().resize(vs[0], vs[1], vs[2]); + break; + case 4 : + ETA->template ref<4>().resize(vs[0], vs[1], vs[2], vs[3]); + break; + case 5 : + ETA->template ref<5>().resize(vs[0], vs[1], vs[2], vs[3], vs[4]); + break; + case 6 : + ETA->template ref<6>().resize(vs[0], vs[1], vs[2], vs[3], vs[4], vs[5]); + break; + } + } + } + } +}; +#endif diff --git a/nCompiler/inst/include/nCompiler/predefined_nClasses/modelBase_nClass/modelBase_nClass_manifest.txt b/nCompiler/inst/include/nCompiler/predefined_nClasses/modelBase_nClass/modelBase_nClass_manifest.txt new file mode 100644 index 00000000..ef22a3e0 --- /dev/null +++ b/nCompiler/inst/include/nCompiler/predefined_nClasses/modelBase_nClass/modelBase_nClass_manifest.txt @@ -0,0 +1,7 @@ +list(saved_at = structure(1759839433.48825, 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", + hContent = "modelBase_nClass_hContent.h", filebase = "modelBase_nClass_filebase.txt", + post_cpp_compiler = "modelBase_nClass_post_cpp_compiler.txt", + copyFiles = "modelBase_nClass_copyFiles.txt")) diff --git a/nCompiler/inst/include/nCompiler/predefined_nClasses/modelBase_nClass/modelBase_nClass_post_cpp_compiler.txt b/nCompiler/inst/include/nCompiler/predefined_nClasses/modelBase_nClass/modelBase_nClass_post_cpp_compiler.txt new file mode 100644 index 00000000..e69de29b diff --git a/nCompiler/inst/include/nCompiler/predefined_nClasses/modelBase_nClass/modelBase_nClass_preamble.cpp b/nCompiler/inst/include/nCompiler/predefined_nClasses/modelBase_nClass/modelBase_nClass_preamble.cpp new file mode 100644 index 00000000..61410333 --- /dev/null +++ b/nCompiler/inst/include/nCompiler/predefined_nClasses/modelBase_nClass/modelBase_nClass_preamble.cpp @@ -0,0 +1,6 @@ +#define NCOMPILER_HANDLE_EIGEN_ERRORS +#define NCOMPILER_USES_EIGEN +// #define NCOMPILER_USES_TBB +#define NCOMPILER_USES_NLIST +#define USES_NCOMPILER +#define NCOMPILER_USES_NCLASS_INTERFACE diff --git a/nCompiler/inst/include/nCompiler/predefined_nClasses/nodeFxnBase_nClass/nodeFxnBase_nClass_copyFiles.txt b/nCompiler/inst/include/nCompiler/predefined_nClasses/nodeFxnBase_nClass/nodeFxnBase_nClass_copyFiles.txt new file mode 100644 index 00000000..e69de29b diff --git a/nCompiler/inst/include/nCompiler/predefined_nClasses/nodeFxnBase_nClass/nodeFxnBase_nClass_cppContent.cpp b/nCompiler/inst/include/nCompiler/predefined_nClasses/nodeFxnBase_nClass/nodeFxnBase_nClass_cppContent.cpp new file mode 100644 index 00000000..86299aef --- /dev/null +++ b/nCompiler/inst/include/nCompiler/predefined_nClasses/nodeFxnBase_nClass/nodeFxnBase_nClass_cppContent.cpp @@ -0,0 +1,51 @@ +/* OPENER (Do not edit this comment) */ +#ifndef __nodeFxnBase_nClass_CPP +#define __nodeFxnBase_nClass_CPP +/* BODY (Do not edit this comment) */ +#ifndef R_NO_REMAP +#define R_NO_REMAP +#endif +#include +#include "nodeFxnBase_nClass_c_.h" +using namespace Rcpp; +// [[Rcpp::plugins(nCompiler_Eigen_plugin)]] +// [[Rcpp::depends(RcppParallel)]] +// [[Rcpp::depends(nCompiler)]] +// [[Rcpp::depends(Rcereal)]] + + bool nodeFxnBase_nClass::ping ( ) { +RESET_EIGEN_ERRORS +return(true); +} + double nodeFxnBase_nClass::calculate ( std::shared_ptr nodeInstr ) { +RESET_EIGEN_ERRORS +return(0.0); +} + nodeFxnBase_nClass::nodeFxnBase_nClass ( ) { +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 +SET_CNCLASS_ENV(nodeFxnBase_nClass, env);; +} + +// [[Rcpp::export(name = "get_CnClass_env_new_nodeFxnBase_nClass")]] + Rcpp::Environment get_CnClass_env_nodeFxnBase_nClass ( ) { +RESET_EIGEN_ERRORS +return GET_CNCLASS_ENV(nodeFxnBase_nClass);; +} + +NCOMPILER_INTERFACE( +nodeFxnBase_nClass, +NCOMPILER_FIELDS(), +NCOMPILER_METHODS( +method("ping", &nodeFxnBase_nClass::ping, args({{}})), +method("calculate", &nodeFxnBase_nClass::calculate, args({{arg("nodeInstr",copy)}})) +) +) +#endif diff --git a/nCompiler/inst/include/nCompiler/predefined_nClasses/nodeFxnBase_nClass/nodeFxnBase_nClass_filebase.txt b/nCompiler/inst/include/nCompiler/predefined_nClasses/nodeFxnBase_nClass/nodeFxnBase_nClass_filebase.txt new file mode 100644 index 00000000..1be34d68 --- /dev/null +++ b/nCompiler/inst/include/nCompiler/predefined_nClasses/nodeFxnBase_nClass/nodeFxnBase_nClass_filebase.txt @@ -0,0 +1 @@ +nodeFxnBase_nClass_c_ diff --git a/nCompiler/inst/include/nCompiler/predefined_nClasses/nodeFxnBase_nClass/nodeFxnBase_nClass_hContent.h b/nCompiler/inst/include/nCompiler/predefined_nClasses/nodeFxnBase_nClass/nodeFxnBase_nClass_hContent.h new file mode 100644 index 00000000..bfd355ba --- /dev/null +++ b/nCompiler/inst/include/nCompiler/predefined_nClasses/nodeFxnBase_nClass/nodeFxnBase_nClass_hContent.h @@ -0,0 +1,43 @@ +/* OPENER (Do not edit this comment) */ +#ifndef __nodeFxnBase_nClass_H +#define __nodeFxnBase_nClass_H +/* BODY (Do not edit this comment) */ +#ifndef R_NO_REMAP +#define R_NO_REMAP +#endif +#include +#include "nodeInstr_nClass_c_.h" + +class nodeFxnBase_nClass : public interface_resolver< genericInterfaceC >, public loadedObjectHookC { +public: + virtual bool ping ( ) ; + virtual double calculate ( std::shared_ptr 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_() {}; +}; + + +#endif diff --git a/nCompiler/inst/include/nCompiler/predefined_nClasses/nodeFxnBase_nClass/nodeFxnBase_nClass_manifest.txt b/nCompiler/inst/include/nCompiler/predefined_nClasses/nodeFxnBase_nClass/nodeFxnBase_nClass_manifest.txt new file mode 100644 index 00000000..97221ec1 --- /dev/null +++ b/nCompiler/inst/include/nCompiler/predefined_nClasses/nodeFxnBase_nClass/nodeFxnBase_nClass_manifest.txt @@ -0,0 +1,7 @@ +list(saved_at = structure(1759839377.88016, 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", + cppContent = "nodeFxnBase_nClass_cppContent.cpp", hContent = "nodeFxnBase_nClass_hContent.h", + filebase = "nodeFxnBase_nClass_filebase.txt", post_cpp_compiler = "nodeFxnBase_nClass_post_cpp_compiler.txt", + copyFiles = "nodeFxnBase_nClass_copyFiles.txt")) diff --git a/nCompiler/inst/include/nCompiler/predefined_nClasses/nodeFxnBase_nClass/nodeFxnBase_nClass_post_cpp_compiler.txt b/nCompiler/inst/include/nCompiler/predefined_nClasses/nodeFxnBase_nClass/nodeFxnBase_nClass_post_cpp_compiler.txt new file mode 100644 index 00000000..e69de29b diff --git a/nCompiler/inst/include/nCompiler/predefined_nClasses/nodeFxnBase_nClass/nodeFxnBase_nClass_preamble.cpp b/nCompiler/inst/include/nCompiler/predefined_nClasses/nodeFxnBase_nClass/nodeFxnBase_nClass_preamble.cpp new file mode 100644 index 00000000..61410333 --- /dev/null +++ b/nCompiler/inst/include/nCompiler/predefined_nClasses/nodeFxnBase_nClass/nodeFxnBase_nClass_preamble.cpp @@ -0,0 +1,6 @@ +#define NCOMPILER_HANDLE_EIGEN_ERRORS +#define NCOMPILER_USES_EIGEN +// #define NCOMPILER_USES_TBB +#define NCOMPILER_USES_NLIST +#define USES_NCOMPILER +#define NCOMPILER_USES_NCLASS_INTERFACE diff --git a/nCompiler/inst/include/nCompiler/predefined_nClasses/nodeInstr_nClass/nodeInstr_nClass_copyFiles.txt b/nCompiler/inst/include/nCompiler/predefined_nClasses/nodeInstr_nClass/nodeInstr_nClass_copyFiles.txt new file mode 100644 index 00000000..e69de29b diff --git a/nCompiler/inst/include/nCompiler/predefined_nClasses/nodeInstr_nClass/nodeInstr_nClass_cppContent.cpp b/nCompiler/inst/include/nCompiler/predefined_nClasses/nodeInstr_nClass/nodeInstr_nClass_cppContent.cpp new file mode 100644 index 00000000..1d323700 --- /dev/null +++ b/nCompiler/inst/include/nCompiler/predefined_nClasses/nodeInstr_nClass/nodeInstr_nClass_cppContent.cpp @@ -0,0 +1,46 @@ +/* OPENER (Do not edit this comment) */ +#ifndef __nodeInstr_nClass_CPP +#define __nodeInstr_nClass_CPP +/* BODY (Do not edit this comment) */ +#ifndef R_NO_REMAP +#define R_NO_REMAP +#endif +#include +#include "nodeInstr_nClass_c_.h" +using namespace Rcpp; +// [[Rcpp::plugins(nCompiler_Eigen_plugin)]] +// [[Rcpp::depends(RcppParallel)]] +// [[Rcpp::depends(nCompiler)]] +// [[Rcpp::depends(Rcereal)]] + + nodeInstr_nClass::nodeInstr_nClass ( ) { +RESET_EIGEN_ERRORS +} + +// [[Rcpp::export(name = "new_nodeInstr_nClass")]] + SEXP new_nodeInstr_nClass ( ) { +RESET_EIGEN_ERRORS +return CREATE_NEW_NCOMP_OBJECT(nodeInstr_nClass);; +} + +// [[Rcpp::export(name = "set_CnClass_env_new_nodeInstr_nClass")]] + void set_CnClass_env_nodeInstr_nClass ( SEXP env ) { +RESET_EIGEN_ERRORS +SET_CNCLASS_ENV(nodeInstr_nClass, env);; +} + +// [[Rcpp::export(name = "get_CnClass_env_new_nodeInstr_nClass")]] + Rcpp::Environment get_CnClass_env_nodeInstr_nClass ( ) { +RESET_EIGEN_ERRORS +return GET_CNCLASS_ENV(nodeInstr_nClass);; +} + +NCOMPILER_INTERFACE( +nodeInstr_nClass, +NCOMPILER_FIELDS( +field("methodInstr", &nodeInstr_nClass::methodInstr), +field("indsInstrVec", &nodeInstr_nClass::indsInstrVec) +), +NCOMPILER_METHODS() +) +#endif diff --git a/nCompiler/inst/include/nCompiler/predefined_nClasses/nodeInstr_nClass/nodeInstr_nClass_filebase.txt b/nCompiler/inst/include/nCompiler/predefined_nClasses/nodeInstr_nClass/nodeInstr_nClass_filebase.txt new file mode 100644 index 00000000..d98d544e --- /dev/null +++ b/nCompiler/inst/include/nCompiler/predefined_nClasses/nodeInstr_nClass/nodeInstr_nClass_filebase.txt @@ -0,0 +1 @@ +nodeInstr_nClass_c_ diff --git a/nCompiler/inst/include/nCompiler/predefined_nClasses/nodeInstr_nClass/nodeInstr_nClass_hContent.h b/nCompiler/inst/include/nCompiler/predefined_nClasses/nodeInstr_nClass/nodeInstr_nClass_hContent.h new file mode 100644 index 00000000..ceeec2d7 --- /dev/null +++ b/nCompiler/inst/include/nCompiler/predefined_nClasses/nodeInstr_nClass/nodeInstr_nClass_hContent.h @@ -0,0 +1,24 @@ +/* OPENER (Do not edit this comment) */ +#ifndef __nodeInstr_nClass_H +#define __nodeInstr_nClass_H +/* BODY (Do not edit this comment) */ +#ifndef R_NO_REMAP +#define R_NO_REMAP +#endif +#include + +class nodeInstr_nClass : public interface_resolver< genericInterfaceC >, public loadedObjectHookC { +public: + nodeInstr_nClass ( ) ; + Eigen::Tensor methodInstr; + nList > indsInstrVec; +}; + + SEXP new_nodeInstr_nClass ( ) ; + + void set_CnClass_env_nodeInstr_nClass ( SEXP env ) ; + + Rcpp::Environment get_CnClass_env_nodeInstr_nClass ( ) ; + + +#endif diff --git a/nCompiler/inst/include/nCompiler/predefined_nClasses/nodeInstr_nClass/nodeInstr_nClass_manifest.txt b/nCompiler/inst/include/nCompiler/predefined_nClasses/nodeInstr_nClass/nodeInstr_nClass_manifest.txt new file mode 100644 index 00000000..82792478 --- /dev/null +++ b/nCompiler/inst/include/nCompiler/predefined_nClasses/nodeInstr_nClass/nodeInstr_nClass_manifest.txt @@ -0,0 +1,7 @@ +list(saved_at = structure(1762351302.257, 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", + hContent = "nodeInstr_nClass_hContent.h", filebase = "nodeInstr_nClass_filebase.txt", + post_cpp_compiler = "nodeInstr_nClass_post_cpp_compiler.txt", + copyFiles = "nodeInstr_nClass_copyFiles.txt")) diff --git a/nCompiler/inst/include/nCompiler/predefined_nClasses/nodeInstr_nClass/nodeInstr_nClass_post_cpp_compiler.txt b/nCompiler/inst/include/nCompiler/predefined_nClasses/nodeInstr_nClass/nodeInstr_nClass_post_cpp_compiler.txt new file mode 100644 index 00000000..e69de29b diff --git a/nCompiler/inst/include/nCompiler/predefined_nClasses/nodeInstr_nClass/nodeInstr_nClass_preamble.cpp b/nCompiler/inst/include/nCompiler/predefined_nClasses/nodeInstr_nClass/nodeInstr_nClass_preamble.cpp new file mode 100644 index 00000000..61410333 --- /dev/null +++ b/nCompiler/inst/include/nCompiler/predefined_nClasses/nodeInstr_nClass/nodeInstr_nClass_preamble.cpp @@ -0,0 +1,6 @@ +#define NCOMPILER_HANDLE_EIGEN_ERRORS +#define NCOMPILER_USES_EIGEN +// #define NCOMPILER_USES_TBB +#define NCOMPILER_USES_NLIST +#define USES_NCOMPILER +#define NCOMPILER_USES_NCLASS_INTERFACE diff --git a/nCompiler/test_compile.cpp b/nCompiler/test_compile.cpp deleted file mode 100644 index 68678dec..00000000 --- a/nCompiler/test_compile.cpp +++ /dev/null @@ -1,21 +0,0 @@ -#ifndef __nFun_2_NFID_2_CPP -#define __nFun_2_NFID_2_CPP -#define NCOMPILER_HANDLE_EIGEN_ERRORS -#ifndef R_NO_REMAP -#define R_NO_REMAP -#endif -#include -#include "test_compile.h" -#include -// [[Rcpp::plugins(nCompiler_Eigen_plugin)]] -// [[Rcpp::depends(RcppEigenAD)]] -// [[Rcpp::depends(RcppParallel)]] -// [[Rcpp::depends(nCompiler)]] -// [[Rcpp::depends(Rcereal)]] - -// [[Rcpp::export]] -double nFun_2_NFID_2 ( double x ) { -RESET_EIGEN_ERRORS -return(x+100.0); -} -#endif diff --git a/nCompiler/test_compile.h b/nCompiler/test_compile.h deleted file mode 100644 index 2d4a691b..00000000 --- a/nCompiler/test_compile.h +++ /dev/null @@ -1,10 +0,0 @@ -#ifndef __nFun_2_NFID_2_H -#define __nFun_2_NFID_2_H -#define NCOMPILER_HANDLE_EIGEN_ERRORS -#ifndef R_NO_REMAP -#define R_NO_REMAP -#endif -#include - -double nFun_2_NFID_2 ( double x ); -#endif diff --git a/nCompiler/test_compile2.cpp b/nCompiler/test_compile2.cpp deleted file mode 100644 index 563af372..00000000 --- a/nCompiler/test_compile2.cpp +++ /dev/null @@ -1,23 +0,0 @@ -#ifndef __nFun_2_NFID_2_CPP -#define __nFun_2_NFID_2_CPP -#define NCOMPILER_HANDLE_EIGEN_ERRORS -#ifndef R_NO_REMAP -#define R_NO_REMAP -#endif -#include -#include "test_compile2.h" -#include -// [[Rcpp::plugins(nCompiler_Eigen_plugin)]] -// [[Rcpp::depends(RcppEigenAD)]] -// [[Rcpp::depends(RcppParallel)]] -// [[Rcpp::depends(nCompiler)]] -// [[Rcpp::depends(Rcereal)]] - -// [[Rcpp::export]] -double nFun_2_NFID_2 ( Eigen::Tensor x ) { -RESET_EIGEN_ERRORS - double y; - flex_(y) = x.sum() + 100.0; -return(y); -} -#endif diff --git a/nCompiler/test_compile2.h b/nCompiler/test_compile2.h deleted file mode 100644 index 9e4edf06..00000000 --- a/nCompiler/test_compile2.h +++ /dev/null @@ -1,11 +0,0 @@ -#ifndef __nFun_2_NFID_2_H -#define __nFun_2_NFID_2_H -#define NCOMPILER_USES_EIGEN -#define NCOMPILER_HANDLE_EIGEN_ERRORS -#ifndef R_NO_REMAP -#define R_NO_REMAP -#endif -#include - -double nFun_2_NFID_2 ( Eigen::Tensor x ); -#endif diff --git a/nCompiler/test_compile3.cpp b/nCompiler/test_compile3.cpp deleted file mode 100644 index 52ccbf03..00000000 --- a/nCompiler/test_compile3.cpp +++ /dev/null @@ -1,83 +0,0 @@ -#ifndef __nClass_1_CPP -#define __nClass_1_CPP -#define NCOMPILER_HANDLE_EIGEN_ERRORS -#define NCOMPILER_USES_EIGEN -#define NCOMPILER_USES_NCLASS_INTERFACE -#ifndef R_NO_REMAP -#define R_NO_REMAP -#endif -#include -#include -#include "test_compile3.h" -using namespace Rcpp; -// [[Rcpp::plugins(nCompiler_Eigen_plugin)]] -// [[Rcpp::depends(RcppEigenAD)]] -// [[Rcpp::depends(RcppParallel)]] -// [[Rcpp::depends(nCompiler)]] -// [[Rcpp::depends(Rcereal)]] - - nClass_1::nClass_1 ( ) { -RESET_EIGEN_ERRORS -} - -// [[Rcpp::export]] -SEXP new_nClass_1 ( ) { -RESET_EIGEN_ERRORS -return CREATE_NEW_NCOMP_OBJECT(nClass_1); -} - -// [[Rcpp::export]] -void set_CnClass_env_nClass_1 ( SEXP env ) { -RESET_EIGEN_ERRORS -SET_CNCLASS_ENV(nClass_1, env); -} - -NCOMPILER_INTERFACE( -nClass_1, -NCOMPILER_FIELDS( -field("x", &nClass_1::x) -), -NCOMPILER_METHODS() -) -#endif -#ifndef __R_interfaces_CPP -#define __R_interfaces_CPP -#ifndef R_NO_REMAP -#define R_NO_REMAP -#endif -#include "test_compile3_interfaces.h" - -inline genericInterfaceBaseC *get_genericInterfaceBaseC(SEXP Xptr) { - return reinterpret_cast - (reinterpret_cast(R_ExternalPtrAddr(Xptr))->get_ptr()); -} - -// This is completely generic, good for all derived classes -// [[Rcpp::export]] -SEXP get_value(SEXP Xptr, const std::string &name) { - genericInterfaceBaseC *obj = - get_genericInterfaceBaseC(Xptr); - // std::cout << name << std::endl; - return(obj->get_value( name )); -} - -// This is completely generic, good for all derived classes -// [[Rcpp::export]] -SEXP set_value(SEXP Xptr, const std::string &name, SEXP Svalue) { - genericInterfaceBaseC *obj = - get_genericInterfaceBaseC(Xptr); - //std::cout << name << std::endl; - obj->set_value( name, Svalue ); - return(R_NilValue); -} - -// This is completely generic, good for all derived classes -// [[Rcpp::export]] -SEXP call_method(SEXP Xptr, const std::string &name, SEXP Sargs) { - genericInterfaceBaseC *obj = - get_genericInterfaceBaseC(Xptr); - // std::cout << name << std::endl; - return(obj->call_method( name, Sargs )); -} - -#endif diff --git a/nCompiler/test_compile3.h b/nCompiler/test_compile3.h deleted file mode 100644 index f516212d..00000000 --- a/nCompiler/test_compile3.h +++ /dev/null @@ -1,26 +0,0 @@ -#ifndef __nClass_1_H -#define __nClass_1_H -#define NCOMPILER_HANDLE_EIGEN_ERRORS -#define NCOMPILER_USES_EIGEN -#define NCOMPILER_USES_NCLASS_INTERFACE -#ifndef R_NO_REMAP -#define R_NO_REMAP -#endif -#include -//#include -//#include -//#include -//#include -//#include - -class nClass_1 : public genericInterfaceC, public loadedObjectHookC { -public: - nClass_1 ( ); - double x; -}; - -SEXP new_nClass_1 ( ); - -void set_CnClass_env_nClass_1 ( SEXP env ); - -#endif diff --git a/nCompiler/test_compile3_interfaces.h b/nCompiler/test_compile3_interfaces.h deleted file mode 100644 index be37e8ea..00000000 --- a/nCompiler/test_compile3_interfaces.h +++ /dev/null @@ -1,10 +0,0 @@ -#ifndef __R_interfaces_H -#define __R_interfaces_H -#ifndef R_NO_REMAP -#define R_NO_REMAP -#endif -// Not sure what if anything is needed here. -//#include -//#include - -#endif diff --git a/nCompiler/tests/testthat/nimble_tests/test-nimbleModel.R b/nCompiler/tests/testthat/nimble_tests/test-nimbleModel.R index 273f3451..bbc7dcfb 100644 --- a/nCompiler/tests/testthat/nimble_tests/test-nimbleModel.R +++ b/nCompiler/tests/testthat/nimble_tests/test-nimbleModel.R @@ -4,32 +4,130 @@ library(nCompiler) library(testthat) -test_that("toy nimble model prototype works", { - varInfoM <- list(list(name = "beta", nDim = 1), list(name = "mu", nDim = 0), - list(name = "gamma", nDim = 2)) +#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)) - #debug(makeModel_nClass) - ncm1 <- makeModel_nClass(varInfoM) - - varInfo <- list(list(name = "x", nDim = 0), list(name = "mu", nDim = 1), +test_that("nimble model prototype works", { + nodeVarInfo <- list(list(name = "x", nDim = 1), list(name = "mu", nDim = 1), list(name = "sd", nDim = 0)) - node_dnorm <- make_node_fun(varInfo) - - Cncm1 <- nCompile(modelBase_nClass, ncm1, node_dnorm) + calc_one <- nFunction( + name = "calc_one", + fun = function(inds = 'integerVector') { + returnType('numericScalar') + ans <- x[inds[1]] + 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) + modelVarInfo <- list(list(name="x", nDim = 1), + list(name = "mu", nDim = 1), + list(name = "sd", nDim = 0), + list(name = "gamma", nDim = 2)) + #debug(makeModel_nClass) + 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_nClass, calcInstr_nClass, nodeInstr_nClass, ncm1, my_nodeFxn) obj <- Cncm1$ncm1$new() - obj$call_setup_node_mgmt() - nodeObj <- obj$beta_node - obj$beta <- 1:3 - expect_equal(obj$beta, 1:3) - obj$set_from_list(list(beta = 10:11)) - obj$set_from_list(list(mu = 110, beta = 11:20, alpha = 101)) + 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(beta = 7)) - expect_error(obj$resize_from_list(list(beta = 5, mu = 3, gamma = c(2, 4)))) - obj$resize_from_list(list(beta = 5, gamma = c(2, 4))) - expect_equal(length(obj$beta), 5) + 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() }) + +###### + +## 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) + } +}) +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_nClass, 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 +# Ditto: this works but relies on nimbleModel +if(FALSE) { + 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) +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) + +nodeFxn_2_nodeIndex <- c(nodeFxn_1 = 1, nodeFxn_3 = 2) + +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 + +calcInstrList <- calcInputList_to_calcInstrList(calcInputList, test) + +obj$calculate(calcInstrList) +} +########