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 librerias

library(titanic)
library(caret)
## Loading required package: ggplot2
## Loading required package: lattice
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.4     ✔ readr     2.1.5
## ✔ forcats   1.0.0     ✔ stringr   1.5.1
## ✔ lubridate 1.9.4     ✔ tibble    3.3.0
## ✔ purrr     1.1.0     ✔ tidyr     1.3.1
## ── 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 <- titanic_train

Entender la base de datos

summary(df)
##   PassengerId       Survived          Pclass          Name          
##  Min.   :  1.0   Min.   :0.0000   Min.   :1.000   Length:891        
##  1st Qu.:223.5   1st Qu.:0.0000   1st Qu.:2.000   Class :character  
##  Median :446.0   Median :0.0000   Median :3.000   Mode  :character  
##  Mean   :446.0   Mean   :0.3838   Mean   :2.309                     
##  3rd Qu.:668.5   3rd Qu.:1.0000   3rd Qu.:3.000                     
##  Max.   :891.0   Max.   :1.0000   Max.   :3.000                     
##                                                                     
##      Sex                 Age            SibSp           Parch       
##  Length:891         Min.   : 0.42   Min.   :0.000   Min.   :0.0000  
##  Class :character   1st Qu.:20.12   1st Qu.:0.000   1st Qu.:0.0000  
##  Mode  :character   Median :28.00   Median :0.000   Median :0.0000  
##                     Mean   :29.70   Mean   :0.523   Mean   :0.3816  
##                     3rd Qu.:38.00   3rd Qu.:1.000   3rd Qu.:0.0000  
##                     Max.   :80.00   Max.   :8.000   Max.   :6.0000  
##                     NA's   :177                                     
##     Ticket               Fare           Cabin             Embarked        
##  Length:891         Min.   :  0.00   Length:891         Length:891        
##  Class :character   1st Qu.:  7.91   Class :character   Class :character  
##  Mode  :character   Median : 14.45   Mode  :character   Mode  :character  
##                     Mean   : 32.20                                        
##                     3rd Qu.: 31.00                                        
##                     Max.   :512.33                                        
## 
str(df)
## 'data.frame':    891 obs. of  12 variables:
##  $ PassengerId: int  1 2 3 4 5 6 7 8 9 10 ...
##  $ Survived   : int  0 1 1 1 0 0 0 0 1 1 ...
##  $ Pclass     : int  3 1 3 1 3 3 1 3 3 2 ...
##  $ Name       : chr  "Braund, Mr. Owen Harris" "Cumings, Mrs. John Bradley (Florence Briggs Thayer)" "Heikkinen, Miss. Laina" "Futrelle, Mrs. Jacques Heath (Lily May Peel)" ...
##  $ Sex        : chr  "male" "female" "female" "female" ...
##  $ Age        : num  22 38 26 35 35 NA 54 2 27 14 ...
##  $ SibSp      : int  1 1 0 1 0 0 0 3 0 1 ...
##  $ Parch      : int  0 0 0 0 0 0 0 1 2 0 ...
##  $ Ticket     : chr  "A/5 21171" "PC 17599" "STON/O2. 3101282" "113803" ...
##  $ Fare       : num  7.25 71.28 7.92 53.1 8.05 ...
##  $ Cabin      : chr  "" "C85" "" "C123" ...
##  $ Embarked   : chr  "S" "C" "S" "S" ...
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.777013   0.401123   9.416  < 2e-16 ***
## Pclass2     -1.309799   0.278066  -4.710 2.47e-06 ***
## Pclass3     -2.580625   0.281442  -9.169  < 2e-16 ***
## Sexmale     -2.522781   0.207391 -12.164  < 2e-16 ***
## Age         -0.036985   0.007656  -4.831 1.36e-06 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 964.52  on 713  degrees of freedom
## Residual deviance: 647.28  on 709  degrees of freedom
## AIC: 657.28
## 
## Number of Fisher Scoring iterations: 5

