Caso Euromotors

1. Planteamiento del problema

En este notebook les mostraré paso a paso el análisis del problema propuesto. El objetivo de este ejercicio es la resolución de las siguientes incógnitas:

1. ¿Cómo son los clientes de lujo para enfocar las estrategias de marketing?

- Seleccionar las 10 variables más importantes del dataset

- ¿Son los precios similares a los de la realidad?

2. ¿Cómo hacer la campaña de marketing más efectiva?

- Seleccionar las variables más relevantes

- ¿De qué manera confirmaría que la propuesta es la adecuada?

2. Información general

Los pasos a seguir son los siguientes:

A) Limpieza de la data

B) Exploración de los datos

C) Construcción del modelo

D) Revisión de los resultados

3. Planeamiento del proyecto

Cuando estoy por empezar un proyecto, me gusta poner el plan que llevaré a cabo.

Entender la naturaleza de la data (summary(), str())

Histogramas y boxplots

Conteo de valores

Manipulación de valores nulos

Correlación entre métricas

Exploración de temas interesantes

• ¿A mayores ingresos tienen más posibilidades de tener un auto de lujo?

  • Sería interesante la revisión de las tarjetas de crédito y deudas

• ¿El tipo de trabajo está relacionado con tener un auto de lujo?

• ¿Por qué tipo de medio se informan las personas con autos de lujo?

  • Hay datos sobre periódicos, internet y noticias en general

• ¿La edad y el sexo están relacionados con tener un auto de lujo?

Feature engineering

Construcción del modelo

Test del modelo (matriz de confusión)

4. Limpieza de la data

Lectura incial de datos

Para empezar, se leen los datos del csv y se ve las dimensiones

db<-read.csv("Base de datos caso práctico.csv")

#View(db)

dim(db)

[1] 5000  124

Son 5000 filas y 124 columnas

