added Zt functions to template approach

Author: Steve Walker

R/templateApproach.R

@@ -1,4 +1,35 @@
-##' Make template for relative covariance factor
+##' Create a section of a transposed random effects model matrix
+##'
+##' @param grp Grouping factor for a particular random effects term.
+##' @param mm Dense model matrix for a particular random effects term.
+##' @return Section of a random effects design matrix corresponding to a
+##' particular term.
+##' @examples
+##' ## consider a term (x | g) with:
+##' ## number of observations, n = 6
+##' ## number of levels, nl = 3
+##' ## number of columns ('predictors'), nc = 2
+##' (X <- cbind("(Intercept)"=1,x=1:6)) # an intercept in the first column
+##'                                     # and 1:6 predictor in the other
+##' (g <- as.factor(letters[rep(1:3,2)])) # grouping factor
+##' nrow(X) # n = 6
+##' nrow(X) == length(g) # and consistent n between X and g
+##' ncol(X) # nc = 2
+##' nlevels(g) # nl = 3
+##' Zsection(g, X)
+mkZtSection <- function(grp,mm) {
+    Jt <- as(as.factor(grp), Class="sparseMatrix")
+    KhatriRao(Jt,t(mm))
+}
+
+##' Make transposed random-effects model matrix
+mkZt <- function(grp,mm){
+    ZtSections <- mapply(mkZtSection, grp, mm)
+    rBind(ZtSections)
+}
+
+
+##' Make a single template for a relative covariance factor
 ##'
 ##' @param nc Number of columns in a dense model matrix for a particular
 ##' random effects term
@@ -16,7 +47,7 @@ mkTemplate <- function(nc){
     sparseMatrix(i=i,j=j,x=theta)
 }
 
-##' Make templates for relative covariance factor
+##' Make list of templates for relative covariance factor
 mkTemplates <- function(nc) lapply(nc, mkTemplate)
 
 ##' Make vector of indices giving the mapping from theta to Lambdat
@@ -51,3 +82,4 @@ mkTheta <- function(templates){
     thetas <- lapply(templates, slot, "x")
     unlist(thetas)
 }
+