if (spaMM.getOption("example_maxtime")>2 &&
requireNamespace("agridat", quietly = TRUE)) {
data("onofri.winterwheat", package="agridat")
##### Fitting a Toeplitz correlation model for temporal correlations #####
# A Toeplitz correlation matrix of dimension d*d has d-1 parameters
# (by symmetry, and with 1s on the main diagonal). These d-1 parameters
# can be fitted as follows:
Toepfn <- function(v) {
toepmat <- Matrix::forceSymmetric(toeplitz(c(1,v))) # dsyMatrix
# Many of the matrices in this family are not valid correlation matrices;
# the regularize() function is handy here:
toepmat <- regularize(toepmat, maxcondnum=1e12)
# And don't forget the rownames!
rownames(toepmat) <- unique(onofri.winterwheat$year)
toepmat
}
(Toepfit <- spaMM::fitme(
yield ~ gen + corrFamily(1|year), data=onofri.winterwheat, method="REML",
covStruct=list(corrFamily=list(Cf=Toepfn, tpar=rep(1e-4,6))),
# (Note the gentle warning if one instead uses tpar=rep(0,6) here)
lower=list(corrPars=list("1"=rep(-0.999,6))),
upper=list(corrPars=list("1"=rep(0.999,6)))))
# The fitted matrix is (nearly) singular, and was regularized:
eigen(Corr(Toepfit)[[1]])$values
# which means that the returned likelihood may be inaccurate,
# and also that the actual matrix elements differ from input parameters:
Corr(Toepfit)[[1]][1,-1]
### The usual rules for specifying covStruct, 'lower', 'upper' and 'init' apply
# here when the corrFamily term is the second random-effect:
(Toep2 <- spaMM::fitme(
yield ~ 1 + (1|gen) + corrFamily(1|year), data=onofri.winterwheat, method="REML",
covStruct=list("1"=NULL, corrFamily=list(Cf=Toepfn, tpar=rep(1e-4,6))),
, init=list(corrPars=list("2"=rep(0.1,6))),
lower=list(corrPars=list("2"=rep(-0.999,6))),
upper=list(corrPars=list("2"=rep(0.999,6)))))
##### Fitting one variance among years per each of 8 genotypes. #####
# First, note that this can be *more efficiently* fitted by another syntax:
### Fit as a constrained random-coefficient model:
# Diagonal matrix of NA's, represented as vector for its lower triangle:
ranCoefs_for_diag <- function(nlevels) {
vec <- rep(0,nlevels*(nlevels+1L)/2L)
vec[cumsum(c(1L,rev(seq(nlevels-1L)+1L)))] <- NA
vec
}
(by_rC <- spaMM::fitme(yield ~ 1 + (0+gen|year), data=onofri.winterwheat, method="REML",
fixed=list(ranCoefs=list("1"=ranCoefs_for_diag(8)))))
### Fit as a corrFamily model:
gy_levels <- paste0(gl(8,1,length =56,labels=levels(onofri.winterwheat$gen)),":",
gl(7,8,labels=unique(onofri.winterwheat$year)))
# A log scale is often suitable for variances, hence is used below;
# a correct but crude implementation of the model is
diagf <- function(logvar) {
corr_map <- kronecker(Matrix::.symDiagonal(n=7),diag(x=exp(logvar)))
rownames(corr_map) <- gy_levels
corr_map
}
# but we can minimize matrix operations as follows:
corr_map <- Matrix::.symDiagonal(n=8,x=seq(8))
rownames(corr_map) <- unique(onofri.winterwheat$gen)
diagf <- function(logvar) {
corr_map@x <- exp(logvar)[corr_map@x]
corr_map
} # (and this returns a dsCMatrix)
(by_cF <- spaMM::fitme(
yield ~ 1 + corrFamily(1|gen %in% year), data=onofri.winterwheat, method="REML",
covStruct=list(corrFamily = list(Cf=diagf, tpar=rep(1,8))),
fixed=list(lambda=1), # Don't forget to fix this redundant parameter!
# init=list(corrPars=list("1"=rep(log(O.1),8))), # 'init' optional
lower=list(corrPars=list("1"=rep(log(1e-6),8))), # 'lower' and 'upper' required
upper=list(corrPars=list("1"=rep(log(1e6),8)))))
# => The 'gen' effect is nested in the 'year' effect and this must be specified in the
# right-hand side of corrFamily(1|gen %in% year) so that the design matrix 'Z' for the
# random effects to have the correct structure. And then, as for other correlation
# structures (say Matern) it should be necessary to specify only the correlation matrix
# for a given year, as done above. Should this fail, it is also possible to specify the
# correlation matrix over years, as done below. spaMM will automatically detect, from
# its size matching the number of columns of Z, that it must be the matrix over years.
corr_map <- Matrix::forceSymmetric(kronecker(Matrix::.symDiagonal(n=7),diag(x=seq(8))))
rownames(corr_map) <- gy_levels
diagf <- function(logvar) {
corr_map@x <- exp(logvar)[corr_map@x]
corr_map
} # (and this returns a dsCMatrix)
(by_cF <- spaMM::fitme(
yield ~ 1 + corrFamily(1|gen %in% year), data=onofri.winterwheat, method="REML",
covStruct=list(corrFamily = list(Cf=diagf, tpar=rep(1,8))),
fixed=list(lambda=1), # Don't forget to fix this redundant parameter!
# init=list(corrPars=list("1"=rep(log(O.1),8))), # 'init' optional
lower=list(corrPars=list("1"=rep(log(1e-6),8))), # 'lower' and 'upper' required
upper=list(corrPars=list("1"=rep(log(1e6),8)))))
exp(get_ranPars(by_cF)$corrPars[[1]]) # fitted variances
}
Run the code above in your browser using DataLab