if (FALSE) {
### Minimal (with many features missing) reimplementation
# of corrMatrix() terms as a corrFamily
corrMatrix_cF <- function(corrMatrix) {
force(corrMatrix) # Makes it available in the environment of the functions next defined.
oldZlevels <- NULL
initialize <- function(Zmatrix, ...) {
oldZlevels <<- colnames(Zmatrix) # Pass info about levels of the random effect in the data.
}
Cf <- function(newlevels=oldZlevels ) {
if (length(newlevels)) {
corrMatrix[newlevels,newlevels]
} else corrMatrix[oldZlevels,oldZlevels] # for Cf(tpar=numeric(0L))
}
calc_moreargs <- function(corrfamily, ...) {
list(init=c(),lower=c(),upper=c())
}
make_new_corr_lists <- function(newLv_env, which_mats, newZAlist, new_rd, ...) {
newlevels <- colnames(newZAlist[[new_rd]])
newLv_env$cov_newLv_oldv_list[[new_rd]] <- corrMatrix[newlevels,oldZlevels, drop=FALSE]
if (which_mats$nn[new_rd]) {
newLv_env$cov_newLv_newLv_list[[new_rd]] <- corrMatrix[newlevels,newlevels, drop=FALSE]
} else {
newLv_env$diag_cov_newLv_newLv_list[[new_rd]] <- rep(1,length(newlevels))
}
}
list(Cf=Cf, tpar=numeric(0L), initialize=initialize, calc_moreargs=calc_moreargs,
make_new_corr_lists=make_new_corr_lists,
tag="corrMatrix_cF")
}
register_cF("corrMatrix_cF")
# usage:
data("blackcap")
MLcorMat <- MaternCorr(proxy::dist(blackcap[,c("latitude","longitude")]),
nu=0.6285603,rho=0.0544659)
corrmat <- proxy::as.matrix(MLcorMat, diag=1)
fitme(migStatus ~ means+ corrMatrix_cF(1|name, corrMatrix=corrmat),data=blackcap,
corrMatrix=MLcorMat,method="ML")
unregister_cF("corrMatrix_cF") # Tidy things before leaving.
}
Run the code above in your browser using DataLab