summary(db)

    custid              region         townsize         gender            age            agecat       birthmonth       
 Length:5000        Min.   :1.000   Min.   :1.000   Min.   :0.0000   Min.   :18.00   Min.   :2.000   Length:5000       
 Class :character   1st Qu.:2.000   1st Qu.:1.000   1st Qu.:0.0000   1st Qu.:31.00   1st Qu.:3.000   Class :character  
 Mode  :character   Median :3.000   Median :3.000   Median :1.0000   Median :47.00   Median :4.000   Mode  :character  
                    Mean   :3.001   Mean   :2.687   Mean   :0.5036   Mean   :47.03   Mean   :4.239                     
                    3rd Qu.:4.000   3rd Qu.:4.000   3rd Qu.:1.0000   3rd Qu.:62.00   3rd Qu.:5.000                     
                    Max.   :5.000   Max.   :5.000   Max.   :1.0000   Max.   :79.00   Max.   :6.000                     
                                    NA's   :2                                                                          
       ed            edcat           jobcat          union            employ          empcat          retire      
 Min.   : 6.00   Min.   :1.000   Min.   :1.000   Min.   :0.0000   Min.   : 0.00   Min.   :1.000   Min.   :0.0000  
 1st Qu.:12.00   1st Qu.:2.000   1st Qu.:1.000   1st Qu.:0.0000   1st Qu.: 2.00   1st Qu.:2.000   1st Qu.:0.0000  
 Median :14.00   Median :2.000   Median :2.000   Median :0.0000   Median : 7.00   Median :3.000   Median :0.0000  
 Mean   :14.54   Mean   :2.672   Mean   :2.753   Mean   :0.1512   Mean   : 9.73   Mean   :2.933   Mean   :0.1476  
 3rd Qu.:17.00   3rd Qu.:4.000   3rd Qu.:4.000   3rd Qu.:0.0000   3rd Qu.:15.00   3rd Qu.:4.000   3rd Qu.:0.0000  
 Max.   :23.00   Max.   :5.000   Max.   :6.000   Max.   :1.0000   Max.   :52.00   Max.   :5.000   Max.   :1.0000  
                                                                                                                  
     income            inccat         debtinc          creddebt           othdebt            default           jobsat     
 Min.   :   9.00   Min.   :1.000   Min.   : 0.000   Min.   :  0.0000   Min.   :  0.0000   Min.   :0.0000   Min.   :1.000  
 1st Qu.:  24.00   1st Qu.:1.000   1st Qu.: 5.100   1st Qu.:  0.3855   1st Qu.:  0.9803   1st Qu.:0.0000   1st Qu.:2.000  
 Median :  38.00   Median :2.000   Median : 8.800   Median :  0.9264   Median :  2.0985   Median :0.0000   Median :3.000  
 Mean   :  54.76   Mean   :2.392   Mean   : 9.954   Mean   :  1.8573   Mean   :  3.6545   Mean   :0.2342   Mean   :2.964  
 3rd Qu.:  67.00   3rd Qu.:3.000   3rd Qu.:13.600   3rd Qu.:  2.0638   3rd Qu.:  4.3148   3rd Qu.:0.0000   3rd Qu.:4.000  
 Max.   :1073.00   Max.   :5.000   Max.   :43.100   Max.   :109.0726   Max.   :141.4591   Max.   :1.0000   Max.   :5.000  
                                                                                                                          
    marital          spoused         spousedcat          reside           pets          pets_cats        pets_dogs     
 Min.   :0.0000   Min.   :-1.000   Min.   :-1.0000   Min.   :1.000   Min.   : 0.000   Min.   :0.0000   Min.   :0.0000  
 1st Qu.:0.0000   1st Qu.:-1.000   1st Qu.:-1.0000   1st Qu.:1.000   1st Qu.: 0.000   1st Qu.:0.0000   1st Qu.:0.0000  
 Median :0.0000   Median :-1.000   Median :-1.0000   Median :2.000   Median : 2.000   Median :0.0000   Median :0.0000  
 Mean   :0.4802   Mean   : 6.113   Mean   : 0.6414   Mean   :2.204   Mean   : 3.067   Mean   :0.5004   Mean   :0.3924  
 3rd Qu.:1.0000   3rd Qu.:14.000   3rd Qu.: 2.0000   3rd Qu.:3.000   3rd Qu.: 5.000   3rd Qu.:1.0000   3rd Qu.:0.0000  
 Max.   :1.0000   Max.   :24.000   Max.   : 5.0000   Max.   :9.000   Max.   :21.000   Max.   :6.0000   Max.   :7.0000  
                                                                                                                       
   pets_birds     pets_reptiles      pets_small     pets_saltfish    pets_freshfish      homeown          hometype    
 Min.   :0.0000   Min.   :0.0000   Min.   :0.0000   Min.   :0.0000   Min.   : 0.000   Min.   :0.0000   Min.   :1.000  
 1st Qu.:0.0000   1st Qu.:0.0000   1st Qu.:0.0000   1st Qu.:0.0000   1st Qu.: 0.000   1st Qu.:0.0000   1st Qu.:1.000  
 Median :0.0000   Median :0.0000   Median :0.0000   Median :0.0000   Median : 0.000   Median :1.0000   Median :2.000  
 Mean   :0.1104   Mean   :0.0556   Mean   :0.1146   Mean   :0.0466   Mean   : 1.847   Mean   :0.6296   Mean   :1.843  
 3rd Qu.:0.0000   3rd Qu.:0.0000   3rd Qu.:0.0000   3rd Qu.:0.0000   3rd Qu.: 4.000   3rd Qu.:1.0000   3rd Qu.:2.000  
 Max.   :5.0000   Max.   :6.0000   Max.   :7.0000   Max.   :8.0000   Max.   :16.000   Max.   :1.0000   Max.   :4.000  
                                                                                                                      
    address       addresscat         cars           carown           cartype           carvalue      carcatvalue    
 Min.   : 0.0   Min.   :1.000   Min.   :0.000   Min.   :-1.0000   Min.   :-1.0000   Min.   :-1.00   Min.   :-1.000  
 1st Qu.: 6.0   1st Qu.:2.000   1st Qu.:1.000   1st Qu.: 0.0000   1st Qu.: 0.0000   1st Qu.: 9.20   1st Qu.: 1.000  
 Median :14.0   Median :3.000   Median :2.000   Median : 1.0000   Median : 0.0000   Median :17.00   Median : 1.000  
 Mean   :16.4   Mean   :3.272   Mean   :2.131   Mean   : 0.6414   Mean   : 0.3438   Mean   :23.23   Mean   : 1.389  
 3rd Qu.:25.0   3rd Qu.:4.000   3rd Qu.:3.000   3rd Qu.: 1.0000   3rd Qu.: 1.0000   3rd Qu.:31.10   3rd Qu.: 2.000  
 Max.   :57.0   Max.   :5.000   Max.   :8.000   Max.   : 1.0000   Max.   : 1.0000   Max.   :99.60   Max.   : 3.000  
                                                                                                                    
   carbought          carbuy         commute         commutecat     commutetime      commutecar    commutemotorcycle
 Min.   :-1.000   Min.   :0.000   Min.   : 1.000   Min.   :1.000   Min.   : 8.00   Min.   :0.000   Min.   :0.0000   
 1st Qu.: 0.000   1st Qu.:0.000   1st Qu.: 1.000   1st Qu.:1.000   1st Qu.:21.00   1st Qu.:0.000   1st Qu.:0.0000   
 Median : 0.000   Median :0.000   Median : 1.000   Median :1.000   Median :25.00   Median :1.000   Median :0.0000   
 Mean   : 0.221   Mean   :0.361   Mean   : 2.996   Mean   :1.973   Mean   :25.35   Mean   :0.679   Mean   :0.1026   
 3rd Qu.: 1.000   3rd Qu.:1.000   3rd Qu.: 4.000   3rd Qu.:3.000   3rd Qu.:29.00   3rd Qu.:1.000   3rd Qu.:0.0000   
 Max.   : 1.000   Max.   :1.000   Max.   :10.000   Max.   :5.000   Max.   :48.00   Max.   :1.000   Max.   :1.0000   
                                                                   NA's   :2                                        
 commutecarpool     commutebus     commuterail     commutepublic     commutebike      commutewalk     commutenonmotor 
 Min.   :0.0000   Min.   :0.000   Min.   :0.0000   Min.   :0.0000   Min.   :0.0000   Min.   :0.0000   Min.   :0.0000  
 1st Qu.:0.0000   1st Qu.:0.000   1st Qu.:0.0000   1st Qu.:0.0000   1st Qu.:0.0000   1st Qu.:0.0000   1st Qu.:0.0000  
 Median :0.0000   Median :0.000   Median :0.0000   Median :0.0000   Median :0.0000   Median :0.0000   Median :0.0000  
 Mean   :0.2718   Mean   :0.406   Mean   :0.2746   Mean   :0.0954   Mean   :0.1234   Mean   :0.3838   Mean   :0.0584  
 3rd Qu.:1.0000   3rd Qu.:1.000   3rd Qu.:1.0000   3rd Qu.:0.0000   3rd Qu.:0.0000   3rd Qu.:1.0000   3rd Qu.:0.0000  
 Max.   :1.0000   Max.   :1.000   Max.   :1.0000   Max.   :1.0000   Max.   :1.0000   Max.   :1.0000   Max.   :1.0000  
                                                                                                                      
  telecommute        reason         polview         polparty        polcontrib          vote            card      
 Min.   :0.000   Min.   :1.000   Min.   :1.000   Min.   :0.0000   Min.   :0.0000   Min.   :0.000   Min.   :1.000  
 1st Qu.:0.000   1st Qu.:9.000   1st Qu.:3.000   1st Qu.:0.0000   1st Qu.:0.0000   1st Qu.:0.000   1st Qu.:2.000  
 Median :0.000   Median :9.000   Median :4.000   Median :0.0000   Median :0.0000   Median :1.000   Median :3.000  
 Mean   :0.188   Mean   :7.637   Mean   :4.089   Mean   :0.3814   Mean   :0.2384   Mean   :0.518   Mean   :2.714  
 3rd Qu.:0.000   3rd Qu.:9.000   3rd Qu.:5.000   3rd Qu.:1.0000   3rd Qu.:0.0000   3rd Qu.:1.000   3rd Qu.:4.000  
 Max.   :1.000   Max.   :9.000   Max.   :7.000   Max.   :1.0000   Max.   :1.0000   Max.   :1.000   Max.   :5.000  
                                                                                                                  
    cardtype      cardbenefit       cardfee         cardtenure    cardtenurecat       card2         card2type    
 Min.   :1.000   Min.   :1.000   Min.   :0.0000   Min.   : 0.00   Min.   :1.000   Min.   :1.000   Min.   :1.000  
 1st Qu.:2.000   1st Qu.:2.000   1st Qu.:0.0000   1st Qu.: 6.00   1st Qu.:3.000   1st Qu.:2.000   1st Qu.:2.000  
 Median :3.000   Median :3.000   Median :0.0000   Median :14.00   Median :4.000   Median :3.000   Median :3.000  
 Mean   :2.507   Mean   :2.506   Mean   :0.1898   Mean   :16.66   Mean   :3.782   Mean   :2.774   Mean   :2.541  
 3rd Qu.:4.000   3rd Qu.:3.250   3rd Qu.:0.0000   3rd Qu.:26.00   3rd Qu.:5.000   3rd Qu.:4.000   3rd Qu.:4.000  
 Max.   :4.000   Max.   :4.000   Max.   :1.0000   Max.   :40.00   Max.   :5.000   Max.   :5.000   Max.   :4.000  
                                                                                                                 
  card2benefit      card2fee       card2tenure    card2tenurecat    carditems       cardspent        card2items    
 Min.   :1.000   Min.   :0.0000   Min.   : 0.00   Min.   :1.000   Min.   : 0.00   Min.   :   0.0   Min.   : 0.000  
 1st Qu.:2.000   1st Qu.:0.0000   1st Qu.: 5.00   1st Qu.:2.000   1st Qu.: 8.00   1st Qu.: 183.4   1st Qu.: 3.000  
 Median :3.000   Median :0.0000   Median :12.00   Median :4.000   Median :10.00   Median : 276.4   Median : 5.000  
 Mean   :2.534   Mean   :0.1872   Mean   :13.08   Mean   :3.571   Mean   :10.18   Mean   : 337.2   Mean   : 4.667  
 3rd Qu.:4.000   3rd Qu.:0.0000   3rd Qu.:21.00   3rd Qu.:5.000   3rd Qu.:12.00   3rd Qu.: 418.5   3rd Qu.: 6.000  
 Max.   :4.000   Max.   :1.0000   Max.   :30.00   Max.   :5.000   Max.   :23.00   Max.   :3926.4   Max.   :15.000  
                                                                                                                   
   card2spent          active          bfast           tenure         churn           longmon          longten       
 Min.   :   0.00   Min.   :0.000   Min.   :1.000   Min.   : 0.0   Min.   :0.0000   Min.   :  0.90   Min.   :    0.9  
 1st Qu.:  66.97   1st Qu.:0.000   1st Qu.:1.000   1st Qu.:18.0   1st Qu.:0.0000   1st Qu.:  5.70   1st Qu.:  104.6  
 Median : 125.34   Median :0.000   Median :2.000   Median :38.0   Median :0.0000   Median :  9.55   Median :  350.0  
 Mean   : 160.88   Mean   :0.466   Mean   :2.059   Mean   :38.2   Mean   :0.2532   Mean   : 13.47   Mean   :  708.9  
 3rd Qu.: 208.31   3rd Qu.:1.000   3rd Qu.:3.000   3rd Qu.:59.0   3rd Qu.:1.0000   3rd Qu.: 16.55   3rd Qu.:  913.9  
 Max.   :2069.25   Max.   :1.000   Max.   :3.000   Max.   :72.0   Max.   :1.0000   Max.   :179.85   Max.   :13046.5  
                                                                                                    NA's   :3        
    tollfree         tollmon         lntollmon        tollten           equip           equipmon         equipten     
 Min.   :0.0000   Min.   :  0.00   Min.   :2.079   Min.   :   0.0   Min.   :0.0000   Min.   :  0.00   Min.   :   0.0  
 1st Qu.:0.0000   1st Qu.:  0.00   1st Qu.:2.970   1st Qu.:   0.0   1st Qu.:0.0000   1st Qu.:  0.00   1st Qu.:   0.0  
 Median :0.0000   Median :  0.00   Median :3.229   Median :   0.0   Median :0.0000   Median :  0.00   Median :   0.0  
 Mean   :0.4756   Mean   : 13.26   Mean   :3.243   Mean   : 577.8   Mean   :0.3408   Mean   : 12.99   Mean   : 470.2  
 3rd Qu.:1.0000   3rd Qu.: 24.50   3rd Qu.:3.519   3rd Qu.: 885.5   3rd Qu.:1.0000   3rd Qu.: 30.80   3rd Qu.: 510.2  
 Max.   :1.0000   Max.   :173.00   Max.   :4.622   Max.   :6923.4   Max.   :1.0000   Max.   :106.30   Max.   :6525.3  
                                   NA's   :2622                                                                       
   lnequipten       callcard         cardmon          cardten          lncardten        wireless         wiremon      
 Min.   :2.489   Min.   :0.0000   Min.   :  0.00   Min.   :    0.0   Min.   :1.558   Min.   :0.0000   Min.   :  0.00  
 1st Qu.:6.172   1st Qu.:0.0000   1st Qu.:  0.00   1st Qu.:    0.0   1st Qu.:5.858   1st Qu.:0.0000   1st Qu.:  0.00  
 Median :7.051   Median :1.0000   Median : 13.75   Median :  425.0   Median :6.640   Median :0.0000   Median :  0.00  
 Mean   :6.747   Mean   :0.7162   Mean   : 15.44   Mean   :  720.5   Mean   :6.426   Mean   :0.2688   Mean   : 10.70  
 3rd Qu.:7.650   3rd Qu.:1.0000   3rd Qu.: 22.75   3rd Qu.: 1080.0   3rd Qu.:7.219   3rd Qu.:1.0000   3rd Qu.: 20.96  
 Max.   :8.783   Max.   :1.0000   Max.   :188.50   Max.   :13705.0   Max.   :9.525   Max.   :1.0000   Max.   :186.25  
 NA's   :3296                                      NA's   :2         NA's   :1422                                     
   lnwiremon        wireten           lnwireten        multline          voice           pager           internet  
 Min.   :2.542   Min.   :    0.00   Min.   :2.542   Min.   :0.0000   Min.   :0.000   Min.   :0.0000   Min.   :0.0  
 1st Qu.:3.330   1st Qu.:    0.00   1st Qu.:6.158   1st Qu.:0.0000   1st Qu.:0.000   1st Qu.:0.0000   1st Qu.:0.0  
 Median :3.598   Median :    0.00   Median :7.147   Median :0.0000   Median :0.000   Median :0.0000   Median :1.0  
 Mean   :3.605   Mean   :  421.99   Mean   :6.808   Mean   :0.4884   Mean   :0.303   Mean   :0.2436   Mean   :1.2  
 3rd Qu.:3.865   3rd Qu.:   89.96   3rd Qu.:7.755   3rd Qu.:1.0000   3rd Qu.:1.000   3rd Qu.:0.0000   3rd Qu.:2.0  
 Max.   :5.227   Max.   :12858.65   Max.   :9.462   Max.   :1.0000   Max.   :1.000   Max.   :1.0000   Max.   :4.0  
 NA's   :3656                       NA's   :3656                                                                   
     callid          callwait        forward           confer          ebill            owntv          hourstv     
 Min.   :0.0000   Min.   :0.000   Min.   :0.0000   Min.   :0.000   Min.   :0.0000   Min.   :0.000   Min.   : 0.00  
 1st Qu.:0.0000   1st Qu.:0.000   1st Qu.:0.0000   1st Qu.:0.000   1st Qu.:0.0000   1st Qu.:1.000   1st Qu.:17.00  
 Median :0.0000   Median :0.000   Median :0.0000   Median :0.000   Median :0.0000   Median :1.000   Median :20.00  
 Mean   :0.4752   Mean   :0.479   Mean   :0.4806   Mean   :0.478   Mean   :0.3486   Mean   :0.983   Mean   :19.64  
 3rd Qu.:1.0000   3rd Qu.:1.000   3rd Qu.:1.0000   3rd Qu.:1.000   3rd Qu.:1.0000   3rd Qu.:1.000   3rd Qu.:23.00  
 Max.   :1.0000   Max.   :1.000   Max.   :1.0000   Max.   :1.000   Max.   :1.0000   Max.   :1.000   Max.   :36.00  
                                                                                                                   
     ownvcr           owndvd           owncd            ownpda          ownpc           ownipod          owngame      
 Min.   :0.0000   Min.   :0.0000   Min.   :0.0000   Min.   :0.000   Min.   :0.0000   Min.   :0.0000   Min.   :0.0000  
 1st Qu.:1.0000   1st Qu.:1.0000   1st Qu.:1.0000   1st Qu.:0.000   1st Qu.:0.0000   1st Qu.:0.0000   1st Qu.:0.0000  
 Median :1.0000   Median :1.0000   Median :1.0000   Median :0.000   Median :1.0000   Median :0.0000   Median :0.0000  
 Mean   :0.9156   Mean   :0.9136   Mean   :0.9328   Mean   :0.201   Mean   :0.6328   Mean   :0.4792   Mean   :0.4748  
 3rd Qu.:1.0000   3rd Qu.:1.0000   3rd Qu.:1.0000   3rd Qu.:0.000   3rd Qu.:1.0000   3rd Qu.:1.0000   3rd Qu.:1.0000  
 Max.   :1.0000   Max.   :1.0000   Max.   :1.0000   Max.   :1.000   Max.   :1.0000   Max.   :1.0000   Max.   :1.0000  
                                                                                                                      
     ownfax            news         response_01      response_02      response_03    
 Min.   :0.0000   Min.   :0.0000   Min.   :0.0000   Min.   :0.0000   Min.   :0.0000  
 1st Qu.:0.0000   1st Qu.:0.0000   1st Qu.:0.0000   1st Qu.:0.0000   1st Qu.:0.0000  
 Median :0.0000   Median :0.0000   Median :0.0000   Median :0.0000   Median :0.0000  
 Mean   :0.1788   Mean   :0.4726   Mean   :0.0836   Mean   :0.1298   Mean   :0.1026  
 3rd Qu.:0.0000   3rd Qu.:1.0000   3rd Qu.:0.0000   3rd Qu.:0.0000   3rd Qu.:0.0000  
 Max.   :1.0000   Max.   :1.0000   Max.   :1.0000   Max.   :1.0000   Max.   :1.0000  
                                                                                     

