# Teoría La regresión logística es un modelo estadístico de clasificación binaria, que estima la probabilidad de que ocurra un evento (valor 1) frente a que no ocurra (valor 0), en función de variables independientes. # Instalar paquetes y llamar librerías

#install.packages("titanic")
library(titanic)
#install.packages("caret")
library(caret)
## Loading required package: ggplot2
## Loading required package: lattice
#install.packages("tidyverse")
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.2.0     ✔ readr     2.1.6
## ✔ forcats   1.0.1     ✔ stringr   1.6.0
## ✔ lubridate 1.9.5     ✔ tibble    3.3.1
## ✔ purrr     1.2.1     ✔ tidyr     1.3.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ✖ purrr::lift()   masks caret::lift()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

Crear la base de datos

df <- read.csv("C:\\Users\\anavi\\Downloads\\titanic.csv")

Entender la base de datos

summary(df)
##      pclass         survived         name               sex           
##  Min.   :1.000   Min.   :0.000   Length:1310        Length:1310       
##  1st Qu.:2.000   1st Qu.:0.000   Class :character   Class :character  
##  Median :3.000   Median :0.000   Mode  :character   Mode  :character  
##  Mean   :2.295   Mean   :0.382                                        
##  3rd Qu.:3.000   3rd Qu.:1.000                                        
##  Max.   :3.000   Max.   :1.000                                        
##  NA's   :1       NA's   :1                                            
##       age              sibsp            parch          ticket         
##  Min.   : 0.1667   Min.   :0.0000   Min.   :0.000   Length:1310       
##  1st Qu.:21.0000   1st Qu.:0.0000   1st Qu.:0.000   Class :character  
##  Median :28.0000   Median :0.0000   Median :0.000   Mode  :character  
##  Mean   :29.8811   Mean   :0.4989   Mean   :0.385                     
##  3rd Qu.:39.0000   3rd Qu.:1.0000   3rd Qu.:0.000                     
##  Max.   :80.0000   Max.   :8.0000   Max.   :9.000                     
##  NA's   :264       NA's   :1        NA's   :1                         
##       fare            cabin             embarked             boat          
##  Min.   :  0.000   Length:1310        Length:1310        Length:1310       
##  1st Qu.:  7.896   Class :character   Class :character   Class :character  
##  Median : 14.454   Mode  :character   Mode  :character   Mode  :character  
##  Mean   : 33.295                                                           
##  3rd Qu.: 31.275                                                           
##  Max.   :512.329                                                           
##  NA's   :2                                                                 
##       body        home.dest        
##  Min.   :  1.0   Length:1310       
##  1st Qu.: 72.0   Class :character  
##  Median :155.0   Mode  :character  
##  Mean   :160.8                     
##  3rd Qu.:256.0                     
##  Max.   :328.0                     
##  NA's   :1189
str(df)
## 'data.frame':    1310 obs. of  14 variables:
##  $ pclass   : int  1 1 1 1 1 1 1 1 1 1 ...
##  $ survived : int  1 1 0 0 0 1 1 0 1 0 ...
##  $ name     : chr  "Allen, Miss. Elisabeth Walton" "Allison, Master. Hudson Trevor" "Allison, Miss. Helen Loraine" "Allison, Mr. Hudson Joshua Creighton" ...
##  $ sex      : chr  "female" "male" "female" "male" ...
##  $ age      : num  29 0.917 2 30 25 ...
##  $ sibsp    : int  0 1 1 1 1 0 1 0 2 0 ...
##  $ parch    : int  0 2 2 2 2 0 0 0 0 0 ...
##  $ ticket   : chr  "24160" "113781" "113781" "113781" ...
##  $ fare     : num  211 152 152 152 152 ...
##  $ cabin    : chr  "B5" "C22 C26" "C22 C26" "C22 C26" ...
##  $ embarked : chr  "S" "S" "S" "S" ...
##  $ boat     : chr  "2" "11" "" "" ...
##  $ body     : int  NA NA NA 135 NA NA NA NA NA 22 ...
##  $ home.dest: chr  "St Louis, MO" "Montreal, PQ / Chesterville, ON" "Montreal, PQ / Chesterville, ON" "Montreal, PQ / Chesterville, ON" ...
df <- df[, c("survived", "pclass","sex","age")]
df <- na.omit(df)
df$survived <- as.factor(df$survived)
df$pclass <- as.factor(df$pclass)
df$sex <- as.factor(df$sex)

Crear el modelo

