wa
Jose Navarro
2023-07-06
1.- 3 latentes/factores
library(rio)
data=import("ceplan mini (4).xlsx")str(data)## 'data.frame': 2100 obs. of 21 variables:
## $ Nivel : chr "Provincia" "Zona" "Región" "Provincia" ...
## $ Ubigeo : chr "150000" "ZONA NORTE" "010000" "010200" ...
## $ Localidad : chr "LIMA" NA "AMAZONAS" "BAGUA" ...
## $ Población total (2007) : num 8730820 8367388 406087 77637 12449 ...
## $ Población total (2017) : num 10135009 8987709 417365 82193 10487 ...
## $ Población de niños menores de un año (CENSO 2017) : num 137218 162076 8043 1636 196 ...
## $ Población con Discapacidad (2020) : num 88625 84289 7826 1586 191 ...
## $ Superficie (km2) : num 34824 572940 39249 5653 809 ...
## $ País fronterizo : chr "No" NA "Ecuador" "Ecuador" ...
## $ Porcentaje de anemia (Niños entre 6 y 35 meses) (2020): num 30.99 40.37 34.23 22.17 6.04 ...
## $ Centros de salud mental comunal (al2021) : num 44 57 6 1 0 1 0 0 0 0 ...
## $ Mercados de abastos (2016) : num 1232 0 26 6 1 ...
## $ Índice de Desarrollo Humano IDH (2019) : num 0.707 NA 0.418 0.461 0.361 ...
## $ Porcentaje de la población en pobreza total : num 26.2 31.8 33 34.8 38.5 ...
## $ Porcentaje de la población en pobreza extrema : num 3.05 5.86 7.3 23.07 19.27 ...
## $ Población Ocupada (2007) : num 3625326 2690762 124320 24239 4019 ...
## $ Población Ocupada (2017 ) : num 4873073 3324782 142701 26886 3569 ...
## $ Devengado per cápita en soles (2020) - Actividad : num 6924 2948 3920 4747 274 ...
## $ Devengado per cápita en soles (2020) - Inversión : num 489 821 1561 1050 373 ...
## $ Devengado per cápita en soles (2020) - Total : num 7412 3769 5481 5798 647 ...
## $ Desocupados : num 5261936 5662927 274664 55307 6918 ...data = na.omit(data)
str(data)## 'data.frame': 1845 obs. of 21 variables:
## $ Nivel : chr "Provincia" "Región" "Provincia" "Distrito" ...
## $ Ubigeo : chr "150000" "010000" "010200" "010202" ...
## $ Localidad : chr "LIMA" "AMAZONAS" "BAGUA" "ARAMANGO" ...
## $ Población total (2007) : num 8730820 406087 77637 12449 25984 ...
## $ Población total (2017) : num 10135009 417365 82193 10487 28836 ...
## $ Población de niños menores de un año (CENSO 2017) : num 137218 8043 1636 196 442 ...
## $ Población con Discapacidad (2020) : num 88625 7826 1586 191 513 ...
## $ Superficie (km2) : num 34824 39249 5653 809 151 ...
## $ País fronterizo : chr "No" "Ecuador" "Ecuador" "No" ...
## $ Porcentaje de anemia (Niños entre 6 y 35 meses) (2020): num 30.99 34.23 22.17 6.04 13.58 ...
## $ Centros de salud mental comunal (al2021) : num 44 6 1 0 1 0 0 0 0 0 ...
## $ Mercados de abastos (2016) : num 1232 26 6 1 1 ...
## $ Índice de Desarrollo Humano IDH (2019) : num 0.707 0.418 0.461 0.361 0.584 ...
## $ Porcentaje de la población en pobreza total : num 26.2 33 34.8 38.5 16.2 ...
## $ Porcentaje de la población en pobreza extrema : num 3.05 7.3 23.07 19.27 4.47 ...
## $ Población Ocupada (2007) : num 3625326 124320 24239 4019 0 ...
## $ Población Ocupada (2017 ) : num 4873073 142701 26886 3569 11913 ...
## $ Devengado per cápita en soles (2020) - Actividad : num 6924 3920 4747 274 3979 ...
## $ Devengado per cápita en soles (2020) - Inversión : num 489 1561 1050 373 1090 ...
## $ Devengado per cápita en soles (2020) - Total : num 7412 5481 5798 647 5068 ...
## $ Desocupados : num 5261936 274664 55307 6918 16923 ...
## - attr(*, "na.action")= 'omit' Named int [1:255] 2 12 19 20 25 31 35 36 40 43 ...
## ..- attr(*, "names")= chr [1:255] "2" "12" "19" "20" ...library(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, uniondatos_filtrados <- filter(data, Nivel == "Distrito")dontselect=c("Nivel","Ubigeo","Localidad","País fronterizo","Desocupados")
select=setdiff(names(datos_filtrados),dontselect)
theData=datos_filtrados[,select]
str(theData)## 'data.frame': 1625 obs. of 16 variables:
## $ Población total (2007) : num 12449 25984 6736 1376 23109 ...
## $ Población total (2017) : num 10487 28836 4972 1293 29852 ...
## $ Población de niños menores de un año (CENSO 2017) : num 196 442 69 18 799 112 3 16 9 108 ...
## $ Población con Discapacidad (2020) : num 191 513 129 19 358 376 7 11 2 42 ...
## $ Superficie (km2) : num 809.1 151 99 18.5 4430.8 ...
## $ Porcentaje de anemia (Niños entre 6 y 35 meses) (2020): num 6.04 13.58 14.71 9.09 35.83 ...
## $ Centros de salud mental comunal (al2021) : num 0 1 0 0 0 0 0 0 0 0 ...
## $ Mercados de abastos (2016) : num 1 1 0 0 2 2 0 0 0 0 ...
## $ Índice de Desarrollo Humano IDH (2019) : num 0.361 0.584 0.467 0.489 0.298 ...
## $ Porcentaje de la población en pobreza total : num 38.5 16.2 24.5 35.2 53.9 ...
## $ Porcentaje de la población en pobreza extrema : num 19.27 4.47 11.24 12.16 48.89 ...
## $ Población Ocupada (2007) : num 4019 0 2307 417 6074 ...
## $ Población Ocupada (2017 ) : num 3569 11913 1701 370 6894 ...
## $ Devengado per cápita en soles (2020) - Actividad : num 274 3979 448 509 2693 ...
## $ Devengado per cápita en soles (2020) - Inversión : num 373 1090 4689 1475 220 ...
## $ Devengado per cápita en soles (2020) - Total : num 647 5068 5137 1984 2913 ...library(polycor)
corMatrix=polycor::hetcor(theData)$correlations
library(ggcorrplot)## Loading required package: ggplot2ggcorrplot(corMatrix)
library(psych)##
## Attaching package: 'psych'## The following objects are masked from 'package:ggplot2':
##
## %+%, alpha## The following object is masked from 'package:polycor':
##
## polyserialpsych::KMO(corMatrix) ## Error in solve.default(r) :
## sistema es computacionalmente singular: número de condición recíproco = 1.98809e-17## matrix is not invertible, image not found## Kaiser-Meyer-Olkin factor adequacy
## Call: psych::KMO(r = corMatrix)
## Overall MSA = 0.5
## MSA for each item =
## Población total (2007)
## 0.5
## Población total (2017)
## 0.5
## Población de niños menores de un año (CENSO 2017)
## 0.5
## Población con Discapacidad (2020)
## 0.5
## Superficie (km2)
## 0.5
## Porcentaje de anemia (Niños entre 6 y 35 meses) (2020)
## 0.5
## Centros de salud mental comunal (al2021)
## 0.5
## Mercados de abastos (2016)
## 0.5
## Índice de Desarrollo Humano IDH (2019)
## 0.5
## Porcentaje de la población en pobreza total
## 0.5
## Porcentaje de la población en pobreza extrema
## 0.5
## Población Ocupada (2007)
## 0.5
## Población Ocupada (2017 )
## 0.5
## Devengado per cápita en soles (2020) - Actividad
## 0.5
## Devengado per cápita en soles (2020) - Inversión
## 0.5
## Devengado per cápita en soles (2020) - Total
## 0.5cortest.bartlett(corMatrix,n=nrow(theData))$p.value>0.05## [1] FALSElibrary(matrixcalc)
is.singular.matrix(corMatrix)## [1] TRUEfa.parallel(theData, fa = 'fa',correct = T,plot = F)## In smc, smcs < 0 were set to .0
## In smc, smcs < 0 were set to .0
## In smc, smcs < 0 were set to .0## Warning in cor.smooth(r): Matrix was not positive definite, smoothing was done## In factor.scores, the correlation matrix is singular, the pseudo inverse is used## Parallel analysis suggests that the number of factors = 3 and the number of components = NAdatos_p <- filter(data, Nivel == "Provincia")# Realizar la regresión Poisson
modelo_poisson <- glm(Desocupados ~ `Mercados de abastos (2016)` + `Devengado per cápita en soles (2020) - Total`,
data = datos_p, family = poisson)
print(modelo_poisson)##
## Call: glm(formula = Desocupados ~ `Mercados de abastos (2016)` + `Devengado per cápita en soles (2020) - Total`,
## family = poisson, data = datos_p)
##
## Coefficients:
## (Intercept)
## 1.133e+01
## `Mercados de abastos (2016)`
## 3.725e-03
## `Devengado per cápita en soles (2020) - Total`
## -5.501e-05
##
## Degrees of Freedom: 193 Total (i.e. Null); 191 Residual
## Null Deviance: 49350000
## Residual Deviance: 13800000 AIC: 13800000# Obtener los coeficientes estimados
coeficientes <- coef(modelo_poisson)
print(coeficientes)## (Intercept)
## 1.133372e+01
## `Mercados de abastos (2016)`
## 3.724699e-03
## `Devengado per cápita en soles (2020) - Total`
## -5.501399e-05# Obtener los coeficientes en forma exponencial
coeficientes_exponenciales <- exp(coeficientes)
print(coeficientes_exponenciales)## (Intercept)
## 83593.695310
## `Mercados de abastos (2016)`
## 1.003732
## `Devengado per cápita en soles (2020) - Total`
## 0.999945# Calcular la desviación estándar de los coeficientes
desviaciones <- sqrt(diag(vcov(modelo_poisson)))# Estandarizar los coeficientes manualmente
coeficientes_estandarizados <- coeficientes_exponenciales / desviaciones
# Imprimir los coeficientes estandarizados
print(coeficientes_estandarizados)## (Intercept)
## 147782390
## `Mercados de abastos (2016)`
## 1913088
## `Devengado per cápita en soles (2020) - Total`
## 8352904Mercados de abastos > devengado per cápita
- todos =
#correr en caso lo soliciten
datos <- filter(data, Nivel == "Provincia")library(BBmisc)##
## Attaching package: 'BBmisc'## The following objects are masked from 'package:dplyr':
##
## coalesce, collapse, symdiff## The following object is masked from 'package:base':
##
## isFALSEdataClus=datos[, c(7,10,21)]
dataClus1=normalize(datos[,c(7,10,21)],method='range',range=c(0,10))
dataClus2=normalize(datos[,c(7,10,21)],method='standardize')boxplot(datos[,c(7,10,17)],horizontal = F,las=2,cex.axis = 0.5)
boxplot(normalize(datos[,c(7,10,17)],method='range',range=c(0,10)))
boxplot(dataClus1)
boxplot(normalize(datos[,c(7,10,17)],method='standardize'))
boxplot(dataClus2)
library(cluster)
g.dist = daisy(dataClus, metric="gower")set.seed(123)
res.pam=pam(g.dist,2,cluster.only = F)
dataClus$pam=res.pam$cluster
library(kableExtra)##
## Attaching package: 'kableExtra'## The following object is masked from 'package:dplyr':
##
## group_rowshead(dataClus,15)%>%kbl()%>%kable_styling()| Población con Discapacidad (2020) | Porcentaje de anemia (Niños entre 6 y 35 meses) (2020) | Desocupados | pam |
|---|---|---|---|
| 88625 | 30.99265 | 5261936 | 1 |
| 1586 | 22.16625 | 55307 | 1 |
| 398 | 11.92053 | 15872 | 1 |
| 1082 | 34.14141 | 34850 | 1 |
| 561 | 42.97782 | 41237 | 2 |
| 1556 | 22.69663 | 32064 | 1 |
| 650 | 20.55336 | 19763 | 1 |
| 1993 | 16.56805 | 75571 | 1 |
| 742 | 48.59272 | 56478 | 2 |
| 3292 | 24.71856 | 237429 | 1 |
| 1454 | 26.65929 | 57036 | 1 |
| 1109 | 28.66667 | 102961 | 1 |
| 190 | 23.25581 | 20044 | 1 |
| 1235 | 22.68775 | 84423 | 1 |
| 659 | 35.44458 | 55762 | 1 |
library(factoextra)## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBafviz_silhouette(res.pam,print.summary = F)
silPAM=data.frame(res.pam$silinfo$widths)
silPAM$country=row.names(silPAM)
poorPAM=silPAM[silPAM$sil_width<0,'country']
print(poorPAM)## character(0)row.names(dataClus1)=datos$Localidadg.dist1 = daisy(dataClus1, metric="gower")set.seed(123)
res.pam1=pam(g.dist1,2,cluster.only = F)
dataClus1$pam=res.pam1$cluster
head(dataClus1,15)%>%kbl()%>%kable_styling()| Población con Discapacidad (2020) | Porcentaje de anemia (Niños entre 6 y 35 meses) (2020) | Desocupados | pam | |
|---|---|---|---|---|
| LIMA | 10.0000000 | 2.6435654 | 10.0000000 | 1 |
| BAGUA | 0.1768503 | 1.6492742 | 0.1004438 | 1 |
| BONGARÁ | 0.0427736 | 0.4950975 | 0.0254646 | 1 |
| CHACHAPOYAS | 0.1199693 | 2.9982729 | 0.0615482 | 1 |
| CONDORCANQUI | 0.0611697 | 3.9936916 | 0.0736920 | 2 |
| LUYA | 0.1734646 | 1.7090216 | 0.0562511 | 1 |
| RODRÍGUEZ DE MENDOZA | 0.0712141 | 1.4675830 | 0.0328627 | 1 |
| UTCUBAMBA | 0.2227840 | 1.0186388 | 0.1389725 | 1 |
| CAJABAMBA | 0.0815972 | 4.6262072 | 0.1026703 | 2 |
| CAJAMARCA | 0.3693881 | 1.9367913 | 0.4467191 | 1 |
| CELENDÍN | 0.1619529 | 2.1554143 | 0.1037312 | 1 |
| CHOTA | 0.1230165 | 2.3815444 | 0.1910501 | 1 |
| CONTUMAZÁ | 0.0192989 | 1.7720136 | 0.0333970 | 1 |
| CUTERVO | 0.1372368 | 1.7080210 | 0.1558032 | 1 |
| HUALGAYOC | 0.0722299 | 3.1450741 | 0.1013089 | 1 |
fviz_silhouette(res.pam1,print.summary = F)
g.dist2 = daisy(dataClus2, metric="gower")set.seed(123)
res.pam2=pam(g.dist2,2,cluster.only = F)
dataClus2$pam=res.pam2$cluster
head(dataClus2,15)%>%kbl()%>%kable_styling()| Población con Discapacidad (2020) | Porcentaje de anemia (Niños entre 6 y 35 meses) (2020) | Desocupados | pam |
|---|---|---|---|
| 13.4791765 | -0.4021404 | 13.3997221 | 1 |
| 0.0017336 | -0.9696396 | -0.1053284 | 1 |
| -0.1822207 | -1.6283946 | -0.2076156 | 1 |
| -0.0763076 | -0.1996885 | -0.1583901 | 1 |
| -0.1569812 | 0.3684543 | -0.1418234 | 2 |
| -0.0029117 | -0.9355383 | -0.1656165 | 1 |
| -0.1432001 | -1.0733412 | -0.1975230 | 1 |
| 0.0647550 | -1.3295795 | -0.0527672 | 1 |
| -0.1289545 | 0.7294673 | -0.1022910 | 2 |
| 0.2658970 | -0.8055370 | 0.3670631 | 1 |
| -0.0187058 | -0.6807564 | -0.1008436 | 1 |
| -0.0721268 | -0.5516909 | 0.0182775 | 1 |
| -0.2144282 | -0.8995852 | -0.1967942 | 1 |
| -0.0526165 | -0.9361094 | -0.0298067 | 1 |
| -0.1418065 | -0.1159006 | -0.1041482 | 1 |
fviz_silhouette(res.pam2,print.summary = F)
4.- >0.3
data$Indice <- rowSums(data[, c("Desocupados", "Población con Discapacidad (2020)", "Porcentaje de anemia (Niños entre 6 y 35 meses) (2020)")])
correlacion <- cor(data$Indice, data$`Índice de Desarrollo Humano IDH (2019)`)
correlacion## [1] 0.1685374