Busqueda de duplicados

Se ve, por si acaso, si es que hay duplicados en el id de cliente

n_occur<-data.frame(table(db$custid))
n_occur[n_occur$Freq>1,]

No hay customers duplicados

Cambio de variables categóricas a factor

Se cambian todas las variables categóricas a factores:

db$region<-as.factor(db$region)
db$townsize<-as.factor(db$townsize)
db$gender<-as.factor(db$gender)
db$agecat<-as.factor(db$agecat)
db$edcat<-as.factor(db$edcat)
db$jobcat<-as.factor(db$jobcat)
db$union<-as.factor(db$union)
db$empcat<-as.factor(db$empcat)
db$retire<-as.factor(db$retire)
db$inccat<-as.factor(db$inccat)
db$default<-as.factor(db$default)
db$jobsat<-as.factor(db$jobsat)
db$marital<-as.factor(db$marital)
db$spousedcat<-as.factor(db$spousedcat)
db$homeown<-as.factor(db$homeown)
db$hometype<-as.factor(db$hometype)
db$addresscat<-as.factor(db$addresscat)
db$carown<-as.factor(db$carown)
db$cartype<-as.factor(db$cartype)
db$carcatvalue<-as.factor(db$carcatvalue)
db$carbought<-as.factor(db$carbought)
db$carbuy<-as.factor(db$carbuy)
db$carcatvalue<-as.factor(db$carcatvalue)
db$commute<-as.factor(db$commute)
db$commutecat<-as.factor(db$commutecat)
db$commutecar<-as.factor(db$commutecar)
db$commuterail<-as.factor(db$commuterail)
db$commutebus<-as.factor(db$commutebus)
db$commutemotorcycle<-as.factor(db$commutemotorcycle)
db$commutepublic<-as.factor(db$commutepublic)
db$commutebike<-as.factor(db$commutebike)
db$commutewalk<-as.factor(db$commutewalk)
db$commutenonmotor<-as.factor(db$commutenonmotor)
db$telecommute<-as.factor(db$telecommute)
db$reason<-as.factor(db$reason)
db$birthmonth<-as.factor(db$birthmonth)
db$polview<-as.factor(db$polview)
db$ebill<-as.factor(db$ebill)
db$polparty<-as.factor(db$polparty)
db$vote<-as.factor(db$vote)
db$card<-as.factor(db$card)
db$cardtype<-as.factor(db$cardtype)
db$cardbenefit<-as.factor(db$cardbenefit)
db$card2<-as.factor(db$card2)
db$card2type<-as.factor(db$card2type)
db$card2benefit<-as.factor(db$card2benefit)
db$active<-as.factor(db$active)
db$bfast<-as.factor(db$bfast)
db$churn<-as.factor(db$churn)
db$tollfree<-as.factor(db$tollfree)
db$equip<-as.factor(db$equip)
db$callcard<-as.factor(db$callcard)
db$wireless<-as.factor(db$wireless)
db$wiremon<-as.factor(db$wiremon)
db$multline<-as.factor(db$multline)
db$voice<-as.factor(db$voice)
db$pager<-as.factor(db$pager)
db$internet<-as.factor(db$internet)
db$callid<-as.factor(db$callid)
db$forward<-as.factor(db$forward)
db$confer<-as.factor(db$confer)
db$owntv<-as.factor(db$owntv)
db$ownvcr<-as.factor(db$ownvcr)
db$owndvd<-as.factor(db$owndvd)
db$owncd<-as.factor(db$owncd)
db$ownpda<-as.factor(db$ownpda)
db$ownpc<-as.factor(db$ownpc)
db$ownipod<-as.factor(db$ownipod)
db$owngame<-as.factor(db$owngame)
db$ownfax<-as.factor(db$ownfax)
db$news<-as.factor(db$news)
db$card2fee<-as.factor(db$card2fee)
db$response_01<-as.factor(db$response_01)
db$response_02<-as.factor(db$response_02)
db$response_03<-as.factor(db$response_03)
db$polcontrib<-as.factor(db$polcontrib)
db$cardfee<-as.factor(db$cardfee)
db$commutecarpool<-as.factor(db$commutecarpool)
db$callwait<-as.factor(db$callwait)
db$ebill<-as.factor(db$ebill)

