https://github.com/cran/aster
Tip revision: aa47935123bfca8a22cbc8345d658d0c1713a289 authored by Charles J. Geyer on 14 December 2023, 15:20:02 UTC
version 1.1-3
version 1.1-3
Tip revision: aa47935
formula.Rout.save
R version 3.6.0 (2019-04-26) -- "Planting of a Tree"
Copyright (C) 2019 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
>
> # needed because of the change in R function "sample" in R-devel
> suppressWarnings(RNGversion("3.5.2"))
>
> 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.162 0.029 0.184