nimbleOptions(enableModelMacros = TRUE)
nimbleOptions(enableMacroComments = FALSE)
nimbleOptions(verbose = FALSE)
## Example 1: Say one is tired of writing "for" loops.
## This macro will generate a "for" loop with dnorm declarations
all_dnorm <- model_macro_builder(
function(stoch, LHS, RHSvar, start, end, sd = 1, modelInfo, .env) {
newCode <- substitute(
for(i in START:END) {
LHS[i] ~ dnorm(RHSvar[i], SD)
},
list(START = start,
END = end,
LHS = LHS,
RHSvar = RHSvar,
SD = sd))
list(code = newCode)
},
use3pieces = TRUE,
unpackArgs = TRUE
)
model1 <- nimbleModel(
nimbleCode(
{
## Create a "for" loop of dnorm declarations by invoking the macro
x ~ all_dnorm(mu, start = 1, end = 10)
}
))
## show code from expansion of macro
model1$getCode()
## The result should be:
## {
## for (i in 1:10) {
## x[i] ~ dnorm(mu[i], 1)
## }
## }
## Example 2: Say one is tired of writing priors.
## This macro will generate a set of priors in one statement
flat_normal_priors <- model_macro_builder(
function(..., modelInfo, .env) {
allVars <- list(...)
priorDeclarations <- lapply(allVars,
function(x)
substitute(VAR ~ dnorm(0, sd = 1000),
list(VAR = x)))
newCode <- quote({})
newCode[2:(length(allVars)+1)] <- priorDeclarations
list(code = newCode)
},
use3pieces = FALSE,
unpackArgs = TRUE
)
model2 <- nimbleModel(
nimbleCode(
{
flat_normal_priors(mu, beta, gamma)
}
))
## show code from expansion of macro
model2$getCode()
## The result should be:
## {
## mu ~ dnorm(0, sd = 1000)
## beta ~ dnorm(0, sd = 1000)
## gamma ~ dnorm(0, sd = 1000)
## }
## Example 3: Macro that modifies constants
new_constant <- model_macro_builder(
function(stoch, LHS, RHS, modelInfo, .env) {
# number of elements
n <- as.numeric(length(modelInfo$constants[[deparse(LHS)]]))
code <- substitute({
for (i in 1:N){
L[i] ~ dnorm(mu[i], 1)
}
}, list(L = LHS, N = n))
# Add a new constant mu
modelInfo$constants$mu <- rnorm(n, 0, 1)
list(code = code, modelInfo = modelInfo)
},
use3pieces = TRUE,
unpackArgs = TRUE
)
const <- list(y = rnorm(10))
code <- nimbleCode({
y ~ new_constant()
})
mod <- nimbleModel(code = code, constants=const)
mod$getCode()
mod$getConstants() # new constant is here
Run the code above in your browser using DataLab