Visualización de valores nulos

Ahora veamos qué columnas tienen una alta cantidad de valores nulos

plot_missing(db,missing_only = TRUE)

Se pasan a eliminar las columans con datos faltantes mayores al 20% (5 columnas)

db<-db[, colMeans(is.na(db)) <= .2]
dim(db)

[1] 5000  119

A continuación podemos ver las columnas que quedan con datos faltantes

plot_missing(db,missing_only = TRUE)

Ahora, se pasará a imputar estas columnas

db<-kNN(db)
db<-db%>%select(-ends_with("_imp")) #Para eliminar las columnas adicionales que se generan en la imputación

Se crea una columna condicional que indica las personas que tienen un auto de lujo (carcatvalue=3)

db$lujo_si<-ifelse(db$carcatvalue==3,1,0)

db$lujo_si<-as.factor(db$lujo_si)

Finalmente, guardamos una copia de seguridad de los datos tratados

write.csv(db,"db_clean.csv")

5. Creación del modelo

Separemos primero las columnas numéricas de las categóricas

db_num<-db %>% dplyr::select(where(is.numeric))
db_cat<-db %>% dplyr::select(where(is.factor))

Datos Numéricos

par(mfrow=c(2,2))

for (i in 1:ncol(db_num)){
  hist(db_num[[i]], main=paste("Plot ", colnames(db_num[i])), xlab = paste("Values Plot",i)) 
  box(lty = "solid")
}

