Carnet: 13003387
Regresion Logistica Sobre el Titanic
En el siguiente proyecto realizaremos una prediccion acerca del personal
del titanic que logro sobrevivir en base a la tarifa que pagaron para
poder abordar el barco.
library(ISLR)
library(ggplot2)
library(caret)
## Loading required package: lattice
library(readr)
titanic_data <- read_csv("titanic_data.csv")
## Warning: Missing column names filled in: 'X1' [1]
## Parsed with column specification:
## cols(
## X1 = col_integer(),
## PassengerId = col_integer(),
## Survived = col_integer(),
## Sex = col_integer(),
## Age = col_double(),
## Fare = col_double(),
## Pclass_1 = col_integer(),
## Pclass_2 = col_integer(),
## Pclass_3 = col_integer(),
## Family_size = col_double(),
## Title_1 = col_integer(),
## Title_2 = col_integer(),
## Title_3 = col_integer(),
## Title_4 = col_integer(),
## Emb_1 = col_integer(),
## Emb_2 = col_integer(),
## Emb_3 = col_integer()
## )
titanic_data$Age<-titanic_data$Age*100
titanic_data$Age<-round(titanic_data$Age)
titanic_data$Family_size<-titanic_data$Family_size*10
titanic_data$Family_size<-round(titanic_data$Family_size)
titanic_data$Fare<-titanic_data$Fare*100
titanic_data$Fare<-round(titanic_data$Fare)
Definimos el Modelo del DataSet
logit_model<-glm(formula = Survived ~ Fare, data =titanic_data,
family = binomial(link="logit"))
summary(logit_model)
##
## Call:
## glm(formula = Survived ~ Fare, family = binomial(link = "logit"),
## data = titanic_data)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.3657 -0.8992 -0.8730 1.3560 1.5805
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.91108 0.10016 -9.096 < 2e-16 ***
## Fare 0.07150 0.01148 6.230 4.67e-10 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1056.68 on 791 degrees of freedom
## Residual deviance: 999.34 on 790 degrees of freedom
## AIC: 1003.3
##
## Number of Fisher Scoring iterations: 4
Definicion de Dominio y Probabilidad
domain <- seq(min(titanic_data$Fare), max(titanic_data$Fare),1)
prediction <- predict(object = logit_model,
newdata = list(Fare = domain),
type = "response")
plot.logit <- data.frame(domain,prediction)
colnames(plot.logit) <- c("Fare", "Probabilidad")
plot.logit
Gráfica del modelo
ggplot(data = plot.logit, aes(x = Fare, y = Probabilidad)) +
ggtitle("Regresion Logistica del Titanic") +
geom_line(color = "red", size = 2) +
labs(x = "Tarifa") +
labs(y = "Probabilidad") +
theme_minimal()
dataframe.train <- titanic_data[1:(0.3*(nrow(titanic_data))), ]
dataframe.test <- titanic_data[(0.3*nrow(titanic_data)) : nrow(titanic_data), ]
logit_model2 <- glm(formula = Survived ~ Fare, data = dataframe.train,
family = binomial(link = "logit"))
summary(logit_model2)
##
## Call:
## glm(formula = Survived ~ Fare, family = binomial(link = "logit"),
## data = dataframe.train)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.4125 -0.8981 -0.8887 1.4505 1.5084
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.77688 0.17435 -4.456 8.35e-06 ***
## Fare 0.02577 0.01964 1.312 0.189
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 305.70 on 236 degrees of freedom
## Residual deviance: 303.94 on 235 degrees of freedom
## AIC: 307.94
##
## Number of Fisher Scoring iterations: 4
prediction2 <- predict(object = logit_model2,
newdata = dataframe.test,
type = "response")
dataframe.result <- data.frame(dataframe.test$Fare, Probabilidad=prediction2)
dataframe.result
Resultado de la Prediccion
thresholdresult <- ifelse(dataframe.result$Probabilidad >= 0.5, "Yes", "No")
dataframe.test$Survived <- as.factor(dataframe.test$Survived)
levels(dataframe.test$Survived) <- c("No","Yes")
confusionMatrix(as.factor(thresholdresult), dataframe.test$Survived)
## Confusion Matrix and Statistics
##
## Reference
## Prediction No Yes
## No 327 210
## Yes 4 14
##
## Accuracy : 0.6144
## 95% CI : (0.5725, 0.6551)
## No Information Rate : 0.5964
## P-Value [Acc > NIR] : 0.2058
##
## Kappa : 0.0592
## Mcnemar's Test P-Value : <2e-16
##
## Sensitivity : 0.9879
## Specificity : 0.0625
## Pos Pred Value : 0.6089
## Neg Pred Value : 0.7778
## Prevalence : 0.5964
## Detection Rate : 0.5892
## Detection Prevalence : 0.9676
## Balanced Accuracy : 0.5252
##
## 'Positive' Class : No
##
Conclusiones
* Se pudo observar que el modelo tiene un 61.44% de exactitud
en la correcta clasificacion de los datos.
* Se predijeron correctamente que 327 personas sobrevivieron gracias a la
tarifa que pagaron para abordar el titanic.
* Se obtuvo una sensibilidad en la clasificacion de los datos, los cuales
clasifico como positivos y que en su valor real si eran positivos
esta sensibilidad fue del 98.79%, clasificando los datos de una muy
buena manera.
* Se obtuvo un 6.25% de especificidad, la cual nos garantiza que el modelo
nos funciono correctamnete y que los datos en un porcentaje muy alto
si se lograron clasificar.