#### concatenate blocks ####
#' @rdname concat
#' @aliases concat,block-method
setMethod("concat",signature = "block", function(...) { return(...) })
#' @rdname concat
#' @aliases concat,GMRF-method
setMethod("concat",signature = "GMRF",function(...) {
l <- list(...)
mu <- Q <- intrinsic <- n <- rep <- list()
for (i in 1:length(l)) {
mu[[i]] <- l[[i]]@mu
Q[[i]] <- l[[i]]@Q
intrinsic[[i]] <- l[[i]]@intrinsic
n[[i]] <- l[[i]]@n
}
mu <- Reduce("rbind",mu)
Q <- Reduce("bdiag",Q)
intrinsic <- Reduce("min",intrinsic)
n <- Reduce("+",n)
common_cols <- Reduce("intersect",lapply(l,function(x) {colnames(x@rep)}))
compatible <- lapply(l,function(x) suppressWarnings(all(common_cols == colnames(x@rep))))
if(!all(unlist(compatible))) warning("Keeping only common columns in mesh attributes when compressing")
rep <- Reduce("rbind",lapply(l,function(x) return(subset(x@rep,select=common_cols))))
return(new("GMRF",
mu = mu,
Q = Q,
intrinsic = intrinsic,
n = n,
rep=rep))
})
#' @rdname concat
#' @aliases concat,GMRF_basis-method
setMethod("concat",signature = "GMRF_basis",function(...) {
l <- list(...)
lG <- lapply(l,function(df) {return(df@G)})
Gconcat <- Reduce("concat",lG)
return(Gconcat)
})
#' @rdname concat
#' @aliases concat,Obs-method
setMethod("concat",signature = "Obs",function(...) {
l <- list(...)
df <- n <- list()
for (i in 1:length(l)) {
df[[i]] <- l[[i]]@df
n[[i]] <- l[[i]]@n
}
common_cols <- Reduce("intersect",lapply(df,colnames))
compatible <- lapply(df,function(x) suppressWarnings(all(common_cols == colnames(x))))
if(!all(unlist(compatible))) warning("Keeping only common columns in data sets when compressing")
df <- Reduce("rbind",lapply(df,function(x) return(subset(x,select=common_cols))))
n <- Reduce("+",n)
return(new("Obs",
df = df))})
concatBasis <- function(G1,G2){
this_basis <- new("Basis", pars=c(G1@pars,G2@pars), n=G1@n + G2@n, fn=c(G1@fn,G2@fn))
return(this_basis)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.