NA
NA

Veamos la comparación de los boxplots por categoría de auto

ggplot(db,aes(x=carcatvalue,y=carvalue,color=carcatvalue))+

Podemos ver que los datos para la categoría de lujo están bastante más dispersos que en las otras categorías. Además, su mediana tiende a la baja.

Veamos también más detenidamente la cantidad de personas por valor del auto

std_values<-ddply(db,"carcatvalue",summarise,Min=min(carvalue),Max=max(carvalue),Mean=mean(carvalue),sd=sd(carvalue))


ggplot(db,aes(x=carvalue,color=carcatvalue))+geom_histogram(fill="white",alpha=0.5,position = "identity")+
  geom_vline(data = std_values,aes(xintercept=Mean,color=carcatvalue),linetype="dashed")+
  theme(axis.text.x = element_text(angle = 90,size = 10))

Podemos ver que a medida que crece el valor del auto, decrece la cantidad de personas que lo tienen.

Datos generales

Comparemos a las personas que tienen autos de lujo vs las que no, de acuerdo a las medias de sus valores numéricos

Son personas de una edad mayor a las personas que no tienen autos de lujo. Además, su educación es un poco mayor en promedio, pero no tanto como para decir que es un rasgo preponderante.

Con el género y estado civil sucede algo similar. Se puede ver que la mayoría son mujeres y que el mayor estado civil es soltero; no obstante, la diferencia es muy pequeña:

