# UNIVERSIDAD NACIONAL DEL ALTIPLANO PUNO
# INGENIERIA ESTADISTICA E INFORMATICA
# ANALISIS DE CORRESPONDENCIA SIMPLE
library(ggplot2)
## Warning: package 'ggplot2' was built under R version 4.1.3
library(gplots)
##
## Attaching package: 'gplots'
## The following object is masked from 'package:stats':
##
## lowess
library(corrplot)
## Warning: package 'corrplot' was built under R version 4.1.3
## corrplot 0.92 loaded
library(factoextra)
## Warning: package 'factoextra' was built under R version 4.1.3
## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa
library(FactoMineR)
## Warning: package 'FactoMineR' was built under R version 4.1.3
library(FactoClass)
## Warning: package 'FactoClass' was built under R version 4.1.3
## Loading required package: ade4
## Warning: package 'ade4' was built under R version 4.1.3
##
## Attaching package: 'ade4'
## The following object is masked from 'package:FactoMineR':
##
## reconst
## Loading required package: ggrepel
## Warning: package 'ggrepel' was built under R version 4.1.3
## Loading required package: xtable
## Warning: package 'xtable' was built under R version 4.1.3
## Loading required package: scatterplot3d
library(Factoshiny)
## Warning: package 'Factoshiny' was built under R version 4.1.3
## Loading required package: shiny
## Warning: package 'shiny' was built under R version 4.1.3
## Loading required package: FactoInvestigate
## Warning: package 'FactoInvestigate' was built under R version 4.1.3
library(shiny)
library(RColorBrewer)
library(ca)
## Warning: package 'ca' was built under R version 4.1.3
library(paran)
## Warning: package 'paran' was built under R version 4.1.3
## Loading required package: MASS
library(PerformanceAnalytics)
## Warning: package 'PerformanceAnalytics' was built under R version 4.1.3
## Loading required package: xts
## Warning: package 'xts' was built under R version 4.1.3
## Loading required package: zoo
## Warning: package 'zoo' was built under R version 4.1.3
##
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric
##
## Attaching package: 'PerformanceAnalytics'
## The following object is masked from 'package:gplots':
##
## textplot
## The following object is masked from 'package:graphics':
##
## legend
data("housetasks")
housetasks
## Wife Alternating Husband Jointly
## Laundry 156 14 2 4
## Main_meal 124 20 5 4
## Dinner 77 11 7 13
## Breakfeast 82 36 15 7
## Tidying 53 11 1 57
## Dishes 32 24 4 53
## Shopping 33 23 9 55
## Official 12 46 23 15
## Driving 10 51 75 3
## Finances 13 13 21 66
## Insurance 8 1 53 77
## Repairs 0 3 160 2
## Holidays 0 1 6 153
# Convertir los datsos como una tabla
Data <- as.table(as.matrix(housetasks))
str(Data)
## 'table' num [1:13, 1:4] 156 124 77 82 53 32 33 12 10 13 ...
## - attr(*, "dimnames")=List of 2
## ..$ : chr [1:13] "Laundry" "Main_meal" "Dinner" "Breakfeast" ...
## ..$ : chr [1:4] "Wife" "Alternating" "Husband" "Jointly"
# Grafico
mosaicplot((housetasks),las=2, col=brewer.pal(10,"Paired"), main="mozaico")
balloonplot(t(Data), main ="housetasks", xlab ="", ylab="", label = F,
show.margins = F)
quisq <- chisq.test(housetasks)
quisq
##
## Pearson's Chi-squared test
##
## data: housetasks
## X-squared = 1944.5, df = 36, p-value < 2.2e-16
res.ca <- ca(housetasks, graph = T)
res.ca
##
## Principal inertias (eigenvalues):
## 1 2 3
## Value 0.542889 0.445003 0.127048
## Percentage 48.69% 39.91% 11.4%
##
##
## Rows:
## Laundry Main_meal Dinner Breakfeast Tidying Dishes Shopping
## Mass 0.100917 0.087729 0.061927 0.080275 0.069954 0.064794 0.068807
## ChiDist 1.152997 1.016747 0.785880 0.715740 0.593815 0.549821 0.466440
## Inertia 0.134160 0.090692 0.038246 0.041124 0.024667 0.019587 0.014970
## Dim. 1 -1.346122 -1.188346 -0.939962 -0.690273 -0.534477 -0.256462 -0.159717
## Dim. 2 -0.742517 -0.734702 -0.461866 -0.678779 0.651108 0.662533 0.604596
## Official Driving Finances Insurance Repairs Holidays
## Mass 0.055046 0.079702 0.064794 0.079702 0.094610 0.091743
## ChiDist 0.984014 1.128542 0.675490 0.852589 1.818512 1.462801
## Inertia 0.053300 0.101509 0.029564 0.057936 0.312874 0.196311
## Dim. 1 0.307586 1.006731 0.367485 0.878213 2.074861 0.342675
## Dim. 2 -0.380181 -0.979506 0.926221 0.710229 -1.295584 2.151159
##
##
## Columns:
## Wife Alternating Husband Jointly
## Mass 0.344037 0.145642 0.218463 0.291858
## ChiDist 0.935393 0.899443 1.321252 1.038436
## Inertia 0.301019 0.117824 0.381373 0.314725
## Dim. 1 -1.136821 -0.084397 1.575600 0.202801
## Dim. 2 -0.547487 -0.437116 -0.902313 1.538902
print(res.ca$eig)
## NULL
# Numero de categoria por variable
cats <- apply(housetasks, 2, function(x)nlevels(as.factor(x)))
cats
## Wife Alternating Husband Jointly
## 12 11 13 12
names(cats)
## [1] "Wife" "Alternating" "Husband" "Jointly"
# Contribucion del Chi-CUadrado
chisq <- chisq.test(housetasks)
chisq
##
## Pearson's Chi-squared test
##
## data: housetasks
## X-squared = 1944.5, df = 36, p-value < 2.2e-16
corrplot(chisq$residuals, is.corr = F, main = 'Residuales')
fviz_screeplot(res.ca, addlabels = T, ylim = c(0,50),
main = "Porcentaje de Varianza Explicada")
fviz_screeplot(res.ca)+geom_hline(yintercept = 33.33, linetype = 2, color = "red")
# Evitar la superpocision de texto
fviz_ca_biplot(res.ca, repel = T)
plotct (housetasks,"row",col=brewer.pal(10,"Paired"))
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"
# Coordinadas
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
# Calidad dentro de los factores del mapa
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
# Contribuciones para los principales componentes
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
# Grafico
fviz_ca_row(res.ca, repel = T)
head(row$cos2,4)
## 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
# Color por 2 : Calidad dentro del factor mapa
fviz_ca_row(res.ca, col.row = "cos2", gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
repel = T)
corrplot(row$cos2,is.corr = F)
# Cos2 de rutas dentro de dim 1 y dim 2
fviz_cos2(res.ca, choice = "row", axes = 1:2)
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
corrplot(row$contrib, is.corr = F)
# Contribucion de rutas para dimension 1
fviz_contrib(res.ca, choice = "row", axes = 1, top = 10)
# Contribution de rutas para dimension 2
fviz_contrib(res.ca, choice = "row", axes = 2, top = 10)
# Total de contribucion para dimension 1 y 2
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 = T)
# Cambio la transparencia por contribuir
fviz_ca_row(res.ca, alpha.row="contrib",
repel = TRUE)
# PERFIL COLUMNA
plotct (housetasks,"col",col=brewer.pal(10,"Paired"))
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"
# Coordenadas de la columna de puntos
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
# Representacion de Calidad
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
#Contribuciones
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 = T)
fviz_cos2(res.ca, choice = "col", axes = 1:2)
fviz_contrib(res.ca, choice = "col", axes = 1:2)
fviz_ca_biplot(res.ca, repel = T)
# Grafico Asimetrico
fviz_ca_biplot(res.ca,
map ="rowprincipal", arrow = c(T, T),
repel = T)
fviz_ca_biplot(res.ca, map ="colgreen", arrow = c(T, F),
repel = T)
# Visualizacion de la matriz de correlacion
chart.Correlation(decathlon2[, 1:6], histogram=T, pch=19)
