## ----setup, include=FALSE------------------------------------------------
knitr::opts_chunk$set(echo = TRUE,fig.width=11, fig.height=9)
## ----libs----------------------------------------------------------------
require(ggplot2)
require(GGally)
require(CCA)
## ----local---------------------------------------------------------------
require(moob)
x <- moob::hello()
## ----data----------------------------------------------------------------
mm <- read.csv("http://www.ats.ucla.edu/stat/data/mmreg.csv")
colnames(mm) <- c("Control", "Concept", "Motivation", "Read", "Write", "Math",
"Science", "Sex")
summary(mm)
## ------------------------------------------------------------------------
xtabs(~Sex, data = mm)
## ------------------------------------------------------------------------
psych <- mm[, 1:3]
acad <- mm[, 4:8]
## ------------------------------------------------------------------------
ggpairs(psych)
## ------------------------------------------------------------------------
ggpairs(acad)
## ------------------------------------------------------------------------
# correlations
matcor(psych, acad)
## ------------------------------------------------------------------------
cc1 <- cc(psych, acad)
# display the canonical correlations
cc1$cor
## ------------------------------------------------------------------------
# raw canonical coefficients
cc1[3:4]
## ------------------------------------------------------------------------
# compute canonical loadings
cc2 <- comput(psych, acad, cc1)
# display canonical loadings
cc2[3:6]
## ------------------------------------------------------------------------
# tests of canonical dimensions
ev <- (1 - cc1$cor^2)
n <- dim(psych)[1]
p <- length(psych)
q <- length(acad)
k <- min(p, q)
m <- n - 3/2 - (p + q)/2
w <- rev(cumprod(rev(ev)))
# initialize
d1 <- d2 <- f <- vector("numeric", k)
for (i in 1:k) {
s <- sqrt((p^2 * q^2 - 4)/(p^2 + q^2 - 5))
si <- 1/s
d1[i] <- p * q
d2[i] <- m * s - p * q/2 + 1
r <- (1 - w[i]^si)/w[i]^si
f[i] <- r * d2[i]/d1[i]
p <- p - 1
q <- q - 1
}
pv <- pf(f, d1, d2, lower.tail = FALSE)
(dmat <- cbind(WilksL = w, F = f, df1 = d1, df2 = d2, p = pv))
## ------------------------------------------------------------------------
# standardized psych canonical coefficients diagonal matrix of psych sd's
s1 <- diag(sqrt(diag(cov(psych))))
s1 %*% cc1$xcoef
## ------------------------------------------------------------------------
# standardized acad canonical coefficients diagonal matrix of acad sd's
s2 <- diag(sqrt(diag(cov(acad))))
s2 %*% cc1$ycoef
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.