Librerias
library(readxl)
library(GGally)
## Loading required package: ggplot2
## Registered S3 method overwritten by 'GGally':
## method from
## +.gg ggplot2
library(Gifi)
library(tidyverse)
## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.1 ──
## ✔ tibble 3.1.7 ✔ dplyr 1.0.9
## ✔ tidyr 1.2.0 ✔ stringr 1.4.0
## ✔ readr 2.1.2 ✔ forcats 0.5.1
## ✔ purrr 0.3.4
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
library(writexl)
Datos
Data <- read_excel("Datos.xlsx",
sheet = "PlataformaFacebook",
range = "A2:Y722")
Data <- data.frame(lapply(Data,
factor))
head(Data[,1:5])
| Femenino |
18-29 |
SÃ |
1 |
1 |
| Femenino |
18-29 |
SÃ |
0 |
1 |
| Masculino |
18-29 |
SÃ |
1 |
1 |
| Femenino |
18-29 |
SÃ |
1 |
1 |
| Masculino |
40-49 |
SÃ |
1 |
0 |
| Femenino |
40-49 |
SÃ |
1 |
1 |
head(Data[,6:15])
| 0 |
1 |
0 |
0 |
0 |
0 |
3 |
3 |
0 |
1 |
| 0 |
0 |
1 |
0 |
0 |
0 |
1 |
1 |
0 |
0 |
| 0 |
0 |
1 |
0 |
0 |
0 |
3 |
3 |
1 |
0 |
| 1 |
0 |
0 |
0 |
0 |
0 |
3 |
4 |
1 |
1 |
| 1 |
0 |
0 |
0 |
0 |
0 |
3 |
3 |
0 |
1 |
| 0 |
1 |
0 |
0 |
0 |
0 |
4 |
1 |
0 |
1 |
head(Data[,16:25])
| 1 |
1 |
0 |
0 |
0 |
0 |
1 |
1 |
1 |
1 |
| 0 |
0 |
0 |
1 |
0 |
0 |
1 |
1 |
1 |
1 |
| 0 |
1 |
0 |
0 |
0 |
1 |
1 |
0 |
1 |
1 |
| 0 |
0 |
1 |
0 |
0 |
1 |
1 |
1 |
0 |
1 |
| 0 |
0 |
0 |
0 |
0 |
0 |
1 |
1 |
1 |
1 |
| 0 |
0 |
0 |
0 |
0 |
1 |
1 |
1 |
0 |
1 |
X1<- read_excel("Datos.xlsx",
sheet = "PlataformaFacebook",
range = "A2:Y722") %>%
select(B1_BibCenUNMSM, B1_BibCenUNMSM_RecursosElectronicos)
X1 <- as.matrix(X1)
head(X1)
## B1_BibCenUNMSM B1_BibCenUNMSM_RecursosElectronicos
## [1,] 1 1
## [2,] 0 1
## [3,] 1 1
## [4,] 1 1
## [5,] 1 0
## [6,] 1 1
Evaluacion de supuestos
y factibilidad de aplicar analisis de componentes principales
categoricos
Correlaciones
n1<-dim(X1)
R1<-cor(X1,
method = "spearman")
R1
## B1_BibCenUNMSM
## B1_BibCenUNMSM 1.0000000
## B1_BibCenUNMSM_RecursosElectronicos -0.4432645
## B1_BibCenUNMSM_RecursosElectronicos
## B1_BibCenUNMSM -0.4432645
## B1_BibCenUNMSM_RecursosElectronicos 1.0000000
ggcorr(X1,
method = c("pairwise",
"spearman",
name="Uso"))
Coeficiente de
dependencia efectiva
d1=det(R1)
DE1=(d1)^(1/(n1[2]-1))
CDE1=1-DE1
CDE1
## [1] 0.1964834
ACPC
data1<-Data[,4:5]
n1<-dim(data1)
acpc1<-princals(data1,
ordinal=TRUE,
normobj.z = TRUE)
summary(acpc1)
##
## Loadings (cutoff = 0.1):
## Comp1 Comp2
## B1_BibCenUNMSM -0.967 0.254
## B1_BibCenUNMSM_RecursosElectronicos 0.656 0.755
##
## Importance (Variance Accounted For):
## Comp1 Comp2
## Eigenvalues 1.4433 0.5567
## VAF 72.1632 27.8368
## Cumulative VAF 72.1600 100.0000
plot(acpc1,
main="Grafico de sedimentacion","screeplot",
col.lines="blue")
plot(acpc1,
plot.type = "transplot",
col.lines="green",
main="Transformaciones variables")
plot(acpc1,
"loadplot",
main = "Cargas de las componentes para Uso",
col.loadings="purple")
plot(acpc1,
"biplot",
labels.scores = TRUE,
main = "Biplot para Uso",
col.scores="orange",
col.loadings="blue" )
## Warning in plot.window(...): "labels.scores" is not a graphical parameter
## Warning in plot.xy(xy, type, ...): "labels.scores" is not a graphical parameter
## Warning in axis(side = side, at = at, labels = labels, ...): "labels.scores" is
## not a graphical parameter
## Warning in axis(side = side, at = at, labels = labels, ...): "labels.scores" is
## not a graphical parameter
## Warning in box(...): "labels.scores" is not a graphical parameter
## Warning in title(...): "labels.scores" is not a graphical parameter
## Warning in text.default(x, xlabs, cex = cex[1L], col = col[1L], ...):
## "labels.scores" is not a graphical parameter
## Warning in plot.window(...): "labels.scores" is not a graphical parameter
## Warning in plot.xy(xy, type, ...): "labels.scores" is not a graphical parameter
## Warning in title(...): "labels.scores" is not a graphical parameter
## Warning in axis(3, col = col[2L], ...): "labels.scores" is not a graphical
## parameter
## Warning in axis(4, col = col[2L], ...): "labels.scores" is not a graphical
## parameter
## Warning in text.default(y, labels = ylabs, cex = cex[2L], col = col[2L], :
## "labels.scores" is not a graphical parameter
Calculo del indice
T<-as.matrix(acpc1$objectscores)
d<-sqrt(acpc1$evals[1:2])
d1<-sum(d)
P<-as.matrix(d/d1)
W<-t(t(P))
I=T%*%W
summary(I)
## V1
## Min. :-0.5014
## 1st Qu.:-0.5014
## Median :-0.5014
## Mean : 0.0000
## 3rd Qu.: 0.7371
## Max. : 1.5595
boxplot(I,
main="Percepcion sobre el uso",
horizontal = TRUE,
border = "red")
qqnorm(I,
col="green",
main="Uso");qqline(I)
hist(I,
main="Indice Uso",
xlab="Indice",
ylab="Numero de personas",
labels=TRUE,
border="blue",
col="yellow",
xlim=c(-1,2),
ylim=c(0,500),
breaks=2)
Reescalamiento del
indice
Indice=matrix(nr=n1[1],nc=1)
Imin<-min(I)
T=matrix(rep(Imin,each=n1[1]),
nrow=n1[1])
r<-max(I)-Imin
Rango=matrix(rep(r,each=n1[1]),
nrow=n1[1])
Indice=((I-T)/Rango)*100
summary(Indice)
## V1
## Min. : 0.00
## 1st Qu.: 0.00
## Median : 0.00
## Mean : 24.33
## 3rd Qu.: 60.10
## Max. :100.00
boxplot(Indice,
main="Indice Uso",
horizontal = TRUE,
border = "red")
qqnorm(Indice,
col="green");qqline(Indice)
hist(Indice,
main="Indice Uso",
xlab="Indice",
ylab="Numero de personas",
labels=TRUE,
border="red",
col="green",
xlim=c(0,100),
ylim=c(0,500),
breaks=seq(from=0,
to=100,
by=100/3))
Exportando indices a un
excel
write_xlsx(data.frame(Indice), "Indice_Uso.xlsx")