Probar 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.94544163
## 2      3   male  40             0.05701133
LS0tCnRpdGxlOiAiUmVncmVzacOzbiBMb2dpc3RpY2EiCmF1dGhvcjogIiBNaWd1ZWwgQW5nZWwgTG9wZXoiCmRhdGU6ICIyMDI1LTA4LTIwIgpvdXRwdXQ6IAogIGh0bWxfZG9jdW1lbnQ6CiAgICB0b2M6IHRydWUKICAgIHRvY19mbG9hdDogdHJ1ZQogICAgY29kZV9kb3dubG9hZDogVFJVRQogICAgdGhlbWU6IGpvdXJuYWwKLS0tCgpgYGB7ciBzZXR1cCwgaW5jbHVkZT1GQUxTRX0Ka25pdHI6Om9wdHNfY2h1bmskc2V0KGVjaG8gPSBUUlVFKQpgYGAKCiFbXSgvVXNlcnMvbWlndWVsL0Rlc2t0b3AvVGl0LmdpZikKCiMgPHNwYW4gc3R5bGU9ImNvbG9yOmJyb3duOyI+IFRlb3LDrWEgPC9zcGFuPiAKCkxhICoqUmVncmVzacOzbiBMb2fDrXN0aWNhKiogZXMgdW4gbW9kZWxvIGVzdGFkw61zdGljbyBkZSBjbGFzaWZpY2FjacOzbiBiaW5hcmlhIHF1ZSBlc3RpbWEgbGEgcHJvYmFiaWxpZGFkIGRlIHF1ZSBvY3VycmEgdW4gZXZlbnRvICh2YWxvciAxKSBmcmVudGUgYSBxdWUgbm8gb2N1cnJhICh2YWxvciAwKSwgZW4gZnVuY2nDs24gZGUgdmFyaWFibGVzIGluZGVwZW5kaWVudGVzLgoKIyA8c3BhbiBzdHlsZT0iY29sb3I6YnJvd247Ij4gSW5zdGFsYXIgUGFxdWV0ZXMgeSBsbGFtYXIgbGlicmVyaWFzIDwvc3Bhbj4gCmBgYHtyfQpsaWJyYXJ5KHRpdGFuaWMpCmxpYnJhcnkoY2FyZXQpCmxpYnJhcnkodGlkeXZlcnNlKQpgYGAKCiMgPHNwYW4gc3R5bGU9ImNvbG9yOmJyb3duOyI+IENyZWFyIGxhIGJhc2UgZGUgZGF0b3MgPC9zcGFuPiAKYGBge3J9CmRmIDwtIHRpdGFuaWNfdHJhaW4KYGBgCgoKIyA8c3BhbiBzdHlsZT0iY29sb3I6YnJvd247Ij4gRW50ZW5kZXIgbGEgYmFzZSBkZSBkYXRvcyA8L3NwYW4+IApgYGB7cn0KCnN1bW1hcnkoZGYpCnN0cihkZikKZGYgPC0gZGZbLGMoIlN1cnZpdmVkIiwgIlBjbGFzcyIsIlNleCIsIkFnZSIpXQpkZiA8LW5hLm9taXQoZGYpCmRmJFN1cnZpdmVkIDwtIGFzLmZhY3RvcihkZiRTdXJ2aXZlZCkKZGYkUGNsYXNzIDwtIGFzLmZhY3RvcihkZiRQY2xhc3MpCmRmJFNleCA8LSBhcy5mYWN0b3IoZGYkU2V4KQpgYGAKIyA8c3BhbiBzdHlsZT0iY29sb3I6YnJvd247Ij4gQ3JlYXIgZWwgbW9kZWxvIDwvc3Bhbj4gCmBgYHtyfQptb2RlbG8gPC0gZ2xtKFN1cnZpdmVkIH4uLCBkYXRhPWRmLCBmYW1pbHk9Ymlub21pYWwpCnN1bW1hcnkobW9kZWxvKQpgYGAKIyA8c3BhbiBzdHlsZT0iY29sb3I6YnJvd247Ij4gUHJvYmFyIE1vZGVsbyA8L3NwYW4+CgpgYGB7cn0KcHJ1ZWJhIDwtIGRhdGEuZnJhbWUoUGNsYXNzPWFzLmZhY3RvcihjKDEsMykpLApTZXg9YXMuZmFjdG9yKGMoImZlbWFsZSIsIm1hbGUiKSksQWdlPWMoMjUsNDApKQpwcm9iYWJpbGlkYWQgPC0gcHJlZGljdChtb2RlbG8sIG5ld2RhdGE9cHJ1ZWJhLCB0eXBlPSJyZXNwb25zZSIpCmNiaW5kKHBydWViYSwgUHJvYmFiaWxpZGFkX1NvYnJldml2ZT1wcm9iYWJpbGlkYWQpCmBgYAoKCgoKCgoKCgoK