Nothing
## ----knitr options, include=FALSE---------------------------------------------
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>",
fig.align = "center", fig.width = 6, fig.height = 5
)
## ----setup--------------------------------------------------------------------
data(HairEyeColor)
library(MASS)
library(ordr)
## -----------------------------------------------------------------------------
print(HairEyeColor)
plot(HairEyeColor)
## -----------------------------------------------------------------------------
haireye <- apply(HairEyeColor, c(1L, 2L), sum)
haireye_ca <- corresp(haireye, nf = 3L)
print(haireye_ca)
# proportion of variance in each dimension
haireye_ca$cor^2 / sum(haireye_ca$cor^2)
## -----------------------------------------------------------------------------
# correspondence matrix (matrix of relative frequencies)
(haireye_p <- haireye / sum(haireye))
# row and column weights
(haireye_r <- rowSums(haireye) / sum(haireye))
(haireye_c <- colSums(haireye) / sum(haireye))
# matrix of standardized residuals
(haireye_s <-
diag(1 / sqrt(haireye_r)) %*%
(haireye_p - haireye_r %*% t(haireye_c)) %*%
diag(1 / sqrt(haireye_c)))
# singular value decomposition
haireye_svd <- svd(haireye_s)
# row and column standard coordinates
diag(1 / sqrt(haireye_r)) %*% haireye_svd$u[, 1:3]
diag(1 / sqrt(haireye_c)) %*% haireye_svd$v[, 1:3]
## ---- fig.height=6------------------------------------------------------------
biplot(
haireye_ca, type = "symmetric", cex = .8,
main = "Correspondence analysis of subjects' hair & eye colors"
)
## -----------------------------------------------------------------------------
(haireye_ca_ord <- as_tbl_ord(haireye_ca))
## -----------------------------------------------------------------------------
get_conference(haireye_ca_ord)
confer_inertia(haireye_ca_ord, c(.25, .75))
confer_inertia(haireye_ca_ord, c(1, 1))
(haireye_ca_ord <- confer_inertia(haireye_ca_ord, "symmetric"))
## -----------------------------------------------------------------------------
glance(haireye_ca_ord)
## -----------------------------------------------------------------------------
augment_ord(haireye_ca_ord)
## ----tidy---------------------------------------------------------------------
tidy(haireye_ca_ord)
## ----scree plot---------------------------------------------------------------
ggplot(tidy(haireye_ca_ord), aes(x = name, y = inertia)) +
geom_col() +
labs(x = "Component", y = "Inertia") +
ggtitle("Correspondence analysis of subjects' hair & eye colors",
"Decomposition of inertia")
## ----fortify------------------------------------------------------------------
fortify(haireye_ca_ord)
## -----------------------------------------------------------------------------
haireye_ca_ord %>%
augment_ord() %>%
fortify() %>%
transform(feature = ifelse(.matrix == "rows", "Hair", "Eye")) %>%
ggbiplot(aes(color = feature, shape = feature, label = name), clip = "off") +
theme_biplot() +
geom_origin() +
geom_rows_point() +
geom_cols_point() +
geom_rows_text(vjust = -1, hjust = 0, size = 3) +
geom_cols_text(vjust = -1, hjust = 0, size = 3) +
scale_color_brewer(type = "qual", palette = "Dark2") +
scale_size_area() +
ggtitle("Correspondence analysis of subjects' hair & eye colors",
"Symmetric biplot")
## -----------------------------------------------------------------------------
sessioninfo::session_info()
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.