all.equal(ksumm, summ[[kresp]], tolerance = 1e-05) is not TRUE

`actual` is [32ma character vector[39m ('Component “component”: Mean relative difference: 0.9995171', 'Component “std.error”: \'is.NA\' value mismatch: 1 in current 1 in target', 'Component “z.ratio”: \'is.NA\' value mismatch: 1 in current 1 in target', 'Component “bound”: 2 string mismatches')
`expected` is [32ma logical vector[39m (TRUE)

cat("#### Test for makeTPPSplineMats with both wheat datasets with asreml42\n")
#'## Use makeTPPSplineMats to produce design matrices
tps.mbf <- makeTPPSplineMats(wheat94.dat, row.covar = "row", col.covar = "col",
tps.grp <- makeTPPSplineMats(wheat94.dat, row.covar = "row", col.covar = "col",
#'## Generate the full length columns from tps.mbf
df.mbf <- cbind(df.mbf, TP.C.1, TP.C.2, TP.R.1, TP.R.2)
#'## Show that both sets of fixed terms are equal
#'## Test whether columns generated from the mbf data.frames are the same as the grp data.frame columns
#'## Test whether random interaction columns are the smae
#'## Repeat for wheat data from asremlPlus
cColumn <- cColumn  - mean(unique(cColumn))
tps.mbf <- makeTPPSplineMats(tmp.dat, row.covar = "cRow", col.covar = "cColumn",
tps.grp <- makeTPPSplineMats(tmp.dat, row.covar = "cRow", col.covar = "cColumn",
# Generate the full length columns from tps.mbf
#'## Test whether random interaction columns are the same
#'## Use makeTPPSplineMats to produce design matrices for theta = c(0,60)
tps.mbf_0_60 <- makeTPPSplineMats(tmp.dat, row.covar = "cRow", col.covar = "cColumn",
asreml.option = "mbf", theta = c(0,60)),
regexp = "The following objects are being overwritten: BcZxx.df, BrZxx.df, BcrZxx.df")
tps.grp_0_60 <- makeTPPSplineMats(tmp.dat, row.covar = "cRow", col.covar = "cColumn",
#'## Generate the full length columns from tps.mbf_0_60 (used to cause problems in asreml)
tps.mbf <- makeTPPSplineMats(tmp.dat, row.covar = "cRow", col.covar = "cColumn", mbf.env = NULL))
#Test trapping of illegal nsect argument
tps <- makeTPPSplineMats(tmp.dat, row.covar = "cRow", col.covar = "cColumn", nsect = 2,
regexp = "the argument\\(s\\) nsect are not legal arguments for 'tpsmmb'")
cat("#### Test makeTPPSplineMats with chick pea example with asreml42\n")
vMPosn <- as.numfac(fac.recast(Mainplot, newlevels = rep(1:11, times = 4)))
#Remove some Lanes in SE Smarthouse so have different grids in the Smarthouses
list(fixed = Biomass.plant ~ Smarthouse + Lines * TRT,
#Create an asrtests object, removing boundary terms
init.asrt <- as.asrtests(current.asr, NULL, NULL, IClikelihood = "full",
label = "Random Lane and Position effects")
#Test makeTPPSplineMats with sections and grp
tps.grp <- makeTPPSplineMats(tmp.dat, sections = "Smarthouse",
row.covar = "vLanes", col.covar = "vMPosn",
tps.mbf <- makeTPPSplineMats(tmp.dat, sections = "Smarthouse",
list(fixed = Biomass.plant ~ Smarthouse + Lines * TRT +
at(Smarthouse,  'SE'):TP.CR.3 + at(Smarthouse,  'SE'):TP.CR.4,
fixed. = . ~ . + at(Smarthouse,  'SW'):TP.CR.2 +
at(Smarthouse,  'SW'):TP.CR.3 + at(Smarthouse,  'SW'):TP.CR.4,
random. = ~ . + at(Smarthouse,  'SW'):TP.C.1:mbf(TP.row) +
cols.grp.SE <- c(paste0("at(Smarthouse, 'SE'):grp(TP.C.1_frow)_TP.C.1_frow_", 1:22),
fixed. = . ~ .+ at(Smarthouse,  'SW'):TP.CR.2 +
cols.grp.SW <- c(paste0("at(Smarthouse, 'SW'):grp(TP.C.1_frow)_TP.C.1_frow_", 1:24),
#### The following shows (i) that mbf  and grp give the same design matrices,
##   (ii) that the design matrices in asreml are the same for mbf and grp, and
##   (iii) that the design matrices in asreml are not equivalent to those generated in tps
#Compare design matrices for SE in asreml.obj - TRUE
#Compare design matrices for SW in asreml.obj - TRUE
#Get the design matrices from the tps objects and test if equal to those from asreml.obj
colnames(dat.grp.SE) <- colnames(des.grp.SE) <- cols.grp.SE
colnames(dat.grp.SW) <- colnames(des.grp.SW) <- cols.grp.SW
cols.df.SE <- c(names(TP.C.1), names(TP.C.2), names(TP.R.1), names(TP.R.2))
#check that cols generated from mbf df are the same as the tps.grp cols - TRUE
colnames(dat.grp.SE) <- colnames(des.grp.SE) <- cols.df.SE
all.equal(df.mbf[529:1012,cols.df.SE], dat.grp.SE) #Only the names differ
#col generated from mbf are not the same as those in the asreml design matrix - FALSE
testthat::show_failure(all.equal(df.mbf[529:1012,cols.df.SE], des.mbf.SE)) #Only the names differ
#'## Test whether random interaction columns are the same in desing for mbf and grp = TRUE
des.grp.SE.CxR <- des.grp.SE.CxR[, grepl("TP_fcol_frow", colnames(des.grp.SE.CxR))]
des.mbf.SE.CxR <- des.mbf.SE.CxR[, grepl("TP.CxR", colnames(des.mbf.SE.CxR))]
cat("#### Test for wheat76 spatial models with asreml42\n")
asreml::asreml.options(extra = 5, ai.sing = TRUE, fail = "soft")
#Fit initial model - Row and column random
list(yield ~ Rep + WithinColPairs + Variety,
info <- infoCriteria(current.asr, IClikelihood = "full")
label = "Random Row and Column effects")
# Check for and remove any boundary terms
init.asrt <- rmboundary(init.asrt, IClikelihood = "full")
current.asrt <- addSpatialModelOnIC(init.asrt, spatial.model = "TPPS",
row.covar = "cRow", col.covar = "cColumn",
regexp = "the argument\\(s\\) nsect are not legal arguments for 'changeModelOnIC.asrtests', 'asreml'")
grp.asrt <- addSpatialModelOnIC(init.asrt, spatial.model = "TPPS",
info <- infoCriteria(grp.asrt$asreml.obj, IClikelihood = "full")
#Repeat to make sure no carry-over effects
info <- infoCriteria(current.asrt$asreml.obj, IClikelihood = "full")
mbf.asrt <- addSpatialModelOnIC(init.asrt, spatial.model = "TPPS",
info <- infoCriteria(list(grp.asrt$asreml.obj, mbf.asrt$asreml.obj), IClikelihood = "full")
testthat::expect_true(all.equal(info[1,], info[2,], tolerance = 1e-06, check.attributes = FALSE)) #mbf & grp are same
#Rotate the penalty matrix with mbf, using an optimizer to search for thetas that maximize loglik
mbf.logl.asrt <- addSpatialModel(init.asrt, spatial.model = "TPPS",
info <- infoCriteria(mbf.logl.asrt$asreml.obj, IClikelihood = "full") #com
testthat::expect_true(all(abs(attr(mbf.logl.asrt$asreml.obj, which = "theta.opt")[[1]] - c(20.19972, 64.98770)) < 0.001))
#Rotate the penalty matrix with grp, testing if full rotated model is better than full, unrotated model
grp.asrt <- addSpatialModel(init.asrt, spatial.model = "TPPS",
testthat::expect_false(info$AIC < 1643.467) #the value is the unrotated AIC
mbf.asrt <- addSpatialModel(init.asrt, spatial.model = "TPPS",
testthat::expect_true(all.equal(info[1,], info[2,], check.attributes = FALSE))
info <- infoCriteria(mbf.asrt$asreml.obj, IClikelihood = "full")
testthat::expect_true(all(attr(mbf.asrt, which = "theta.opt")[[1]] == c(20,60)))
#Rotate the penalty matrix with grp, using an optimizer to search for thetas
testthat::expect_true(all(abs(attr(grp.asrt$asreml.obj, which = "theta.opt")[[1]] -
#Rotate the penalty matrix with mbf, using an optimizer to search for thetas
testthat::expect_true(all.equal(info[1,], info[2,], check.attributes = FALSE, tolerance = 1e-05))
testthat::expect_true(all(abs(attr(mbf.asrt, which = "theta.opt")[[1]] - c(20.1997, 64.9876)) < 0.001))
testthat::expect_true(all(abs(attr(grp.asrt, which = "theta.opt")[[1]] -
attr(mbf.asrt, which = "theta.opt")[[1]]) < 0.001))
#Compare the data.frames on which the rotated fits are based
current.asrt <- addSpatialModelOnIC(init.asrt, spatial.model = "TPNCSS",
# Try corr model - at the moment this fit fails because the addition of a unit terms
# clashes with the addition of a variance term for cRow:exp(cColumn)
current.asrt <- addSpatialModelOnIC(init.asrt, spatial.model = "corr",
row.factor = "Row", col.factor = "Column",
asreml.option = "mbf", IClikelihood = "full")
asreml.option = "grp", return.asrts = "all")
testthat::expect_equal(names(spatial.asrts$asrts), c("corr", "TPNCSS", "TPPSC2", "TPPSL1"))
c("nonspatial", "corr", "TPNCSS", "TPPSC2", "TPPSL1")))
spatial.asrts <- chooseSpatialModelOnIC(init.asrt, trySpatial = c("TPN", "TPPSC"),
testthat::expect_true(all(rownames(spatial.asrts$spatial.IC) == c("nonspatial", "TPNCSS", "TPPSC2")))
testthat::expect_true(all(abs(spatial.asrts$spatial.IC$AIC - c(1720.891, 1639.792, 1643.467)) < 0.10))
#Fit all models with Row and Column random and return all
spatial.asrts <- chooseSpatialModelOnIC(init.asrt, trySpatial = c("corr", "TPN", "TPPSC", "TPPSL"),
#Check that calculated spatial.IC is the same as those for models fitted using addSpatialModel
spatialEach.asrts[["corr"]] <- addSpatialModel(init.asrt, spatial.model = "corr",
row.factor = "Row", col.factor = "Column")
spatialEach.asrts[["TPNCSS"]] <- addSpatialModel(init.asrt, spatial.model = "TPN",
spatialEach.asrts[["TPPSC2"]] <- addSpatialModel(init.asrt, spatial.model = "TPPS",
spatialEach.asrts[["TPPSL1"]] <- addSpatialModel(init.asrt, spatial.model = "TPPS",
function(asrt) infoCriteria(asrt$asreml.obj, IClikelihood = "full")))
#Test rotateX with grp and no parallel processing
spatial.asrt <- addSpatialModel(init.asrt, spatial.model = "TPPS",
testthat::expect_true(abs(infoCriteria(spatial.asrt$asreml.obj, IClikelihood = "full")$AIC - 1650.192) < 1e-03)
#Test rotateX with grp and parallel processing
#Test rotateX with mbf and no parallel processing
#Test rotateX with mbf and parallel processing - gives error
regexp = paste("Parallel processing has not been implemented for asreml.option set to mbf;",
# testthat::expect_true(abs(infoCriteria(spatial.asrt$asreml.obj, IClikelihood = "full")$AIC - 1650.192) < 1e-03)
#Fit initial model - Row and column fixed
list(yield ~ Rep + WithinColPairs + Row + Column + Variety,
# Try a TPNCSS model with fixed Row and Column
#Check Row and COlumn terms not in model
# Try TPPS model with fixed Row and Column
#Fit all models with Row and Column fixed and return all
#NB chooseSpatialModel returns that spatialICs for the best fitting correlation model
spatial.asrts <- chooseSpatialModelOnIC(init.asrt, trySpatial = "all",
spatialEach.asrts[["corr"]] <- addSpatialModelOnIC(init.asrt, spatial.model = "corr",
cat("#### Test for wheat76 spatial models using mbf with asreml42\n")
# Try TPPS model using mbf - does not fit the same model as grp
cat("#### Test for wheat703 corr spatial models with asreml42\n")
mod.ch <- paste(kresp, "~ Block + Line")
current.asrt <- as.asrtests(current.asr, NULL, NULL, IClikelihood = "full",
row.covar = "cLane", col.covar = "cPosn",
row.factor = "Lane", col.factor = "Position",
#    print(all.equal(ksumm, summ[[kresp]], tolerance = 1e-05))
testthat::expect_true(all.equal(ksumm, summ[[kresp]], tolerance = 1e-05))
#    summ <- c(summ, list(summary(corr.asrt$asrts[[1]]$asreml.obj)$varcomp))
#  save(summ, file = "./data/summ703.rda")
cat("#### Test for wheat76 corr spatial models with asreml42\n")
# Try corb(Row):corb(Colum) with corr.orders 0 - Column fits order 2
# There is currently a problem in asreml 4.2 that results in the following model fit to crash R
current.asrt <- addSpatialModel(init.asrt, spatial.model = "corr",
corr.funcs = c("corb", "corb"), corr.orders = c(0,0))
names(vpars) <- c("Row", "Column", "Row:Column", "Row:Column!Row!cor1",
c("Row", "Column", "Column:cRow", "Column:cRow!cRow!pow", "units!R"))
spatial.asrts[["lvr"]] <- addSpatialModel(init.asrt, spatial.model = "corr",
spatial.asrts[["TPPSL1"]] <- addSpatialModel(init.asrt, spatial.model = "TPPS",
testthat::expect_true(all.equal(infoEach$AIC, c(1714.861, 1710.282), tolerance = 1e-05))
regexp = "Both correlation functions are id or equivalent")
c("Row", "Column", "Column:Row", "Column:Row!Row!cor", "units!R"))
#Fit a correlation model with id to check spatial.IC
spatial.asrts <- chooseSpatialModelOnIC(init.asrt, trySpatial = c("corr",  "TPPSC"),
cat("#### Test for PSA_NW corb spatial models with asreml42\n")
Half <- fac.recast(Lane, newlevels = rep(1:2, each = 12))
HLane <- fac.recast(Lane, newlevels = rep(1:12, times = 2))
#Fit initial model - Lane and Position fixed
label = "Start with no spatial modelling")
new.asrt <- changeTerms(init.asrt, newResidual = "Lane:Position")
corr.funcs = c("corb", "corb"), corr.orders = c(1, 1),
info <- infoCriteria(current.asrt$asreml.obj, IClikelihood = "full"),
regexp = "The following bound terms were discounted:")
#Fit a single-band corb model with Residual Lane:Position
current.asrt <- addSpatialModel(new.asrt, spatial.model = "corr",
#Fit a single-band corb model with unneeded set.terms
set.terms = "units!R", ignore.suffices = FALSE,
corr.funcs = c("corb", ""), corr.orders = c(1, 0),
names(vpars) <- c("Position:Lane", "Position:Lane!Lane!cor1", "units!R")
corr.funcs = c("corb", "corb"), corr.orders = c(3, 3),
corr.funcs = c("corb", "corb"), corr.orders = c(0, 0),
"Add random Lane:Position and fix residual",
"Try corb(Lane, b = 1)", "Try corb(Lane, b = 2)",
"Try corb(Position, b = 1)", "Try corb(Position, b = 2)",
"Force positive nugget (residual) variance"))
# Fit ar1 for Lane and up to 10-band corb model for Position
corr.funcs = c("ar1", "corb"), corr.orders = c(0, 0),
testthat::expect_lt(abs(info$AIC - 757.5911 ), 0.10)
#### Fit separate model to two Halves of the Smarthouse
#Fit initial model - Lane and Position fixed and separate dsum terms
list(PSA.14 ~ at(Half, 1):Lane + at(Half, 2):Lane +
at(Half, 1):Position + at(Half, 2):Position,
residual = ~ dsum(~ Lane:Position | Half, levels = 1) +
dsum(~ Lane:Position | Half, levels = 2),
#Fit a single-band corb model to each Half using separate dsum terms
#Fit an ar1 model for a single dsum term
testthat::expect_lt(abs(info$AIC - 790.7611 ), 0.10)
#Fit initial model - Lane and Position fixed and a single dsum term
residual = ~ dsum(~ Lane:Position | Half),
#Fit a single-band corb model to each Half using a single dsum term
#Fit up to a 10-band corb model to each Half using a single dsum term
"Add random at(Half, '1'):Lane:Position and fix residual for Half 1",
"Add random at(Half, '2'):Lane:Position and fix residual for Half 2",
"Try corb(Lane, b = 1) and corb(Position, b = 1) for Half 2"))
#Fit initial model - Lane and Position fixed with idh
#Fit a single-band corb model to each Half using a single idh terms
cat("#### Test for spatial models with asreml42\n")
#This data is for the Durban 2003 barley data cited in Piepho, Boer and Williams (2022)
infoEach <- lapply(spatialEach.asrts, function(asrt) infoCriteria(asrt$asreml.obj,
R2adj <- sapply(spatialEach.asrts, function(asrt) R2adj(asrt$asreml.obj,
include.which.fixed = ~ ., include.which.random = ~ .)
testthat::expect_true(abs(R2adj.corr - 79.27872) < 1e-03)
testthat::expect_true(abs(R2adj.TPNCSS - 85.47652) < 1e-03)
testthat::expect_true(abs(R2adj.TPPSC2 - 87.78192) < 1e-03)
testthat::expect_true(abs(R2adj.TPPSL1 - 90.82785) < 1e-03)
cat("#### Test for nonfitting spatial models with asreml42\n")
args = list(y ~ Species:Substrate:Irrigation + cRow +cCol,
spatial.asrts <- chooseSpatialModelOnIC(init.asrt, trySpatial = "none")
testthat::expect_true(abs(spatial.asrts$best.spatial.IC - 892.861) < 1e-04)
testthat::expect_true(abs(spatial.asrts$spatial.IC$AIC - 892.861) < 1e-04)
#Fit two models and return both - neither fits
#Fit all models and return all - corr fits
spatial.asrts <- chooseSpatialModelOnIC(init.asrt, trySpatial = c("corr", "TPN", "TPPSC"),
testthat::expect_true(all(rownames(spatial.asrts$spatial.IC) == c("nonspatial", "corr", "TPNCSS", "TPPSC2")))
#The spline models AIC are greater than the nonspatial model and so chooseModelOnIC returns the nonspatial AIC for them
function(asrt) infoCriteria(asrt$asreml.obj, , IClikelihood = "full")))
testthat::expect_false(all(abs(infoEach$AIC[1:3] - spatial.asrts$spatial.IC$AIC[2:4]) < 0.001))
#testthat::expect_true(all.equal(spatial.asrts$spatial.IC[2:4,], infoEach[-4,-3], tolerance = 1e-01))
cat("#### Test spatial modelling for chick pea example with asreml42\n")
list(fixed  = Biomass.plant ~ Smarthouse + Lines * TRT,
random = ~ (at(Smarthouse, "SW") + at(Smarthouse, "SE")):Zone +
(at(Smarthouse, "SW") + at(Smarthouse, "SE")):Zone:Mainplot, #nugget terms
# Try TPPS model with Mainplots and two Smarthouses
TPPS.Main.grp.asrt <- addSpatialModelOnIC(init.asrt, spatial.model = "TPPS",
info <- infoCriteria(list(split = init.asrt$asreml.obj, TPPS = TPPS.Main.grp.asrt$asreml.obj),
testthat::expect_false(all(c("at(Smarthouse, 'SW'):Zone", "at(Smarthouse, 'SE'):Zone") %in%
# Try TPPS model with Lanes x Positions and two Smarthouses
TPPS.LP.grp.asrt <- addSpatialModelOnIC(init.asrt, spatial.model = "TPPS",
row.covar = "vLanes", col.covar = "vPos",
info <- infoCriteria(list(split = init.asrt$asreml.obj, TPPS = TPPS.LP.grp.asrt$asreml.obj),
# Try TPPS model with rotation for Mainplots and two Smarthouses
TPPSRot.Main.grp.asrt <- addSpatialModelOnIC(init.asrt, spatial.model = "TPPS",
info <- infoCriteria(list(split = init.asrt$asreml.obj, TPPS = TPPSRot.Main.grp.asrt$asreml.obj),
theta.opt <- attr(TPPSRot.Main.grp.asrt$asreml.obj, which = "theta.opt")
TPPSRot.Main.grp.opt.asrt <- addSpatialModelOnIC(init.asrt, spatial.model = "TPPS",
info <- infoCriteria(list(split = init.asrt$asreml.obj, TPPS = TPPSRot.Main.grp.opt.asrt$asreml.obj),
theta.opt <- attr(TPPSRot.Main.grp.opt.asrt$asreml.obj, which = "theta.opt")
testthat::expect_true(all(abs(theta.opt$SW - c( 64.0218, 49.9553)) < 0.001))
testthat::expect_true(all(abs(theta.opt$SE - c(34.3136, 15.6094)) < 0.001))
# Try TPPS model with rotation for Lanes x Positions and two Smarthouses
#Test makeTPPSplineMats with sections with Lanes x Positions  and mbf
testthat::expect_equal(sapply(list(BcZSE.df,BrZSE.df,BcrZSE.df), nrow), c(22, 24, 528))
testthat::expect_equal(sapply(list(BcZSE.df,BrZSE.df,BcrZSE.df), ncol), c(23, 25, 529))
# Try TPPS model with Lanes x Positions and two Smarthouses and mbf
TPPS.LP.mbf.asrt <- addSpatialModelOnIC(init.asrt, spatial.model = "TPPS",
print(info <- infoCriteria(list(split = init.asrt$asreml.obj, TPPS = TPPS.LP.mbf.asrt$asreml.obj),
#Test makeTPPSplineMats with sections with Lanes x MainPosns  and mbf
testthat::expect_equal(sapply(list(BcZSE.df,BrZSE.df,BcrZSE.df), nrow), c(11, 24, 264))
testthat::expect_equal(sapply(list(BcZSE.df,BrZSE.df,BcrZSE.df), ncol), c(12, 25, 265))
# Try TPPS model with Lanes x MPosn and two Smarthouses and supplying tpps object
TPPS.Main.mbf.asrt <- addSpatialModelOnIC(init.asrt, spatial.model = "TPPS",
asreml.option = "mbf", tpps4mbf.obj = tps.mbf)
print(info <- infoCriteria(list(split = init.asrt$asreml.obj,
#Change initial model to have Smarthouse Zone so can test dropping an over-sections term
TPPS.LP.grp.drop1.asrt <- addSpatialModelOnIC(init.asrt, spatial.model = "TPPS",
info <- infoCriteria(list(split = init.asrt$asreml.obj, TPPS = TPPS.LP.grp.drop1.asrt$asreml.obj),
cat("#### Test hetero variances for HEB25 with asreml42\n")
#Re-arrange and re-order the data.frame and add factors
xPosition <- xPosition - mean(unique(xPosition))
tmp.dat <- tmp.dat[c("Snapshot.ID.Tag", "Smarthouses", "Lanes", "Positions",
"Genotype.ID", "Lines.nos", "Check", "Treatment.1", "Conditions",
"Plant.Length", "ratio", "Water_Amount", "SSA", "ASA",
"WUE.2", "agrOST", "rgrOST", "linOST", "logOST", "linm4OST",
names(tmp.dat)[match(c("xLane", "xPosition", "xMainPosn", "MainCol"), names(tmp.dat))] <-
tmp.dat <- with(tmp.dat, tmp.dat[order(Treat.Smarthouse, Zones, Mainplots), ])
#Fit an initial model that includes the random term us(Treatment):Genotype
asreml.options(keep.order = TRUE) #required for asreml4 only
list(fixed = Dry.Weight ~ Smarthouse + Check + Treatment.1 +
random = ~ us(Treatment.1):Genotype.ID +
(at(Smarthouse, 'NW') + at(Smarthouse, 'NE')):Zones:Mainplots,  #nugget terms
data = tmp.dat, na.action=na.method(y="include", x="include"),
HEB25.idh.asrt <- as.asrtests(HEB25.asr, NULL, NULL, label = "Nonspatial model",
#Test spatial models on Lanes x MainPosn
#Check makeTPPSplineMats - must be ordered for Smarthouse then Treatment.1
tpsLM.mat <- makeTPPSplineMats(tmp.dat, sections = "Smarthouse",
row.covar = "cLane", col.covar = "cMainPosn",
#Check that order of dat.plus is the same as in the original tmp.dat
#Choose best model for L x M spatial variation
row.factor = "Lanes", col.factor = "MainPosn",
summ$bound[summ$bound == " "] <- "P" #hack to overcome asreml returning spaces
row.factor = "Lanes", col.factor = "MainPosn")
row.covar = "cLane", col.covar = "cMainPosn")
asreml.obj <- update(asreml.obj, aom = TRUE)
t <- convEffectNames2DataFrame.asreml(asreml.obj, term = term,
#Test spatial models on Lanes x Positions
tpsLP.mat <- makeTPPSplineMats(tmp.dat, sections = "Smarthouse",
row.covar = "cLane", col.covar = "cPosition",
#Choose best model for L x P spatial variation
row.factor = "Lanes", col.factor = "Positions",
#Return two P-spline models with rotation  for L x P spatial variation
chooseSpatialModelOnIC(HEB25.idh.asrt,  trySpatial = c("TPPSC2", "TPPSL1"),
theta.opt <- attr(HEB25Rot.spatialLP.asrts$asrts$TPPSC2$asreml.obj, which = "theta.opt")
(at(Smarthouse, 'NW') + at(Smarthouse, 'NE')):Zones:Mainplots, #nugget terms
residual = ~ dsum(~ Zones:Mainplots | Treat.Smarthouse),
HEB25.ds.asrt <- as.asrtests(HEB25.asr, NULL, NULL, label = "Nonspatial model",
#Check that varcomp is the same for idh and dsum
testthat::expect_true(all.equal(summ.idh[-6,], summ.ds, tolerance = 1e-03,
#Choose best model for L x M spatial variation when variance specified using dsum
summ.idh$bound[summ.idh$bound == " "] <- "P" #hack to overcome asreml returning spaces
summ.ds$bound[summ.ds$bound == " "] <- "P" #hack to overcome asreml returning spaces
testthat::expect_true(all.equal(summ.idh[-14,-5], summ.ds[,-5], tolerance = 1e-02,
#                                 summ.ds[, 1:2], tolerance = 0.1,
summ.idh$bound[summ$bound == " "] <- "P" #hack to overcome asreml returning spaces
summ.ds$bound[summ$bound == " "] <- "P" #hack to overcome asreml returning spaces
testthat::expect_true(all.equal(summ.idh[-15,], summ.ds, tolerance = 1e-03,
#idh and ds do not give equivalent answers
#                                summ.ds[,"component"], tolerance = 1e-03,
infoAIC <- infoCriteria(list(idh = HEB25.spatialLP.asrts$asrts$corr$asreml.obj,