Ejercicio 1. Atencion medica.

Datos

library(readr)
Atencion <- read_csv("C:/Users/Nieves M/Documents/ESTA55503/Datos-Tareas/Atencion.csv")
library(psych)
describe(Atencion)
##    vars   n  mean    sd median trimmed   mad min max range  skew kurtosis   se
## S*    1 100  1.52  0.50    2.0    1.52  0.00   1   2     1 -0.08    -2.01 0.05
## E     2 100 68.64 17.52   68.5   70.15 18.53  24  94    70 -0.63    -0.08 1.75
## DI    3 100 13.31 10.03   14.0   12.93 14.83   1  30    29  0.27    -1.44 1.00
## C*    4 100  1.42  0.50    1.0    1.40  0.00   1   2     1  0.32    -1.92 0.05
## D     5 100  2.03  0.98    2.0    1.95  1.48   1   4     3  0.39    -1.11 0.10
## P1    6 100  3.50  1.17    3.5    3.51  2.22   1   5     4 -0.06    -1.36 0.12
## P2    7 100  3.29  1.09    3.0    3.24  1.48   2   5     3  0.15    -1.36 0.11
## P3    8 100  3.64  1.28    3.5    3.69  2.22   1   5     4 -0.15    -1.59 0.13
## P4    9 100  3.21  1.18    3.0    3.21  1.48   1   5     4 -0.01    -1.04 0.12
## P5   10 100  3.32  1.06    3.0    3.29  1.48   1   5     4  0.05    -1.14 0.11
## P6   11 100  3.47  1.23    3.0    3.48  1.48   1   5     4  0.20    -1.48 0.12
## P7   12 100  2.85  1.08    3.0    2.94  1.48   1   4     3 -0.18    -1.45 0.11
## P8   13 100  3.76  1.05    3.0    3.81  1.48   2   5     3  0.01    -1.45 0.10
## P9   14 100  3.62  1.50    5.0    3.65  0.00   2   5     3 -0.16    -1.99 0.15
Atencion <- Atencion[,-c(1,4)]

Mapa de calor de correlaciones

R2 <- cor(Atencion)
library(ggcorrplot)
ggcorrplot(R2,type="lower",hc.order = T)

Se observan relaciones significativas entre ciertas variables por ejemplo, las relacionadas con “Información recibida” y “valoración general”. Correlaciones débiles entre algunas variables como “día de ingreso respecto al 1 de enero del año registrado.” y “Estado de las habitaciones”.

Prueba de esfericidad de Barlett

cortest.bartlett(R2)
## $chisq
## [1] 1080.798
## 
## $p.value
## [1] 2.295366e-183
## 
## $df
## [1] 66

Debido a que el p-value es significativamente menor que 0.05, rechazamos la hipótesis nula de que la matriz de correlación es una matriz identidad, ya que las variables están correlacionadas.

Prueba de KMO

KMO(R2)
## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = R2)
## Overall MSA =  0.69
## MSA for each item = 
##    E   DI    D   P1   P2   P3   P4   P5   P6   P7   P8   P9 
## 0.40 0.11 0.74 0.64 0.82 0.67 0.61 0.69 0.72 0.66 0.82 0.72

Al KMO general ser uno de 0.69, algunas variables, como E y DI, tienen MSA muy bajas, lo que sugiere que podrían no ser útiles en el modelo y podrían excluirse para mejorar los resultados. Las variables con alta MSA, como P2 y P8, son las más adecuadas para el análisis factorial y contribuyen significativamente al modelo.

Atencion1 <- Atencion[,-c(1,2)]
R3 <- cor(Atencion1)
cortest.bartlett(R3)
## $chisq
## [1] 1069.976
## 
## $p.value
## [1] 9.071663e-195
## 
## $df
## [1] 45
KMO(R3)
## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = R3)
## Overall MSA =  0.71
## MSA for each item = 
##    D   P1   P2   P3   P4   P5   P6   P7   P8   P9 
## 0.74 0.64 0.82 0.68 0.62 0.69 0.79 0.67 0.83 0.73

Numero de factores por Screeplot

scree(R3)

Grafico circular de correlaciones

library(ade4)
modelo <- principal(Atencion1,nfactors = 2,rotate = "varimax")
load <-modelo$loadings[,1:2]
s.corcircle(load,grid=FALSE)

Rotacion de factores

library(GPArotation)
rot <- c("none","varimax","quartimax","Promax")
bi_mod <- function(tipo){biplot.psych(fa(Atencion1,nfactors = 2,fm="paf",rotate=tipo),main=paste("Biplot con rotacion",tipo),col=c("red","black"),pch=c(5,19),group = bfi[,"gender"])}
sapply(rot,bi_mod)

## $none
## NULL
## 
## $varimax
## NULL
## 
## $quartimax
## NULL
## 
## $Promax
## NULL

Ejercicio 2. Calificaciones estudiantiles

Datos

