Examen Parcial-20202566
Fabricio Flores
2023-10-13
Ejercicio 1
library(rio)##
## Attaching package: 'rio'## The following object is masked from 'package:lme4':
##
## factorizedata3=import("wbDataMini.xlsx")str(data3)## 'data.frame': 265 obs. of 6 variables:
## $ pais : chr "MAR" "ABW" "AFG" "AGO" ...
## $ TasaFertil1mMuje : num 32.3 24.3 73.1 157.4 20.7 ...
## $ EmployPerPop : num 22.4 NA 16.2 69.7 39.5 ...
## $ Tuberculosis100m : num 101 14 189 370 16 5.9 NA 0.79 25 47 ...
## $ MaterMort100m : num 121 NA 396 477 29 NA 156 6 52 25 ...
## $ UndernourishPerPop: num 3.5 NA 23 14 4.9 ...library(ggplot2)
ggplot(data3, aes(x = MaterMort100m)) +
geom_histogram(binwidth = 100, fill = "blue", color = "black", alpha = 0.7) +
labs(title = "Histograma de Variable Dependiente",
x = "Valor de Variable Dependiente",
y = "Frecuencia") +
theme_minimal()## Warning: Removed 35 rows containing non-finite values (`stat_bin()`).
hip1=formula(MaterMort100m~Tuberculosis100m+EmployPerPop)
rp1=glm(hip1, data = data3,
family = poisson(link = "log"))
hip2=formula(MaterMort100m~TasaFertil1mMuje+EmployPerPop)
rp2=glm(hip2, data = data3,
family = poisson(link = "log"))
modelsPois=list('POISSON asegurados (I)'=rp1,
'POISSON asegurados (II)'=rp2)
modelsummary(modelsPois,
title = "Regresiones Poisson anidadas",
stars = TRUE,
output = "kableExtra")| POISSON asegurados (I) | POISSON asegurados (II) | |
|---|---|---|
| (Intercept) | 4.987*** | 4.839*** |
| (0.006) | (0.006) | |
| Tuberculosis100m | 0.003*** | |
| (0.000) | ||
| EmployPerPop | -0.006*** | -0.019*** |
| (0.000) | (0.000) | |
| TasaFertil1mMuje | 0.019*** | |
| (0.000) | ||
| Num.Obs. | 200 | 227 |
| AIC | 41310.4 | 29494.7 |
| BIC | 41320.3 | 29505.0 |
| Log.Lik. | -20652.184 | -14744.339 |
| RMSE | 219.89 | 175.84 |
| + p < 0.1, * p < 0.05, ** p < 0.01, *** p < 0.001 |
# formula para limitar a 4 digitos decimales,
# sin que se muestre notación científica:
formatoNum <- function(x) format(x, digits = 4, scientific = FALSE)
modelsummary(modelsPois,
fmt=formatoNum, # uso mi formula
exponentiate = T, # exponenciar!!!!!
statistic = 'conf.int',
title = "Regresión Poisson - coeficientes exponenciados",
stars = TRUE,
output = "kableExtra")| POISSON asegurados (I) | POISSON asegurados (II) | |
|---|---|---|
| (Intercept) | 146.4672*** | 126.2968*** |
| [144.7622, 148.1854] | [124.7376, 127.868] | |
| Tuberculosis100m | 1.0027*** | |
| [ 1.0027, 1.0027] | ||
| EmployPerPop | 0.9943*** | 0.9807*** |
| [ 0.9942, 0.9944] | [ 0.9805, 0.981] | |
| TasaFertil1mMuje | 1.0191*** | |
| [ 1.0189, 1.019] | ||
| Num.Obs. | 200 | 227 |
| AIC | 41310.4 | 29494.7 |
| BIC | 41320.3 | 29505.0 |
| Log.Lik. | -20652.184 | -14744.339 |
| RMSE | 219.89 | 175.84 |
| + p < 0.1, * p < 0.05, ** p < 0.01, *** p < 0.001 |
#Interpretación
De acuerdo con los resultados obtenidos en la tabla de coeficientes, yo apoyaría al colega B porque su modelo cuenta con un menor AIC (29494.7) en comparación al colega A, quien cuenta con un AIC igual a 41310.4.
Ejercicio 2
library(rio)
data=import("dataprovincias.xlsx")## New names:
## • `Población de niños menores de un año
(CENSO 2017)
1a/` -> `Población de
## niños menores de un año
(CENSO 2017)
1a/...6`
## • `Población de niños menores de un año
(CENSO 2017)
1a/` -> `Población de
## niños menores de un año
(CENSO 2017)
1a/...19`str(data)## 'data.frame': 228 obs. of 45 variables:
## $ Ubigeo : chr "NACIONAL" "NACIONAL SIN LA PROV. DE LIMA" "150000" "ZONA NORTE" ...
## $ Región /
## Provincia : chr NA NA "LIMA" NA ...
## $ Población total
## (2007)
## 1a/ : chr "28481901" "20620156" "8730820" "8367388" ...
## $ Población total
## (2017)
## 1a/ : num 31237385 22075063 10135009 8987709 417365 ...
## $ Población total
## (2020)
## 1b/ : num 34393444 24188630 11261067 9962022 472993 ...
## $ Población de niños menores de un año
## (CENSO 2017)
## 1a/...6 : num 493495 371675 137218 162076 8043 ...
## $ Población mayor de 80 años
## (2020)
## 1b/ : num 628342 434258 217672 171114 7743 ...
## $ Población con Discapacidad
## (2020)
## 1c/ : num 297030 217586 88625 84289 7826 ...
## $ Superficie (km2)
## 2/ : num 1280172 1277557 34824 572940 39249 ...
## $ Densidad
## (2020) : num 26.9 18.9 323.4 17.4 12.1 ...
## $ Capital legal
## 3/ : chr NA NA "Lima" NA ...
## $ Altitud (msnm)
## 3/ : num NA NA 162 NA 2338 ...
## $ Latitud
## sur
## 3/ : num NA NA -12.05 NA -6.23 ...
## $ Longitud oeste
## 3/ : num NA NA -77 NA -77.9 ...
## $ Número de Provincias 3/ : chr "196" "195" "10" "64" ...
## $ Número de Distritos
## 3/ : num 1874 1831 171 540 84 ...
## $ Número de Centros Poblados
## 3/ : num 94922 94811 5229 22540 3174 ...
## $ País fronterizo : chr "-" "-" "No" "-" ...
## $ Población de niños menores de un año
## (CENSO 2017)
## 1a/...19 : num 493495 371675 137218 162076 8043 ...
## $ Número anual de nacidos vivos según distrito de residencia habitual de la madre (2020)
## 5/ : num 460712 330104 144830 123503 5113 ...
## $ Número anual de nacidos vivos con bajo peso según distrito de residencia habitual de la madre (2020)
## 5/: num 27823 20982 7499 8942 365 ...
## $ Porcentaje de nacidos vivos con bajo peso al nacer (2020)
## 5/ 6/ : num 6.04 6.36 5.18 7.24 7.14 ...
## $ Total : num 383860 297857 97559 126022 5600 ...
## $ Número de niños menores de un año con DNI emitido hasta los 30 días de nacido (2020)
## 7/ : num 28251 20780 7707 7110 184 ...
## $ Porcentaje de niños menores de un año con DNI emitido hasta los 30 días de nacido (al 2021)
## 7/ : num 7.36 6.98 7.9 5.64 3.29 ...
## $ Índice de Vulnerabilidad a la Inseguridad Alimentaria (IVIA)
## (2018)
## 8/ : chr "0.49689161300659201" "-" "0.26664412021637002" "-" ...
## $ Porcentaje de desnutrición crónica
## (Niños menores de 5 años)
## (2020)
## 9/ : num 12.07 14.86 5.09 15.74 17.47 ...
## $ Porcentaje de anemia
## (Niños entre 6 y 35 meses) (2020)
## 9/ : chr "39.959892864837599" "43.622848383996903" "30.992647930417299" "40.368807272935101" ...
## $ Porcentaje de personas de 15 años y más con exceso de peso
## (2020)
## 10/ : chr "62.5" "-" "-" "-" ...
## $ Distritos dentro de Meta 4
## 11/ : chr "865" "822" "73" "291" ...
## $ Índice de Densidad del Estado -IDE
## (2017)
## 12/ : chr "0.75900264069939904" "-" "0.82746140000000001" "-" ...
## $ Centros de salud mental comunal
## (al 2021)
## 13/ : chr "203" "166" "44" "57" ...
## $ Cámara de comercio
## 13a/ : num 51 49 5 18 1 1 0 0 0 0 ...
## $ Sedes del SENATI
## (al 2021)
## 13b/ : num 70 61 12 22 2 0 0 1 0 0 ...
## $ Mercados de abastos (2016)
## 14/ : chr "2612" "1490" "1232" "-" ...
## $ Índice de Desarrollo Humano -IDH
## (2019)
## 15/ : chr "0.58576377555328896" "-" "0.70733610728959495" "-" ...
## $ Porcentaje de la población en pobreza total
## 16a/ : num 30.1 31.7 26.2 31.8 33 ...
## $ Pobreza total: Número de habitantes en situación de pobreza
##
## 16b/ : num 10352427 7673663 2956030 3171351 155851 ...
## $ Porcentaje de la población en pobreza extrema
## 17a/ : num 5.1 5.96 3.05 5.86 7.3 ...
## $ Pobreza extrema: Número de habitantes en situación de pobreza extrema
## 17b/ : num 1754066 1442819 343463 584263 34528 ...
## $ Población Ocupada
## (2007)
## 18/ : chr "10251272" "6964502" "3625326" "2690762" ...
## $ Población Ocupada
## (2017 )
## 18/ : num 13149569 8705205 4873073 3324782 142701 ...
## $ Devengado per cápita en soles (2020) - Actividad
## 19/ : num 4520 3330 6924 2948 3920 ...
## $ Devengado per cápita en soles (2020) - Inversión
## 19/ : num 771 897 489 821 1561 ...
## $ Devengado per cápita en soles (2020) - Total
## 19/ : num 5291 4227 7412 3769 5481 ...data = na.omit(data)
str(data)## 'data.frame': 222 obs. of 45 variables:
## $ Ubigeo : chr "150000" "010000" "010200" "010300" ...
## $ Región /
## Provincia : chr "LIMA" "AMAZONAS" "BAGUA" "BONGARÁ" ...
## $ Población total
## (2007)
## 1a/ : chr "8730820" "406087" "77637" "29552" ...
## $ Población total
## (2017)
## 1a/ : num 10135009 417365 82193 27085 60419 ...
## $ Población total
## (2020)
## 1b/ : num 11261067 472993 98110 29335 58773 ...
## $ Población de niños menores de un año
## (CENSO 2017)
## 1a/...6 : num 137218 8043 1636 397 981 ...
## $ Población mayor de 80 años
## (2020)
## 1b/ : num 217672 7743 1217 655 1362 ...
## $ Población con Discapacidad
## (2020)
## 1c/ : num 88625 7826 1586 398 1082 ...
## $ Superficie (km2)
## 2/ : num 34824 39249 5653 2870 3312 ...
## $ Densidad
## (2020) : num 323.4 12.1 17.4 10.2 17.7 ...
## $ Capital legal
## 3/ : chr "Lima" "Chachapoyas" "Bagua" "Jumbilla" ...
## $ Altitud (msnm)
## 3/ : num 162 2338 408 2081 2338 ...
## $ Latitud
## sur
## 3/ : num -12.05 -6.23 -5.64 -5.9 -6.23 ...
## $ Longitud oeste
## 3/ : num -77 -77.9 -78.5 -77.8 -77.9 ...
## $ Número de Provincias 3/ : chr "10" "7" "-" "-" ...
## $ Número de Distritos
## 3/ : num 171 84 6 12 21 3 23 12 7 127 ...
## $ Número de Centros Poblados
## 3/ : num 5229 3174 345 291 745 ...
## $ País fronterizo : chr "No" "Ecuador" "Ecuador" "No" ...
## $ Población de niños menores de un año
## (CENSO 2017)
## 1a/...19 : num 137218 8043 1636 397 981 ...
## $ Número anual de nacidos vivos según distrito de residencia habitual de la madre (2020)
## 5/ : num 144830 5113 1077 401 787 ...
## $ Número anual de nacidos vivos con bajo peso según distrito de residencia habitual de la madre (2020)
## 5/: num 7499 365 69 20 69 ...
## $ Porcentaje de nacidos vivos con bajo peso al nacer (2020)
## 5/ 6/ : num 5.18 7.14 6.41 4.99 8.77 ...
## $ Total : num 97559 5600 986 343 889 ...
## $ Número de niños menores de un año con DNI emitido hasta los 30 días de nacido (2020)
## 7/ : num 7707 184 13 4 40 ...
## $ Porcentaje de niños menores de un año con DNI emitido hasta los 30 días de nacido (al 2021)
## 7/ : num 7.9 3.29 1.32 1.17 4.5 ...
## $ Índice de Vulnerabilidad a la Inseguridad Alimentaria (IVIA)
## (2018)
## 8/ : chr "0.26664412021637002" "0.86835986375808705" "0.51947927474975597" "0.50935518741607699" ...
## $ Porcentaje de desnutrición crónica
## (Niños menores de 5 años)
## (2020)
## 9/ : num 5.09 17.47 24.9 20.09 13.69 ...
## $ Porcentaje de anemia
## (Niños entre 6 y 35 meses) (2020)
## 9/ : chr "30.992647930417299" "34.230743011719603" "22.166246851385399" "11.9205298013245" ...
## $ Porcentaje de personas de 15 años y más con exceso de peso
## (2020)
## 10/ : chr "-" "51.9" "-" "-" ...
## $ Distritos dentro de Meta 4
## 11/ : chr "73" "35" "3" "3" ...
## $ Índice de Densidad del Estado -IDE
## (2017)
## 12/ : chr "0.82746140000000001" "0.66289520000000002" "0.64920285677771705" "0.71639089022042102" ...
## $ Centros de salud mental comunal
## (al 2021)
## 13/ : chr "44" "6" "1" "0" ...
## $ Cámara de comercio
## 13a/ : num 5 1 1 0 0 0 0 0 0 2 ...
## $ Sedes del SENATI
## (al 2021)
## 13b/ : num 12 2 0 0 1 0 0 0 1 4 ...
## $ Mercados de abastos (2016)
## 14/ : chr "1232" "26" "6" "2" ...
## $ Índice de Desarrollo Humano -IDH
## (2019)
## 15/ : chr "0.70733610728959495" "0.41773584000101999" "0.46103622424613799" "0.41289545257260002" ...
## $ Porcentaje de la población en pobreza total
## 16a/ : num 26.2 33 34.8 33.2 22 ...
## $ Pobreza total: Número de habitantes en situación de pobreza
##
## 16b/ : num 2956030 155851 34184 9751 12943 ...
## $ Porcentaje de la población en pobreza extrema
## 17a/ : num 3.05 7.3 23.07 10.74 11.7 ...
## $ Pobreza extrema: Número de habitantes en situación de pobreza extrema
## 17b/ : num 343463 34528 22632 3151 6876 ...
## $ Población Ocupada
## (2007)
## 18/ : chr "3625326" "124320" "24239" "10037" ...
## $ Población Ocupada
## (2017 )
## 18/ : num 4873073 142701 26886 11213 25569 ...
## $ Devengado per cápita en soles (2020) - Actividad
## 19/ : num 6924 3920 4747 819 14783 ...
## $ Devengado per cápita en soles (2020) - Inversión
## 19/ : num 489 1561 1050 1288 5187 ...
## $ Devengado per cápita en soles (2020) - Total
## 19/ : num 7412 5481 5798 2107 19970 ...
## - attr(*, "na.action")= 'omit' Named int [1:6] 1 2 4 77 78 144
## ..- attr(*, "names")= chr [1:6] "1" "2" "4" "77" ...Ejercicio 3
library(rio)
data1=import("admision.xlsx")str(data1)## 'data.frame': 400 obs. of 4 variables:
## $ admitido : num 0 1 1 1 0 1 1 0 1 0 ...
## $ letras : num 380 660 800 640 520 760 560 400 540 700 ...
## $ ciencias : num 361 367 400 319 293 300 298 308 339 392 ...
## $ prestigio: num 2 2 4 1 1 3 4 3 2 3 ...table(data1$admitido)##
## 0 1
## 273 127data1$admitido = factor(data1$admitido, levels = c(0:1), labels = c("NO ADM","SI ADM"), ordered = FALSE)
table(data1$admitido)##
## NO ADM SI ADM
## 273 127str(data1$admitido)## Factor w/ 2 levels "NO ADM","SI ADM": 1 2 2 2 1 2 2 1 2 1 ...### first hypothesis
h1=formula(admitido~letras+ciencias+prestigio)
rlog1=glm(h1, data=data1,family = binomial)
modelsrl=list('Ser admitido (I)'=rlog1,
'Ser admitido (II)'=rlog1)
# formato creado para modelsummary
formatoNumero = function(x) format(x, digits = 4, scientific = FALSE)
modelsummary(modelsrl,
fmt=formatoNumero, # usa función que creé antes
exponentiate = c(F,T), # coeficientes sin logaritmo
statistic = 'conf.int', # mostrar ICs
title = "Regresión Logísticas (Coeficientes Exponenciados)",
stars = TRUE,
output = "kableExtra")| Ser admitido (I) | Ser admitido (II) | |
|---|---|---|
| (Intercept) | -6.249705*** | 0.001931*** |
| [-8.5808048, -4.041269] | [0.0001877, 0.01758] | |
| letras | 0.002294* | 1.002297* |
| [ 0.0001715, 0.004461] | [1.0001716, 1.00447] | |
| ciencias | 0.007770* | 1.007800* |
| [ 0.0014157, 0.014283] | [1.0014167, 1.01439] | |
| prestigio | 0.560031*** | 1.750727*** |
| [ 0.3154797, 0.814961] | [1.3709168, 2.25909] | |
| Num.Obs. | 400 | 400 |
| AIC | 467.4 | 467.4 |
| BIC | 483.4 | 483.4 |
| Log.Lik. | -229.721 | -229.721 |
| F | 11.633 | 11.633 |
| RMSE | 0.44 | 0.44 |
| + p < 0.1, * p < 0.05, ** p < 0.01, *** p < 0.001 |
#Interpretación:
La variable “letras” presenta una significancia al 0.05. El odds ratio de ser admitido se multiplica por 1.002297, cada que la variable “letras” aumenta en una unidad. Asimismo, la variable “ciencias” tiene una significancia al 0.05. El odds ratio de ser admitido se mulitiplica por 1.007800 cada vez que la variable “ciencias” aumenta en una unidad. Por último, la variable “prestigio” posee una significancia al 0.001. El odds ratio de ser admitido se multiplica por 1.750727 cada vez que la variable “prestigio” aumenta en una unidad.
Ejercicio 4
library(rio)
data2=import("dataCarcel.xlsx")str(data2)## 'data.frame': 432 obs. of 10 variables:
## $ semanasLibre : num 20 17 25 52 52 52 23 52 52 52 ...
## $ fueArrestado : num 1 1 1 0 0 0 1 0 0 0 ...
## $ tuvoApoyoDinero : num 0 0 0 1 0 0 0 1 0 0 ...
## $ edad : num 27 18 19 23 19 24 25 21 22 20 ...
## $ esNegro : num 1 1 0 1 0 1 1 1 1 1 ...
## $ expLaboralPrevia : num 0 0 1 1 1 1 1 1 0 1 ...
## $ casado : num 0 0 0 1 0 0 1 0 0 0 ...
## $ libertadCondicional: num 1 1 1 1 1 0 1 1 0 0 ...
## $ vecesEnCarcel : num 3 8 13 1 3 2 0 4 6 0 ...
## $ nivelEduca : num 2 3 2 4 2 3 3 2 2 4 ...data2[,c(2,3,5,6,7,8)]=lapply(data2[,c(2,3,5,6,7,8)], as.factor)
data2$nivelEduca=as.ordered(data2$nivelEduca)
str(data2)## 'data.frame': 432 obs. of 10 variables:
## $ semanasLibre : num 20 17 25 52 52 52 23 52 52 52 ...
## $ fueArrestado : Factor w/ 2 levels "0","1": 2 2 2 1 1 1 2 1 1 1 ...
## $ tuvoApoyoDinero : Factor w/ 2 levels "0","1": 1 1 1 2 1 1 1 2 1 1 ...
## $ edad : num 27 18 19 23 19 24 25 21 22 20 ...
## $ esNegro : Factor w/ 2 levels "0","1": 2 2 1 2 1 2 2 2 2 2 ...
## $ expLaboralPrevia : Factor w/ 2 levels "0","1": 1 1 2 2 2 2 2 2 1 2 ...
## $ casado : Factor w/ 2 levels "0","1": 1 1 1 2 1 1 2 1 1 1 ...
## $ libertadCondicional: Factor w/ 2 levels "0","1": 2 2 2 2 2 1 2 2 1 1 ...
## $ vecesEnCarcel : num 3 8 13 1 3 2 0 4 6 0 ...
## $ nivelEduca : Ord.factor w/ 5 levels "1"<"2"<"3"<"4"<..: 2 3 2 4 2 3 3 2 2 4 ...library(survival)
# note que necesito el factor como numérico
data2$survival=with(data2,Surv(time = semanasLibre,event = as.numeric(fueArrestado)))
# que es:
library(magrittr) # needed for pipe %>%
data2%>%
rmarkdown::paged_table()library(ggplot2)
library(ggfortify)
#aqui el generico
KM.generico = survfit(survival ~ 1, data = data2)
###graficando
ejeX='SEMANAS\n curva cae cuando alguien es arrestado'
ejeY='Probabilidad \n(PERMANECER LIBRE)'
titulo="Curva de Sobrevivencia: permanecer libre"
autoplot(KM.generico,xlab=ejeX,ylab=ejeY, main = titulo,conf.int = F)
COX_H1= formula(survival~edad+casado)
#regression
rcox1 <- coxph(COX_H1,data=data2)
modelcox=list('Riesgo - Re arrestado'=rcox1,'Riesgo- Re arrestado (exponenciado)'=rcox1)
#f <- function(x) format(x, digits = 4, scientific = FALSE)
library(modelsummary)
modelsummary(modelcox,
#fmt=f,
exponentiate = c(F,T),
statistic = 'conf.int',
title = "Regresión Cox",
stars = TRUE,
output = "kableExtra")| Riesgo - Re arrestado | Riesgo- Re arrestado (exponenciado) | |
|---|---|---|
| edad | -0.067** | 0.935** |
| [-0.108, -0.026] | [0.898, 0.974] | |
| casado1 | -0.493 | 0.611 |
| [-1.224, 0.237] | [0.294, 1.268] | |
| Num.Obs. | 432 | 432 |
| AIC | 1337.5 | 1337.5 |
| BIC | 1345.6 | 1345.6 |
| RMSE | 0.51 | 0.51 |
| + p < 0.1, * p < 0.05, ** p < 0.01, *** p < 0.001 |
#Interpretación:
De acuerdo con los resultados obtenidos, a mayor edad, el riesgo de volver a la cárcel disminuye, porque el exponenciado es menor que 1. Además, la variable “casado” no tiene efecto significativo sobre el riesgo de volver a la cárcel. En ese sentido, dado que ambos investigadores sostienen que el hecho de estar casado disminuye el riesgo de volver a la cárcel, ninguno estaría en lo correcto.