Nothing
#devtools::test("asremlPlus")
context("model_selection3")
asr3.lib <- "D:\\Analyses\\R oldpkg"
cat("#### Test variofaces using Atieno with asreml3\n")
test_that("Variofaces_asreml3", {
skip_if_not_installed("asreml")
skip_on_cran()
library(dae)
library(asreml, lib.loc = asr3.lib)
library(asremlPlus)
data(chkpeadat)
testthat::expect_equal(nrow(chkpeadat), 1056)
testthat::expect_equal(ncol(chkpeadat), 18)
# Fit the final fitted asreml object
current.asr <- asreml(fixed = Biomass.plant ~ Lines * TRT + Smarthouse/(vLanes + vPos),
random = ~Smarthouse:Zone + Smarthouse:spl(vLanes),
rcov = ~at(Smarthouse):ar1(Lane):ar1(Position),
data = chkpeadat, trace = FALSE)
summary(current.asr)$varcomp
current.asrt <- as.asrtests(current.asr, denDF = "numeric")
current.asrt$wald.tab
recalcWaldTab(current.asrt, denDF="numeric", dDF.na = "maximum")
testthat::expect_equal(length(current.asrt), 3)
testthat::expect_equal(nrow(current.asrt$wald.tab), 7)
testthat::expect_equal(nrow(current.asrt$test.summary), 0)
# Fit initial model
current.asr <- asreml(Biomass.plant ~ Smarthouse + Lines*TRT ,
random = ~ Smarthouse:(Lane + Position),
rcov = ~ at(Smarthouse):ar1(Lane):ar1(Position),
data=chkpeadat)
summary(current.asr)$varcomp
# Load current fit into an asrtests object
current.asrt <- as.asrtests(current.asr, NULL, NULL)
# Check for and remove any boundary terms
current.asrt <- rmboundary(current.asrt)
print(current.asrt)
# Test Lanes autocorrelation
current.asrt <- testresidual(current.asrt, "~ at(Smarthouse):Lane:ar1(Position)",
label="Lane autocorrelation", simpler=TRUE)
# Test Pos autocorrelation (depends on whether Lane autocorrelation retained)
k <- match("Lane autocorrelation", current.asrt$test.summary$terms)
p <- current.asrt$test.summary$p
{if (p[k] <= 0.05)
current.asrt <- testresidual(current.asrt, "~ at(Smarthouse):ar1(Lane):Position",
label="Pos autocorrelation", simpler=TRUE,
update=FALSE)
else
current.asrt <- testresidual(current.asrt, "~ at(Smarthouse):Lane:Position",
label="Pos autocorrelation", simpler=TRUE,
update=FALSE)
}
testthat::expect_equal(length(current.asrt), 3)
testthat::expect_equal(nrow(current.asrt$wald.tab), 5)
testthat::expect_equal(nrow(current.asrt$test.summary), 3)
print(current.asrt)
# Get current fitted asreml object
current.asr <- current.asrt$asreml.obj
current.asr <- update(current.asr, aom=TRUE)
# Form variance matrix based on estimated variance parameters
gamma.Lane <- current.asr$gammas[1]
s2.SW <- current.asr$gammas[2]
rho.lSW <- current.asr$gammas[3]
rho.pSW <- current.asr$gammas[4]
lane.ar1SW <- mat.ar1(order=24, rho=rho.lSW)
pos.ar1SW <- mat.ar1(order=22, rho=rho.pSW)
RSW <- s2.SW * mat.dirprod(lane.ar1SW, pos.ar1SW)
s2.SE <- current.asr$gammas[5]
rho.pSE <- current.asr$gammas[6]
rho.lSE <- current.asr$gammas[7]
lane.ar1SE <- mat.ar1(order=24, rho=rho.lSE)
pos.ar1SE <- mat.ar1(order=22, rho=rho.pSE)
RSE <- s2.SE * mat.dirprod(lane.ar1SE, pos.ar1SE)
V <- mat.dirsum(list(RSW, RSE))
#2 Smarthouses = 1056
V <- gamma.Lane * with(chkpeadat, fac.sumop(fac.combine(list(Smarthouse,Lane)))) + V
testthat::expect_equal(nrow(V), 1056)
testthat::expect_equal(ncol(V), 1056)
#Produce variogram faces plot (Stefanaova et al, 2009)
faces <- variofaces(current.asr, V=V, nsim = 50, maxit = 20, seed = 14522)
testthat::expect_equal(nrow(faces$face1), 48)
testthat::expect_equal(ncol(faces$face1), 6)
testthat::expect_equal(nrow(faces$face2), 44)
testthat::expect_equal(ncol(faces$face2), 6)
#Get Variety predictions
Var.pv <- predict(current.asr, classify="Lines")$predictions$pvals
testthat::expect_equal(nrow(Var.pv), 247)
testthat::expect_equal(ncol(Var.pv), 4)
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.