library(FactoMineR)
## Warning: package 'FactoMineR' was built under R version 4.3.3
library(factoextra)
## Warning: package 'factoextra' was built under R version 4.3.3
## Loading required package: ggplot2
## Warning: package 'ggplot2' was built under R version 4.3.3
## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa
library(gplots)
## Warning: package 'gplots' was built under R version 4.3.3
##
## Attaching package: 'gplots'
## The following object is masked from 'package:stats':
##
## lowess
library(corrplot)
## Warning: package 'corrplot' was built under R version 4.3.3
## corrplot 0.92 loaded
data(housetasks)
dt <- as.table(as.matrix(housetasks))
balloonplot(t(dt), main="housetasks", xlab="", ylab="",
label = FALSE, show.margins= FALSE)
chisq <- chisq.test(housetasks)
chisq
##
## Pearson's Chi-squared test
##
## data: housetasks
## X-squared = 1944.5, df = 36, p-value < 2.2e-16
res.ca <- CA(housetasks, graph = FALSE)
print(res.ca)
## **Results of the Correspondence Analysis (CA)**
## The row variable has 13 categories; the column variable has 4 categories
## The chi square of independence between the two variables is equal to 1944.456 (p-value = 0 ).
## *The results are available in the following objects:
##
## name description
## 1 "$eig" "eigenvalues"
## 2 "$col" "results for the columns"
## 3 "$col$coord" "coord. for the columns"
## 4 "$col$cos2" "cos2 for the columns"
## 5 "$col$contrib" "contributions of the columns"
## 6 "$row" "results for the rows"
## 7 "$row$coord" "coord. for the rows"
## 8 "$row$cos2" "cos2 for the rows"
## 9 "$row$contrib" "contributions of the rows"
## 10 "$call" "summary called parameters"
## 11 "$call$marge.col" "weights of the columns"
## 12 "$call$marge.row" "weights of the rows"
chi2 <- 1944.456
df <- (nrow(housetasks)-1) * (ncol(housetasks) - 1)
pval <- pchisq(chi2, df = df, lower.tail = FALSE)
pval
## [1] 0
eig.val <- get_eigenvalue(res.ca)
eig.val
## eigenvalue variance.percent cumulative.variance.percent
## Dim.1 0.5428893 48.69222 48.69222
## Dim.2 0.4450028 39.91269 88.60491
## Dim.3 0.1270484 11.39509 100.00000
fviz_screeplot(res.ca, addlabels = TRUE, ylim = c(0, 50))
fviz_screeplot(res.ca)+
geom_hline(yintercept = 33.33, linetype = 2, color = "red")
fviz_ca_biplot(res.ca, repel = TRUE)
row <- get_ca_row(res.ca)
row
## Correspondence Analysis - Results for rows
## ===================================================
## Name Description
## 1 "$coord" "Coordinates for the rows"
## 2 "$cos2" "Cos2 for the rows"
## 3 "$contrib" "contributions of the rows"
## 4 "$inertia" "Inertia of the rows"
head(row$coord)
## Dim 1 Dim 2 Dim 3
## Laundry -0.9918368 0.4953220 -0.31672897
## Main_meal -0.8755855 0.4901092 -0.16406487
## Dinner -0.6925740 0.3081043 -0.20741377
## Breakfeast -0.5086002 0.4528038 0.22040453
## Tidying -0.3938084 -0.4343444 -0.09421375
## Dishes -0.1889641 -0.4419662 0.26694926
head(row$cos2)
## Dim 1 Dim 2 Dim 3
## Laundry 0.7399874 0.1845521 0.07546047
## Main_meal 0.7416028 0.2323593 0.02603787
## Dinner 0.7766401 0.1537032 0.06965666
## Breakfeast 0.5049433 0.4002300 0.09482670
## Tidying 0.4398124 0.5350151 0.02517249
## Dishes 0.1181178 0.6461525 0.23572969
head(row$contrib)
## Dim 1 Dim 2 Dim 3
## Laundry 18.2867003 5.563891 7.968424
## Main_meal 12.3888433 4.735523 1.858689
## Dinner 5.4713982 1.321022 2.096926
## Breakfeast 3.8249284 3.698613 3.069399
## Tidying 1.9983518 2.965644 0.488734
## Dishes 0.4261663 2.844117 3.634294
fviz_ca_row(res.ca, repel = TRUE)
fviz_ca_row(res.ca, col.row = "steelblue", shape.row = 15)
fviz_ca_row(res.ca, col.row = "cos2",
gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
repel = TRUE)
corrplot(row$cos2, is.corr = FALSE)
fviz_cos2(res.ca, choice = "row", axes = 1:2)
corrplot(row$contrib, is.corr = FALSE)
fviz_contrib(res.ca, choice = "row", axes = 1, top = 10)
fviz_contrib(res.ca, choice = "row", axes = 2, top = 10)
fviz_contrib(res.ca, choice = "row", axes = 1:2, top = 10)
fviz_ca_row(res.ca, col.row = "contrib",
gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
repel = TRUE)
col <- get_ca_col(res.ca)
col
## Correspondence Analysis - Results for columns
## ===================================================
## Name Description
## 1 "$coord" "Coordinates for the columns"
## 2 "$cos2" "Cos2 for the columns"
## 3 "$contrib" "contributions of the columns"
## 4 "$inertia" "Inertia of the columns"
head(col$coord)
## Dim 1 Dim 2 Dim 3
## Wife -0.83762154 0.3652207 -0.19991139
## Alternating -0.06218462 0.2915938 0.84858939
## Husband 1.16091847 0.6019199 -0.18885924
## Jointly 0.14942609 -1.0265791 -0.04644302
head(col$cos2)
## Dim 1 Dim 2 Dim 3
## Wife 0.801875947 0.1524482 0.045675847
## Alternating 0.004779897 0.1051016 0.890118521
## Husband 0.772026244 0.2075420 0.020431728
## Jointly 0.020705858 0.9772939 0.002000236
head(col$contrib)
## Dim 1 Dim 2 Dim 3
## Wife 44.462018 10.312237 10.8220753
## Alternating 0.103739 2.782794 82.5492464
## Husband 54.233879 17.786612 6.1331792
## Jointly 1.200364 69.118357 0.4954991
fviz_ca_col(res.ca)
fviz_ca_col(res.ca, col.col = "cos2",
gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
repel = TRUE)
fviz_cos2(res.ca, choice = "col", axes = 1:2)
fviz_contrib(res.ca, choice = "col", axes = 1:2)
fviz_ca_biplot(res.ca, repel = TRUE)
fviz_ca_biplot(res.ca,
map="rowprincipal", arrows = c(TRUE, TRUE),
repel = TRUE)
fviz_ca_biplot(res.ca, map="colgreen", arrows = c(TRUE, TRUE),
repel = TRUE)
data(children)
res.ca <- CA(children, row.sup = 15:18, col.sup = 6:8,
graph = FALSE)
fviz_ca_biplot(res.ca, repel = TRUE)
fviz_ca_row(res.ca, repel = TRUE)
fviz_ca_col(res.ca, repel = TRUE)
fviz_ca_row(res.ca, select.row = list(cos2 = 0.8))
fviz_ca_row(res.ca, select.row = list(cos2 = 5))
name <- list(name = c("employmet", "fear", "future"))
fviz_ca_row(res.ca, select.row = name)
fviz_ca_biplot(res.ca, select.row = list(contrib = 5),
select.col = list(contrib = 5)) +
theme_minimal()
