-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathExplorando_Caso_BancoPortuguese.Rmd
394 lines (281 loc) · 14.6 KB
/
Explorando_Caso_BancoPortuguese.Rmd
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
---
title: "Explorando el Caso Banco Portugues - Bank Marketing"
author: "Nestor Montano | SEE"
date: "22 de mayo de 2020"
output: html_document
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```
# Caso Banco Portugues - Bank Marketing
Se ha producido una disminución de ingresos para el Banco Portugués y les gustaría saber qué medidas tomar. Después de la investigación se descubre que la causa principal es que sus clientes no están depositando con tanta frecuencia como antes. Además, se conoce que:
Los depósitos a plazo permiten a los bancos retener un depósito por un período de tiempo específico, de tal manera que el banco invierta en productos financieros de mayor ganancia y que además,
Hay más posibilidad de persuadir a un clientes con depósito a plazo para que compre otro productos como fondos o seguros y así aumentar aún más el ingreso del banco. El Banco Portugués decide entonces hacer una campaña para promover depósitos a plazo, para ello su departamento de inteligencia debe **identificar a los clientes existentes que tienen mayores posibilidades de suscribirse a un depósito a plazo** y de esta manera enfocar el esfuerzo de marketing en dichos clientes
Fuente: [Moro et al., 2014] S. Moro, P. Cortez and P. Rita. A Data-Driven Approach to Predict the Success of Bank Telemarketing. Decision Support Systems, Elsevier, 62:22-31, June 2014
**Variables socio demográficas**
* y: ¿el cliente ha suscrito un depósito a plazo? ('yes','no')
* age: Edad,
* job: trabajo ('admin.', 'blue-collar', 'entrepreneur', 'housemaid', 'management', 'retired', 'self-employed', 'services', 'student', 'technician', 'unemployed', 'unknown'),
* marital: estado civil ('divorced','married','single','unknown'; note: 'divorced' means divorced or widowed),
* education: nivel educativo: ('basic.4y', 'basic.6y', 'basic.9y', 'high.school', 'illiterate', 'professional.course', 'university.degree', 'unknown')
* default: ¿ha caído en mora? ('no','yes','unknown')
* housing: ¿tiene préstamo para vivienda? ('no','yes','unknown')
* loan: ¿tiene prestamo personal?
**Variables de último contacto de la presente campaña**
* contact: tipo de comunicación de contacto ('cellular', 'telephone')
* month, day_of_week
* duration: duración del último contacto, en segundos **Leer nota**
* campaign: número de contactos realizados durante esta campaña y para este cliente
* pdays: número de días que pasaron después de que el cliente fue contactado por última vez desde una campaña anterior (numérico; 999 significa que el cliente no fue contactado previamente)
* previous: número de contactos realizados antes de esta campaña y para este cliente
* poutcome: resultado de la campaña de marketing anterior ('failure','nonexistent','success')
* emp.var.rate: tasa de variación del empleo - indicador trimestral
* cons.price.idx: índice de precios al consumidor - indicador mensual
* cons.conf.idx: índice de confianza del consumidor - indicador mensual
* euribor3m: euribor tasa de 3 meses - indicador diario
* nr.employed: número de empleados - indicador trimestral
## Preeliminares
### Paquetes
```{r message=FALSE, warning=FALSE}
library(dplyr) # manipulacion datos
library(tidyr) # manipulacion datos 2
library(magrittr) # Pipe %>%
library(readr) # Importar csv
library(ggplot2) # Gráficos
library(lubridate) # Manipular fechas
library(cowplot) # Grid de Gráficos
library(scales) # Escalas en los gráficos
library(purrr) # mapear funciones a las columnas
```
### Importacion de la data
```{r}
# read_delim : Leer el archivo csv (prueben con read_csv también)
data_banco <- read_delim("Data/bank-additional-full.csv", delim= ";")
head(data_banco)
```
### Entender la data
```{r}
# str(data_publicidad) # Opcion de R-base
# glimpse permite ver tipos de variables
glimpse(data_banco)
```
### Variables a transformar
Se debe transformar la variable **y** a factor, primero vemos los valores que tiene la variable (aunque presuponemos que sea "yes" y "no")
```{r}
# %$% : Pipe para enviar una columna al otro comando
# Unique : permite obtener valores únicos
data_banco %$% unique(y) # Unique de la columna "y"
```
Ahora los labels serán "si" y "no" respectivamente, es un **factor no ordenado**
```{r}
# %<>% : Pipe que permite calcular todo y guardarlo en la variable de la izquierda.
# Convertir a factor
data_banco %<>%
mutate( y = factor(y,
levels= c("yes","no"),
labels= c("si", "no")) )
# Verificar
# str : ver la estructura de la variable
data_banco %$% str(y)
```
Vemos que se debe transformar la variable **education** a factor, esta vez es un **factor ordenado**, primero exploremos los datos que tiene.
```{r}
# %$% : Pipe para enviar una columna al otro comando
# Unique : permite obtener valores únicos
data_banco %$% unique(education) # Unique de la columna "y"
```
Se convierte en **factor ordenado** y además se lo pone en español.
```{r}
# Convertir a factor
data_banco %<>%
mutate( education = factor( education,
levels= c("illiterate", "basic.4y", "basic.6y",
"basic.9y", "high.school", "professional.course",
"university.degree", "unknown" ),
labels= c("No Educ.", "4A Bas.", "6A Bas.",
"9A Bas.", "Bachill.", "Tecnico",
"Univer.", "Descon.") ,
ordered = TRUE) )
# Verificar
# str : ver la estructura de la variable
data_banco %$% str(education)
```
El mismo trabajo se debe hacer con las variables **month** y **day_of_week**
```{r}
# %$% : Pipe para enviar una columna al otro comando
# Unique : permite obtener valores únicos
data_banco %$% unique(month)
data_banco %$% unique(day_of_week)
```
Se convierte en **factor ordenado** y además se lo pone en español.
```{r}
# Convertir a factor
data_banco %<>%
mutate( month = factor( month,
levels= c("mar", "apr", "may", "jun", "jul",
"aug", "sep", "oct", "nov", "dec" ),
labels= c("Mar", "Abr", "May", "Jun", "Jul",
"Ago", "Sep", "Oct", "Nov", "Dec" ),
ordered = TRUE),
day_of_week = factor( day_of_week,
levels= c("mon", "tue", "wed", "thu", "fri" ),
labels= c("Lun", "Mar", "Mie", "Jue", "Vie" ),
ordered = TRUE),
)
# Verificar
# str : ver la estructura de la variable
data_banco %$% str(month)
data_banco %$% str(day_of_week)
```
## EDA Análisis Exploratorio de Datos
Una de las primeras cosas que se debe realizar es ver cuántos datos únicos tiene cada variable, esto debido a que una vairable que tenga siempre el mismo valor no aporta en el estudio.
```{r}
data_banco %>%
map_df(.f = function(x) length(unique(x))) %>% # Contar valores únicos por variable
gather(value = "NumValoresUnicos", key = "Variable") %>% # pasar de horizontal a vertical
arrange(NumValoresUnicos)
```
Otra cosa a revisar son la cantidad de datos en cada nivel de las variables categóricas, esto para poder agrupar niveles en un nivel genérico tipo "otros"; probemos con la variable **job**
```{r}
data_banco %>%
group_by(job) %>%
summarise( Frecuencia= n()) %>%
arrange(-Frecuencia)
```
La vairable trabajo no parece tener niveles que puedan ser agrupados. Podríamos hacer una **exploración rápida** con:
```{r}
summary(data_banco)
```
Recordemos que el objetivo al final es **identificar a los clientes existentes que tienen mayores posibilidades de suscribirse a un depósito a plazo**, por lo que vamos a empezar a hacernos preguntas que nos permitan entender el problema.
**¿Incíde el índice de precios al consumidor?**
Para empezar se va a comparar el índice de precios al consumidor versus si el cliente ha suscrito un depósito a plazo, para ello vamos a realizar una tabla que resuma algunas estadísticas básicas poren función de `y`.
```{r}
data_banco %>%
group_by(y) %>%
summarise(
Freq= n(),
Min= min(cons.price.idx, na.rm = T),
Q25= quantile(cons.price.idx, probs = 0.25),
Media= mean(cons.price.idx, na.rm = T),
Media_Acotada= median(cons.price.idx, trim = 0.05, na.rm = T),
Mediana= mean(cons.price.idx),
Q75= quantile(cons.price.idx, probs = 0.75),
Max= max(cons.price.idx, na.rm = T)
)
```
Ahora se explorará gráficamente con un boxplot.
```{r echo=TRUE, fig.align='center'}
ggplot(data_banco, aes(y, cons.price.idx)) +
geom_boxplot(aes(fill = y)) +
labs(title = "Boxplot Indice consumidor vs adquiere préstamo",
x= "Adquiere prestamo")
```
La distribución del índice cuando no se tiene el préstamo tiene una mediana mayor que cuando sí, sin embargo los cuartiles no muestran mayor diferencia.
Podríamos ahora analizar todos los índices a la vez a través de un gráfico compuesto, para esto haremos varios gráficos que guardaremos en objetos de R y con ellos construiremos un gráfico compuesto usando el comando plot_grid
```{r echo=TRUE, fig.align='center'}
plot_consprice <- ggplot(data_banco, aes(y, cons.price.idx)) +
geom_boxplot(aes(fill = y)) +
labs(title = "Boxplot Indice consumidor \n vs adquiere dep.plazo",
x= "Adquiere prestamo")
plot_consconf <- ggplot(data_banco, aes(y, cons.conf.idx)) +
geom_boxplot(aes(fill = y)) +
labs(title = "Boxplot Confianza consumidor \n vs adquiere dep.plazo",
x= "Adquiere prestamo")
plot_euribor3m <- ggplot(data_banco, aes(y, euribor3m)) +
geom_boxplot(aes(fill = y)) +
labs(title = "Boxplot tasa euribor \n vs adquiere dep.plazo",
x= "Adquiere prestamo")
plot_employed <- ggplot(data_banco, aes(y, nr.employed)) +
geom_boxplot(aes(fill = y)) +
labs(title = "Boxplot Numero empleados \n vs adquiere dep.plazo",
x= "Adquiere prestamo")
```
```{r echo=TRUE, fig.align='center'}
# Grafico compuesto
plot_grid(plot_consprice, plot_consconf, plot_euribor3m, plot_employed, nrow = 2, ncol= 2)
```
Para todos los índices se muestra un comportamiento parecido al anterior, es decir, la distribución del índice cuando no se tiene el préstamo tiene una mediana mayor que cuando sí (excepto en índice de confianza), sin embargo los cuartiles no muestran mayor diferencia, en la variable que sí se ven diferencias es en el **número de empleados** donde la mediana para los que no adquieron el depósito a plazo es casi igual al cuartil 3 de los que sí lo cogen.
**¿La edad está relacionada con la aceptación o no del depósito a plazo?**
Así como en el caso anterior, empezaremos con una tabla de estadísticas descriptivas.
```{r}
data_banco %>%
group_by(y) %>%
summarise(
Q25= quantile(age, probs = 0.25),
Media= mean(age),
Media_Acotada= median(age, trim = 0.05),
Mediana= mean(age),
Q75= quantile(age, probs = 0.75)
)
```
Y ahora haremos un histograma, escogeremos 10 como el ancho del intervalo.
```{r}
ggplot(data_banco, aes(age)) +
geom_histogram(aes(fill = y), binwidth = 10) +
labs( x= 'Edad', y= 'Porcentaje', title= 'Histograma de la cantidad de personas que \n aceptan el deposito según la edad', fill= 'Suscribe \n deposito')
```
Pero el gráfico propuesto no permite ver bien si la edad tiene relación con la aceptación, veamos el gráfico en forma de proporción:
```{r}
ggplot(data_banco, aes(age)) +
geom_histogram(aes(fill = y), binwidth = 10, position = 'fill') +
labs( x= 'Edad', y= 'Porcentaje', title= 'Histograma de la proporcion aceptar deposito vs edad', fill= 'Suscribe \n deposito')
```
**¿Afecta el trabajo a la aceptación de un depósito?**
Empezaremos con una tabla de estadísticas descriptivas, en este caso estamos hablando de dos variables cualitativas, por lo que empezaremos con una tabla de contingencia.
```{r}
data_banco %$%
table(job, y) %>%
prop.table() %>%
round(digits = 4) * 100
```
Pero veamos si los porcentajes de los que toman el depósito a plazo o no, varían según el trabajo
```{r}
data_banco %$%
table(job, y) %>%
prop.table(margin = 1) %>%
round(digits = 4) * 100
```
Y ahora un gráfico de barras:
```{r}
ggplot(data_banco, aes(job)) +
geom_bar(aes(fill = y), position = 'fill') +
coord_flip() +
labs( x= 'Trabajo', y= 'Porcentaje', title= 'Proporcion aceptar deposito vs trabajo', fill= 'Suscribe \n deposito') +
scale_y_continuous(labels = percent)
```
Interesante ver que los estudiantes y los retirados son los que tienen más propensión a aceptar el depósito a plazo.
**Exploremos los días desde el último contacto**
Haremos un histograma de la variable días desde el último contacto:
```{r}
ggplot(data_banco, aes(pdays)) +
geom_histogram( binwidth = 10) +
labs( x= 'Dias desde ultimo contacto', y= 'Porcentaje', title= 'Histograma de dias desde ultimo contacto')
```
Como el "999" significaba "no contactado", se repite el histograma sin este valor
```{r}
ggplot(data_banco %>% filter(pdays!=999), aes(pdays)) +
geom_histogram( binwidth = 2) +
labs( x= 'Dias desde ultimo contacto', y= 'Porcentaje', title= 'Histograma de dias desde ultimo contacto')
```
**pDays** como variable en un modelamiento no nos será útil, vamos a crear una nueva variable que indique si fue contactado o no.
```{r}
data_banco %<>%
mutate(pdays_binaria = ifelse(pdays==999, "No", "Si"))
data_banco %$%
table(pdays_binaria)
```
**A modo de ejemplo, exploremos la cantidad de llamadas y la tasa eurobor3m vs poseer casa y aceptar depósito**
```{r}
ggplot(data_banco, aes(euribor3m)) +
geom_histogram(aes(fill = y), binwidth = 1) + facet_grid(housing~. ) +
labs( x= 'Tasa Eurobor', y= 'Cantidad de llamadas', title= 'Histograma de cantidad de llamadas \n según posesión de casa', fill= 'Suscribe \n deposito')
```
Ahora en porcentaje
```{r}
ggplot(data_banco, aes(euribor3m)) +
geom_histogram(aes(fill = y), binwidth = 1, position = 'fill') + facet_grid(housing~. ) +
labs( x= 'Tasa Eurobor', y= 'Porcentaje', title= 'Histograma de la proporcion aceptar deposito vs Tasa Eurobor', fill= 'Suscribe \n deposito')
```
## Tú turno
**Ejercicio 1: Explorar el estado civil versus el aceptar o no un depósito**
**Ejercicio 2: Asumamos que nos interesa analizar la duración de la llamada, explore la variable sola y en función de la edad**