R Under development (unstable) (2023-12-13 r85679 ucrt) -- "Unsuffered Consequences" Copyright (C) 2023 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 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. 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. > > library(aster) > > # needed because of the change in R function "sample" in R-devel > suppressWarnings(RNGversion("3.5.2")) > > set.seed(42) > nind <- 25 > nnode <- 5 > > theta <- rnorm(nind * nnode) / 10 > theta <- matrix(theta, nind, nnode) > > root <- sample(1:3, nind * nnode, replace = TRUE) > root <- matrix(root, nind, nnode) > > fam <- c(1, 1, 2, 3, 3) > pred <- c(0, 1, 1, 2, 3) > famnam <- sapply(fam.default(), as.character) > > save.seed <- .Random.seed > x <- raster(theta, pred, fam, root) > > .Random.seed <- save.seed > my.x <- NaN * x > > for (i in 1:nnode) { + ipred <- pred[i] + if (ipred == 0) { + xpred <- root[ , i] + } else { + xpred <- my.x[ , ipred] + } + if (famnam[fam[i]] == "bernoulli") { + p <- 1 / (1 + exp(- theta[ , i])) + xi <- rep(0, nind) + ii <- xpred > 0 + xi[ii] <- rbinom(sum(ii), xpred[ii], p[ii]) + my.x[ , i] <- xi + } + if (famnam[fam[i]] == "poisson") { + mu <- exp(theta[ , i]) + xi <- rep(0, nind) + ii <- xpred > 0 + xi[ii] <- rpois(sum(ii), xpred[ii] * mu[ii]) + my.x[ , i] <- xi + } + if (famnam[fam[i]] == "truncated.poisson(truncation = 0)") { + mu <- exp(theta[ , i]) + my.x[ , i] <- rnzp(nind, mu, xpred) + } + } > > all.equal(x, my.x) [1] TRUE > > > proc.time() user system elapsed 0.14 0.07 0.20