jcat<-db%>%group_by(lujo_si,jobcat)%>%summarise(count=n())

`summarise()` has grouped output by 'lujo_si'. You can override using the `.groups` argument.

cast(jcat,jobcat~lujo_si,value = "count")

Datos de empleo e ingresos

db%>%group_by(lujo_si)%>%summarise(mean(income),mean(employ),mean(creddebt),mean(cardspent))

Otro rasgo característico de estas personas es que tienen unos sueldos muy altos (más de 136 000 al año) y están en el mismo trabajo desde hace 16 años (employ). El débito en sus tarjetas de crédito también es mayor.

Veamos también lo correspondiente a las tarjetas

card_tb<-db%>%group_by(lujo_si,cardtype)%>%summarise(count=n())

`summarise()` has grouped output by 'lujo_si'. You can override using the `.groups` argument.

cast(card_tb,cardtype~lujo_si,value = "count")

Respecto a si realizan facturaciones electrónicas

elect<-db%>%group_by(lujo_si,ebill)%>%summarise(count=n())

`summarise()` has grouped output by 'lujo_si'. You can override using the `.groups` argument.

cast(elect,ebill~lujo_si,value = "count")

Datos de publicidad

db%>%group_by(lujo_si)%>%summarise(mean(hourstv))

nw<-db%>%group_by(lujo_si,news)%>%summarise(count=n())

