Ejercicio de Regresión Logística

# Datos cargados al ambiente
library(ggplot2)
KP <- read.csv("Karn_Penrose_infant_survivorship.csv")

1. Explique en sus propias palabras cuales son las hipótesis que se pueden probar. Especificamente mencione si la hipótesis es una hipótesis nula o alterna.

Las hipótesis que se pueden probar son:

Hipótesis nula: El peso y el periodo de gestación no afecta la supervivencia de los bebés.

Hipótesis alterna: EL peso y el periodo de gestación afecta la supervivencia de los bebés.

2. Graficar la variable de respuesta

# Resumen de los datos 
summary(KP)
##     row_num        Survival       Weigth_lb      Gestation_Time_days
##  Min.   :   1   Min.   :0.000   Min.   : 1.000   Min.   :155.0      
##  1st Qu.:1014   1st Qu.:1.000   1st Qu.: 6.000   1st Qu.:265.0      
##  Median :2026   Median :1.000   Median : 7.000   Median :280.0      
##  Mean   :2026   Mean   :0.923   Mean   : 7.015   Mean   :276.2      
##  3rd Qu.:3039   3rd Qu.:1.000   3rd Qu.: 8.000   3rd Qu.:295.0      
##  Max.   :4052   Max.   :1.000   Max.   :13.000   Max.   :345.0
# Gráfica variable de respuesta
library(ggplot2)
ggplot(data = KP, aes(x = Survival)) +
  geom_histogram()
## `stat_bin()` using `bins = 30`. Pick better value `binwidth`.

  labs(x = "Supervivencia ( 1 = Sobrevivientes, 0 = Fallecidos)", y = "Frecuencia") 
## <ggplot2::labels> List of 2
##  $ x: chr "Supervivencia ( 1 = Sobrevivientes, 0 = Fallecidos)"
##  $ y: chr "Frecuencia"

3. Grafique las variables explicativas

# Gráficalas variables explicativas juntas
library(ggplot2)
ggplot(KP, aes(Weigth_lb, Gestation_Time_days))+
  geom_point() + 
  labs(x = "Peso de los varones al nacer", y = "Periodo de Gestación") 

# Gráfica de peso de los bebés
ggplot(KP, aes(x = Weigth_lb)) + geom_histogram(binwidth=0.5)

# Gráfica de periodo de gestación
ggplot(KP, aes(x = Gestation_Time_days)) + geom_histogram(binwidth=1)

4. Pregunta: Usando la prueba correcta evalúa la relación entre la supervivencia y:

# Modelo de regresión logistíca para el periodo de gestación 
KPPGModel <- glm(Survival~Gestation_Time_days,
            data = KP, family = binomial())
# Resumen del modelo
summary(KPPGModel)
## 
## Call:
## glm(formula = Survival ~ Gestation_Time_days, family = binomial(), 
##     data = KP)
## 
## Coefficients:
##                      Estimate Std. Error z value Pr(>|z|)    
## (Intercept)         -8.831160   0.658080  -13.42   <2e-16 ***
## Gestation_Time_days  0.042397   0.002529   16.77   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 2199.2  on 4051  degrees of freedom
## Residual deviance: 1885.0  on 4050  degrees of freedom
## AIC: 1889
## 
## Number of Fisher Scoring iterations: 6
# Modelo de regresión logistíca para el peso de los bebés

KPPVModel <- glm(Survival~Weigth_lb,
            data = KP, family = binomial())
# Resumen del modelo 
summary(KPPVModel)
## 
## Call:
## glm(formula = Survival ~ Weigth_lb, family = binomial(), data = KP)
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)    
## (Intercept) -1.76189    0.22628  -7.786 6.91e-15 ***
## Weigth_lb    0.67591    0.03825  17.670  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 2199.2  on 4051  degrees of freedom
## Residual deviance: 1833.2  on 4050  degrees of freedom
## AIC: 1837.2
## 
## Number of Fisher Scoring iterations: 6
# Modelo de regresión logistíca para el periodo de gestación y el peso de los bebés
KPGWMOdel <- glm(Survival ~ Gestation_Time_days+Weigth_lb, 
                 data = KP, family = binomial ())
# Resumen del modelo 
summary(KPGWMOdel)
## 
## Call:
## glm(formula = Survival ~ Gestation_Time_days + Weigth_lb, family = binomial(), 
##     data = KP)
## 
## Coefficients:
##                      Estimate Std. Error z value Pr(>|z|)    
## (Intercept)         -6.478426   0.692953  -9.349  < 2e-16 ***
## Gestation_Time_days  0.022551   0.003101   7.273 3.52e-13 ***
## Weigth_lb            0.462342   0.046481   9.947  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 2199.2  on 4051  degrees of freedom
## Residual deviance: 1777.9  on 4049  degrees of freedom
## AIC: 1783.9
## 
## Number of Fisher Scoring iterations: 6

La prueba que evalua correctamente la relación entre la supervivencia de y periodo de gestación y peso de los varones es la regresión logística debido a que las variables son binomiales y continuas. Al evaluar la relación entre la supervivencia y el periodo de gestación se determino un coeficiente de 0.042397 siendo un resultado positivo y significativo indicando así que mientras este aumenta la probabilidad de sobrevivir también. De ese modo, el coeficiente del peso de los bebés fue de 0.67591 mostrando un efecto positivo y significativo presentando que al tener un mayor peso al nacer aumenta la probabilidad de sobrevivir. Con esto se concluye que un cambio a estas variables afecta directamente la probabilidad de sobrevivir de los bebés.

5. Graficar la Relación entre la supervivencia y el peso de los bebes

#Gráfica de la relación entre la supervivenvia y el peso de los bebés
library(ggplot2)
ggplot(KP, aes(Weigth_lb,Survival))+
  geom_point()+
  stat_smooth(method="glm", se=TRUE, method.args = list(family=binomial))
## `geom_smooth()` using formula = 'y ~ x'

Analisis de probabilidades

model1=glm(Survival~Weigth_lb, data=KP, family=binomial())
summary(model1)
## 
## Call:
## glm(formula = Survival ~ Weigth_lb, family = binomial(), data = KP)
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)    
## (Intercept) -1.76189    0.22628  -7.786 6.91e-15 ***
## Weigth_lb    0.67591    0.03825  17.670  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 2199.2  on 4051  degrees of freedom
## Residual deviance: 1833.2  on 4050  degrees of freedom
## AIC: 1837.2
## 
## Number of Fisher Scoring iterations: 6
e=exp(1) 
e
## [1] 2.718282

6. ¿Cual es la probabilidad de un bebe de 4 lbs sobrevivir?

P_4=1/(1+2.7182818284^-(-1.76189 + 0.67591*4))
P_4
## [1] 0.719453

La probabilidad de un bebe de 4lbs de sobrevivir es bastante alta según los cálculos con aproximadamente 71%.

7. ¿Cual es la probabilidad de un bebe de 7 lbs sobrevivir?

P_7=1/(1+2.7182818284^-(-1.76189 + 0.67591*7))
P_7
## [1] 0.9511761

La probabilidad de un bebe de 7 lbs de sobrevivir es casi segura con alrededor de 95% según los cálculos.

8. Preguntar a su familia cual era el peso de nacer cuando Ud. nacio, calcula la probabilidad de sobrevivir (3 puntos)

Peso al nacer: 6.5 lbs de Kamyla

P_6.5=1/(1+2.7182818284^-(-1.76189 + 0.67591*6.5))
P_6.5
## [1] 0.9328631

La probabilidad de sobrevivir en relación a mí peso al nacer era de 93% según los datos provistos y los cálculos.