library(readxl)
Calificaciones <- read_csv("C:/Users/Nieves M/Documents/ESTA55503/Datos-Tareas/Calificaciones.csv")
describe(Calificaciones)
##             vars   n  mean   sd median trimmed   mad min max range  skew
## Edad           1 100 14.44 2.51   15.0   14.50  2.97  10  18     8 -0.18
## Grado          2 100  8.99 1.98    9.0    8.99  2.97   6  12     6 -0.09
## Naturales      3 100 85.30 4.81   85.5   85.40  5.19  74  95    21 -0.17
## Sociales       4 100 85.61 6.99   85.5   85.61  8.15  70  99    29 -0.02
## Matematicas    5 100 81.62 9.24   81.5   81.46 11.12  66 100    34  0.07
## Espanol        6 100 74.75 9.00   76.0   74.76 11.12  60  90    30 -0.02
## Ingles         7 100 75.22 9.47   77.5   75.49 11.86  57  91    34 -0.19
## Deportes       8 100 94.92 3.19   95.0   94.89  4.45  90 100    10  0.11
## Humanidades    9 100 89.99 4.82   90.0   89.99  5.93  81  98    17 -0.02
## Etica         10 100 83.92 9.08   84.0   83.69 11.86  70 100    30  0.16
##             kurtosis   se
## Edad           -1.26 0.25
## Grado          -1.22 0.20
## Naturales      -0.85 0.48
## Sociales       -1.00 0.70
## Matematicas    -1.04 0.92
## Espanol        -1.35 0.90
## Ingles         -1.26 0.95
## Deportes       -1.22 0.32
## Humanidades    -1.23 0.48
## Etica          -1.26 0.91
str(Calificaciones)
## spc_tbl_ [100 × 10] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
##  $ Edad       : num [1:100] 17 13 14 15 18 11 17 12 14 17 ...
##  $ Grado      : num [1:100] 11 8 9 9 12 6 11 7 9 11 ...
##  $ Naturales  : num [1:100] 80 78 79 90 89 89 81 87 83 82 ...
##  $ Sociales   : num [1:100] 75 74 83 95 85 80 81 95 90 82 ...
##  $ Matematicas: num [1:100] 79 98 90 88 69 95 90 86 68 82 ...
##  $ Espanol    : num [1:100] 69 61 61 88 78 86 71 76 63 72 ...
##  $ Ingles     : num [1:100] 67 57 58 85 82 85 69 79 67 67 ...
##  $ Deportes   : num [1:100] 93 99 99 94 95 93 93 94 98 96 ...
##  $ Humanidades: num [1:100] 91 97 92 94 92 90 86 94 96 88 ...
##  $ Etica      : num [1:100] 85 99 91 87 73 100 91 93 70 84 ...
##  - attr(*, "spec")=
##   .. cols(
##   ..   Edad = col_double(),
##   ..   Grado = col_double(),
##   ..   Naturales = col_double(),
##   ..   Sociales = col_double(),
##   ..   Matematicas = col_double(),
##   ..   Espanol = col_double(),
##   ..   Ingles = col_double(),
##   ..   Deportes = col_double(),
##   ..   Humanidades = col_double(),
##   ..   Etica = col_double()
##   .. )
##  - attr(*, "problems")=<externalptr>

Mapa de calor de correlaciones

R2_ <- cor(Calificaciones)

library(ggcorrplot)
ggcorrplot(R2_,type="lower",hc.order = T)

Se observan relaciones significativas entre ciertas variables como las relacionadas con “Grado”, “Edad” o asignaturas similares. Variables como “Matemáticas” y “Ciencias Naturales” parecen estar moderadamente correlacionadas, lo que podría indicar que miden aspectos relacionados del rendimiento estudiantil. Correlaciones débiles entre algunas variables como “Deportes” y las asignaturas académicas sugieren independencia o poca relación entre estas áreas.

Prueba de esfericidad de Barlett

cortest.bartlett(R2_)
## $chisq
## [1] 1534.538
## 
## $p.value
## [1] 2.760711e-292
## 
## $df
## [1] 45

El p-value es muy bajo, lo que confirma que las variables están correlacionadas. Por lo tanto, los datos son adecuados para realizar un análisis factorial.

Prueba de KMO

KMO(R2_)
## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = R2_)
## Overall MSA =  0.56
## MSA for each item = 
##        Edad       Grado   Naturales    Sociales Matematicas     Espanol 
##        0.48        0.48        0.51        0.99        0.51        0.94 
##      Ingles    Deportes Humanidades       Etica 
##        0.52        0.26        0.91        0.51

Sin embargo, el KMO general de 0.56 sugiere que las correlaciones entre las variables no son ideales para realizar un análisis factorial, tales como, Deportes(0.26), lo que sugiere que esta variable no está suficientemente correlacionada con las demás y podría excluirse del análisis, al igual que Edad y Grado.

Calificaciones1 <- Calificaciones[,-c(1,2,8)]
R3_ <- cor(Calificaciones1)
cortest.bartlett(R3)
## $chisq
## [1] 1069.976
## 
## $p.value
## [1] 9.071663e-195
## 
## $df
## [1] 45
KMO(R3_)
## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = R3_)
## Overall MSA =  0.63
## MSA for each item = 
##   Naturales    Sociales Matematicas     Espanol      Ingles Humanidades 
##        0.64        0.98        0.51        0.85        0.64        0.14 
##       Etica 
##        0.51

Numero de factores por Screeplot

scree(R3_)

Según el gráfico, se observa un codo alrededor del componente 3. Esto sugiere que tres factores principales capturan la mayor parte de la variabilidad en los datos. A partir del tercer componente, los valores propios se estabilizan y contribuyen muy poco a explicar la variabilidad.

Grafico circular de correlaciones

library(ade4)
modelo_ <- principal(Calificaciones1,nfactors = 2,rotate = "varimax")
load <-modelo$loadings[,1:2]
s.corcircle(load,grid=FALSE)

Rotacion de factores

library(GPArotation)
rot_ <- c("none","varimax","quartimax","Promax")
bi_mod_ <- function(tipo){biplot.psych(fa(Calificaciones1,nfactors = 2,fm="paf",rotate=tipo),main=paste("Biplot con rotacion",tipo),col=c("red","black"),pch=c(5,19),group = bfi[,"gender"])}
sapply(rot,bi_mod)

## $none
## NULL
## 
## $varimax
## NULL
## 
## $quartimax
## NULL
## 
## $Promax
## NULL