`summarise()` has grouped output by 'lujo_si'. You can override using the `.groups` argument.

cast(nw,news~lujo_si,value = "count")

5. Planteamiento del modelo

Se plantea realizar un modelo de regresión logistica para predecir en base a las variables seleccionadas la posibilidad de que una persona posea un auto de lujo. Esto permitirá comprobar que las variables seleccionadas son las más adecuadas para el caso planteado

Ahora se pasará a tomar una muestra aleatoria del total

#Se dividen los datos para entrenamiento (75% de train y 25% de test)

set.seed(88)
split=sample.split(db$lujo_si,SplitRatio = 0.75)


#Crear el training y testing data sets

dt=subset(db,split==TRUE)  #Train
de=subset(db,split==FALSE) #Test

Modelo de regresión

RL_Eur<-glm(lujo_si~income+tollfree+cardtype+forward+ebill+cardspent+spoused+forward+jobcat+pets_reptiles,data=dt,family = binomial())

glm.fit: fitted probabilities numerically 0 or 1 occurred

summary(RL_Eur)

Call:
glm(formula = lujo_si ~ income + tollfree + cardtype + forward + 
    ebill + cardspent + spoused + forward + jobcat + pets_reptiles, 
    family = binomial(), data = dt)

Deviance Residuals: 
    Min       1Q   Median       3Q      Max  
