Skip to content

Commit af9055c

Browse files
perrydvperrydv
authored
infrastructure for nimble models (#92)
* manual initializer now works and can manage Cpp object construction if desired * get nimbleModel into CI testing setup * fix test-indexing to allow evolving names of public_methods
1 parent 8c6e04b commit af9055c

8 files changed

Lines changed: 235 additions & 42 deletions

File tree

‎.github/workflows/test-all.yaml‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -39,6 +39,10 @@ jobs:
3939
- uses: actions/checkout@v3
4040
- name: SessionInfo
4141
run: R -q -e 'sessionInfo()'
42+
- name: Install nimbleModel
43+
run: R -q -e 'remotes::install_github("https://github.com/perrydv/nimbleModel", subdir="nimbleModel", auth_token=Sys.getenv("GITHUB_TOKEN_NIMBLEMODEL"))'
44+
env:
45+
GITHUB_TOKEN_NIMBLEMODEL: ${{ secrets.GH_NM_PAT }}
4246
- name: Package Dependencies
4347
run: R -q -e 'remotes::install_deps("nCompiler", dependencies=TRUE)'
4448
- name: Install inline

‎nCompiler/R/NC.R‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -169,10 +169,11 @@ nClass <- function(classname,
169169
# Uncompiled behavior for Cpublic fields needs to be handled.
170170
# Right now a type string like 'numericScalar' just becomes a
171171
# default value.
172+
builtIn <- list(isCompiled=function() FALSE)
172173
eval(substitute(
173174
result <- R6::R6Class(
174175
classname = classname,
175-
public = c(Rpublic, Cpublic),
176+
public = c(Rpublic, Cpublic, builtIn),
176177
portable = FALSE,
177178
inherit = INHERIT,
178179
parent_env = new_env

‎nCompiler/R/NC_FullCompiledInterface.R‎

Lines changed: 46 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -191,6 +191,52 @@ build_compiled_nClass <- function(NCgenerator,
191191

192192
classname <- paste0(NCgenerator$classname, '_compiled')
193193

194+
if("isCompiled" %in% names(RinterfaceMethods))
195+
RinterfaceMethods[["isCompiled"]] <- function() TRUE
196+
197+
## How the initialize scheme works:
198+
## If a user has not provided an Rpublic method called initialize,
199+
## then we insert a default initialize, which takes CppObj and calls initializeCpp(CppObj),
200+
## which builds a new Cpp object in the usual case that CppObj is missing or
201+
## inserts it as the private$CppObj if provided.
202+
## If a user has provided an Rpublic method called initialize,
203+
## then if compileInfo$omit_automatic_Cpp_construction is not TRUE,
204+
## we modify the body of that initialize to call initializeCpp() at the start.
205+
##. In that case, there is no option to pass in a CppObj; the C++ object is always constructed.
206+
## If a user wants to write an initialize AND allow the use of an existing CppObj,
207+
## they must set compileInfo=list(omit_automatic_Cpp_construction=TRUE)
208+
##. AND write the call to initializeCpp(CppObj) themselves, which should normally check
209+
## if the object is compiled: `if(isCompiled()) initializeCpp(CppObj)`.
210+
211+
if("initializeCpp" %in% names(RinterfaceMethods))
212+
stop("Rpublic method name 'initializeCpp' is reserved for nCompiler use.")
213+
214+
RinterfaceMethods[["initializeCpp"]] <- substitute(
215+
function(CppObj) {
216+
if(missing(CppObj)) {
217+
newCobjFun <- NEWCOBJFUN
218+
if(is.null(newCobjFun))
219+
stop("Cannot create a nClass full interface object without a newCobjFun or a CppObj argument.")
220+
CppObj <- newCobjFun()
221+
}
222+
private$CppObj <- CppObj
223+
private$DLLenv <- `:::`("nCompiler", "get_DLLenv")(CppObj) # workaround static code scanning for nCompiler:::get_DLLenv(CppObj)
224+
},
225+
list(
226+
NEWCOBJFUN = if(quoted) as.name(newCobjFun)
227+
else quote(parent.env(parent.env(self))$.newCobjFun)
228+
)
229+
)
230+
omit_automatic_Cpp_construction <- isTRUE(NCI$compileInfo$omit_automatic_Cpp_construction)
231+
if("initialize" %in% names(RinterfaceMethods)) {
232+
if(!omit_automatic_Cpp_construction) {
233+
body(RinterfaceMethods[["initialize"]]) <-
234+
substitute({initializeCpp(); OLDBODY}, list(OLDBODY = body(RinterfaceMethods[["initialize"]])))
235+
}
236+
} else {
237+
if(!omit_automatic_Cpp_construction)
238+
RinterfaceMethods[["initialize"]] <- function(CppObj) {initializeCpp(CppObj)}
239+
}
194240
ans <- substitute(
195241
expr = R6::R6Class(
196242
classname = CLASSNAME,
@@ -199,16 +245,6 @@ build_compiled_nClass <- function(NCgenerator,
199245
DLLenv = NULL
200246
),
201247
public = c(
202-
list(initialize = function(CppObj) {
203-
if(missing(CppObj)) {
204-
newCobjFun <- NEWCOBJFUN
205-
if(is.null(newCobjFun))
206-
stop("Cannot create a nClass full interface object without a newCobjFun or a CppObj argument.")
207-
CppObj <- newCobjFun()
208-
}
209-
private$CppObj <- CppObj
210-
private$DLLenv <- `:::`("nCompiler", "get_DLLenv")(CppObj) # workaround static code scanning for nCompiler:::get_DLLenv(CppObj)
211-
}),
212248
RPUBLIC,
213249
RFIELDS,
214250
CINTERFACE),
@@ -219,10 +255,6 @@ build_compiled_nClass <- function(NCgenerator,
219255
),
220256
env = list(
221257
CLASSNAME = classname,
222-
NEWCOBJFUN = if(quoted) as.name(newCobjFun)
223-
else quote(parent.env(parent.env(self))$.newCobjFun),
224-
#parse(text = paste0('new_', NCgenerator$classname),
225-
# keep.source = FALSE)[[1]],
226258
RPUBLIC = parse(text = deparse(
227259
RinterfaceMethods #NCgenerator$public_methods[RmethodNames]
228260
), keep.source = FALSE)[[1]],

‎nCompiler/R/nimbleModels.R‎

Lines changed: 1 addition & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -128,10 +128,7 @@ make_node_fun <- function(varInfo = list(),
128128
classname) {
129129
# varInfo will be a list (names not used) of name, nDim, sizes.
130130
varInfo_2_cppVar <- \(x) nCompiler:::symbolBasic$new(
131-
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
132-
# varInfo_2_cppVar <- \(x) nCompiler:::symbolCppVar$new(
133-
# baseType = nCompiler:::symbolBasic$new(type="double", nDim=x$nDim, name="")$genCppVar()$generate(),
134-
# ref=TRUE, const=TRUE)
131+
type="double", nDim=x$nDim, name="", isRef=TRUE, isConst=FALSE, interface=FALSE) # In future maybe isConst=TRUE, but it might not matter much
135132
typeList <- varInfo |> lapply(varInfo_2_cppVar)
136133
names(typeList) <- varInfo |> lapply(\(x) x$name) |> unlist()
137134

‎nCompiler/tests/nimble/test-coreR.R‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1090,6 +1090,7 @@ test_that('seq_along works in nimbleFunctions', {
10901090
})
10911091

10921092
## Some tests of using coreR features in BUGS models
1093+
require(nimbleModel)
10931094

10941095
test_that('c(a, 1.1) in BUGS works', {
10951096
mc <- nimbleCode({

‎nCompiler/tests/testthat/nClass_tests/test-nClass_constructor.R‎

Lines changed: 158 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -72,3 +72,161 @@ test_that("nClass replacing default constructor works", {
7272
# rm(obj)
7373
# gc()
7474
})
75+
76+
test_that("manual initialize works and Cpp ctor call is inserted", {
77+
nc <- nClass(
78+
classname = "methods_test",
79+
Rpublic = list(
80+
Ra = 0,
81+
initialize = function() {
82+
print("calling initialize")
83+
self$Ra <- 1
84+
},
85+
get_Ra = function() {
86+
self$Ra
87+
},
88+
get_Ca = function() {
89+
self$Ca
90+
}
91+
),
92+
Cpublic = list(
93+
Ca = 'numericScalar',
94+
methods_test = nFunction(
95+
function() {
96+
nCpp('Rprintf("calling c++ constructor\\n")')
97+
Ca <- 2
98+
},
99+
compileInfo = list(constructor=TRUE)
100+
)
101+
)
102+
)
103+
104+
obj <- nc$new()
105+
expect_equal(obj$Ra, 1)
106+
expect_equal(obj$get_Ra(), 1)
107+
#obj$Ca
108+
#obj$get_Ca()
109+
# Need initialization of uncompiled Cpublic variables?
110+
111+
Cnc <- nCompile(nc)
112+
out <- capture_output(Cobj <- Cnc$new())
113+
# the C++ initializer output should appear BEFORE the R initializer msg
114+
expect_true(regexpr("initialize", out) > regexpr("constructor", out))
115+
116+
expect_equal(Cobj$Ra, 1)
117+
expect_equal(Cobj$get_Ra(), 1)
118+
expect_equal(Cobj$Ca, 2)
119+
expect_equal(Cobj$get_Ca(), 2)
120+
rm(Cobj); gc()
121+
})
122+
123+
124+
test_that("manual initialize with hand-coded C++ initialization works", {
125+
nc <- nClass(
126+
classname = "methods_test",
127+
Rpublic = list(
128+
Ra = 0,
129+
initialize = function() {
130+
print("calling initialize")
131+
if(isCompiled()) initializeCpp()
132+
self$Ra <- 1
133+
},
134+
get_Ra = function() {
135+
self$Ra
136+
},
137+
get_Ca = function() {
138+
self$Ca
139+
}
140+
),
141+
Cpublic = list(
142+
Ca = 'numericScalar',
143+
methods_test = nFunction(
144+
function() {
145+
nCpp('Rprintf("calling c++ constructor\\n")')
146+
Ca <- 2
147+
},
148+
compileInfo = list(constructor=TRUE)
149+
)
150+
),
151+
compileInfo=list(omit_automatic_Cpp_construction=TRUE)
152+
)
153+
154+
obj <- nc$new()
155+
expect_equal(obj$Ra, 1)
156+
expect_equal(obj$get_Ra(), 1)
157+
expect_true(isFALSE(obj$isCompiled()))
158+
#obj$Ca
159+
#obj$get_Ca()
160+
# Need initialization of uncompiled Cpublic variables?
161+
162+
Cnc <- nCompile(nc)
163+
out <- capture_output(Cobj <- Cnc$new())
164+
# the C++ initializer output should now appear AFTER the R initializer msg
165+
expect_true(regexpr("initialize", out) < regexpr("constructor", out))
166+
expect_true(isTRUE(Cobj$isCompiled()))
167+
expect_equal(Cobj$Ra, 1)
168+
expect_equal(Cobj$get_Ra(), 1)
169+
expect_equal(Cobj$Ca, 2)
170+
expect_equal(Cobj$get_Ca(), 2)
171+
rm(Cobj); gc()
172+
})
173+
174+
175+
test_that("manual initialize OMITTED with hand-coded C++ initialization compiles but is correctly broken", {
176+
nc <- nClass(
177+
classname = "methods_test",
178+
Rpublic = list(
179+
Ra = 0,
180+
initialize = function() {
181+
print("calling initialize")
182+
# if(isCompiled()) initializeCpp() # OMITTED!
183+
self$Ra <- 1
184+
},
185+
get_Ra = function() {
186+
self$Ra
187+
},
188+
get_Ca = function() {
189+
self$Ca
190+
}
191+
),
192+
Cpublic = list(
193+
Ca = 'numericScalar',
194+
methods_test = nFunction(
195+
function() {
196+
nCpp('Rprintf("calling c++ constructor\\n")')
197+
Ca <- 2
198+
},
199+
compileInfo = list(constructor=TRUE)
200+
)
201+
),
202+
compileInfo=list(omit_automatic_Cpp_construction=TRUE)
203+
)
204+
205+
obj <- nc$new()
206+
expect_equal(obj$Ra, 1)
207+
expect_equal(obj$get_Ra(), 1)
208+
expect_true(isFALSE(obj$isCompiled()))
209+
#obj$Ca
210+
#obj$get_Ca()
211+
# Need initialization of uncompiled Cpublic variables?
212+
213+
Cnc <- nCompile(nc)
214+
out <- capture_output(Cobj <- Cnc$new())
215+
# the C++ initializer output should now appear AFTER the R initializer msg
216+
expect_true(regexpr("constructor", out)==-1)
217+
expect_true(isTRUE(Cobj$isCompiled()))
218+
expect_equal(Cobj$Ra, 1)
219+
expect_equal(Cobj$get_Ra(), 1)
220+
expect_error(Cobj$Ca)
221+
expect_error(Cobj$get_Ca())
222+
223+
out2 <- capture_output(Cobj$initializeCpp())
224+
expect_true(regexpr("constructor", out2)>0)
225+
expect_true(isTRUE(Cobj$isCompiled()))
226+
expect_equal(Cobj$Ra, 1)
227+
expect_equal(Cobj$get_Ra(), 1)
228+
expect_equal(Cobj$Ca, 2)
229+
expect_equal(Cobj$get_Ca(), 2)
230+
231+
rm(Cobj); gc()
232+
})

‎nCompiler/tests/testthat/nCompile_tests/test-argumentPassing.R‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -14,7 +14,7 @@ message("doing scalar = vector + scalar does not error out if the vector in leng
1414
message("blockRef error trapping can be more involved -- using dims.")
1515
message("blockRef cannot cross between scalar types")
1616

17-
cat("startig test-argumentPassing\n")
17+
cat("starting test-argumentPassing\n")
1818

1919
# This is a workaround to pkg_name::var.
2020
# This is necessary because on GitHub Actions for testing, we use

0 commit comments

Comments
 (0)