Advertencia: Los datos presentados en este documento son completamente ficticios y fueron creados con propósitos ilustrativos. No representan eventos, personas ni organizaciones reales. Por favor tenga en cuenta que cualquier parecido con la realidad es pura coincidencia.
Los informes de noticias sugieren que lo imposible se ha vuelto posible… ¡zombis han aparecido en las calles de los EE.UU.! ¿Qué deberíamos hacer? El sitio web de preparación para zombis de los Centros para el Control y la Prevención de Enfermedades (CDC) recomienda almacenar agua, alimentos, medicamentos, herramientas, artículos de saneamiento, ropa, documentos esenciales y suministros de primeros auxilios. ¡Afortunadamente, somos analistas de los CDC y estamos preparados, pero puede ser demasiado tarde para otros!
Nuestro equipo decide identificar los suministros que protegen a las personas y coordinar la distribución de suministros. Algunos valientes recolectores de datos se ofrecen como voluntarios para verificar el estado de 200 adultos seleccionados al azar que estaban vivos antes de la aparición de los zombis. Tenemos datos recientes de los 200 sobre edad y sexo, cuántos hay en su hogar y su ubicación rural, suburbana o urbana. Nuestros heroicos voluntarios visitan cada hogar y registran el estado de zombi y la preparación. ¡Ahora es nuestro trabajo descubrir qué suministros se asocian con la seguridad!
# Read in the data
zombies <- read.csv("C:/Users/sbadi/OneDrive - Instituto Tecnologico y de Estudios Superiores de Monterrey/Documents/TEC NOTAS/Semestre 7/CD2011_mineria-de-datos/zombies.csv")
# Lista de nombres de columnas a convertir a factores
columnas_a_factores <- c("zombie", "sex", "rurality", "food", "medication", "tools", "firstaid", "sanitation","clothing","documents")
# Convertir las columnas a factores utilizando lapply
zombies[columnas_a_factores] <- lapply(zombies[columnas_a_factores], as.factor)
# Examine the data with summary()
summary(zombies)
## zombieid zombie age sex rurality
## Min. : 1.00 Human :121 Min. :18.00 Female: 99 Rural :98
## 1st Qu.: 50.75 Zombie: 79 1st Qu.:29.00 Male :101 Suburban:48
## Median :100.50 Median :42.00 Urban :54
## Mean :100.50 Mean :44.41
## 3rd Qu.:150.25 3rd Qu.:58.00
## Max. :200.00 Max. :85.00
## household water food medication
## Min. :1.00 Min. : 0.00 Food :110 Medication : 94
## 1st Qu.:2.00 1st Qu.: 0.00 No food: 90 No medication:106
## Median :2.50 Median : 8.00
## Mean :2.68 Mean : 8.75
## 3rd Qu.:4.00 3rd Qu.: 8.00
## Max. :6.00 Max. :40.00
## tools firstaid sanitation clothing
## No tools:101 First aid supplies :106 No sanitation:102 Clothing:126
## tools : 99 No first aid supplies: 94 Sanitation : 98 NA's : 74
##
##
##
##
## documents
## Documents: 66
## NA's :134
##
##
##
##
# Create water-per-person
# it represents the amount of water per person in each household
zombies$water.person <- zombies$water / zombies$household
# Examine the new variable
summary(zombies$water.person)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.000 0.000 2.000 3.092 5.333 13.333
¡Debido a que cada momento cuenta cuando se trata de vida y (no) muerte, queremos hacerlo bien! La primera tarea es comparar humanos y zombis para identificar diferencias en los suministros. Revisamos los datos y encontramos lo siguiente:
# Load ggplot2 and gridExtra
library(ggplot2)
## Warning: package 'ggplot2' was built under R version 4.3.1
library(gridExtra)
## Warning: package 'gridExtra' was built under R version 4.3.1
# Create the ageZombies graph
ageZombies <- ggplot(data = zombies, aes(x = age, fill = zombie)) +
geom_density(alpha = 0.3) +
theme_minimal() +
theme(legend.position = "bottom", legend.title = element_blank())
# Create the waterPersonZom graph
waterPersonZom <- ggplot(data = zombies, aes(x = water.person, fill = zombie)) +
geom_density(alpha = 0.3) +
theme_minimal() +
theme(legend.position = "bottom", legend.title = element_blank())
# Display plots side by side
grid.arrange(ageZombies, waterPersonZom, ncol = 2)
¡Parece que aquellos que se convirtieron en zombis eran mayores y tenían menos agua limpia disponible! Esto sugiere que proporcionar agua al resto de los humanos podría ayudar a protegerlos de las hordas de zombis. ¡Proteger a los ciudadanos mayores es importante, así que debemos pensar en las mejores formas de llegar a este grupo! ¿Cuáles son las otras características y suministros que difieren entre humanos y zombis? ¿Viven los zombis en áreas urbanas? ¿O son más comunes en áreas rurales? ¿Es fundamental el agua para seguir siendo humano? ¿Es fundamental la comida para seguir siendo humano?
# Make a subset of the zombies data with only factors
zombies.factors <- zombies[ , sapply(zombies, is.factor)]
# Write a function to get percent zombies
perc.zombies <- lapply(zombies.factors,
function(x){
return(prop.table(table(x, zombies$zombie),
margin = 1))
})
# Print the data
print(perc.zombies)
## $zombie
##
## x Human Zombie
## Human 1 0
## Zombie 0 1
##
## $sex
##
## x Human Zombie
## Female 0.6262626 0.3737374
## Male 0.5841584 0.4158416
##
## $rurality
##
## x Human Zombie
## Rural 0.8163265 0.1836735
## Suburban 0.5208333 0.4791667
## Urban 0.2962963 0.7037037
##
## $food
##
## x Human Zombie
## Food 0.8272727 0.1727273
## No food 0.3333333 0.6666667
##
## $medication
##
## x Human Zombie
## Medication 0.8297872 0.1702128
## No medication 0.4056604 0.5943396
##
## $tools
##
## x Human Zombie
## No tools 0.6039604 0.3960396
## tools 0.6060606 0.3939394
##
## $firstaid
##
## x Human Zombie
## First aid supplies 0.6320755 0.3679245
## No first aid supplies 0.5744681 0.4255319
##
## $sanitation
##
## x Human Zombie
## No sanitation 0.4705882 0.5294118
## Sanitation 0.7448980 0.2551020
##
## $clothing
##
## x Human Zombie
## Clothing 0.5873016 0.4126984
##
## $documents
##
## x Human Zombie
## Documents 0.6666667 0.3333333
# Recodificar variables con valores perdidos
# Add new level and recode NA to "No clothing"
levels(zombies$clothing) <- c(levels(zombies$clothing), "No clothing")
zombies$clothing[is.na(zombies$clothing)] <- "No clothing"
# Add new level and recode NA to "No documents"
levels(zombies$documents ) <- c(levels(zombies$documents), "No documents")
zombies$documents[is.na(zombies$documents)] <- "No documents"
# Check recoding
summary(zombies)
## zombieid zombie age sex rurality
## Min. : 1.00 Human :121 Min. :18.00 Female: 99 Rural :98
## 1st Qu.: 50.75 Zombie: 79 1st Qu.:29.00 Male :101 Suburban:48
## Median :100.50 Median :42.00 Urban :54
## Mean :100.50 Mean :44.41
## 3rd Qu.:150.25 3rd Qu.:58.00
## Max. :200.00 Max. :85.00
## household water food medication
## Min. :1.00 Min. : 0.00 Food :110 Medication : 94
## 1st Qu.:2.00 1st Qu.: 0.00 No food: 90 No medication:106
## Median :2.50 Median : 8.00
## Mean :2.68 Mean : 8.75
## 3rd Qu.:4.00 3rd Qu.: 8.00
## Max. :6.00 Max. :40.00
## tools firstaid sanitation
## No tools:101 First aid supplies :106 No sanitation:102
## tools : 99 No first aid supplies: 94 Sanitation : 98
##
##
##
##
## clothing documents water.person
## Clothing :126 Documents : 66 Min. : 0.000
## No clothing: 74 No documents:134 1st Qu.: 0.000
## Median : 2.000
## Mean : 3.092
## 3rd Qu.: 5.333
## Max. :13.333
Parece que el 70,4% de las personas en áreas urbanas son zombis, mientras que solo el 18,4% de las de áreas rurales son zombis. ¡Sacar a los humanos de las ciudades y proteger a aquellos que no pueden irse parece importante!
Para la mayoría de los suministros, hay menos diferencia entre humanos y zombis, por lo que es difícil decidir qué más hacer. Dado que solo hay una oportunidad de acertar y cada minuto cuenta, el equipo de análisis decide realizar pruebas estadísticas bivariadas para obtener una mejor comprensión de qué diferencias en porcentajes están estadísticamente asociadas significativamente con ser humano o zombi.
# Update subset of factors
zombies.factors <- zombies[ , sapply(zombies, is.factor)]
# Chi-squared for factors
chi.zombies <- lapply(zombies.factors,
function(x){
return(chisq.test(x, zombies.factors$zombie))
})
# T-tests for numeric
ttest.age <- t.test(zombies$age ~ zombies$zombie)
ttest.water <- t.test(zombies$water.person ~ zombies$zombie)
# Examine the results
chi.zombies
## $zombie
##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: x and zombies.factors$zombie
## X-squared = 195.84, df = 1, p-value < 2.2e-16
##
##
## $sex
##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: x and zombies.factors$zombie
## X-squared = 0.21561, df = 1, p-value = 0.6424
##
##
## $rurality
##
## Pearson's Chi-squared test
##
## data: x and zombies.factors$zombie
## X-squared = 41.271, df = 2, p-value = 1.092e-09
##
##
## $food
##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: x and zombies.factors$zombie
## X-squared = 48.49, df = 1, p-value = 3.32e-12
##
##
## $medication
##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: x and zombies.factors$zombie
## X-squared = 35.747, df = 1, p-value = 2.247e-09
##
##
## $tools
##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: x and zombies.factors$zombie
## X-squared = 0, df = 1, p-value = 1
##
##
## $firstaid
##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: x and zombies.factors$zombie
## X-squared = 0.47178, df = 1, p-value = 0.4922
##
##
## $sanitation
##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: x and zombies.factors$zombie
## X-squared = 14.61, df = 1, p-value = 0.0001322
##
##
## $clothing
##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: x and zombies.factors$zombie
## X-squared = 0.26864, df = 1, p-value = 0.6042
##
##
## $documents
##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: x and zombies.factors$zombie
## X-squared = 1.206, df = 1, p-value = 0.2721
ttest.age
##
## Welch Two Sample t-test
##
## data: zombies$age by zombies$zombie
## t = -5.6247, df = 155.02, p-value = 8.453e-08
## alternative hypothesis: true difference in means between group Human and group Zombie is not equal to 0
## 95 percent confidence interval:
## -18.099289 -8.690751
## sample estimates:
## mean in group Human mean in group Zombie
## 39.12397 52.51899
ttest.water
##
## Welch Two Sample t-test
##
## data: zombies$water.person by zombies$zombie
## t = 5.5436, df = 197.43, p-value = 9.415e-08
## alternative hypothesis: true difference in means between group Human and group Zombie is not equal to 0
## 95 percent confidence interval:
## 1.636281 3.443253
## sample estimates:
## mean in group Human mean in group Zombie
## 4.095041 1.555274
¡Ahora vamos progresando! La ruralidad, la comida, los medicamentos, el saneamiento, la edad y el agua por persona tienen relaciones estadísticamente significativas con el estado de zombi. ¡Usamos esta información para coordinar la entrega de alimentos y medicamentos mientras continuamos examinando los datos!
El siguiente paso es estimar un modelo de regresión logística con
zombie como resultado. El comando de modelo lineal
generalizado, glm(), se puede usar para determinar si y
cómo cada variable, y el conjunto de variables en su conjunto,
contribuyen a predecir el estado de zombi. Después de
glm(), odds.n.ends() calcula la significación
del modelo, el ajuste y las razones de posibilidades.
# Create zombie model
zombie.model <- glm(zombie ~ age + water.person + food + rurality + medication + sanitation,
data = zombies, family = binomial(logit))
# Model significance, fit, and odds ratios with 95% CI
library(odds.n.ends)
## Warning: package 'odds.n.ends' was built under R version 4.2.3
zombie.model.fit <- odds.n.ends(zombie.model)
## Waiting for profiling to be done...
# Print the results of the odds.n.ends command
print(zombie.model.fit)
## $`Logistic regression model significance`
## Chi-squared d.f. p
## 145.596 7 <.001
##
## $`Contingency tables (model fit): frequency predicted`
## Number observed
## Number predicted 1 0 Sum
## 1 63 12 75
## 0 16 109 125
## Sum 79 121 200
##
## $`Count R-squared (model fit): percent correctly predicted`
## [1] 86
##
## $`Model sensitivity`
## [1] 0.7974684
##
## $`Model specificity`
## [1] 0.9008264
##
## $`Predictor odds ratios and 95% CI`
## OR 2.5 % 97.5 %
## (Intercept) 0.00224594 0.0002093871 0.01622961
## age 1.08005714 1.0485596858 1.11810998
## water.person 0.78377398 0.6600894297 0.91287014
## foodNo food 9.02618095 3.4071657576 26.70797145
## ruralitySuburban 3.69686205 1.2545823697 11.59438611
## ruralityUrban 14.55818400 4.5481528429 54.42513843
## medicationNo medication 5.52134058 2.0232321555 16.53129848
## sanitationSanitation 0.31417163 0.1177847153 0.78789714
El modelo es estadísticamente significativo (c2 = 145,6; p <0,05), lo que indica que las variables en el modelo funcionan juntas para ayudar a explicar el estado de zombi. Una edad más avanzada, no tener comida, vivir en áreas suburbanas o urbanas (en comparación con las rurales) y no tener acceso a medicamentos aumentaron las probabilidades de ser un zombi. El acceso a saneamiento y tener suficiente agua disminuyeron las probabilidades de ser un zombi. El modelo predijo correctamente el estado de zombi de 63 zombis y 109 humanos, o 172 de los 200 participantes. Antes de confiar en el modelo, se deben comprobar los supuestos del modelo: no multicolinealidad y linealidad.
Comprobando la multicolinealidad: Podemos usar el factor de inflación de varianza generalizado (GVIF) para verificar la multicolinealidad. El GVIF determina en qué medida cada variable independiente puede ser explicada por el resto de las variables independientes. Cuando una variable independiente está bien explicada por las otras variables independientes, el GVIF es alto, lo que indica que la variable es redundante y debe eliminarse del modelo. A menudo se utilizan valores superiores a dos para indicar un supuesto de multicolinealidad fallido.
GVIF (1/(2df)) <2df = grados de libertad
Comprobando la linealidad: La linealidad se puede comprobar graficando el logaritmo de las probabilidades del resultado frente a cada predictor numérico para ver si la relación es lineal.
# Compute GVIF
library(car)
## Warning: package 'car' was built under R version 4.3.1
## Loading required package: carData
## Warning: package 'carData' was built under R version 4.3.1
vif(zombie.model)
## GVIF Df GVIF^(1/(2*Df))
## age 1.508748 1 1.228311
## water.person 1.188868 1 1.090352
## food 1.304250 1 1.142038
## rurality 1.313980 2 1.070649
## medication 1.271348 1 1.127541
## sanitation 1.102351 1 1.049929
# Make a variable of the logit of the outcome
zombies$logitZombie <- log(zombie.model$fitted.values/(1-zombie.model$fitted.values))
# Graph the logit variable against age and water.person
ageLinearity <- ggplot(data = zombies, aes(x = age, y = logitZombie))+
geom_point(color = "gray") +
geom_smooth(method = "loess", se = FALSE, color = "orange") +
geom_smooth(method = "lm", se = FALSE, color = "gray") +
theme_bw()
waterPersonLin <- ggplot(data = zombies, aes(x = water.person, y = logitZombie))+
geom_point(color = "gray") +
geom_smooth(method = "loess", se = FALSE, color = "orange") +
geom_smooth(method = "lm", se = FALSE, color = "gray") +
theme_bw()
# View both plots side-by-side
grid.arrange(ageLinearity, waterPersonLin, ncol = 2)
## `geom_smooth()` using formula = 'y ~ x'
## `geom_smooth()` using formula = 'y ~ x'
## `geom_smooth()` using formula = 'y ~ x'
## `geom_smooth()` using formula = 'y ~ x'
Descubrimos que las puntuaciones GVIF son bajas, lo que indica que el
modelo cumple con el supuesto de no multicolinealidad perfecta. Las
trazas muestran una desviación relativamente menor del supuesto de
linealidad para edad y agua.persona. Los
supuestos parecen cumplirse suficientemente.
Una de tus amigas en el equipo de análisis no ha podido comunicarse con su padre o hermano durante horas, pero sabe por una conversación telefónica anterior que tienen comida, medicamentos y saneamiento. Su padre de 71 años vive solo en un área suburbana y es excelente en la preparación; tiene unos cinco galones de agua. Su hermano de 40 años vive en un área urbana y estimó tres galones de agua por persona. Ella decide usar el modelo para calcular la probabilidad de que sean zombis.
# Make a new data frame with the relatives data in it
newdata <- data.frame(age = c(71, 40),
water.person = c(5, 3),
food = c("Food", "Food"),
rurality = c("Suburban", "Urban"),
medication = c("Medication", "Medication"),
sanitation = c("Sanitation", "Sanitation"))
# Use the new data frame to predict
predictions <- predict(zombie.model, newdata, type = "response")
# Print the predicted probabilities
predictions
## 1 2
## 0.15457694 0.09720797
Su padre tiene alrededor de un 15,5 por ciento de posibilidades de ser un zombi y su hermano tiene menos de un 10 por ciento de posibilidades. ¡Parece que probablemente están a salvo, lo cual es un gran alivio! Ella regresa al equipo para comenzar a trabajar en un plan para distribuir alimentos y medicamentos comunes para mantener a otros a salvo. El equipo discute lo que se necesitaría para comenzar a evacuar las zonas urbanas para llevar a las personas a las zonas rurales del país donde hay un menor porcentaje de zombis. Mientras el equipo trabaja en estos planes, un pensamiento sigue distrayéndote… tu familia puede estar a salvo, pero ¿qué tan seguro estás tú?
¡Agrega tus propios datos de la vida real al marco de datos
newdata y predice tu propia probabilidad de convertirte en
un zombi!
# Add your data to the newdata data frame
newdata <- data.frame(age = c(71, 40, 20),
water.person = c(5, 3, 2),
food = c("Food", "Food", "Food"),
rurality = c("Suburban", "Urban", "Urban"),
medication = c("Medication", "Medication", "No medication"),
sanitation = c("Sanitation", "Sanitation", "Sanitation"))
# Use the new data frame to predict
predictions <- predict(zombie.model, newdata, type = "response")
# Print the predictions
predictions
## 1 2 3
## 0.15457694 0.09720797 0.13983475
Si bien es poco probable que ocurra un apocalipsis zombi en un futuro cercano, la información presentada en este cuaderno se basa en las recomendaciones de preparación para emergencias de los CDC. Aunque no hay forma de volvernos más jóvenes, podemos tener comida, agua, medicamentos y otros suministros listos para garantizar que estemos seguros en caso de una tormenta de nieve, inundación, tornado u otra emergencia. Después de calcular tu probabilidad de zombi, piensa en lo que podrías hacer personalmente para aumentar la probabilidad de que te mantengas seguro en la próxima tormenta o apocalipsis zombi.
# What is your probability of becoming a zombie?
me <- 0.139834750161706
# How prepared are you for a real emergency?
preparedness_level <- "Okay, but I should probably pick up a few emergency items at the store."