-5.7045  -0.2479  -0.1289  -0.0767   2.3865  

Coefficients:
                Estimate Std. Error z value Pr(>|z|)    
(Intercept)   -6.5825378  0.3171776 -20.753  < 2e-16 ***
income         0.0724357  0.0030602  23.670  < 2e-16 ***
tollfree1     -0.6437073  0.1912504  -3.366 0.000763 ***
cardtype2     -0.4858296  0.2064148  -2.354 0.018590 *  
cardtype3     -0.1285183  0.1970437  -0.652 0.514251    
cardtype4     -0.5206139  0.2084453  -2.498 0.012504 *  
forward1       0.4726924  0.1908615   2.477 0.013263 *  
ebill1        -0.4204455  0.1577652  -2.665 0.007699 ** 
cardspent      0.0005434  0.0002685   2.024 0.042966 *  
spoused        0.0173578  0.0091474   1.898 0.057755 .  
jobcat2       -0.0814042  0.2051047  -0.397 0.691448    
jobcat3        0.1716952  0.2328781   0.737 0.460955    
jobcat4        0.0304426  0.3767898   0.081 0.935605    
jobcat5        0.1700695  0.2705825   0.629 0.529656    
jobcat6        0.4527598  0.2212254   2.047 0.040697 *  
pets_reptiles -0.4833516  0.2793629  -1.730 0.083596 .  
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 3388.8  on 3749  degrees of freedom
Residual deviance: 1298.9  on 3734  degrees of freedom
AIC: 1330.9

Number of Fisher Scoring iterations: 7

predictions<-predict(RL_Eur,de)

6. Comprobación de resultados

sigmoide=function(x){1/(1+exp(-x))}

plot(predictions,sigmoide(predictions),col="blue")

mod_pred<-ifelse(predictions>0.5,1,0)

mod_pred<-factor(mod_pred)

head(mod_pred)

 5  6  9 12 18 24 
 0  1  0  0  1  0 
Levels: 0 1

de$lujo_si<-factor(de$lujo_si)

head(de$lujo_si)

[1] 0 0 0 0 1 0
Levels: 0 1

confusionMatrix(mod_pred,de$lujo_si)

Confusion Matrix and Statistics

          Reference
Prediction    0    1
         0 1023   64
         1   18  145
                                          
               Accuracy : 0.9344          
                 95% CI : (0.9192, 0.9475)
    No Information Rate : 0.8328          
    P-Value [Acc > NIR] : < 2.2e-16       
                                          
                  Kappa : 0.7417          
                                          
 Mcnemar's Test P-Value : 6.715e-07       
                                          
            Sensitivity : 0.9827          
            Specificity : 0.6938          
         Pos Pred Value : 0.9411          
         Neg Pred Value : 0.8896          
             Prevalence : 0.8328          
         Detection Rate : 0.8184          
   Detection Prevalence : 0.8696          
      Balanced Accuracy : 0.8382          
                                          
       'Positive' Class : 0               
                                          

7. Comparación de precios de autos con el dataset

Se hizo un scrape de precios de algunas marcas de lujo

car_prices<-readxl::read_excel("Scrapes.xlsx")
head(car_prices)

dim(car_prices)

[1] 46  3

ggplot(car_prices,aes(x=Marca,y=Price,color=Marca))+
  geom_boxplot(outlier.colour = "black",notch = FALSE)+
  scale_fill_viridis(discrete = TRUE, alpha=0.6) +
  geom_jitter(color="gray", size=0.4, alpha=0.15)

db%>% filter(lujo_si==1)%>%summarise(mean(carvalue),median(carvalue),min(carvalue),max(carvalue))

NA
NA