Nothing
# These functions use fuse() to calculate correlations between item composites.
# Internal functions ----------------------------------------------------------
#' Correlations between item composites and the original correlation matrix
#'
#' The key matrix is used to specify any number of weighted item composites.
#' The correlations between each specified composite and the original correlation
#' matrix are computed.
#'
#' @param r_mat A correlation matrix.
#' @param key_mat A matrix with one row for each composite and one column for
#' each item contained in r_mat. The value if each element corresponds
#' to the weight given to an item.
#' @return A matrix of intercorrelations.
#' @author Allen Goebl and Jeff Jones
#' @examples
#' print("example needed")
#' @keywords internal
#' @rdname internal.fuseRmat
.fuseRmat <- function(r_mat, key_mat) {
len <- dim(key_mat)[1]
input <- .unpackMat(key_mat)
fn <- function(x) {
fuseVec(r_mat=r_mat, a=input$key_id[[x]], wt_a=input$key_wt[[x]])
}
return(sapply(seq(len), fn))
}
#' Computes the intercorrelations of item composites
#'
#' The key matrix is used to specify any number of weighted item composites.
#' A correlation matrix of these composites is then computed and returned.
#'
#' @param r_mat A correlation matrix.
#' @param key_mat A matrix with one row for each composite and one column for
#' each item contained in r_mat. The value if each element corresponds
#' to the weight given to an item.
#' @return A matrix of intercorrelations.
#' @author Allen Goebl and Jeff Jones
#' @examples
#' print("example needed")
#' @keywords internal
#' @rdname internal.fuseCom
.fuseCom <- function(r_mat, key_mat) {
input <- .unpackMat(key_mat)
unpackedfuse <- function(X, Y){
ua <- .unpack(key_mat[X,])
ub <- .unpack(key_mat[Y,])
fuse(r_mat=r_mat, a=ua$key_id, b=ub$key_id, wt_a=ua$key_wt, wt_b=ub$key_wt)
}
len <- dim(key_mat)[1]
return(outer(X=1:len, Y=1:len, FUN=Vectorize(unpackedfuse)))
}
#' The intercorrelation among items and composites made of these items.
#'
#' The key matrix is used to specify any number of weighted item composites.
#' A correlation matrix of these composites and the original correlation matrix
#' is then computed and returned.
#'
#' @param r_mat A correlation matrix.
#' @param key_mat A matrix with one row for each composite and one column for
#' each item contained in r_mat. The value if each element corresponds
#' to the weight given to an item.
#' @return A matrix of intercorrelations.
#' @author Allen Goebl and Jeff Jones
#' @examples
#' print("example needed")
#' @keywords internal
#' @rdname internal.fusefull
.fuseFull <- function(r_mat, key_mat) {
swr <- .fuseRmat(r_mat=r_mat, key_mat=key_mat)
sws <- .fuseCom(r_mat=r_mat, key_mat=key_mat)
#Combine 4 matrices together.
tp <- cbind(r_mat, swr)
bt <- cbind(t(swr), sws)
return(rbind(tp,bt))
}
# External functions ----------------------------------------------------------
#' Computes the correlation between two composites of items.
#'
#' Computes the correlation between two composites of items. Composites may
#' contain overalapping items. Items weights for each composite may be specified.
#'
#' @param r_mat A correlation matrix.
#' @param a The items used for composite A specified as a vector of column numbers.
#' @param b The items used for composite B specified as a vector of column numbers.
#' @param wt_a A vector containing the weights of each item in composite A.
#' @param wt_b A vector containing the weights of each item in composite B.
#' @return A correlation coefficient.
#' @author Allen Goebl and Jeff Jones
#' @references Lord, F.M. & Novick, M.R. (1968). \emph{Statisticl theories of
#' menal test scores.}, 97-98.
#' @examples
#' Rxx <- matrix(c(1.00, 0.25, 0.50, 0.61,
#' 0.25, 1.00, 0.30, 0.10,
#' 0.50, 0.30, 1.00, -0.30,
#' 0.61, 0.10, -0.30, 1.00), 4, 4)
#' a <- c(1, 3)
#' b <- c(2, 4)
#'
#' # Example using overlapping items and weights
#' Rxx <- matrix(.3, 4, 4); diag(Rxx) <- 1
#' a <- c(1, 2, 4)
#' b <- c(2, 3)
#' wt_a <- c(.60, .25, .15)
#' wt_b <- c(2, 3)
#'
#' fuse(r_mat = Rxx, a = a, b = b, wt_a = wt_a, wt_b = wt_b)
#'
#' @export
fuse <- function(r_mat, a, b, wt_a=rep(1, length(a)), wt_b=rep(1, length(b))) {
#Sanity check
.isCorMat(r_mat)
if(length(a) != length(wt_a)) {stop("wt_a must be the same length as a")}
if(length(b) != length(wt_b)) {stop("wt_b must be the same length as b")}
#Variances
ab <- (wt_a %*% r_mat[a,b] %*% wt_b)
aa <- (wt_a %*% r_mat[a,a] %*% wt_a)
bb <- (wt_b %*% r_mat[b,b] %*% wt_b)
#Equation
return(ab / (sqrt(aa) * sqrt(bb)))
}
#' Computes the correlation between a composite and a vector of items.
#'
#' @param r_mat A correlation matrix.
#' @param a The items used for composite A specified as a vector of column numbers.
#' @param wt_a A vector containing the weights of each item in composite A.
#' @param output Output can be set to "mat", to return a matrix made up of the
#' newly generated correlations appened to the original correlation matrix.
#' @return A vector of correlation coefficients.
#' @author Allen Goebl and Jeff Jones
#' @references Lord, F.M. & Novick, M.R. (1968). \emph{Statisticl theories of
#' mental test scores.}, 97-98.
#' @examples
#' data(dls2007)
#' dat <- dls2007
#' rxx <- dat[1:4, 2:5]
#' items <- c(1,3)
#' wt_a <- c(2,1)
#'
#' fuseVec(r_mat=rxx, a=items)
#' fuseVec(r_mat=rxx, a=items, wt_a=wt_a, output="mat")
#' @export
fuseVec <- function(r_mat, a, wt_a=rep(1, length(a)), output="vec") {
.isCorMat(r_mat)
len <- nrow(r_mat)
out.vec <- sapply(seq(len),
function(x) fuse(r_mat=r_mat, a=a, b=x, wt_a=wt_a, wt_b=1))
if(output == "vec") { return(out.vec) }
else if(output == "mat") { return(.corAdd(r_mat=r_mat, r_vec=out.vec)) }
else (stop("The output type is incorrectly specified."))
}
#' The intercorrelation among items and composites made of these items.
#'
#' The key matrix is used to specify any number of weighted item composites.
#' A correlation matrix of these composites and the original correlation matrix
#' is then computed and returned.
#'
#' @param r_mat A correlation matrix.
#' @param key_mat A matrix with one row for each composite and one column for
#' each item contained in r_mat. The value if each element corresponds
#' to the weight given to an item.
#' @param type The type of output desired.
#' @return If type = cxc then a matrix of the intercorrelations between the specified
#' composites are returned. If type = cxr then the intercorrelations
#' between the original item and the specified composites are returned.
#' If type = full then all the intercorrelations between both the original items and the specified composites are returned.
#' @author Allen Goebl and Jeff Jones
#' @examples
#' Rxx <- matrix(c(1.00, 0.25, 0.50, 0.61,
#' 0.25, 1.00, 0.30, 0.10,
#' 0.50, 0.30, 1.00, -0.30,
#' 0.61, 0.10, -0.30, 1.00), 4, 4); Rxx
#'
#' # Single composite
#' Key <- matrix(c(1, 2, 3, -1), 1, 4); Key
#'
#' fuseMat(r_mat = Rxx, key_mat = Key)
#'
#' # Three composites
#' Key <- matrix(c(1, 2, 3, -1,
#' 2, 1, 0, -2,
#' 1, 1, 0, 0), 3, 4, byrow = TRUE)
#'
#' fuseMat(Rxx, Key)
#' @export
fuseMat <- function(r_mat, key_mat, type="full"){
#Check input
.isCorMat(r_mat)
if(nrow(r_mat) != ncol(key_mat)) { stop("key_mat does not match r_mat") }
#Call specified function
switch(type,
full = { out <- .fuseFull(r_mat=r_mat, key_mat=key_mat)},
rxc = { out <- .fuseRmat(r_mat=r_mat, key_mat=key_mat)},
cxc = { out <- .fuseCom(r_mat=r_mat, key_mat=key_mat)})
return(out)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.