https://github.com/cran/aster
Tip revision: 7016e6b97f24943bdab11323884baf030f38260b authored by Charles J. Geyer on 06 July 2018, 07:20:08 UTC
version 1.0-2
version 1.0-2
Tip revision: 7016e6b
formula.Rout.save
R version 3.3.2 (2016-10-31) -- "Sincere Pumpkin Patch"
Copyright (C) 2016 The R Foundation for Statistical Computing
Platform: x86_64-pc-linux-gnu (64-bit)
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)
Loading required package: trust
>
> set.seed(42)
>
> nind <- 25
>
> vars <- c("l2", "l3", "f2", "f3", "h2", "h3")
> pred <- c(0, 1, 1, 2, 3, 4)
> fam <- c(1, 1, 1, 1, 3, 3)
> length(pred) == length(fam)
[1] TRUE
> nnode <- length(pred)
>
> theta <- matrix(0, nind, nnode)
> root <- matrix(1, nind, nnode)
> x <- raster(theta, pred, fam, root)
> dimnames(x) <- list(NULL, vars)
>
> data <- as.data.frame(x)
> site <- factor(sample(LETTERS[1:4], nind, replace = TRUE))
> foo <- rnorm(nind)
> data <- data.frame(x, site = site, foo = foo, root = 1)
>
> redata <- reshape(data, varying = list(vars),
+ direction = "long", timevar = "varb", times = as.factor(vars),
+ v.names = "resp")
>
> out <- aster(resp ~ foo + site, pred, fam, varb, id, root, data = redata)
> sout1 <- summary(out, show.graph = TRUE)
>
> out <- aster(resp ~ foo + site + varb, pred, fam, varb, id, root,
+ data = redata)
> sout2 <- summary(out)
>
> out0 <- aster(resp ~ foo + site + varb, pred, fam, varb, id, root,
+ origin = rep(0, nind * nnode), data = redata)
> sout0 <- summary(out0)
>
> foo <- new.env(parent = emptyenv())
> bar <- suppressWarnings(try(load("formula.rda", foo), silent = TRUE))
> if (inherits(bar, "try-error")) {
+ save(sout0, sout1, sout2, file = "formula.rda")
+ } else {
+ print(all.equal(sout0, foo$sout0))
+ print(all.equal(sout1, foo$sout1))
+ print(all.equal(sout2, foo$sout2))
+ }
[1] TRUE
[1] TRUE
[1] TRUE
>
> ncoef <- length(out$coefficients)
> foo <- as.numeric(out0$origin) +
+ matrix(out0$modmat, ncol = ncoef) %*% out0$coefficients
> bar <- as.numeric(out$origin) +
+ matrix(out$modmat, ncol = ncoef) %*% out$coefficients
> all.equal(foo, bar)
[1] TRUE
>
> all.equal(out$fisher, out0$fisher)
[1] TRUE
> identical(out$modmat, out0$modmat)
[1] TRUE
>
> all.equal(summary(out)$coefficients[ , "Std. Error"],
+ summary(out0)$coefficients[ , "Std. Error"])
[1] TRUE
>
>
> proc.time()
user system elapsed
0.196 0.000 0.191