modelo <- glm(survived ~ ., data=df, family=binomial)
summary(modelo)
## 
## Call:
## glm(formula = survived ~ ., family = binomial, data = df)
## 
## Coefficients:
##              Estimate Std. Error z value Pr(>|z|)    
## (Intercept)  3.522074   0.326702  10.781  < 2e-16 ***
## pclass2     -1.280570   0.225538  -5.678 1.36e-08 ***
## pclass3     -2.289661   0.225802 -10.140  < 2e-16 ***
## sexmale     -2.497845   0.166037 -15.044  < 2e-16 ***
## age         -0.034393   0.006331  -5.433 5.56e-08 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 1414.62  on 1045  degrees of freedom
## Residual deviance:  982.45  on 1041  degrees of freedom
## AIC: 992.45
## 
## Number of Fisher Scoring iterations: 4

Probar el modelo

prueba <- data.frame(pclass=as.factor(c(1,3)), sex=as.factor(c("female","male")),age=c(25,40))
probabilidad <- predict(modelo, newdata=prueba, type="response")
cbind(prueba, Probabilidad_Sobrevive=probabilidad)
##   pclass    sex age Probabilidad_Sobrevive
## 1      1 female  25             0.93476160
## 2      3   male  40             0.06653593

#Conclusiones

Una mujer de 25 años en primera clase presenta una probabilidad estimada de supervivencia de 93.48%, lo que confirma que genero femenino y clase alta son factores fuertemente asociados a mayor supervivencia.

Un hombre de 40 años en tercera clase tiene una probabilidad estimada de supervivencia de 6.65%, evidenciando un riesgo extremadamente alto de fallecimiento.

La clase del boleto actua como segundo factor critico, ya que pertenecer a tercera clase reduce la probabilidad de supervivencia frente a primera clase.

