# Datos cargados al ambiente
library(ggplot2)
KP <- read.csv("Karn_Penrose_infant_survivorship.csv")
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.
# 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"
# 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)
# 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.
#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'
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
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%.
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.
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.