R Under development (unstable) (2026-08-05 r90355) -- "Unsuffered Consequences" Copyright (C) 2026 The R Foundation for Statistical Computing Platform: x86_64-pc-linux-gnu R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. Natural language support but running in an English locale R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > pkgname <- "nimble" > source(file.path(R.home("share"), "R", "examples-header.R")) > options(warn = 1) > library('nimble') nimble version 1.4.2 is loaded. For more information on NIMBLE and a User Manual, please visit https://R-nimble.org. Attaching package: ‘nimble’ The following object is masked from ‘package:stats’: simulate The following object is masked from ‘package:base’: declare > > base::assign(".oldSearch", base::search(), pos = 'CheckExEnv') > base::assign(".old_wd", base::getwd(), pos = 'CheckExEnv') > cleanEx() > nameEx("CAR-Normal") > ### * CAR-Normal > > flush(stderr()); flush(stdout()) > > ### Name: CAR-Normal > ### Title: The CAR-Normal Distribution > ### Aliases: CAR-Normal dcar_normal rcar_normal > > ### ** Examples > > x <- c(1, 3, 3, 4) > num <- c(1, 2, 2, 1) > adj <- c(2, 1,3, 2,4, 3) > weights <- c(1, 1, 1, 1, 1, 1) > lp <- dcar_normal(x, adj, weights, num, tau = 1) > > > > cleanEx() > nameEx("CAR-Proper") > ### * CAR-Proper > > flush(stderr()); flush(stdout()) > > ### Name: CAR-Proper > ### Title: The CAR-Proper Distribution > ### Aliases: CAR-Proper dcar_proper rcar_proper > > ### ** Examples > > > x <- c(1, 3, 3, 4) > mu <- rep(3, 4) > adj <- c(2, 1,3, 2,4, 3) > num <- c(1, 2, 2, 1) > > ## omitting C and M uses all weights = 1 > dcar_proper(x, mu, adj = adj, num = num, tau = 1, gamma = 0.95) /usr/local/clang22me/bin/../include/c++/v1/__string/constexpr_c_functions.h:227:25: runtime error: store to misaligned address 0x000000000001 for type 'double *', which requires 8 byte alignment 0x000000000001: note: pointer points here #0 0x7fcb760c1b9a in double* std::__1::__constexpr_memmove[abi:nqe220108](double*, double const*, std::__1::__element_count) /usr/local/clang22me/bin/../include/c++/v1/__string/constexpr_c_functions.h:227:5 #1 0x7fcb760c1b9a in std::__1::pair std::__1::__copy_trivial_impl[abi:nqe220108](double const*, double const*, double*) /usr/local/clang22me/bin/../include/c++/v1/__algorithm/copy_move_common.h:64:3 #2 0x7fcb760c1b9a in std::__1::pair std::__1::__copy_impl::operator()[abi:nqe220108](double const*, double const*, double*) const /usr/local/clang22me/bin/../include/c++/v1/__algorithm/copy.h:115:12 #3 0x7fcb760c1b9a in std::__1::pair std::__1::__copy_move_unwrap_iters[abi:nqe220108](double const*, double const*, double*) /usr/local/clang22me/bin/../include/c++/v1/__algorithm/copy_move_common.h:94:19 #4 0x7fcb760bda9b in SEXPREC* NimArr_2_SEXP<2>(NimArr<2, double>&) /data/localhost/ripley/R/packages/tests-clang-UBSAN/nimble/src/../inst/include/nimble/RcppNimbleUtils.h:313:3 #5 0x7fcb760bca1d in EIGEN_EIGENCLASS_R::copyToSEXP() /data/localhost/ripley/R/packages/tests-clang-UBSAN/nimble/src/eigenUsingClasses.cpp:78:22 #6 0x7fcb760bd11f in C_nimEigen /data/localhost/ripley/R/packages/tests-clang-UBSAN/nimble/src/eigenUsingClasses.cpp:162:16 #7 0x55c3daff6585 in R_doDotCall (/data/localhost/ripley/R/R-clang/bin/exec/R+0x8f585) #8 0x55c3db0424b7 in bcEval_loop eval.c #9 0x55c3db03083b in bcEval eval.c #10 0x55c3db02fff4 in Rf_eval (/data/localhost/ripley/R/R-clang/bin/exec/R+0xc8ff4) #11 0x55c3db048158 in R_execClosure eval.c #12 0x55c3db04764a in applyClosure_core eval.c #13 0x55c3db030f16 in Rf_applyClosure (/data/localhost/ripley/R/R-clang/bin/exec/R+0xc9f16) #14 0x55c3db030447 in Rf_eval (/data/localhost/ripley/R/R-clang/bin/exec/R+0xc9447) #15 0x55c3db030a93 in forcePromise eval.c #16 0x55c3db0445bf in getvar eval.c #17 0x55c3db034c78 in bcEval_loop eval.c #18 0x55c3db03083b in bcEval eval.c #19 0x55c3db02fff4 in Rf_eval (/data/localhost/ripley/R/R-clang/bin/exec/R+0xc8ff4) #20 0x55c3db048158 in R_execClosure eval.c #21 0x55c3db04764a in applyClosure_core eval.c #22 0x55c3db030f16 in Rf_applyClosure (/data/localhost/ripley/R/R-clang/bin/exec/R+0xc9f16) #23 0x55c3db030447 in Rf_eval (/data/localhost/ripley/R/R-clang/bin/exec/R+0xc9447) #24 0x55c3db07d777 in Rf_ReplIteration (/data/localhost/ripley/R/R-clang/bin/exec/R+0x116777) #25 0x55c3db07f27e in run_Rmainloop (/data/localhost/ripley/R/R-clang/bin/exec/R+0x11827e) #26 0x55c3db07f2ea in Rf_mainloop (/data/localhost/ripley/R/R-clang/bin/exec/R+0x1182ea) #27 0x55c3daf68db7 in main (/data/localhost/ripley/R/R-clang/bin/exec/R+0x1db7) #28 0x7fcb8090b680 in __libc_start_call_main (/lib64/libc.so.6+0x3680) (BuildId: 17f2e1fd905f485786f6fd6e3bede4ad737137e7) #29 0x7fcb8090b797 in __libc_start_main@GLIBC_2.2.5 (/lib64/libc.so.6+0x3797) (BuildId: 17f2e1fd905f485786f6fd6e3bede4ad737137e7) #30 0x55c3daf68cd4 in _start (/data/localhost/ripley/R/R-clang/bin/exec/R+0x1cd4) SUMMARY: UndefinedBehaviorSanitizer: undefined-behavior /usr/local/clang22me/bin/../include/c++/v1/__string/constexpr_c_functions.h:227:25 [1] 0.001142647 > > ## equivalent to above: specifying all weights = 1, > ## then using as.carCM to generate C and M arguments > weights <- rep(1, 6) > CM <- as.carCM(adj, weights, num) > C <- CM$C > M <- CM$M > dcar_proper(x, mu, C, adj, num, M, tau = 1, gamma = 0.95) [1] 0.001142647 > > ## now using non-unit weights > weights <- c(2, 2, 3, 3, 4, 4) > CM2 <- as.carCM(adj, weights, num) > C2 <- CM2$C > M2 <- CM2$M > dcar_proper(x, mu, C2, adj, num, M2, tau = 1, gamma = 0.95) [1] 0.0002922717 > > > > cleanEx() > nameEx("Categorical") > ### * Categorical > > flush(stderr()); flush(stdout()) > > ### Name: Categorical > ### Title: The Categorical Distribution > ### Aliases: Categorical dcat rcat > > ### ** Examples > > probs <- c(1/4, 1/10, 1 - 1/4 - 1/10) > x <- rcat(n = 30, probs) > dcat(x, probs) [1] 0.10 0.65 0.65 0.65 0.25 0.65 0.65 0.65 0.65 0.25 0.25 0.25 0.65 0.65 0.65 [16] 0.65 0.65 0.65 0.65 0.65 0.65 0.25 0.65 0.25 0.10 0.65 0.25 0.65 0.65 0.10 > > > > > cleanEx() > nameEx("ChineseRestaurantProcess") > ### * ChineseRestaurantProcess > > flush(stderr()); flush(stdout()) > > ### Name: ChineseRestaurantProcess > ### Title: The Chinese Restaurant Process Distribution > ### Aliases: ChineseRestaurantProcess dCRP rCRP > > ### ** Examples > > x <- rCRP(n=1, conc = 1, size=10) > dCRP(x, conc = 1, size=10) [1] 6.613757e-05 > > > > cleanEx() > nameEx("Constraint") > ### * Constraint > > flush(stderr()); flush(stdout()) > > ### Name: Constraint > ### Title: Constraint calculations in NIMBLE > ### Aliases: Constraint dconstraint rconstraint > > ### ** Examples > > constr <- 3 > 2 && 4 > 0 > x <- rconstraint(1, constr) > dconstraint(x, constr) [1] 1 > dconstraint(0, 3 > 4) [1] 1 > dconstraint(1, 3 > 4) [1] 0 > rconstraint(1, 3 > 4) [1] 0 > > > > cleanEx() > nameEx("Dirichlet") > ### * Dirichlet > > flush(stderr()); flush(stdout()) > > ### Name: Dirichlet > ### Title: The Dirichlet Distribution > ### Aliases: Dirichlet dirichlet ddirch rdirch > > ### ** Examples > > alpha <- c(1, 10, 30) > x <- rdirch(1, alpha) > ddirch(x, alpha) [1] 180.0518 > > > > cleanEx() > nameEx("Double-Exponential") > ### * Double-Exponential > > flush(stderr()); flush(stdout()) > > ### Name: Double-Exponential > ### Title: The Double Exponential (Laplace) Distribution > ### Aliases: Double-Exponential ddexp rdexp pdexp qdexp > > ### ** Examples > > x <- rdexp(50, location = 2, scale = 1) > ddexp(x, 2, 1) [1] 0.153387181 0.434768122 0.362495664 0.027650382 0.291466553 0.323555636 [7] 0.148609224 0.431627138 0.233359047 0.005993490 0.177569868 0.259786843 [13] 0.277585329 0.319637073 0.263147710 0.283934215 0.471146430 0.009541734 [19] 0.314184572 0.184526880 0.054833526 0.191784834 0.361621450 0.407930880 [25] 0.369764813 0.235819199 0.175067072 0.169817947 0.137324461 0.287139081 [31] 0.189465310 0.298997078 0.327787540 0.119996616 0.291402533 0.131778778 [37] 0.405346200 0.165450463 0.457114552 0.330160408 0.163130953 0.103816119 [43] 0.324886525 0.160417001 0.221681098 0.064583104 0.412891194 0.049508109 [49] 0.375784978 0.410930152 > > > > cleanEx() > nameEx("Exponential") > ### * Exponential > > flush(stderr()); flush(stdout()) > > ### Name: Exponential > ### Title: The Exponential Distribution > ### Aliases: Exponential dexp_nimble rexp_nimble pexp_nimble qexp_nimble > > ### ** Examples > > x <- rexp_nimble(50, scale = 3) > dexp_nimble(x, scale = 3) [1] 0.156641720 0.102258121 0.288137058 0.289845415 0.215524451 0.018433588 [7] 0.097473538 0.194311035 0.128069809 0.287751425 0.082964090 0.155572698 [13] 0.096692848 0.003995660 0.116117176 0.118379912 0.051065433 0.173191229 [19] 0.237985444 0.185056886 0.031331618 0.175431807 0.248395592 0.189289477 [25] 0.299786444 0.314097620 0.186873240 0.006361156 0.103113558 0.123017920 [31] 0.079349143 0.321139133 0.241080966 0.089003444 0.271953920 0.119871114 [37] 0.246509876 0.161406929 0.157212800 0.263516383 0.113211964 0.119211126 [43] 0.091549640 0.095205493 0.191426054 0.246622788 0.091470666 0.123295906 [49] 0.199331386 0.044759808 > > > > cleanEx() > nameEx("Interval") > ### * Interval > > flush(stderr()); flush(stdout()) > > ### Name: Interval > ### Title: Interval calculations > ### Aliases: Interval dinterval rinterval > > ### ** Examples > > endpoints <- c(-3, 0, 3) > vals <- c(-4, -1, 1, 5) > x <- rinterval(4, vals, endpoints) > dinterval(x, vals, endpoints) [1] 1 1 1 1 > dinterval(c(1, 5, 2, 3), vals, endpoints) [1] 0 0 1 1 > > > > cleanEx() > nameEx("Inverse-Gamma") > ### * Inverse-Gamma > > flush(stderr()); flush(stdout()) > > ### Name: Inverse-Gamma > ### Title: The Inverse Gamma Distribution > ### Aliases: Inverse-Gamma dinvgamma rinvgamma pinvgamma qinvgamma > > ### ** Examples > > x <- rinvgamma(50, shape = 1, scale = 3) > dinvgamma(x, shape = 1, scale = 3) [1] 6.870002e-03 1.797988e-01 1.786112e-01 1.010017e-01 1.467113e-01 [6] 1.404413e-01 1.213966e-01 2.315904e-02 2.714837e-03 7.039156e-03 [11] 2.359798e-02 4.583108e-02 1.448091e-03 1.491578e-01 1.236195e-01 [16] 1.583102e-01 1.451479e-01 5.880712e-02 1.452448e-01 1.705812e-01 [21] 5.001964e-03 1.284832e-02 2.839827e-02 4.008711e-02 6.156320e-03 [26] 1.017789e-01 1.537087e-02 1.714147e-01 1.431373e-01 3.438791e-02 [31] 1.412762e-02 1.190305e-01 5.059020e-03 1.095003e-01 9.887523e-02 [36] 7.345038e-03 2.777056e-03 1.804152e-01 1.551611e-01 1.903333e-02 [41] 3.615157e-02 4.641646e-02 3.884565e-02 3.772409e-03 1.714813e-01 [46] 1.382820e-01 1.088001e-01 4.527482e-03 3.853050e-02 1.376343e-05 > > > > cleanEx() > nameEx("Inverse-Wishart") > ### * Inverse-Wishart > > flush(stderr()); flush(stdout()) > > ### Name: Inverse-Wishart > ### Title: The Inverse Wishart Distribution > ### Aliases: Inverse-Wishart inverse-wishart dinvwish_chol rinvwish_chol > > ### ** Examples > > df <- 40 > ch <- chol(matrix(c(1, .7, .7, 1), 2)) > x <- rwish_chol(1, ch, df = df) > dwish_chol(x, ch, df = df) [1] 5.729682e-05 > > > > > cleanEx() > nameEx("LKJ") > ### * LKJ > > flush(stderr()); flush(stdout()) > > ### Name: LKJ > ### Title: The LKJ Distribution for the Cholesky Factor of a Correlation > ### Matrix > ### Aliases: LKJ lkj dlkj rlkj lkj_corr lkj_corr_cholesky > ### dlkj_corr_cholesky rlkj_corr_cholesky > > ### ** Examples > > eta <- 3 > x <- rlkj_corr_cholesky(1, eta, 5) > dlkj_corr_cholesky(x, eta, 5) [1] 0.06535809 > > > > > cleanEx() > nameEx("MCMCconf-class") > ### * MCMCconf-class > > flush(stderr()); flush(stdout()) > > ### Name: MCMCconf-class > ### Title: Class 'MCMCconf' > ### Aliases: MCMCconf-class MCMCconf addSampler removeSamplers setSamplers > ### printSamplers getSamplers setSamplerExecutionOrder > ### getSamplerExecutionOrder addMonitors addMonitors2 setMonitors > ### setMonitors2 resetMonitors getMonitors getMonitors2 printMonitors > ### setThin setThin2 addDerivedQuantity removeDerivedQuantity > ### removeDerivedQuantities printDerivedQuantities getDerivedQuantities > ### getDerivedQuantityDefinition > > ### ** Examples > > code <- nimbleCode({ + mu ~ dnorm(0, 1) + x ~ dnorm(mu, 1) + }) > Rmodel <- nimbleModel(code) Defining model Building model Running calculate on model [Note] Any error reports that follow may simply reflect missing values in model variables. Checking model sizes and dimensions [Note] This model is not fully initialized. This is not an error. To see which variables are not initialized, use model$initializeInfo(). For more information on model initialization, see help(modelInitialization). > conf <- configureMCMC(Rmodel) ===== Monitors ===== thin = 1: mu ===== Samplers ===== posterior_predictive sampler (1) - mu ===== Comments ===== [Note] Additional downstream predictive nodes are also being sampled by posterior_predictive sampler. > conf$setSamplers(1) > conf$addSampler(target = 'x', type = 'slice', control = list(adaptInterval = 100)) > conf$addMonitors('mu') thin = 1: mu > conf$addMonitors2('x') thin = 1: mu thin2 = 1: x > conf$setThin(5) thin = 5: mu thin2 = 1: x > conf$setThin2(10) thin = 5: mu thin2 = 10: x > conf$printMonitors() thin = 5: mu thin2 = 10: x > conf$printSamplers() [1] posterior_predictive sampler: mu [2] slice sampler: x, adaptInterval: 100 > > > > cleanEx() > nameEx("Multinomial") > ### * Multinomial > > flush(stderr()); flush(stdout()) > > ### Name: Multinomial > ### Title: The Multinomial Distribution > ### Aliases: Multinomial multinomial dmulti rmulti > > ### ** Examples > > size <- 30 > probs <- c(1/4, 1/10, 1 - 1/4 - 1/10) > x <- rmulti(1, size, probs) > dmulti(x, size, probs) [1] 0.03456631 > > > > cleanEx() > nameEx("Multivariate-t") > ### * Multivariate-t > > flush(stderr()); flush(stdout()) > > ### Name: Multivariate-t > ### Title: The Multivariate t Distribution > ### Aliases: Multivariate-t mvt multivariate-t dmvt_chol rmvt_chol > > ### ** Examples > > mu <- c(-10, 0, 10) > scalemat <- matrix(c(1, .9, .3, .9, 1, -0.1, .3, -0.1, 1), 3) > ch <- chol(scalemat) > x <- rmvt_chol(1, mu, ch, df = 1, prec_param = FALSE) > dmvt_chol(x, mu, ch, df = 1, prec_param = FALSE) [1] 0.1317285 > > > > > cleanEx() > nameEx("MultivariateNormal") > ### * MultivariateNormal > > flush(stderr()); flush(stdout()) > > ### Name: MultivariateNormal > ### Title: The Multivariate Normal Distribution > ### Aliases: MultivariateNormal dmnorm_chol rmnorm_chol dmnorm_inv_ld > ### rmnorm_inv_ld > > ### ** Examples > > mean <- c(-10, 0, 10) > covmat <- matrix(c(1, .9, .3, .9, 1, -0.1, .3, -0.1, 1), 3) > ch <- chol(covmat) > x <- rmnorm_chol(1, mean, ch, prec_param = FALSE) > dmnorm_chol(x, mean, ch, prec_param = FALSE) [1] 0.1907256 > > > > cleanEx() > nameEx("StickBreakingFunction") > ### * StickBreakingFunction > > flush(stderr()); flush(stdout()) > > ### Name: StickBreakingFunction > ### Title: The Stick Breaking Function > ### Aliases: StickBreakingFunction stickbreaking stick_breaking > > ### ** Examples > > z <- rbeta(5, 1, 1) > stick_breaking(z) [1] 0.734491337 0.113411132 0.121422207 0.001697104 0.010747615 0.018230605 > > ## Not run: > ##D cstick_breaking <- compileNimble(stick_breaking) > ##D cstick_breaking(z) > ## End(Not run) > > > > cleanEx() > nameEx("Wishart") > ### * Wishart > > flush(stderr()); flush(stdout()) > > ### Name: Wishart > ### Title: The Wishart Distribution > ### Aliases: Wishart wishart dwish_chol rwish_chol > > ### ** Examples > > df <- 40 > ch <- chol(matrix(c(1, .7, .7, 1), 2)) > x <- rwish_chol(1, ch, df = df) > dwish_chol(x, ch, df = df) [1] 5.729682e-05 > > > > > cleanEx() > nameEx("buildMCEM") > ### * buildMCEM > > flush(stderr()); flush(stdout()) > > ### Name: buildMCEM > ### Title: Builds an MCEM algorithm for a given NIMBLE model > ### Aliases: buildMCEM > > ### ** Examples > > ## Not run: > ##D pumpCode <- nimbleCode({ > ##D for (i in 1:N){ > ##D theta[i] ~ dgamma(alpha,beta); > ##D lambda[i] <- theta[i]*t[i]; > ##D x[i] ~ dpois(lambda[i]) > ##D } > ##D alpha ~ dexp(1.0); > ##D beta ~ dgamma(0.1,1.0); > ##D }) > ##D > ##D pumpConsts <- list(N = 10, > ##D t = c(94.3, 15.7, 62.9, 126, 5.24, > ##D 31.4, 1.05, 1.05, 2.1, 10.5)) > ##D > ##D pumpData <- list(x = c(5, 1, 5, 14, 3, 19, 1, 1, 4, 22)) > ##D > ##D pumpInits <- list(alpha = 1, beta = 1, > ##D theta = rep(0.1, pumpConsts$N)) > ##D pumpModel <- nimbleModel(code = pumpCode, name = 'pump', constants = pumpConsts, > ##D data = pumpData, inits = pumpInits, > ##D buildDerivs=TRUE) > ##D > ##D pumpMCEM <- buildMCEM(model = pumpModel) > ##D > ##D CpumpModel <- compileNimble(pumpModel) > ##D > ##D CpumpMCEM <- compileNimble(pumpMCEM, project=pumpModel) > ##D > ##D MLE <- CpumpMCEM$findMLE() > ##D vcov <- CpumpMCEM$vcov(MLE$par) > ##D > ## End(Not run) > > > > cleanEx() > nameEx("buildMCMC") > ### * buildMCMC > > flush(stderr()); flush(stdout()) > > ### Name: buildMCMC > ### Title: Create an MCMC object from a NIMBLE model, or an MCMC > ### configuration object > ### Aliases: buildMCMC > > ### ** Examples > > ## Not run: > ##D code <- nimbleCode({ > ##D mu ~ dnorm(0, 1) > ##D x ~ dnorm(mu, 1) > ##D y ~ dnorm(x, 1) > ##D }) > ##D Rmodel <- nimbleModel(code, data = list(y = 0)) > ##D conf <- configureMCMC(Rmodel, monitors = c('mu', 'x'), enableWAIC = TRUE) > ##D Rmcmc <- buildMCMC(conf) > ##D Cmodel <- compileNimble(Rmodel) > ##D Cmcmc <- compileNimble(Rmcmc, project=Rmodel) > ##D > ##D ## Running the MCMC with `run` > ##D Cmcmc$run(10000) > ##D samples <- as.matrix(Cmcmc$mvSamples) > ##D samplesAsList <- as.list(Cmcmc$mvSamples) > ##D head(samples) > ##D > ##D ## Getting WAIC > ##D waicInfo <- Cmcmc$getWAIC() > ##D waicInfo$WAIC > ##D waicInfo$pWAIC > ##D > ##D ## Timing the samplers (must set `time = TRUE` when running the MCMC) > ##D Cmcmc$run(10000, time = TRUE) > ##D Cmcmc$getTimes() > ## End(Not run) > > > > > cleanEx() > nameEx("buildMacro") > ### * buildMacro > > flush(stderr()); flush(stdout()) > > ### Name: buildMacro > ### Title: EXPERIMENTAL: Turn a function into a model macro > ### Aliases: buildMacro > > ### ** Examples > > nimbleOptions(enableMacros = 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 <- buildMacro( + 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() { for (i in 1:10) { x[i] ~ dnorm(mu[i], 1) } } > ## 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 <- buildMacro( + 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() { mu ~ dnorm(0, sd = 1000) beta ~ dnorm(0, sd = 1000) gamma ~ dnorm(0, sd = 1000) } > ## 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 <- buildMacro( + 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() { for (i in 1:10) { y[i] ~ dnorm(mu[i], 1) } } > mod$getConstants() # new constant is here $mu [1] 1.51178117 0.38984324 -0.62124058 -2.21469989 1.12493092 -0.04493361 [7] -0.01619026 0.94383621 0.82122120 0.59390132 > > > > cleanEx() > nameEx("calculateWAIC") > ### * calculateWAIC > > flush(stderr()); flush(stdout()) > > ### Name: calculateWAIC > ### Title: Calculating WAIC using an offline algorithm > ### Aliases: calculateWAIC > > ### ** Examples > > code <- nimbleCode({ + for(j in 1:J) { + for(i in 1:n) + y[j, i] ~ dnorm(mu[j], sd = sigma) + mu[j] ~ dnorm(mu0, sd = tau) + } + tau ~ dunif(0, 10) + sigma ~ dunif(0, 10) + }) > J <- 5 > n <- 10 > y <- matrix(rnorm(J*n), J, n) > Rmodel <- nimbleModel(code, constants = list(J = J, n = n), data = list(y = y), + inits = list(tau = 1, sigma = 1)) > > ## Make sure the needed variables are monitored. > ## Only conditional WAIC without data grouping is available via this approach. > conf <- configureMCMC(Rmodel, monitors = c('mu', 'sigma')) > ## Not run: > ##D Cmodel <- compileNimble(Rmodel) > ##D Rmcmc <- buildMCMC(conf) > ##D Cmcmc <- compileNimble(Rmcmc, project = Rmodel) > ##D output <- runMCMC(Cmcmc, niter = 1000) > ##D calculateWAIC(Cmcmc) # Can run on the MCMC object > ##D calculateWAIC(output, Rmodel) # Can run on the samples directly > ##D > ##D ## Apply additional burnin (additional to any burnin already done in the MCMC. > ##D calculateWAIC(Cmcmc, burnin = 500) > ## End(Not run) > > > > cleanEx() > nameEx("configureRJ") > ### * configureRJ > > flush(stderr()); flush(stdout()) > > ### Name: configureRJ > ### Title: Configure Reversible Jump for Variable Selection > ### Aliases: configureRJ > > ### ** Examples > > > ## Not run: > ##D > ##D ## Linear regression with intercept and two covariates, using indicator variables > ##D > ##D code <- nimbleCode({ > ##D beta0 ~ dnorm(0, sd = 100) > ##D beta1 ~ dnorm(0, sd = 100) > ##D beta2 ~ dnorm(0, sd = 100) > ##D sigma ~ dunif(0, 100) > ##D z1 ~ dbern(psi) ## indicator variable associated with beta1 > ##D z2 ~ dbern(psi) ## indicator variable associated with beta2 > ##D psi ~ dunif(0, 1) ## hyperprior on inclusion probability > ##D for(i in 1:N) { > ##D Ypred[i] <- beta0 + beta1 * z1 * x1[i] + beta2 * z2 * x2[i] > ##D Y[i] ~ dnorm(Ypred[i], sd = sigma) > ##D } > ##D }) > ##D > ##D ## simulate some data > ##D set.seed(1) > ##D N <- 100 > ##D x1 <- runif(N, -1, 1) > ##D x2 <- runif(N, -1, 1) ## this covariate is not included > ##D Y <- rnorm(N, 1 + 2.5 * x1, sd = 1) > ##D > ##D ## build the model > ##D rIndicatorModel <- nimbleModel(code, constants = list(N = N), > ##D data = list(Y = Y, x1 = x1, x2 = x2), > ##D inits = list(beta0 = 0, beta1 = 0, beta2 = 0, sigma = sd(Y), > ##D z1 = 1, z2 = 1, psi = 0.5)) > ##D > ##D indicatorModelConf <- configureMCMC(rIndicatorModel) > ##D > ##D ## Add reversible jump > ##D configureRJ(conf = indicatorModelConf, ## model configuration > ##D targetNodes = c("beta1", "beta2"), ## coefficients for selection > ##D indicatorNodes = c("z1", "z2"), ## indicators paired with coefficients > ##D control = list(mean = 0, scale = 2)) > ##D > ##D indicatorModelConf$addMonitors("beta1", "beta2", "z1", "z2") > ##D > ##D rIndicatorMCMC <- buildMCMC(indicatorModelConf) > ##D cIndicatorModel <- compileNimble(rIndicatorModel) > ##D cIndicatorMCMC <- compileNimble(rIndicatorMCMC, project = rIndicatorModel) > ##D > ##D set.seed(1) > ##D samples <- runMCMC(cIndicatorMCMC, 10000, nburnin = 6000) > ##D > ##D ## posterior probability to be included in the mode > ##D mean(samples[ , "z1"]) > ##D mean(samples[ , "z2"]) > ##D > ##D ## posterior means when in the model > ##D mean(samples[ , "beta1"][samples[ , "z1"] != 0]) > ##D mean(samples[ , "beta2"][samples[ , "z2"] != 0]) > ##D > ##D > ##D ## Linear regression with intercept and two covariates, without indicator variables > ##D > ##D code <- nimbleCode({ > ##D beta0 ~ dnorm(0, sd = 100) > ##D beta1 ~ dnorm(0, sd = 100) > ##D beta2 ~ dnorm(0, sd = 100) > ##D sigma ~ dunif(0, 100) > ##D for(i in 1:N) { > ##D Ypred[i] <- beta0 + beta1 * x1[i] + beta2 * x2[i] > ##D Y[i] ~ dnorm(Ypred[i], sd = sigma) > ##D } > ##D }) > ##D > ##D rNoIndicatorModel <- nimbleModel(code, constants = list(N = N), > ##D data = list(Y = Y, x1 = x1, x2 = x2), > ##D inits= list(beta0 = 0, beta1 = 0, beta2 = 0, sigma = sd(Y))) > ##D > ##D noIndicatorModelConf <- configureMCMC(rNoIndicatorModel) > ##D > ##D ## Add reversible jump > ##D configureRJ(conf = noIndicatorModelConf, ## model configuration > ##D targetNodes = c("beta1", "beta2"), ## coefficients for selection > ##D priorProb = 0.5, ## prior probability of inclusion > ##D control = list(mean = 0, scale = 2)) > ##D > ##D ## add monitors > ##D noIndicatorModelConf$addMonitors("beta1", "beta2") > ##D rNoIndicatorMCMC <- buildMCMC(noIndicatorModelConf) > ##D > ##D cNoIndicatorModel <- compileNimble(rNoIndicatorModel) > ##D cNoIndicatorMCMC <- compileNimble(rNoIndicatorMCMC, project = rNoIndicatorModel) > ##D > ##D set.seed(1) > ##D samples <- runMCMC(cNoIndicatorMCMC, 10000, nburnin = 6000) > ##D > ##D ## posterior probability to be included in the mode > ##D mean(samples[ , "beta1"] != 0) > ##D mean(samples[ , "beta2"] != 0) > ##D > ##D ## posterior means when in the model > ##D mean(samples[ , "beta1"][samples[ , "beta1"] != 0]) > ##D mean(samples[ , "beta2"][samples[ , "beta2"] != 0]) > ## End(Not run) > > > > > cleanEx() > nameEx("declare") > ### * declare > > flush(stderr()); flush(stdout()) > > ### Name: declare > ### Title: Explicitly declare a variable in run-time code of a > ### nimbleFunction > ### Aliases: declare > > ### ** Examples > > declare(A, logical()) ## scalar logical, the only kind allowed NULL > declare(B, integer(2, c(10, 10))) ## 10 x 10 integer matrix > declare(C, double(3)) ## 3-dimensional double array with no sizes set. > > > > cleanEx() > nameEx("derived") > ### * derived > > flush(stderr()); flush(stdout()) > > ### Name: derived_BASE > ### Title: MCMC Derived Quantities > ### Aliases: derived_BASE derived_mean derived_variance derived_logProb > ### derived_predictive derived > > ### ** Examples > > ## Not run: > ##D conf <- configureMCMC(model) > ##D > ##D conf$addDerivedQuantity("mean", nodes = c("a", "b")) > ##D > ##D conf$addDerivedQuantity("mean", nodes = "theta", interval = 5) > ##D > ##D conf$addDerivedQuantity("variance", nodes = "x[1:4]", control = list(recordingFrequency = 10)) > ##D > ##D conf$addDerivedQuantity("logProb", nodes = c('alpha', 'beta')) > ##D > ##D conf <- configureMCMC(model, mean = 'a', variance = 'b', logProb = TRUE) > ## End(Not run) > > > > > cleanEx() > nameEx("distributionInfo") > ### * distributionInfo > > flush(stderr()); flush(stdout()) > > ### Name: distributionInfo > ### Title: Get information about a distribution > ### Aliases: distributionInfo isUserDefined pqDefined getType getParamNames > ### getDistributionInfo > > ### ** Examples > > distInfo <- getDistributionInfo('dnorm') > distInfo Reference class object of class "distClass" Field "BUGSdistName": [1] "dnorm" Field "BUGSdistExpr": dnorm(mean, tau, sd, var) Field "RdistExprList": [[1]] dnorm(mean, sd = 1/sqrt(tau)) [[2]] dnorm(mean, sd = sqrt(var)) Field "numAlts": [1] 2 Field "alts": [[1]] [1] "tau" "mean" [[2]] [1] "var" "mean" Field "exprs": [[1]] [[1]]$sd 1/sqrt(tau) [[2]] [[2]]$sd sqrt(var) Field "reqdArgs": [1] "mean" "sd" Field "densityName": [1] "dnorm" Field "density_code": dnorm Field "simulateName": [1] "rnorm" Field "sim_code": rnorm Field "altParams": $tau sd^-2 $var sd * sd Field "discrete": [1] FALSE Field "pqAvail": [1] TRUE Field "cdf_code": pnorm Field "quantile_code": qnorm Field "mixedSizes": [1] FALSE Field "range": $lower [1] -Inf $upper [1] Inf Field "types": $value $value$type [1] "double" $value$nDim [1] 0 $mean $mean$type [1] "double" $mean$nDim [1] 0 $sd $sd$type [1] "double" $sd$nDim [1] 0 $tau $tau$type [1] "double" $tau$nDim [1] 0 $var $var$type [1] "double" $var$nDim [1] 0 Field "paramIDs": value mean sd tau var 1 2 3 4 5 Field "buildDerivs": [1] TRUE > distInfo$range $lower [1] -Inf $upper [1] Inf > > isDiscrete('dbin') [1] TRUE > > isUserDefined('dbin') [1] FALSE > > pqDefined('dgamma') [1] TRUE > pqDefined('dmnorm') [1] FALSE > > getDimension('dnorm') value 0 > getDimension('dnorm', includeParams = TRUE) value mean sd tau var 0 0 0 0 0 > getDimension('dnorm', c('var', 'sd')) var sd 0 0 > getDimension('dcat', includeParams = TRUE) value prob k 0 1 0 > getDimension('dwish', includeParams = TRUE) value cholesky df scale_param R S 2 2 0 0 2 2 > > getType('dnorm') value "double" > getType('dnorm', includeParams = TRUE) value mean sd tau var "double" "double" "double" "double" "double" > getType('dnorm', c('var', 'sd')) var sd "double" "double" > getType('dcat', includeParams = TRUE) value prob k "double" "double" "double" > getType('dwish', includeParams = TRUE) value cholesky df scale_param R S "double" "double" "double" "double" "double" "double" > > getParamNames('dnorm', includeValue = FALSE) [1] "mean" "sd" "tau" "var" > getParamNames('dmnorm') [1] "value" "mean" "cholesky" "prec_param" "prec" [6] "cov" > > > > > cleanEx() > nameEx("expAv") > ### * expAv > > flush(stderr()); flush(stdout()) > > ### Name: expAv > ### Title: Matrix Exponential times a vector > ### Aliases: expAv > > ### ** Examples > > A <- rbind(c(-1, 0.25, 0.75), c(0, -2, 2), c(0.25, 0.25, -0.5)) > v <- c(0.35, 0.25, 0.1) > expAv(A, v) [1] 0.2195048 0.1523694 0.1478786 > > > > cleanEx() > nameEx("expm") > ### * expm > > flush(stderr()); flush(stdout()) > > ### Name: expm > ### Title: Matrix Exponential > ### Aliases: expm > > ### ** Examples > > A <- rbind(c(-1, 0.25, 0.75), c(0, -2, 2), c(0.25, 0.25, -0.5)) > Lambda <- diag(c(0.25, 0.1, 0)) > expm((A-Lambda)*2.5) [,1] [,2] [,3] [1,] 0.1387245 0.08263382 0.5363518 [2,] 0.1267913 0.09867308 0.6610706 [3,] 0.1365201 0.09848274 0.6750763 > > > > cleanEx() > nameEx("flat") > ### * flat > > flush(stderr()); flush(stdout()) > > ### Name: flat > ### Title: The Improper Uniform Distribution > ### Aliases: flat halfflat dflat rflat dhalfflat rhalfflat > > ### ** Examples > > dflat(1) [1] 1 > > > > cleanEx() > nameEx("getMacroParameters") > ### * getMacroParameters > > flush(stderr()); flush(stdout()) > > ### Name: getMacroParameters > ### Title: EXPERIMENTAL: Get list of parameter names generated by model > ### macros > ### Aliases: getMacroParameters > > ### ** Examples > > nimbleOptions(enableMacros = TRUE) > nimbleOptions(enableMacroComments = FALSE) > nimbleOptions(verbose = FALSE) > > testMacro <- list(process = function(code, modelInfo, .env){ + code <- quote({ + for (i_ in 1:n){ + mu[i_] <- alpha + beta + y[i_] ~ dnorm(0, sigma) + } + alpha ~ dnorm(0, 1) + }) + list(code = code, modelInfo=modelInfo) + }) > class(testMacro) <- "model_macro" > > code <- nimbleCode({ + y[1:n] ~ testMacro() + }) > > const <- list(y = rnorm(10), n = 10) > > mod <- nimbleModel(code, constants=const) > > mod$getMacroParameters() $testMacro $testMacro[[1]] [1] "mu" "alpha" "beta" "sigma" > # should be list(testMacro = list(c("mu", "alpha", "beta", "sigma"))) > > mod$getMacroParameters(includeRHS = FALSE) $testMacro $testMacro[[1]] [1] "mu" "alpha" > # should be list(testMacro = list(c("mu", "alpha"))) > > > > cleanEx() > nameEx("getNimbleOption") > ### * getNimbleOption > > flush(stderr()); flush(stdout()) > > ### Name: getNimbleOption > ### Title: Get NIMBLE Option > ### Aliases: getNimbleOption > > ### ** Examples > > getNimbleOption('MCMCverifyConjugatePosteriors') [1] FALSE > > > > cleanEx() > nameEx("getSamplesDPmeasure") > ### * getSamplesDPmeasure > > flush(stderr()); flush(stdout()) > > ### Name: getSamplesDPmeasure > ### Title: Get posterior samples for a Dirichlet process distribution > ### (measure) > ### Aliases: getSamplesDPmeasure > > ### ** Examples > > ## Not run: > ##D conf <- configureMCMC(model) > ##D mcmc <- buildMCMC(conf) > ##D cmodel <- compileNimble(model) > ##D cmcmc <- compileNimble(mcmc, project = model) > ##D runMCMC(cmcmc, niter = 1000) > ##D outputG <- getSamplesDPmeasure(cmcmc) > ## End(Not run) > > > > cleanEx() > nameEx("getsize") > ### * getsize > > flush(stderr()); flush(stdout()) > > ### Name: getsize > ### Title: Returns number of rows of modelValues > ### Aliases: getsize > > ### ** Examples > > mvConf <- modelValuesConf(vars = 'a', types = 'double', sizes = list(a = 1) ) > mv <- modelValues(mvConf) > resize(mv, 10) > getsize(mv) [1] 10 > > > > cleanEx() > nameEx("identityMatrix") > ### * identityMatrix > > flush(stderr()); flush(stdout()) > > ### Name: identityMatrix > ### Title: Create an Identity matrix (Deprecated) > ### Aliases: identityMatrix > > ### ** Examples > > Id <- identityMatrix(d = 3) > > > > > cleanEx() > nameEx("initializeModel") > ### * initializeModel > > flush(stderr()); flush(stdout()) > > ### Name: initializeModel > ### Title: Performs initialization of nimble model node values and log > ### probabilities > ### Aliases: initializeModel > > ### ** Examples > > myNewAlgorithm <- nimbleFunction( + setup = function(model, ...) { + my_initializeModel <- initializeModel(model) + .... + }, + run = function(...) { + my_initializeModel() + .... + } + ) > > > > cleanEx() > nameEx("modelBaseClass-class") > ### * modelBaseClass-class > > flush(stderr()); flush(stdout()) > > ### Name: modelBaseClass-class > ### Title: Class 'modelBaseClass' > ### Aliases: modelBaseClass-class modelBaseClass getVarNames getNodeNames > ### topologicallySortNodes resetData setData isData isEndNode > ### getDistribution isDiscrete isBinary isStoch isDeterm isTruncated > ### isUnivariate isMultivariate getDimension getDependencies > ### getDependenciesList getDownstream expandNodeNames setInits > ### checkConjugacy getCode getMacroInits getConstants newModel getParents > ### [[,modelBaseClass-method [[<-,modelBaseClass-method initializeInfo > > ### ** Examples > > code <- nimbleCode({ + mu ~ dnorm(0, 1) + x[1] ~ dnorm(mu, 1) + x[2] ~ dnorm(mu, 1) + }) > Rmodel <- nimbleModel(code) > modelVars <- Rmodel$getVarNames() ## returns 'mu' and 'x' > modelNodes <- Rmodel$getNodeNames() ## returns 'mu', 'x[1]' and 'x[2]' > Rmodel$resetData() > Rmodel$setData(list(x = c(1.2, NA))) ## flags only 'x[1]' node as data > Rmodel$isData(c('mu', 'x[1]', 'x[2]')) ## returns c(FALSE, TRUE, FALSE) [1] FALSE TRUE FALSE > > > > cleanEx() > nameEx("modelValues") > ### * modelValues > > flush(stderr()); flush(stdout()) > > ### Name: modelValues > ### Title: Create a NIMBLE modelValues Object > ### Aliases: modelValues > > ### ** Examples > > #From model object: > code <- nimbleCode({ + a ~ dnorm(0,1) + for(i in 1:3){ + for(j in 1:3) + b[i,j] ~ dnorm(0,1) + } + }) > Rmodel <- nimbleModel(code) > Rmodel_mv <- modelValues(Rmodel, m = 2) > #Custom modelValues object: > mvConf <- modelValuesConf(vars = c('x', 'y'), + types = c('double', 'int'), + sizes = list(x = 3, y = c(2,2))) > custom_mv <- modelValues(mvConf, m = 2) > custom_mv['y',] [[1]] [,1] [,2] [1,] NA NA [2,] NA NA [[2]] [,1] [,2] [1,] NA NA [2,] NA NA > > > > cleanEx() > nameEx("modelValuesBaseClass-class") > ### * modelValuesBaseClass-class > > flush(stderr()); flush(stdout()) > > ### Name: modelValuesBaseClass-class > ### Title: Class 'modelValuesBaseClass' > ### Aliases: modelValuesBaseClass-class modelValuesBaseClass > ### [,CmodelValues-method [<-,CmodelValues-method [[,CmodelValues-method > ### [[<-,CmodelValues-method [,CmodelValues-method,character,missing > ### [,modelValuesBaseClass-method [<-,modelValuesBaseClass-method > ### [,CmodelValues-method,character,missing,ANY-method > ### [,CmodelValues-method,ANY,ANY > > ### ** Examples > > mvConf <- modelValuesConf(vars = c('a', 'b'), + types = c('double', 'double'), + sizes = list(a = 1, b = c(2,2) ) ) > mv <- modelValues(mvConf) > as.matrix(mv) a[1] b[1, 1] b[2, 1] b[1, 2] b[2, 2] [1,] NA NA NA NA NA > resize(mv, 2) > as.matrix(mv) a[1] b[1, 1] b[2, 1] b[1, 2] b[2, 2] [1,] NA NA NA NA NA [2,] NA NA NA NA NA > mv['a',1] <- 1 > mv['a',2] <- 2 > mv['b',1] <- matrix(0, nrow = 2, ncol = 2) > mv['b',2] <- matrix(1, nrow = 2, ncol = 2) > mv['a',] [[1]] [1] 1 [[2]] [1] 2 > as.matrix(mv) a[1] b[1, 1] b[2, 1] b[1, 2] b[2, 2] [1,] 1 0 0 0 0 [2,] 2 1 1 1 1 > basicModelCode <- nimbleCode({ + a ~ dnorm(0,1) + for(i in 1:4) + b[i] ~ dnorm(0,1) + }) > basicModel <- nimbleModel(basicModelCode) > basicMV <- modelValues(basicModel, m = 2) # m sets the number of rows > basicMV['b',] [[1]] [1] NA NA NA NA [[2]] [1] NA NA NA NA > > > > cleanEx() > nameEx("modelValuesConf") > ### * modelValuesConf > > flush(stderr()); flush(stdout()) > > ### Name: modelValuesConf > ### Title: Create the confs for a custom NIMBLE modelValues object > ### Aliases: modelValuesConf > > ### ** Examples > > #Custom modelValues object: > mvConf <- modelValuesConf(vars = c('x', 'y'), + types = c('double', 'int'), + sizes = list(x = 3, y = c(2,2))) > custom_mv <- modelValues(mvConf, m = 2) > custom_mv['y',] [[1]] [,1] [,2] [1,] NA NA [2,] NA NA [[2]] [,1] [,2] [1,] NA NA [2,] NA NA > > > > cleanEx() > nameEx("nfVar") > ### * nfVar > > flush(stderr()); flush(stdout()) > > ### Name: nfVar > ### Title: Access or set a member variable of a nimbleFunction > ### Aliases: nfVar nfVar<- > > ### ** Examples > > nfGen1 <- nimbleFunction( + setup = function(A) { + B <- matrix(rnorm(4), nrow = 2) + setupOutputs(B) ## preserves B even though it is not used in run-code + }, + run = function() { + print('This is A', A, '\n') + }) > > nfGen2 <- nimbleFunction( + setup = function() { + nf1 <- nfGen1(1000) + }, + run = function() { + print('accessing A:', nfVar(nf1, 'A')) + nfVar(nf1, 'B')[2,2] <<- -1000 + print('accessing B:', nfVar(nf1, 'B')) + }) > > nf2 <- nfGen2() > nf2$run() accessing A:1000 accessing B: [,1] [,2] [1,] -0.6264538 -0.8356286 [2,] 0.1836433 -1000.0000000 > > > > cleanEx() > nameEx("nimCat") > ### * nimCat > > flush(stderr()); flush(stdout()) > > ### Name: nimCat > ### Title: cat function for use in nimbleFunctions > ### Aliases: nimCat cat > > ### ** Examples > > ans <- matrix(1:4, nrow = 2) ## R code, not NIMBLE code > nimCat('Answer is ', ans) ## would work in R or NIMBLE Answer is [,1] [,2] [1,] 1 3 [2,] 2 4 > > > > > cleanEx() > nameEx("nimCopy") > ### * nimCopy > > flush(stderr()); flush(stdout()) > > ### Name: nimCopy > ### Title: Copying function for NIMBLE > ### Aliases: nimCopy copy > > ### ** Examples > > # Building model and modelValues object > simpleModelCode <- nimbleCode({ + for(i in 1:100) + x[i] ~ dnorm(0,1) + }) > rModel <- nimbleModel(simpleModelCode) > rModelValues <- modelValues(rModel) > > #Setting model nodes > rModel$x <- rnorm(100) > #Using nimCopy in R. > nimCopy(from = rModel, to = rModelValues, nodes = 'x', rowTo = 1) > > #Use of nimCopy in a simple nimbleFunction > cCopyGen <- nimbleFunction( + setup = function(model, modelValues, nodeNames){}, + run = function(){ + nimCopy(from = model, to = modelValues, nodes = nodeNames, rowTo = 1) + } + ) > > rCopy <- cCopyGen(rModel, rModelValues, 'x') > ## Not run: > ##D cModel <- compileNimble(rModel) > ##D cCopy <- compileNimble(rCopy, project = rModel) > ##D cModel[['x']] <- rnorm(100) > ##D > ##D cCopy$run() ## execute the copy with the compiled function > ## End(Not run) > > > > cleanEx() > nameEx("nimDerivs") > ### * nimDerivs > > flush(stderr()); flush(stdout()) > > ### Name: nimDerivs > ### Title: Nimble Derivatives > ### Aliases: nimDerivs derivs AD > > ### ** Examples > > > ## Not run: > ##D model <- nimbleModel(code = ...) > ##D calcDerivs <- nimDerivs(model$calculate(model$getDependencies('x')), > ##D wrt = 'x') > ## End(Not run) > > > > > cleanEx() > nameEx("nimDim") > ### * nimDim > > flush(stderr()); flush(stdout()) > > ### Name: nimDim > ### Title: return sizes of an object whether it is a vector, matrix or > ### array > ### Aliases: nimDim dim > > ### ** Examples > > x <- rnorm(4) > dim(x) NULL > nimDim(x) [1] 4 > y <- matrix(x, nrow = 2) > dim(y) [1] 2 2 > nimDim(y) [1] 2 2 > > > > > cleanEx() > nameEx("nimEigen") > ### * nimEigen > > flush(stderr()); flush(stdout()) > > ### Name: nimEigen > ### Title: Spectral Decomposition of a Matrix > ### Aliases: nimEigen eigen > > ### ** Examples > > eigenvaluesDemoFunction <- nimbleFunction( + setup = function(){ + demoMatrix <- diag(4) + 2 + }, + run = function(){ + eigenvalues <- eigen(demoMatrix, symmetric = TRUE)$values + returnType(double(1)) + return(eigenvalues) + }) > > > > > cleanEx() > nameEx("nimIntegrate") > ### * nimIntegrate > > flush(stderr()); flush(stdout()) > > ### Name: nimIntegrate > ### Title: Integration of One-Dimensional Functions > ### Aliases: nimIntegrate integrate > > ### ** Examples > > integrand <- nimbleFunction( + run = function(x = double(1), theta = double(1)) { + return(x*theta[1]) + returnType(double(1)) + } + ) > > fun <- nimbleFunction( + run = function(theta = double(0), lower = double(0), upper = double(0)) { + param = c(theta, 0) # cannot be scalar, so pad with zero. + output = integrate(integrand, lower, upper, param) + returnType(double(1)) + return(output) + }) > > fun(3.1415927, 0, 1) [1] 1.570796e+00 1.743934e-14 0.000000e+00 > ## Not run: > ##D cfun <- compileNimble(fun) > ##D cfun(3.1415927, 0, 1) > ## End(Not run) > > > > > cleanEx() > nameEx("nimOptim") > ### * nimOptim > > flush(stderr()); flush(stdout()) > > ### Name: nimOptim > ### Title: General-purpose Optimization > ### Aliases: nimOptim > > ### ** Examples > > ## Not run: > ##D objectiveFunction <- nimbleFunction( > ##D run = function(par = double(1)) { > ##D return(sum(par) * exp(-sum(par ^ 2) / 2)) > ##D returnType(double(0)) > ##D } > ##D ) > ##D optimizer <- nimbleFunction( > ##D run = function(method = character(0), fnscale = double(0)) { > ##D control <- optimDefaultControl() > ##D control$fnscale <- fnscale > ##D par <- c(0.1, -0.1) > ##D return(optim(par, objectiveFunction, method = method, control = control)) > ##D returnType(optimResultNimbleList()) > ##D } > ##D ) > ##D cOptimizer <- compileNimble(optimizer) > ##D cOptimizer(method = 'BFGS', fnscale = -1) > ## End(Not run) > > > > cleanEx() > nameEx("nimPrint") > ### * nimPrint > > flush(stderr()); flush(stdout()) > > ### Name: nimPrint > ### Title: print function for use in nimbleFunctions > ### Aliases: nimPrint print > > ### ** Examples > > ans <- matrix(1:4, nrow = 2) ## R code, not NIMBLE code > nimPrint('Answer is ', ans) ## would work in R or NIMBLE Answer is [,1] [,2] [1,] 1 3 [2,] 2 4 > > > > > cleanEx() > nameEx("nimSvd") > ### * nimSvd > > flush(stderr()); flush(stdout()) > > ### Name: nimSvd > ### Title: Singular Value Decomposition of a Matrix > ### Aliases: nimSvd svd > > ### ** Examples > > singularValuesDemoFunction <- nimbleFunction( + setup = function(){ + demoMatrix <- diag(4) + 2 + }, + run = function(){ + singularValues <- svd(demoMatrix)$d + returnType(double(1)) + return(singularValues) + }) > > > > cleanEx() > nameEx("nimbleCode") > ### * nimbleCode > > flush(stderr()); flush(stdout()) > > ### Name: nimbleCode > ### Title: Turn BUGS model code into an object for use in 'nimbleModel' or > ### 'readBUGSmodel' > ### Aliases: nimbleCode > > ### ** Examples > > # Provide a single block of code directly > code <- nimbleCode({ + x ~ dnorm(mu, sd = 1) + mu ~ dnorm(0, sd = prior_sd) + }) > > code_new <- nimbleCode({ + prior_sd ~ dhalfflat() + }) > > # Combine multiple previously saved code objects > code2 <- nimbleCode(code, code_new) > > # Combine code and previously saved code objects > code3 <- nimbleCode({ + y ~ dnorm(mu, sd = 1) + }, code, code_new) > > > > > cleanEx() > nameEx("nimbleExternalCall") > ### * nimbleExternalCall > > flush(stderr()); flush(stdout()) > > ### Name: nimbleExternalCall > ### Title: Create a nimbleFunction that wraps a call to external compiled > ### code > ### Aliases: nimbleExternalCall > > ### ** Examples > > ## Not run: > ##D sink('add1.h') > ##D cat(' > ##D extern "C" { > ##D void my_internal_function(double *p, double*ans, int n); > ##D } > ##D ') > ##D sink() > ##D sink('add1.cpp') > ##D cat(' > ##D #include > ##D #include "add1.h" > ##D void my_internal_function(double *p, double *ans, int n) { > ##D printf("In my_internal_function\\n"); > ##D /* cat reduces the double slash to single slash */ > ##D for(int i = 0; i < n; i++) > ##D ans[i] = p[i] + 1.0; > ##D } > ##D ') > ##D sink() > ##D system('g++ add1.cpp -c -o add1.o') > ##D Radd1 <- nimbleExternalCall(function(x = double(1), ans = double(1), > ##D n = integer()){}, Cfun = 'my_internal_function', > ##D headerFile = file.path(getwd(), 'add1.h'), returnType = void(), > ##D oFile = file.path(getwd(), 'add1.o')) > ##D ## If you need to use a function with non-scalar return object in model code, > ##D ## you can wrap it in another nimbleFunction like this: > ##D model_add1 <- nimbleFunction( > ##D run = function(x = double(1)) { > ##D ans <- numeric(length(x)) > ##D Radd1(x, ans, length(x)) > ##D return(ans) > ##D returnType(double(1)) > ##D }) > ##D demoCode <- nimbleCode({ > ##D for(i in 1:4) {x[i] ~ dnorm(0,1)} ## just to get a vector > ##D y[1:4] <- model_add1(x[1:4]) > ##D }) > ##D demoModel <- nimbleModel(demoCode, inits = list(x = rnorm(4)), > ##D check = FALSE, calculate = FALSE) > ##D CdemoModel <- compileNimble(demoModel, showCompilerOutput = TRUE) > ## End(Not run) > > > > cleanEx() > nameEx("nimbleList") > ### * nimbleList > > flush(stderr()); flush(stdout()) > > ### Name: nimbleList > ### Title: create a nimbleList > ### Aliases: nimbleList > > ### ** Examples > > exampleNimListDef <- nimbleList(x = integer(0), Y = double(2)) > > nimbleListTypes <- list(nimbleType(name = 'x', type = 'integer', dim = 0), + nimbleType(name = 'Y', type = 'double', dim = 2)) > > ## this nimbleList definition is identical to the one created above > exampleNimListDef <- nimbleList(nimbleListTypes) > > > > cleanEx() > nameEx("nimbleMCMC") > ### * nimbleMCMC > > flush(stderr()); flush(stdout()) > > ### Name: nimbleMCMC > ### Title: Executes one or more chains of NIMBLE's default MCMC algorithm, > ### for a model specified using BUGS code > ### Aliases: nimbleMCMC > > ### ** Examples > > > ## Not run: > ##D code <- nimbleCode({ > ##D mu ~ dnorm(0, sd = 1000) > ##D sigma ~ dunif(0, 1000) > ##D for(i in 1:10) { > ##D x[i] ~ dnorm(mu, sd = sigma) > ##D } > ##D }) > ##D data <- list(x = c(2, 5, 3, 4, 1, 0, 1, 3, 5, 3)) > ##D inits <- function() list(mu = rnorm(1,0,1), sigma = runif(1,0,10)) > ##D mcmc.output <- nimbleMCMC(code, data = data, inits = inits, > ##D monitors = c("mu", "sigma"), thin = 10, > ##D niter = 20000, nburnin = 1000, nchains = 3, > ##D summary = TRUE, WAIC = TRUE) > ## End(Not run) > > > > > cleanEx() > nameEx("nimbleModel") > ### * nimbleModel > > flush(stderr()); flush(stdout()) > > ### Name: nimbleModel > ### Title: Create a NIMBLE model from model code > ### Aliases: nimbleModel > > ### ** Examples > > code <- nimbleCode({ + x ~ dnorm(mu, sd = 1) + mu ~ dnorm(0, sd = prior_sd) + }) > constants = list(prior_sd = 1) > data = list(x = 4) > Rmodel <- nimbleModel(code, constants = constants, data = data) > > > > cleanEx() > nameEx("nimbleOptions") > ### * nimbleOptions > > flush(stderr()); flush(stdout()) > > ### Name: nimbleOptions > ### Title: NIMBLE Options Settings > ### Aliases: nimbleOptions > > ### ** Examples > > # Set one option: > nimbleOptions(MCMCverifyConjugatePosteriors = FALSE) > > # Compactly print all options: > str(nimbleOptions(), max.level = 1) List of 83 $ useNewNimCopy : logi TRUE $ unsupportedDerivativeHandling : chr "error" $ disallow_multivariate_argument_expressions : logi TRUE $ clearNimbleFunctionsAfterCompiling : logi FALSE $ MCMCenableWAIC : logi FALSE $ MCMCmultivariateNodesAsScalars : logi FALSE $ includeUnneededLatents : logi FALSE $ MCMCreturnDerivedQuantities : logi TRUE $ MCMCuseConjugacy : logi TRUE $ MCMCsaveHistory : logi FALSE $ checkModelBasics : logi TRUE $ stripUnusedTypeDefs : logi TRUE $ prioritizeColonLikeBUGS : logi TRUE $ MCMCorderPriorSamplesSamplersFirst : logi TRUE $ useADdmnorm : logi TRUE $ useADreconfigure : logi TRUE $ getDependenciesIncludesPredictiveNodes : logi TRUE $ useClearCompiledInADTesting : logi TRUE $ digits : NULL $ enableMacros : logi TRUE $ use_C_getParents : logi FALSE $ determinePredictiveNodesInModel : logi TRUE $ CppAD_directory : logi NA $ MCMCRJcheckHyperparam : logi TRUE $ MCMCassignSamplersToPosteriorPredictiveNodes : logi TRUE $ stopOnSizeErrors : logi TRUE $ MCMCmonitorAllSampledNodes : logi FALSE $ parameterTransformWarnUserDists : logi TRUE $ checkDerivsArgs : logi TRUE $ enableDerivs : logi TRUE $ processBackwardsModelIndexRanges : logi FALSE $ indexDrop : logi TRUE $ useSafeDeparse : logi TRUE $ debugSizeProcessing : logi FALSE $ compileOnly : logi FALSE $ MCMCusePosteriorPredictiveSampler : logi TRUE $ showCompilerOutput : logi FALSE $ experimentalSelfLiftStage : logi FALSE $ MCMCprogressBar : logi TRUE $ doADerrorTraps : logi TRUE $ compileAltParamFunctions : logi TRUE $ MCMCwarnUnfinishedThinningInterval : logi TRUE $ doRStudioHangingFix : logi FALSE $ debugCppLineByLine : logi FALSE $ checkNimbleFunction : logi TRUE $ verbose : logi FALSE $ errorIfMissingNFVariable : logi TRUE $ useADmatMultAtomic : logi TRUE $ MCMCusePredictiveDependenciesInCalculations : logi FALSE $ nimbleProjectForTesting : NULL $ MCMCwarnUnsampledStochasticNodes : logi TRUE $ codeInMacroComments : logi FALSE $ oldConjugacyChecking : logi FALSE $ useCppADoptimize : logi TRUE $ MCMCverifyConjugatePosteriors : logi FALSE $ checkModel : logi FALSE $ stop_after_processing_model_code : logi FALSE $ buildInterfacesForCompiledNestedNimbleFunctions: logi FALSE $ pauseAfterWritingFiles : logi FALSE $ useOldcWiseRule : logi FALSE $ useADcholAtomic : logi TRUE $ useNewConfigureMCMC : logi TRUE $ enableMacroComments : logi FALSE $ includeCPPdists : logi TRUE $ stopCompilationBeforeLinking : NULL $ allowNFobjInModel : logi TRUE $ precleanCompilation : logi TRUE $ verboseErrors : logi FALSE $ experimentalNewSizeProcessing : logi FALSE $ enableSpecialHandling : logi FALSE $ useADmatInverseAtomic : logi TRUE $ enableVirtualNodeFunctionDefs : logi FALSE $ newAssignSizeChecks : logi TRUE $ MCMCorderPosteriorPredictiveSamplersLast : logi TRUE $ allowDynamicIndexing : logi TRUE $ debugRCfunProcessing : logi FALSE $ buildModelDerivs : logi FALSE $ useADsolveAtomic : logi TRUE $ debugNFProcessing : logi FALSE $ MCMCuseBarkerAsDefaultMV : logi FALSE $ messagesWhenBuildingOrFinalizingCppObjects : logi FALSE $ checkDuplicateNodeDefinitions : logi TRUE $ convertSingleVectorsToScalarsInSetupArgs : logi TRUE > > # Save-and-restore options: > old <- nimbleOptions() # Saves old options. > nimbleOptions(showCompilerOutput = TRUE, + verboseErrors = TRUE) # Sets temporary options. > # ...do stuff... > nimbleOptions(old) # Restores old options. > > > > cleanEx() > nameEx("nimbleRcall") > ### * nimbleRcall > > flush(stderr()); flush(stdout()) > > ### Name: nimbleRcall > ### Title: Make an R function callable from compiled nimbleFunctions > ### (including nimbleModels). > ### Aliases: nimbleRcall > > ### ** Examples > > ## Not run: > ##D ## Say we want an R function that adds 2 to every value in a vector > ##D add2 <- function(x) { > ##D x + 2 > ##D } > ##D Radd2 <- nimbleRcall(function(x = double(1)){}, Rfun = 'add2', > ##D returnType = double(1)) > ##D demoCode <- nimbleCode({ > ##D for(i in 1:4) {x[i] ~ dnorm(0,1)} > ##D z[1:4] <- Radd2(x[1:4]) > ##D }) > ##D demoModel <- nimbleModel(demoCode, inits = list(x = rnorm(4)), > ##D check = FALSE, calculate = FALSE) > ##D CdemoModel <- compileNimble(demoModel) > ## End(Not run) > > > > cleanEx() > nameEx("nimbleType-class") > ### * nimbleType-class > > flush(stderr()); flush(stdout()) > > ### Name: nimbleType-class > ### Title: create a nimbleType object > ### Aliases: nimbleType-class nimbleType > > ### ** Examples > > nimbleTypeList <- list() > nimbleTypeList[[1]] <- nimbleType(name = 'x', type = 'integer', dim = 0) > nimbleTypeList[[2]] <- nimbleType(name = 'Y', type = 'double', dim = 2) > > > > > cleanEx() > nameEx("parameterTransform") > ### * parameterTransform > > flush(stderr()); flush(stdout()) > > ### Name: parameterTransform > ### Title: Automated transformations of model nodes to unconstrained scales > ### Aliases: parameterTransform > > ### ** Examples > > ## Not run: > ##D code <- nimbleCode({ > ##D a ~ dnorm(0, 1) > ##D b ~ dgamma(1, 1) > ##D c ~ dunif(2, 10) > ##D d[1:3] ~ dmnorm(mu[1:3], cov = C[1:3,1:3]) > ##D e[1:3,1:3] ~ dwish(R = C[1:3,1:3], df = 5) > ##D }) > ##D > ##D constants <- list(mu=rep(0,3), C=diag(3)) > ##D > ##D Rmodel <- nimbleModel(code, constants) > ##D > ##D ## create a specialized parameterTransform function: > ##D nodes <- c('a', 'b', 'c', 'd', 'e') > ##D pt <- parameterTransform(Rmodel, nodes) > ##D > ##D vals <- c(1, 10, 5, 1,2,3, as.numeric(diag(3))) > ##D > ##D ## transform values to unconstrained scale: > ##D transformedVals <- pt$transform(vals) > ##D > ##D ## back-transform to original constrained scale of parameterization > ##D pt$inverseTransform(transformedVals) ## return is same as original vals > ##D > ##D ## dimensionality of original constrained scale = 1 + 1 + 1 + 3 + 9 > ##D pt$getOriginalLength() ## 15 > ##D > ##D ## dimensionality of transformed (unconstrained) scale = 1 + 1 + 1 + 3 + 6 > ##D pt$getTransformedLength() ## 12 > ##D > ##D ## log of the jacobian of the inverse transformation matrix: > ##D pt$logDetJacobian(transformedVals) > ## End(Not run) > > > > > cleanEx() > nameEx("rankSample") > ### * rankSample > > flush(stderr()); flush(stdout()) > > ### Name: rankSample > ### Title: Generates a weighted sample (with replacement) of ranks > ### Aliases: rankSample > > ### ** Examples > > set.seed(1) > sampInts = NA #sampled integers will be placed in sampInts > rankSample(weights = c(1, 1, 2), size = 10, sampInts) > sampInts [1] 1 1 2 2 2 2 2 3 3 3 > # [1] 1 1 2 2 2 2 2 3 3 3 > rankSample(weights = c(1, 1, 2), size = 10000, sampInts) > table(sampInts) sampInts 1 2 3 2434 2492 5074 > #sampInts > # 1 2 3 > #2434 2492 5074 > > #Used in a nimbleFunction > sampGen <- nimbleFunction(setup = function(){ + x = 1:2 + }, + run = function(weights = double(1), k = integer() ){ + rankSample(weights, k, x) + returnType(integer(1)) + return(x) + }) > rSamp <- sampGen() > rSamp$run(1:4, 5) [1] 3 3 4 4 4 > #[1] 3 3 4 4 4 > > > > cleanEx() > nameEx("readBUGSmodel") > ### * readBUGSmodel > > flush(stderr()); flush(stdout()) > > ### Name: readBUGSmodel > ### Title: Create a NIMBLE BUGS model from a variety of input formats, > ### including BUGS model files > ### Aliases: readBUGSmodel > > ### ** Examples > > ## Reading a model defined in the R session > > code <- nimbleCode({ + x ~ dnorm(mu, sd = 1) + mu ~ dnorm(0, sd = prior_sd) + }) > data = list(prior_sd = 1, x = 4) > model <- readBUGSmodel(code, data = data, inits = list(mu = 0)) > model$x [1] 4 > model[['mu']] [1] 0 > model$calculate('x') [1] -8.918939 > > ## Reading a classic BUGS model > > pumpModel <- readBUGSmodel('pump.bug', dir = getBUGSexampleDir('pump')) > pumpModel$getVarNames() [1] "lifted_d1_over_beta" "theta" "lambda" [4] "x" "alpha" "beta" > pumpModel$x [1] 5 1 5 14 3 19 1 1 4 22 > > > > > cleanEx() > nameEx("registerDistributions") > ### * registerDistributions > > flush(stderr()); flush(stdout()) > > ### Name: registerDistributions > ### Title: Add user-supplied distributions for use in NIMBLE BUGS models > ### Aliases: registerDistributions > > ### ** Examples > > dmyexp <- nimbleFunction( + run = function(x = double(0), rate = double(0), log = integer(0)) { + returnType(double(0)) + logProb <- log(rate) - x*rate + if(log) { + return(logProb) + } else { + return(exp(logProb)) + } + }) > rmyexp <- nimbleFunction( + run = function(n = integer(0), rate = double(0)) { + returnType(double(0)) + if(n != 1) nimPrint("rmyexp only allows n = 1; using n = 1.") + dev <- runif(1, 0, 1) + return(-log(1-dev) / rate) + } + ) > registerDistributions(list( + dmyexp = list( + BUGSdist = "dmyexp(rate, scale)", + Rdist = "dmyexp(rate = 1/scale)", + altParams = "scale = 1/rate", + pqAvail = FALSE))) > code <- nimbleCode({ + y ~ dmyexp(rate = r) + r ~ dunif(0, 100) + }) > m <- nimbleModel(code, inits = list(r = 1), data = list(y = 2)) > m$calculate('y') [1] -2 > m$r <- 2 > m$calculate('y') [1] -3.306853 > m$resetData() > m$simulate('y') > m$y [1] 0.1542885 > > # alternatively, simply specify a character vector with the > # name of one or more 'd' functions > deregisterDistributions('dmyexp') > registerDistributions('dmyexp') > > # or simply use in BUGS code without registration > deregisterDistributions('dmyexp') > m <- nimbleModel(code, inits = list(r = 1), data = list(y = 2)) > > # example of Dirichlet-multinomial registration to illustrate > # use of 'types' (note that registration is not actually needed > # in this case) > ddirchmulti <- nimbleFunction( + run = function(x = double(1), alpha = double(1), size = double(0), + log = integer(0, default = 0)) { + returnType(double(0)) + logProb <- lgamma(size) - sum(lgamma(x)) + lgamma(sum(alpha)) - + sum(lgamma(alpha)) + sum(lgamma(alpha + x)) - lgamma(sum(alpha) + + size) + if(log) return(logProb) + else return(exp(logProb)) + }) > > rdirchmulti <- nimbleFunction( + run = function(n = integer(0), alpha = double(1), size = double(0)) { + returnType(double(1)) + if(n != 1) print("rdirchmulti only allows n = 1; using n = 1.") + p <- rdirch(1, alpha) + return(rmulti(1, size = size, prob = p)) + }) > > registerDistributions(list( + ddirchmulti = list( + BUGSdist = "ddirchmulti(alpha, size)", + types = c('value = double(1)', 'alpha = double(1)') + ) + )) > > > > cleanEx() > nameEx("resize") > ### * resize > > flush(stderr()); flush(stdout()) > > ### Name: resize > ### Title: Resizes a modelValues object > ### Aliases: resize > > ### ** Examples > > mvConf <- modelValuesConf(vars = c('a', 'b'), + types = c('double', 'double'), + sizes = list(a = 1, b = c(2,2) ) ) > mv <- modelValues(mvConf) > as.matrix(mv) a[1] b[1, 1] b[2, 1] b[1, 2] b[2, 2] [1,] NA NA NA NA NA > resize(mv, 3) > as.matrix(mv) a[1] b[1, 1] b[2, 1] b[1, 2] b[2, 2] [1,] NA NA NA NA NA [2,] NA NA NA NA NA [3,] NA NA NA NA NA > > > > > cleanEx() > nameEx("runCrossValidate") > ### * runCrossValidate > > flush(stderr()); flush(stdout()) > > ### Name: runCrossValidate > ### Title: Perform k-fold cross-validation on a NIMBLE model fit by MCMC > ### Aliases: runCrossValidate > > ### ** Examples > > ## Not run: > ##D > ##D ## We conduct CV on the classic "dyes" BUGS model. > ##D > ##D dyesCode <- nimbleCode({ > ##D for (i in 1:BATCHES) { > ##D for (j in 1:SAMPLES) { > ##D y[i,j] ~ dnorm(mu[i], tau.within); > ##D } > ##D mu[i] ~ dnorm(theta, tau.between); > ##D } > ##D > ##D theta ~ dnorm(0.0, 1.0E-10); > ##D tau.within ~ dgamma(0.001, 0.001); sigma2.within <- 1/tau.within; > ##D tau.between ~ dgamma(0.001, 0.001); sigma2.between <- 1/tau.between; > ##D }) > ##D > ##D dyesData <- list(y = matrix(c(1545, 1540, 1595, 1445, 1595, > ##D 1520, 1440, 1555, 1550, 1440, > ##D 1630, 1455, 1440, 1490, 1605, > ##D 1595, 1515, 1450, 1520, 1560, > ##D 1510, 1465, 1635, 1480, 1580, > ##D 1495, 1560, 1545, 1625, 1445), > ##D nrow = 6, ncol = 5)) > ##D > ##D dyesConsts <- list(BATCHES = 6, > ##D SAMPLES = 5) > ##D > ##D dyesInits <- list(theta = 1500, tau.within = 1, tau.between = 1) > ##D > ##D dyesModel <- nimbleModel(code = dyesCode, > ##D constants = dyesConsts, > ##D data = dyesData, > ##D inits = dyesInits) > ##D > ##D # Define the fold function. > ##D # This function defines the data to leave out for the i'th fold > ##D # as the i'th row of the data matrix y. This implies we will have > ##D # 6 folds. > ##D > ##D dyesFoldFunction <- function(i){ > ##D foldNodes_i <- paste0('y[', i, ', ]') # will return 'y[1,]' for i = 1 e.g. > ##D return(foldNodes_i) > ##D } > ##D > ##D # We define our own loss function as well. > ##D # The function below will compute the root mean squared error. > ##D > ##D RMSElossFunction <- function(simulatedDataValues, actualDataValues){ > ##D dataLength <- length(simulatedDataValues) # simulatedDataValues is a vector > ##D SSE <- 0 > ##D for(i in 1:dataLength){ > ##D SSE <- SSE + (simulatedDataValues[i] - actualDataValues[i])^2 > ##D } > ##D MSE <- SSE / dataLength > ##D RMSE <- sqrt(MSE) > ##D return(RMSE) > ##D } > ##D > ##D dyesMCMCconfiguration <- configureMCMC(dyesModel) > ##D > ##D crossValOutput <- runCrossValidate(MCMCconfiguration = dyesMCMCconfiguration, > ##D k = 6, > ##D foldFunction = dyesFoldFunction, > ##D lossFunction = RMSElossFunction, > ##D MCMCcontrol = list(niter = 5000, > ##D nburnin = 500)) > ## End(Not run) > > > > > > cleanEx() > nameEx("runMCMC") > ### * runMCMC > > flush(stderr()); flush(stdout()) > > ### Name: runMCMC > ### Title: Run one or more chains of an MCMC algorithm and return samples, > ### summary and/or WAIC > ### Aliases: runMCMC > > ### ** Examples > > ## Not run: > ##D code <- nimbleCode({ > ##D mu ~ dnorm(0, sd = 1000) > ##D sigma ~ dunif(0, 1000) > ##D for(i in 1:10) { > ##D x[i] ~ dnorm(mu, sd = sigma) > ##D } > ##D }) > ##D Rmodel <- nimbleModel(code) > ##D Rmodel$setData(list(x = c(2, 5, 3, 4, 1, 0, 1, 3, 5, 3))) > ##D Rmcmc <- buildMCMC(Rmodel) > ##D Cmodel <- compileNimble(Rmodel) > ##D Cmcmc <- compileNimble(Rmcmc, project = Rmodel) > ##D inits <- function() list(mu = rnorm(1,0,1), sigma = runif(1,0,10)) > ##D samplesList <- runMCMC(Cmcmc, niter = 10000, nchains = 3, inits = inits) > ## End(Not run) > > > > > cleanEx() > nameEx("samplers") > ### * samplers > > flush(stderr()); flush(stdout()) > > ### Name: sampler_BASE > ### Title: MCMC Sampling Algorithms > ### Aliases: sampler_BASE sampler_prior_samples > ### sampler_posterior_predictive sampler_binary sampler_categorical > ### sampler_noncentered sampler_RW sampler_RW_block sampler_RW_llFunction > ### sampler_slice sampler_ess sampler_AF_slice sampler_crossLevel > ### sampler_RW_llFunction_block sampler_RW_multinomial > ### sampler_RW_dirichlet sampler_RW_wishart sampler_RW_lkj_corr_cholesky > ### sampler_RW_block_lkj_corr_cholesky sampler_CAR_normal > ### sampler_CAR_proper sampler_polyagamma sampler_barker > ### sampler_partial_mvn samplers sampler binary categorical prior_samples > ### posterior_predictive RW RW_block RW_multinomial RW_dirichlet > ### RW_wishart RW_llFunction slice AF_slice crossLevel > ### RW_llFunction_block CRP CRP_concentration DPmeasure RJ_fixed_prior > ### RJ_indicator RJ_toggled RW_PF RW_PF_block RW_lkj_corr_cholesky > ### RW_block_lkj_corr_cholesky barker partial_mvn sampler_RJ_fixed_prior > ### sampler_RJ_indicator sampler_RJ_toggled sampler_CRP_concentration > ### sampler_CRP sampler_slice_CRP_base_param > > ### ** Examples > > ## y[1] ~ dbern() or dbinom(): > # mcmcConf$addSampler(target = 'y[1]', type = 'binary') > > # mcmcConf$addSampler(target = 'a', type = 'RW', > # control = list(log = TRUE, adaptive = FALSE, scale = 3)) > # mcmcConf$addSampler(target = 'b', type = 'RW', > # control = list(adaptive = TRUE, adaptInterval = 200)) > # mcmcConf$addSampler(target = 'p', type = 'RW', > # control = list(reflective = TRUE)) > > ## a, b, and c all continuous-valued: > # mcmcConf$addSampler(target = c('a', 'b', 'c'), type = 'RW_block') > > # mcmcConf$addSampler(target = 'p', type = 'RW_llFunction', > # control = list(llFunction = RllFun, includesTarget = FALSE)) > > # mcmcConf$addSampler(target = 'y[1]', type = 'slice', > # control = list(adaptive = FALSE, sliceWidth = 3)) > # mcmcConf$addSampler(target = 'y[2]', type = 'slice', > # control = list(adaptive = TRUE, sliceMaxSteps = 1)) > > # mcmcConf$addSampler(target = 'x[1:10]', type = 'ess') ## x[1:10] ~ dmnorm() > > # mcmcConf$addSampler(target = 'p[1:5]', type = 'RW_dirichlet') ## p[1:5] ~ ddirch() > > ## y[1] is a posterior predictive node: > # mcmcConf$addSampler(target = 'y[1]', type = 'posterior_predictive') > > > > > cleanEx() > nameEx("setAndCalculate") > ### * setAndCalculate > > flush(stderr()); flush(stdout()) > > ### Name: setAndCalculate > ### Title: Creates a nimbleFunction for setting the values of one or more > ### model nodes, calculating the associated deterministic dependents and > ### logProb values, and returning the total sum log-probability. > ### Aliases: setAndCalculate setAndCalculateDiff > > ### ** Examples > > code <- nimbleCode({ for(i in 1:3) { x[i] ~ dnorm(0,1); y[i] ~ dnorm(0, 1)}}) > Rmodel <- nimbleModel(code) > my_setAndCalc <- setAndCalculate(Rmodel, c('x[1]', 'x[2]', 'y[1]', 'y[2]')) > lp <- my_setAndCalc$run(c(1.2, 1.4, 7.6, 8.9)) > > > > cleanEx() > nameEx("setAndCalculateOne") > ### * setAndCalculateOne > > flush(stderr()); flush(stdout()) > > ### Name: setAndCalculateOne > ### Title: Creates a nimbleFunction for setting the value of a scalar model > ### node, calculating the associated deterministic dependents and logProb > ### values, and returning the total sum log-probability. > ### Aliases: setAndCalculateOne > > ### ** Examples > > code <- nimbleCode({ for(i in 1:3) x[i] ~ dnorm(0, 1) }) > Rmodel <- nimbleModel(code) > my_setAndCalc <- setAndCalculateOne(Rmodel, 'x[1]') > lp <- my_setAndCalc$run(2) > > > > cleanEx() > nameEx("simNodesMV") > ### * simNodesMV > > flush(stderr()); flush(stdout()) > > ### Name: simNodesMV > ### Title: Basic nimbleFunctions for using a NIMBLE model with sets of > ### stored values > ### Aliases: simNodesMV calcNodesMV getLogProbNodesMV > > ### ** Examples > > code <- nimbleCode({ + for(i in 1:5) + x[i] ~ dnorm(0,1) + }) > > myModel <- nimbleModel(code) > myMV <- modelValues(myModel) > > Rsim <- simNodesMV(myModel, myMV) > Rcalc <- calcNodesMV(myModel, myMV) > Rglp <- getLogProbNodesMV(myModel, myMV) > ## Not run: > ##D cModel <- compileNimble(myModel) > ##D Csim <- compileNimble(Rsim, project = myModel) > ##D Ccalc <- compileNimble(Rcalc, project = myModel) > ##D Cglp <- compileNimble(Rglp, project = myModel) > ##D Csim$run(10) > ##D Ccalc$run(saveLP = TRUE) > ##D Cglp$run() #Gives identical answers to Ccalc because logProbs were saved > ##D Csim$run(10) > ##D Ccalc$run(saveLP = FALSE) > ##D Cglp$run() #Gives wrong answers because logProbs were not saved > ##D result <- as.matrix(Csim$mv) > ## End(Not run) > > > > cleanEx() > nameEx("t") > ### * t > > flush(stderr()); flush(stdout()) > > ### Name: t > ### Title: The t Distribution > ### Aliases: t dt_nonstandard rt_nonstandard pt_nonstandard qt_nonstandard > > ### ** Examples > > x <- rt_nonstandard(50, df = 1, mu = 5, sigma = 1) > dt_nonstandard(x, 3, 5, 1) [1] 0.2941132662 0.3387185361 0.0001846619 0.3221574142 0.2477028012 [6] 0.0426090014 0.3605974001 0.3669593190 0.0080965071 0.3658314308 [11] 0.3119846291 0.2453746787 0.3515426258 0.1236995828 0.1447795604 [16] 0.0046617945 0.2351653017 0.3225342095 0.0013354402 0.3558564236 [21] 0.2579155336 0.0238785099 0.2483736214 0.2557702689 0.0060583777 [26] 0.0614320948 0.0493626661 0.3613702758 0.3657870013 0.1576425318 [31] 0.3552575332 0.3585356788 0.2956015745 0.0315072052 0.0481203106 [36] 0.2678903363 0.2136866239 0.3465574713 0.1032726764 0.1924978132 [41] 0.3382521530 0.3151090273 0.2744158065 0.0729264644 0.3545936478 [46] 0.3655498309 0.3362332736 0.3130476959 0.1253751197 0.0429194664 > > > > cleanEx() > nameEx("testBUGSmodel") > ### * testBUGSmodel > > flush(stderr()); flush(stdout()) > > ### Name: testBUGSmodel > ### Title: Tests BUGS examples in the NIMBLE system > ### Aliases: testBUGSmodel > > ### ** Examples > > ## Not run: > ##D testBUGSmodel('pump') > ## End(Not run) > > > > cleanEx() > nameEx("waic") > ### * waic > > flush(stderr()); flush(stdout()) > > ### Name: waic > ### Title: Using WAIC > ### Aliases: waic getWAIC getWAICdetails buildWAIC WAIC enableWAIC > > ### ** Examples > > code <- nimbleCode({ + for(j in 1:J) { + for(i in 1:n) + y[j, i] ~ dnorm(mu[j], sd = sigma) + mu[j] ~ dnorm(mu0, sd = tau) + } + sigma ~ dunif(0, 10) + tau ~ dunif(0, 10) + }) > J <- 5 > n <- 10 > groups <- paste0('y[', 1:J, ', 1:', n, ']') > y <- matrix(rnorm(J*n), J, n) > Rmodel <- nimbleModel(code, constants = list(J = J, n = n), data = list(y = y), + inits = list(tau = 1, sigma = 1)) > > ## Various versions of WAIC available via online calculation. > ## Conditional WAIC without data grouping: > conf <- configureMCMC(Rmodel, enableWAIC = TRUE) > ## Conditional WAIC with data grouping > conf <- configureMCMC(Rmodel, enableWAIC = TRUE, controlWAIC = list(dataGroups = groups)) > ## Marginal WAIC with data grouping: > conf <- configureMCMC(Rmodel, enableWAIC = TRUE, controlWAIC = + list(dataGroups = groups, marginalizeNodes = 'mu')) > ## Not run: > ##D Rmcmc <- buildMCMC(conf) > ##D Cmodel <- compileNimble(Rmodel) > ##D Cmcmc <- compileNimble(Rmcmc, project = Rmodel) > ##D output <- runMCMC(Cmcmc, niter = 1000, WAIC = TRUE) > ##D output$WAIC # direct access > ##D ## Alternatively call via the `getWAIC` method; this doesn't require setting > ##D ## `waic=TRUE` in `runMCMC` > ##D Cmcmc$getWAIC() > ##D Cmcmc$getWAICdetails() > ## End(Not run) > > > > cleanEx() > nameEx("withNimbleOptions") > ### * withNimbleOptions > > flush(stderr()); flush(stdout()) > > ### Name: withNimbleOptions > ### Title: Temporarily set some NIMBLE options. > ### Aliases: withNimbleOptions > > ### ** Examples > > ## Not run: > ##D if (!(getNimbleOption('showCompilerOutput') == FALSE)) stop() > ##D nf <- nimbleFunction(run = function(){ return(0); returnType(double()) }) > ##D cnf <- withNimbleOptions(list(showCompilerOutput = TRUE), { > ##D if (!(getNimbleOption('showCompilerOutput') == TRUE)) stop() > ##D compileNimble(nf) > ##D }) > ##D if (!(getNimbleOption('showCompilerOutput') == FALSE)) stop() > ## End(Not run) > > > > ### *