LS0tDQp0aXRsZTogIlRJVEFOSUNyZWdyZXNpb25mZWIxOSINCmF1dGhvcjogIkFuYSBWaWN0b3JpYSBWZW5lZ2FzIEEwMTU2NzI0NyINCmRhdGU6ICIyMDI2LTAyLTE5Ig0Kb3V0cHV0Og0KICBodG1sX2RvY3VtZW50Og0KICAgIHRvYzogVFJVRQ0KICAgIHRvY19mbG9hdDogVFJVRQ0KICAgIGNvZGVfZG93bmxvYWQ6IFRSVUUNCiAgICB0aGVtZTogY29zbW8NCi0tLQ0KIVtdKGh0dHBzOi8vbWVkaWE0LmdpcGh5LmNvbS9tZWRpYS92MS5ZMmxrUFRaak1EbGlPVFV5TWpobGFHbDBjMmQ1TkdscmFteDNNSE54Y1dwM09UbHlaV3hsYUdod01USTBZMmQ1YlRocFlTWmxjRDEyTVY5bmFXWnpYM05sWVhKamFDWmpkRDFuL1hPWTV5N1lYalREN3EvZ2lwaHkuZ2lmKQ0KIyA8c3BhbiBzdHlsZT0iY29sb3I6Ymx1ZSI+IFRlb3LDrWEgPC9zcGFuPg0KTGEgKipyZWdyZXNpw7NuIGxvZ8Otc3RpY2EqKiBlcyB1biBtb2RlbG8gZXN0YWTDrXN0aWNvIGRlIGNsYXNpZmljYWNpw7NuIGJpbmFyaWEsIHF1ZSBlc3RpbWEgbGEgcHJvYmFiaWxpZGFkIGRlIHF1ZSBvY3VycmEgdW4gZXZlbnRvICh2YWxvciAxKSBmcmVudGUgYSBxdWUgbm8gb2N1cnJhICh2YWxvciAwKSwgZW4gZnVuY2nDs24gZGUgdmFyaWFibGVzIGluZGVwZW5kaWVudGVzLiANCiMgPHNwYW4gc3R5bGU9ImNvbG9yOmJsdWUiPiBJbnN0YWxhciBwYXF1ZXRlcyB5IGxsYW1hciBsaWJyZXLDrWFzIDwvc3Bhbj4NCmBgYHtyfQ0KI2luc3RhbGwucGFja2FnZXMoInRpdGFuaWMiKQ0KbGlicmFyeSh0aXRhbmljKQ0KI2luc3RhbGwucGFja2FnZXMoImNhcmV0IikNCmxpYnJhcnkoY2FyZXQpDQojaW5zdGFsbC5wYWNrYWdlcygidGlkeXZlcnNlIikNCmxpYnJhcnkodGlkeXZlcnNlKQ0KYGBgDQojIDxzcGFuIHN0eWxlPSJjb2xvcjpibHVlIj4gQ3JlYXIgbGEgYmFzZSBkZSBkYXRvcyA8L3NwYW4+DQpgYGB7cn0NCmRmIDwtIHJlYWQuY3N2KCJDOlxcVXNlcnNcXGFuYXZpXFxEb3dubG9hZHNcXHRpdGFuaWMuY3N2IikNCmBgYA0KIyA8c3BhbiBzdHlsZT0iY29sb3I6Ymx1ZSI+IEVudGVuZGVyIGxhIGJhc2UgZGUgZGF0b3MgPC9zcGFuPg0KYGBge3J9DQpzdW1tYXJ5KGRmKQ0Kc3RyKGRmKQ0KZGYgPC0gZGZbLCBjKCJzdXJ2aXZlZCIsICJwY2xhc3MiLCJzZXgiLCJhZ2UiKV0NCmRmIDwtIG5hLm9taXQoZGYpDQpkZiRzdXJ2aXZlZCA8LSBhcy5mYWN0b3IoZGYkc3Vydml2ZWQpDQpkZiRwY2xhc3MgPC0gYXMuZmFjdG9yKGRmJHBjbGFzcykNCmRmJHNleCA8LSBhcy5mYWN0b3IoZGYkc2V4KQ0KYGBgDQojIDxzcGFuIHN0eWxlPSJjb2xvcjpibHVlIj4gQ3JlYXIgZWwgbW9kZWxvIDwvc3Bhbj4NCmBgYHtyfQ0KbW9kZWxvIDwtIGdsbShzdXJ2aXZlZCB+IC4sIGRhdGE9ZGYsIGZhbWlseT1iaW5vbWlhbCkNCnN1bW1hcnkobW9kZWxvKQ0KYGBgDQojIDxzcGFuIHN0eWxlPSJjb2xvcjpibHVlIj4gUHJvYmFyIGVsIG1vZGVsbyA8L3NwYW4+DQpgYGB7cn0NCnBydWViYSA8LSBkYXRhLmZyYW1lKHBjbGFzcz1hcy5mYWN0b3IoYygxLDMpKSwgc2V4PWFzLmZhY3RvcihjKCJmZW1hbGUiLCJtYWxlIikpLGFnZT1jKDI1LDQwKSkNCnByb2JhYmlsaWRhZCA8LSBwcmVkaWN0KG1vZGVsbywgbmV3ZGF0YT1wcnVlYmEsIHR5cGU9InJlc3BvbnNlIikNCmNiaW5kKHBydWViYSwgUHJvYmFiaWxpZGFkX1NvYnJldml2ZT1wcm9iYWJpbGlkYWQpDQpgYGANCiNDb25jbHVzaW9uZXMNCg0KIyBVbmEgbXVqZXIgZGUgMjUgYcOxb3MgZW4gcHJpbWVyYSBjbGFzZSBwcmVzZW50YSB1bmEgcHJvYmFiaWxpZGFkIGVzdGltYWRhIGRlIHN1cGVydml2ZW5jaWEgZGUgOTMuNDglLCBsbyBxdWUgY29uZmlybWEgcXVlIGdlbmVybyBmZW1lbmlubyB5IGNsYXNlIGFsdGEgc29uIGZhY3RvcmVzIGZ1ZXJ0ZW1lbnRlIGFzb2NpYWRvcyBhIG1heW9yIHN1cGVydml2ZW5jaWEuDQoNCiMgVW4gaG9tYnJlIGRlIDQwIGHDsW9zIGVuIHRlcmNlcmEgY2xhc2UgdGllbmUgdW5hIHByb2JhYmlsaWRhZCBlc3RpbWFkYSBkZSBzdXBlcnZpdmVuY2lhIGRlIDYuNjUlLCBldmlkZW5jaWFuZG8gdW4gcmllc2dvIGV4dHJlbWFkYW1lbnRlIGFsdG8gZGUgZmFsbGVjaW1pZW50by4NCg0KIyBMYSBjbGFzZSBkZWwgYm9sZXRvIGFjdHVhIGNvbW8gc2VndW5kbyBmYWN0b3IgY3JpdGljbywgeWEgcXVlIHBlcnRlbmVjZXIgYSB0ZXJjZXJhIGNsYXNlIHJlZHVjZSBsYSBwcm9iYWJpbGlkYWQgZGUgc3VwZXJ2aXZlbmNpYSBmcmVudGUgYSBwcmltZXJhIGNsYXNlLg0K