if (FALSE) {
sink('add1.h')
cat('
extern "C" {
void my_internal_function(double *p, double*ans, int n);
}
')
sink()
sink('add1.cpp')
cat('
#include
#include "add1.h"
void my_internal_function(double *p, double *ans, int n) {
printf("In my_internal_function\\n");
/* cat reduces the double slash to single slash */
for(int i = 0; i < n; i++)
ans[i] = p[i] + 1.0;
}
')
sink()
system('g++ add1.cpp -c -o add1.o')
Radd1 <- nimbleExternalCall(function(x = double(1), ans = double(1),
n = integer()){}, Cfun = 'my_internal_function',
headerFile = file.path(getwd(), 'add1.h'), returnType = void(),
oFile = file.path(getwd(), 'add1.o'))
## If you need to use a function with non-scalar return object in model code,
## you can wrap it in another nimbleFunction like this:
model_add1 <- nimbleFunction(
run = function(x = double(1)) {
ans <- numeric(length(x))
Radd1(x, ans, length(x))
return(ans)
returnType(double(1))
})
demoCode <- nimbleCode({
for(i in 1:4) {x[i] ~ dnorm(0,1)} ## just to get a vector
y[1:4] <- model_add1(x[1:4])
})
demoModel <- nimbleModel(demoCode, inits = list(x = rnorm(4)),
check = FALSE, calculate = FALSE)
CdemoModel <- compileNimble(demoModel, showCompilerOutput = TRUE)
}
Run the code above in your browser using DataLab