setwd("C:/Users/jvill/Documents/ESCUELA/Machine/tarea 4")
base<-read.csv("base_unam.csv",header = TRUE,stringsAsFactors = FALSE)
base<-base[rowSums(is.na(base)) == 0,]
str(base)
## 'data.frame': 1440 obs. of 16 variables:
## $ cuenta : int 1 2 4 5 6 7 8 9 10 11 ...
## $ incumplido : int 1 0 1 0 0 0 0 0 0 0 ...
## $ limite : int 26500 86500 11000 14000 19000 39000 31500 12500 10100 48200 ...
## $ saldo : int 11819 86679 4139 9257 17518 1138 11264 11681 11091 7401 ...
## $ exigible : int 250 3640 2235 250 706 250 444 514 250 610 ...
## $ tasa : num 45.4 45.4 45.4 44 45.4 44 45.4 45.4 45.4 45.4 ...
## $ ACT : int 0 0 3 0 0 0 0 0 0 0 ...
## $ HIST : int 0 3 3 0 0 0 0 2 1 0 ...
## $ ATDC : num 72.1 71.1 70.1 67.1 66.1 ...
## $ PJPAGO : num 0.22 0.0692 0 0.3252 0.1284 ...
## $ PULINEA : num 0.446 1.002 0.376 0.661 0.922 ...
## $ ANTBANCO : num 81 70 69 95 65 126 63 62 62 61 ...
## $ BKATR : int 13 13 0 13 13 13 9 13 0 13 ...
## $ SEGMENTO_RIESGO : chr "Medio" "Bajo" "Medio" "Medio" ...
## $ monto_pagar_R_banco: int 2855 3450 250 580 730 597 480 1648 2320 0 ...
## $ monto_pagar_R : int 2855 3450 45648 3215 2263 1896 1361 3323 12665 12072 ...
library(RSQLite)
## Warning: package 'RSQLite' was built under R version 3.4.3
library(ggplot2)
## Warning: package 'ggplot2' was built under R version 3.4.4
library(ROCR)
## Warning: package 'ROCR' was built under R version 3.4.3
## Loading required package: gplots
## Warning: package 'gplots' was built under R version 3.4.3
##
## Attaching package: 'gplots'
## The following object is masked from 'package:stats':
##
## lowess
library(boot)
# Mostraremos la descripción de las varables que trabajaremos:
# incumplido: vale 1 si el crédito fue uncumplido, y cero en caso contrario.
# limite: máxima cantidad de la que puede disponer el acreditado.
# saldo: cantidad que ha dispuesto el acreditado.
# exigible:monto mínimo que el acreditado debe cubrir para cumplir con su obligación contractual.
# HIST: núumero de impagos observados en los últimos 6 meses.
# ATDC: meses que el acreditado tiene con tarjeta de crédito.
# PJPAGO: porcentaje que representa el pago realizado respecto al saldo a pagar.
# ANTBANCO: antiguedad del acreditado con la institución.
# BKATR: meses transcurridos desde el últimoatraso mayor a un día del acreditado en sus
# compromisos crediticios registrados en la totalidad de las sociedades de información
# crediticia con instituciones en los últimos trece meses.
# monto pagar R: monto correspondiente a la suma de todas las obligaciones que el
# acreditado tiene con todos sus acredores.
# ACT: núumero de impagos en periodos consecutivos inmediatos anteriores a la fecha reportada.
# Obtendremos las consultas de la variable "incumplido" con el resto en las que tenga
# sentido, agruparemos de dos en dos y haremos el conteo de las condiciones de la consulta
######################## EJERCICIO 2 ###############################################
# Para empezar, realizo un análisis de colinealidad mediante la matriz
# de correlaciones, y VIF.
#Matriz de correlaciones.
Rho<-as.matrix(base[,c(3,4,5,6,7,8,9,10,11,12,13,15,16)])
Matriz<-cor(Rho)
Matriz
## limite saldo exigible tasa
## limite 1.00000000 0.65857133 0.25454109 -0.4243573427
## saldo 0.65857133 1.00000000 0.47408190 -0.2900704255
## exigible 0.25454109 0.47408190 1.00000000 -0.0644901861
## tasa -0.42435734 -0.29007043 -0.06449019 1.0000000000
## ACT -0.09723007 0.01201097 0.09095665 0.0954249994
## HIST -0.08115960 0.03545240 0.05385523 0.1463793728
## ATDC 0.30763622 0.14628255 0.05226569 -0.1191483104
## PJPAGO 0.07947756 -0.21940612 -0.04726486 -0.1021641818
## PULINEA -0.23729914 0.35493045 0.15194309 0.1305423325
## ANTBANCO 0.38521419 0.20932607 0.08019304 -0.1599626669
## BKATR 0.06599925 -0.05583892 -0.09570180 -0.1323241606
## monto_pagar_R_banco 0.18388733 0.37105544 0.68002420 -0.0407601165
## monto_pagar_R 0.13363098 0.31551221 0.72491987 -0.0001609481
## ACT HIST ATDC PJPAGO
## limite -0.09723007 -0.08115960 0.30763622 0.07947756
## saldo 0.01201097 0.03545240 0.14628255 -0.21940612
## exigible 0.09095665 0.05385523 0.05226569 -0.04726486
## tasa 0.09542500 0.14637937 -0.11914831 -0.10216418
## ACT 1.00000000 0.60695844 -0.06111835 -0.17613676
## HIST 0.60695844 1.00000000 -0.03186817 -0.16274572
## ATDC -0.06111835 -0.03186817 1.00000000 0.06295373
## PJPAGO -0.17613676 -0.16274572 0.06295373 1.00000000
## PULINEA 0.17862958 0.20227201 -0.14044808 -0.49476713
## ANTBANCO -0.05221226 -0.05584552 0.68758400 0.04247264
## BKATR -0.15795589 -0.24909827 0.04798181 0.10381894
## monto_pagar_R_banco 0.11010019 0.07261329 0.02080571 -0.05773460
## monto_pagar_R 0.15040415 0.10353365 0.05486577 -0.05757469
## PULINEA ANTBANCO BKATR monto_pagar_R_banco
## limite -0.2372991 0.38521419 0.06599925 0.18388733
## saldo 0.3549305 0.20932607 -0.05583892 0.37105544
## exigible 0.1519431 0.08019304 -0.09570180 0.68002420
## tasa 0.1305423 -0.15996267 -0.13232416 -0.04076012
## ACT 0.1786296 -0.05221226 -0.15795589 0.11010019
## HIST 0.2022720 -0.05584552 -0.24909827 0.07261329
## ATDC -0.1404481 0.68758400 0.04798181 0.02080571
## PJPAGO -0.4947671 0.04247264 0.10381894 -0.05773460
## PULINEA 1.0000000 -0.17495324 -0.23961528 0.13735698
## ANTBANCO -0.1749532 1.00000000 0.05879586 0.11702375
## BKATR -0.2396153 0.05879586 1.00000000 -0.14904527
## monto_pagar_R_banco 0.1373570 0.11702375 -0.14904527 1.00000000
## monto_pagar_R 0.1425360 0.11756572 -0.20293854 0.78579274
## monto_pagar_R
## limite 0.1336309828
## saldo 0.3155122063
## exigible 0.7249198727
## tasa -0.0001609481
## ACT 0.1504041482
## HIST 0.1035336453
## ATDC 0.0548657678
## PJPAGO -0.0575746899
## PULINEA 0.1425360136
## ANTBANCO 0.1175657229
## BKATR -0.2029385412
## monto_pagar_R_banco 0.7857927385
## monto_pagar_R 1.0000000000
#Aquí podemos ver que las variables casi no están correlacionadas.
#Todas las correlaciones son menores a 0.8.
#Las correlaciones más grandes están alrededor de 0.6, y se dan entre:
# límite y saldo,
# hist y act,
# antbanco y atdc,
# monto_pagar_R_banco y exigible.
#Y aún hay 2 correlaciones más altas de 0.7 entre:
# monto_pagar_R y exigible
# monto_pagar_R y monto_pagar_R_banco (la más alta)
#Factores de inflación de varianza
M1<-lm(base$ACT~base$BKATR+base$HIST+base$monto_pagar_R+base$saldo+base$limite)
M2<-lm(base$BKATR~base$ACT+base$HIST+base$monto_pagar_R+base$saldo+base$limite)
M3<-lm(base$HIST~base$ACT+base$BKATR+base$monto_pagar_R+base$saldo+base$limite)
M4<-lm(base$monto_pagar_R~base$BKATR+base$HIST+base$ACT+base$saldo+base$limite)
M5<-lm(base$saldo~base$BKATR+base$HIST+base$monto_pagar_R+base$ACT+base$limite)
M6<-lm(base$limite~base$BKATR+base$HIST+base$monto_pagar_R+base$ACT+base$saldo)
r1<-summary(M1)$r.squared
r2<-summary(M2)$r.squared
r3<-summary(M3)$r.squared
r4<-summary(M4)$r.squared
r5<-summary(M5)$r.squared
r6<-summary(M6)$r.squared
v1<-1/(1-r1)
v2<-1/(1-r2)
v3<-1/(1-r3)
v4<-1/(1-r4)
v5<-1/(1-r5)
v6<-1/(1-r6)
#Todos los factores vif son aceptables, ya que, están cerca del 1,
#por los tanto, los modelos de M1 a M6 casi no presentan colinealidad.
######################## EJERCICIO 3 ###############################################
#Creamos la conección
db <- dbConnect(SQLite(),"Base")
dbSendQuery(db,"DROP TABLE Mibase")
## <SQLiteResult>
## SQL DROP TABLE Mibase
## ROWS Fetched: 0 [complete]
## Changed: 0
#Leemos la tabla con la que trabajaremos
dbWriteTable(conn = db, name = "Mibase",
value = base, row.names = FALSE)
## Warning: Closing open result set, pending rows
#Vemos nuestras variables
dbListFields(db, "Mibase")
## [1] "cuenta" "incumplido" "limite"
## [4] "saldo" "exigible" "tasa"
## [7] "ACT" "HIST" "ATDC"
## [10] "PJPAGO" "PULINEA" "ANTBANCO"
## [13] "BKATR" "SEGMENTO_RIESGO" "monto_pagar_R_banco"
## [16] "monto_pagar_R"
# Agrupamiento de variables,
# Primero trabajaremos con las variables categóricas
#(para obtener el woe y la iv de las variables respecto las respuesta):
TACT<-dbGetQuery(conn = db,"select ACT,incumplido,count(incumplido) as conteo
from (select
case when ACT in (2,3) then 3 else ACT end as ACT,
incumplido from Mibase)group by ACT,incumplido;")
THIST<-dbGetQuery(conn = db,"select HIST,incumplido,count(incumplido) as conteo
from (select
case when HIST in (3,4,5) then 3 else HIST end as HIST,
incumplido from Mibase)group by HIST,incumplido;")
TBKATR<-dbGetQuery(conn = db,"select BKATR,incumplido,count(incumplido) as conteo
from (select
case when BKATR in (0,1,2) then 1 else (case when BKATR=13 then
3 else 2 end)end as BKATR,
incumplido from Mibase)group by BKATR,incumplido;")
dbDisconnect(db)
#Construimos la tabla para calcular woe e iv para la variable ACT.
TACT
## ACT incumplido conteo
## 1 0 0 1183
## 2 0 1 108
## 3 1 0 72
## 4 1 1 25
## 5 3 0 14
## 6 3 1 38
Mact<-as.data.frame(matrix(TACT$conteo,nrow=3,ncol=2,byrow = TRUE))
colnames(Mact)<-c("Buenos","Malos")
rownames(Mact)<-c("0","1","2:3")
Mact
## Buenos Malos
## 0 1183 108
## 1 72 25
## 2:3 14 38
Mact$TodDist<-(Mact$Buenos+Mact$Malos)/sum(Mact)
Mact$BuenosDistr<-Mact$Buenos/sum(Mact$Buenos)
Mact$MalosDistr<-Mact$Malos/sum(Mact$Malos)
Mact$Tincmp<-Mact$Malos/(Mact$Buenos+Mact$Malos)
Mact$WOE<-log(Mact$BuenosDistr/Mact$MalosDistr)
IVACT<-sum((Mact$BuenosDistr-Mact$MalosDistr)*Mact$WOE)
#Cálculo del IV
IVACT #0.8359099 Act tiene fuerte poder predictivo
## [1] 0.8359099
#IV< .02 no predictivo
#IV .02-.1 bajo poder predictivo
#IV .1-.3 medio poder predictivo
#IV>.3 fuerte poder predictivo
#Construimos la tabla para la variable HIST
THIST
## HIST incumplido conteo
## 1 0 0 919
## 2 0 1 66
## 3 1 0 244
## 4 1 1 41
## 5 2 0 75
## 6 2 1 29
## 7 3 0 31
## 8 3 1 35
Mhist<-as.data.frame(matrix(THIST$conteo,nrow=4,ncol=2,byrow = TRUE))
colnames(Mhist)<-c("Buenos","Malos")
rownames(Mhist)<-c("0","1","2","3:5")
Mhist
## Buenos Malos
## 0 919 66
## 1 244 41
## 2 75 29
## 3:5 31 35
Mhist$TodDist<-(Mhist$Buenos+Mhist$Malos)/sum(Mhist)
Mhist$BuenosDistr<-Mhist$Buenos/sum(Mhist$Buenos)
Mhist$MalosDistr<-Mhist$Malos/sum(Mhist$Malos)
Mhist$Tincmp<-Mhist$Malos/(Mhist$Buenos+Mhist$Malos)
Mhist$WOE<-log(Mhist$BuenosDistr/Mhist$MalosDistr)
IVHIST<-sum((Mhist$BuenosDistr-Mhist$MalosDistr)*Mhist$WOE)
#Cálculo del IV # 0.722955 es buena variable explicativa
IVHIST
## [1] 0.722955
#Construimos la tabla para la variable BKATR
TBKATR
## BKATR incumplido conteo
## 1 1 0 240
## 2 1 1 77
## 3 2 0 152
## 4 2 1 23
## 5 3 0 877
## 6 3 1 71
Mbkatr<-as.data.frame(matrix(TBKATR$conteo,nrow=3,ncol=2,byrow = TRUE))
colnames(Mbkatr)<-c("Buenos","Malos")
rownames(Mbkatr)<-c("0-2","3-12","13")
Mbkatr
## Buenos Malos
## 0-2 240 77
## 3-12 152 23
## 13 877 71
Mbkatr$TodDist<-(Mbkatr$Buenos+Mbkatr$Malos)/sum(Mbkatr)
Mbkatr$BuenosDistr<-Mbkatr$Buenos/sum(Mbkatr$Buenos)
Mbkatr$MalosDistr<-Mbkatr$Malos/sum(Mbkatr$Malos)
Mbkatr$Tincmp<-Mbkatr$Malos/(Mbkatr$Buenos+Mbkatr$Malos)
Mbkatr$WOE<-log(Mbkatr$BuenosDistr/Mbkatr$MalosDistr)
IVBKATR<-sum((Mbkatr$BuenosDistr-Mbkatr$MalosDistr)*Mbkatr$WOE)
#Cálculo del IV
IVBKATR # 0.3688342 bkatr tiene un poder predictivo medio
## [1] 0.3688342
# Función para graficar las distribuciones de buenos y malos (KS)
grfs<-function(x){
plot(tapply(base[,x],base$incumplido,quantile,c(.1,.2,.3,.4,.5,.6,.7,.8,.9,1))$`0`,
c(.1,.2,.3,.4,.5,.6,.7,.8,.9,1),type="l",xlab="",ylab="",col="blue")
lines(tapply(base[,x],base$incumplido,quantile,c(.1,.2,.3,.4,.5,.6,.7,.8,.9,1))$`1`,
c(.1,.2,.3,.4,.5,.6,.7,.8,.9,1),col="red")
}
# Gráficas de IV y WoE de la variable HIST
barplot(Mhist$WOE,space=0,main="WOE HIST",ylab="WOE")
lines(Mhist$WOE)
points(Mhist$WOE)
# El WOE esta decreciendo, así que la variable HIST es candidata a ser elegida en la regresión
# Gráfica KS de la variable HIST
grfs("HIST")
# Observemos que las distribuciones entre buenos y malos si se distinguen bien, por lo que
# si consideraríamos esta variable.
# Gráficas de IV y WoE de la variable ACT
barplot(Mact$WOE,space=0,main="WOE ACT",ylab="WOE")
lines(Mact$WOE)
points(Mact$WOE)
# El WOE esta decreciendo, así que la variable ACT es candidata a ser elegida en la regresión
# Gráfica KS de la variable ACT
# La gráfica nos muestra que si hay una buena distinción para separar los datos buenos y malos
grfs("ACT")
# Gráficas de IV y WoE de la variable BKATR
barplot(Mbkatr$WOE,space=0,main="WOE BKATR",ylab="WOE")
lines(Mbkatr$WOE)
points(Mbkatr$WOE)
# El WOE esta de forma creciente, así que la variable bkatr es candidata a ser elegida en la regresión
# Gráfica KS de la variable BKATR
grfs("BKATR")
# Obsevamos que la distribucion entre buenos y malos se separa muy bien en dicha variable.
# Ahora analizaremos las variables continuas, para ello haremos asignación por cuantiles
ptsc1<-quantile(base$limite0,c(.2,.5,.7))
ptsc2<-quantile(base$saldo0,c(.25,.5,.75))
ptsc3<-quantile(base$exigible0,c(.25,.5,.75))
ptsc4<-quantile(base$monto_pagar_R,c(.25,.5,.75))
ptsc5<-quantile(base$ANTBANCO,c(.25,.5,.75))
ptsc6<-quantile(base$ATDC,c(.25,.5,.75))
ptsc7<-quantile(base$PJPAGO,c(.3,.55,.75))
# Construimos la tabla para la variable PJPAGO
db <- dbConnect(SQLite(),"Base")
TPJPAGO<-dbGetQuery(conn = db,"select PJPAGO,incumplido,count(incumplido) as conteo
from (select
case when PJPAGO<=.083 then 1 else (case when PJPAGO<=.1887 then
2 else (case when PJPAGO<=.41 then 3 else 4 end)end)end as PJPAGO,
incumplido from Mibase)group by PJPAGO,incumplido;")
TPJPAGO
## PJPAGO incumplido conteo
## 1 1 0 337
## 2 1 1 96
## 3 2 0 326
## 4 2 1 33
## 5 3 0 264
## 6 3 1 24
## 7 4 0 342
## 8 4 1 18
MPJPAGO<-as.data.frame(matrix(TPJPAGO$conteo,nrow=4,ncol=2,byrow = TRUE))
colnames(MPJPAGO)<-c("Buenos","Malos")
rownames(MPJPAGO)<-c("q30","q30-55","q55-75","q75-100")
MPJPAGO
## Buenos Malos
## q30 337 96
## q30-55 326 33
## q55-75 264 24
## q75-100 342 18
MPJPAGO$TodDist<-(MPJPAGO$Buenos+MPJPAGO$Malos)/sum(MPJPAGO)
MPJPAGO$BuenosDistr<-MPJPAGO$Buenos/sum(MPJPAGO$Buenos)
MPJPAGO$MalosDistr<-MPJPAGO$Malos/sum(MPJPAGO$Malos)
MPJPAGO$Tincmp<-MPJPAGO$Malos/(MPJPAGO$Buenos+MPJPAGO$Malos)
MPJPAGO$WOE<-log(MPJPAGO$BuenosDistr/MPJPAGO$MalosDistr)
IVPJPAGO<-sum((MPJPAGO$BuenosDistr-MPJPAGO$MalosDistr)*MPJPAGO$WOE)
#Cálculo del IV
IVPJPAGO
## [1] 0.4207904
#¿Qué podemos decir de la gráfica?
barplot(MPJPAGO$WOE,space=0,main="WOE PJPAGO",ylab="WOE")
lines(MPJPAGO$WOE)
points(MPJPAGO$WOE)
# El WOE tiene un comportamiento regular, es creciente, sin embargo su crecimiento no es constante
# Gráfica KS de la variable BKATR
grfs("PJPAGO")
# Observemos que no hay tanta separación entre las distribuciones de buenos y malos de la variable
# "PJPAGO", por lo que es posible que esta variable no vaya a ser considerada en el modelo
# de regresión
# Construimos la tabla para la variable ATDC
TATDC<-dbGetQuery(conn = db,"select ATDC,incumplido,count(incumplido) as conteo
from (select
case when ATDC<=18 then 1 else (case when ATDC<=46 then
2 else (case when ATDC<=100 then 3 else 4 end)end)end as ATDC,
incumplido from Mibase)group by ATDC,incumplido;")
TATDC
## ATDC incumplido conteo
## 1 1 0 304
## 2 1 1 42
## 3 2 0 322
## 4 2 1 44
## 5 3 0 322
## 6 3 1 38
## 7 4 0 321
## 8 4 1 47
MATDC<-as.data.frame(matrix(TATDC$conteo,nrow=4,ncol=2,byrow = TRUE))
colnames(MATDC)<-c("Buenos","Malos")
rownames(MATDC)<-c("q25","q25-50","q50-75","q75-100")
MATDC
## Buenos Malos
## q25 304 42
## q25-50 322 44
## q50-75 322 38
## q75-100 321 47
MATDC$TodDist<-(MATDC$Buenos+MATDC$Malos)/sum(MATDC)
MATDC$BuenosDistr<-MATDC$Buenos/sum(MATDC$Buenos)
MATDC$MalosDistr<-MATDC$Malos/sum(MATDC$Malos)
MATDC$Tincmp<-MATDC$Malos/(MATDC$Buenos+MATDC$Malos)
MATDC$WOE<-log(MATDC$BuenosDistr/MATDC$MalosDistr)
IVATDC<-sum((MATDC$BuenosDistr-MATDC$MalosDistr)*MATDC$WOE)
#Cálculo del IV
IVATDC
## [1] 0.006200212
#¿Qué podemos decir de la gráfica?
barplot(MATDC$WOE,space=0,main="WOE ATDC",ylab="WOE")
lines(MATDC$WOE)
points(MATDC$WOE)
# Obsevemos que la gráfica WOE de la variable ATDC es muy mala, no es creciente ni decreciente
# Entonces haremos otra partición para ver si mejora el comportamiento.
# Gráfica KS de la variable ATDC
grfs("ATDC")
# Observemos que no hay una aceptable separación entre las distribuciones, por lo que esta
# variable no es candidata a anexar en el modelo de regresión.
# Intentaremos hacer un ajuste para mejorar su comportamiento
ptsc6<-quantile(base$ATDC,c(.3,.6))
TATDC<-dbGetQuery(conn = db,"select ATDC,incumplido,count(incumplido) as conteo
from (select
case when ATDC<=21.05 then 3 else (case when ATDC<=69.111 then
2 else 1 end)end as ATDC,
incumplido from Mibase)group by ATDC,incumplido;")
TATDC
## ATDC incumplido conteo
## 1 1 0 504
## 2 1 1 74
## 3 2 0 391
## 4 2 1 42
## 5 3 0 374
## 6 3 1 55
MATDC<-as.data.frame(matrix(TATDC$conteo,nrow=3,ncol=2,byrow = TRUE))
colnames(MATDC)<-c("Buenos","Malos")
rownames(MATDC)<-c("q30","q30-60","q60-100")
MATDC
## Buenos Malos
## q30 504 74
## q30-60 391 42
## q60-100 374 55
MATDC$TodDist<-(MATDC$Buenos+MATDC$Malos)/sum(MATDC)
MATDC$BuenosDistr<-MATDC$Buenos/sum(MATDC$Buenos)
MATDC$MalosDistr<-MATDC$Malos/sum(MATDC$Malos)
MATDC$Tincmp<-MATDC$Malos/(MATDC$Buenos+MATDC$Malos)
MATDC$WOE<-log(MATDC$BuenosDistr/MATDC$MalosDistr)
IVATDC<-sum((MATDC$BuenosDistr-MATDC$MalosDistr)*MATDC$WOE)
#Cálculo del IV
IVATDC
## [1] 0.01957649
#¿Qué podemos decir de la gráfica?
barplot(MATDC$WOE,space=0,main="WOE ATDC",ylab="WOE")
lines(MATDC$WOE)
points(MATDC$WOE)
# Obsevemos que el WOE sigue siendo malo
# Gráfica KS de la variable ATDC
grfs("ATDC")
# Y las distribuciones continuan muy pegadas, así que esta variable no se considerará en
# el modelo de regresión.
# Construimos la tabla para la variable ANTBANCO
TANTBANCO<-dbGetQuery(conn = db,"select ANTBANCO,incumplido,count(incumplido) as conteo
from (select
case when ANTBANCO<=43 then 3 else (case when ANTBANCO<=86.5 then
2 else (case when ANTBANCO<=151 then 1 else 0 end)end)end as ANTBANCO,
incumplido from Mibase)group by ANTBANCO,incumplido;")
TANTBANCO
## ANTBANCO incumplido conteo
## 1 0 0 321
## 2 0 1 38
## 3 1 0 319
## 4 1 1 42
## 5 2 0 316
## 6 2 1 43
## 7 3 0 313
## 8 3 1 48
MTANTBANCO<-as.data.frame(matrix(TANTBANCO$conteo,nrow=4,ncol=2,byrow = TRUE))
colnames(MTANTBANCO)<-c("Buenos","Malos")
rownames(MTANTBANCO)<-c("q25","q25-50","q50-75","q75-100")
MTANTBANCO
## Buenos Malos
## q25 321 38
## q25-50 319 42
## q50-75 316 43
## q75-100 313 48
MTANTBANCO$TodDist<-(MTANTBANCO$Buenos+MTANTBANCO$Malos)/sum(MTANTBANCO)
MTANTBANCO$BuenosDistr<-MTANTBANCO$Buenos/sum(MTANTBANCO$Buenos)
MTANTBANCO$MalosDistr<-MTANTBANCO$Malos/sum(MTANTBANCO$Malos)
MTANTBANCO$Tincmp<-MTANTBANCO$Malos/(MTANTBANCO$Buenos+MTANTBANCO$Malos)
MTANTBANCO$WOE<-log(MTANTBANCO$BuenosDistr/MTANTBANCO$MalosDistr)
IVANTBANCO<-sum((MTANTBANCO$BuenosDistr-MTANTBANCO$MalosDistr)*MTANTBANCO$WOE)
#Cálculo del IV
IVANTBANCO
## [1] 0.008542045
#¿Qué podemos decir de la gráfica?
barplot(MTANTBANCO$WOE,space=0,main="WOE ANTBANCO",ylab="WOE")
lines(MTANTBANCO$WOE)
points(MTANTBANCO$WOE)
# Observemos que el WOE de la variable ANTBANCO tiene un comportamiento aceptable,
# sin embargo, haremos un ajuste para mejorarlo.
# Ajuste a la variable ANTBANCO
ptsc5<-quantile(base$ANTBANCO,c(.3,.7))
TANTBANCO<-dbGetQuery(conn = db,"select ANTBANCO,incumplido,count(incumplido) as conteo
from (select
case when ANTBANCO<=55 then 3 else (case when ANTBANCO<=131.3 then
2 else 1 end)end as ANTBANCO,
incumplido from Mibase)group by ANTBANCO,incumplido;")
TANTBANCO
## ANTBANCO incumplido conteo
## 1 1 0 384
## 2 1 1 48
## 3 2 0 506
## 4 2 1 67
## 5 3 0 379
## 6 3 1 56
MTANTBANCO<-as.data.frame(matrix(TANTBANCO$conteo,nrow=3,ncol=2,byrow = TRUE))
colnames(MTANTBANCO)<-c("Buenos","Malos")
rownames(MTANTBANCO)<-c("q30","q30-70","q70-100")
MTANTBANCO
## Buenos Malos
## q30 384 48
## q30-70 506 67
## q70-100 379 56
MTANTBANCO$TodDist<-(MTANTBANCO$Buenos+MTANTBANCO$Malos)/sum(MTANTBANCO)
MTANTBANCO$BuenosDistr<-MTANTBANCO$Buenos/sum(MTANTBANCO$Buenos)
MTANTBANCO$MalosDistr<-MTANTBANCO$Malos/sum(MTANTBANCO$Malos)
MTANTBANCO$Tincmp<-MTANTBANCO$Malos/(MTANTBANCO$Buenos+MTANTBANCO$Malos)
MTANTBANCO$WOE<-log(MTANTBANCO$BuenosDistr/MTANTBANCO$MalosDistr)
IVANTBANCO<-sum((MTANTBANCO$BuenosDistr-MTANTBANCO$MalosDistr)*MTANTBANCO$WOE)
#Cálculo del IV
IVANTBANCO
## [1] 0.004422249
#¿Qué podemos decir de la gráfica?
barplot(MTANTBANCO$WOE,space=0,main="WOE ANTBANCO",ylab="WOE")
lines(MTANTBANCO$WOE)
points(MTANTBANCO$WOE)
# Mejoró el comportamiento, así que quizá esta variable pueda ser considerada en el modelo.
# Gráfica KS de la variable ATDC
grfs("ANTBANCO")
# Y las distribuciones están muy pegadas, así que esta variable no se considerará en
# el modelo de regresión.
# Construimos la tabla para la variable limite
Tlimite0<-dbGetQuery(conn = db,"select limite,incumplido,count(incumplido) as conteo
from (select
case when limite<=13600 then 0 else (case when limite<=34500 then
1 else (case when limite<=56150 then 2 else 3 end)end)end as limite,
incumplido from Mibase)group by limite,incumplido;")
Tlimite0
## limite incumplido conteo
## 1 0 0 250
## 2 0 1 40
## 3 1 0 364
## 4 1 1 70
## 5 2 0 264
## 6 2 1 20
## 7 3 0 391
## 8 3 1 41
Mlimite0<-as.data.frame(matrix(Tlimite0$conteo,nrow=4,ncol=2,byrow = TRUE))
colnames(Mlimite0)<-c("Buenos","Malos")
rownames(Mlimite0)<-c("q20","q20-50","q50-75","q75-100")
Mlimite0
## Buenos Malos
## q20 250 40
## q20-50 364 70
## q50-75 264 20
## q75-100 391 41
Mlimite0$TodDist<-(Mlimite0$Buenos+Mlimite0$Malos)/sum(Mlimite0)
Mlimite0$BuenosDistr<-Mlimite0$Buenos/sum(Mlimite0$Buenos)
Mlimite0$MalosDistr<-Mlimite0$Malos/sum(Mlimite0$Malos)
Mlimite0$Tincmp<-Mlimite0$Malos/(Mlimite0$Buenos+Mlimite0$Malos)
Mlimite0$WOE<-log(Mlimite0$BuenosDistr/Mlimite0$MalosDistr)
IVlimite0<-sum((Mlimite0$BuenosDistr-Mlimite0$MalosDistr)*Mlimite0$WOE)
#Cálculo del IV
IVlimite0
## [1] 0.1195091
#¿Qué podemos decir de la gráfica?
barplot(Mlimite0$WOE,space=0,main="WOE Limite 0",ylab="WOE")
lines(Mlimite0$WOE)
points(Mlimite0$WOE)
# Veamos que el comportamiento del WOE es malísimo, así que es no es una variable adecuada para el modelo
# Gráfica KS de la variable ATDC
grfs("limite")
# Y las distribuciones están algo pegadas, así que esta variable no se considerará en
# el modelo de regresión.
#Cálculo del IV
IVlimite0
## [1] 0.1195091
#¿Qué podemos decir de la gráfica?
barplot(Mlimite0$WOE,space=0,main="WOE Limite 0",ylab="WOE")
lines(Mlimite0$WOE)
points(Mlimite0$WOE)
# El comportamiento del WOE mejoró mucho, ahora tiene un comportamiento creciente.
# Gráfica KS de la variable limite
grfs("limite")
# Y las distribuciones están un poco pegadas, así que esta variable está en duda de ser
# considerada en el modelo
# Construimos la tabla para la variable saldo
quantile(base$saldo,c(.2,.4,.6,.8))
## 20% 40% 60% 80%
## 4962.8 10035.0 17595.0 34579.0
Tsaldo0<-dbGetQuery(conn = db,"select saldo,incumplido,count(incumplido) as conteo
from (select
case when saldo<=4962.8 then 0 else (case when saldo<=10035 then
1 else (case when saldo<=17595 then 3 else (case when saldo<34579
then 4 else 5 end) end) end) end as saldo,
incumplido from Mibase)group by saldo,incumplido;")
Tsaldo0
## saldo incumplido conteo
## 1 0 0 253
## 2 0 1 35
## 3 1 0 263
## 4 1 1 26
## 5 3 0 261
## 6 3 1 26
## 7 4 0 248
## 8 4 1 40
## 9 5 0 244
## 10 5 1 44
Msaldo0<-as.data.frame(matrix(Tsaldo0$conteo,nrow=5,ncol=2,byrow = TRUE))
colnames(Msaldo0)<-c("Buenos","Malos")
rownames(Msaldo0)<-c("q20","q20-40","q40-60","q60-q80","q80-q100")
Msaldo0
## Buenos Malos
## q20 253 35
## q20-40 263 26
## q40-60 261 26
## q60-q80 248 40
## q80-q100 244 44
Msaldo0$TodDist<-(Msaldo0$Buenos+Msaldo0$Malos)/sum(Msaldo0)
Msaldo0$BuenosDistr<-Msaldo0$Buenos/sum(Msaldo0$Buenos)
Msaldo0$MalosDistr<-Msaldo0$Malos/sum(Msaldo0$Malos)
Msaldo0$Tincmp<-Msaldo0$Malos/(Msaldo0$Buenos+Msaldo0$Malos)
Msaldo0$WOE<-log(Msaldo0$BuenosDistr/Msaldo0$MalosDistr)
IVsaldo0<-sum((Msaldo0$BuenosDistr-Msaldo0$MalosDistr)*Msaldo0$WOE)
#Cálculo del IV
IVsaldo0
## [1] 0.05930468
#¿Qué podemos decir de la gráfica?
barplot(Msaldo0$WOE,space=0,main="WOE saldo 0",ylab="WOE")
lines(Msaldo0$WOE)
points(Msaldo0$WOE)
# El WOE de la variable saldo es muy malo
# Gráfica KS de la variable saldo
grfs("saldo")
# Y las distribuciones están muy pegadas, así que esta variable no se considerará en
# el modelo de regresión.
# Construimos la tabla para la variable monto_pagar_R
quantile(base$monto_pagar_R,c(.5,.75))
## 50% 75%
## 2587.5 5714.5
Tmonto_pagar_R<-dbGetQuery(conn = db,"select monto_pagar_R,incumplido,count(incumplido) as conteo
from (select
case when monto_pagar_R<=2587.5 then 0 else (case when monto_pagar_R<=5714.5 then
1 else 2 end) end as monto_pagar_R,
incumplido from Mibase)group by monto_pagar_R,incumplido;")
dbDisconnect(db)
Tmonto_pagar_R
## monto_pagar_R incumplido conteo
## 1 0 0 656
## 2 0 1 64
## 3 1 0 321
## 4 1 1 39
## 5 2 0 292
## 6 2 1 68
Mmonto_pagar_R<-as.data.frame(matrix(Tmonto_pagar_R$conteo,nrow=3,ncol=2,byrow = TRUE))
colnames(Mmonto_pagar_R)<-c("Buenos","Malos")
rownames(Mmonto_pagar_R)<-c("q30","q30-60","q60-100")
Mmonto_pagar_R
## Buenos Malos
## q30 656 64
## q30-60 321 39
## q60-100 292 68
Mmonto_pagar_R$TodDist<-(Mmonto_pagar_R$Buenos+Mmonto_pagar_R$Malos)/sum(Mmonto_pagar_R)
Mmonto_pagar_R$BuenosDistr<-Mmonto_pagar_R$Buenos/sum(Mmonto_pagar_R$Buenos)
Mmonto_pagar_R$MalosDistr<-Mmonto_pagar_R$Malos/sum(Mmonto_pagar_R$Malos)
Mmonto_pagar_R$Tincmp<-Mmonto_pagar_R$Malos/(Mmonto_pagar_R$Buenos+Mmonto_pagar_R$Malos)
Mmonto_pagar_R$WOE<-log(Mmonto_pagar_R$BuenosDistr/Mmonto_pagar_R$MalosDistr)
IVACT<-sum((Mmonto_pagar_R$BuenosDistr-Mmonto_pagar_R$MalosDistr)*Mmonto_pagar_R$WOE)
#Cálculo del IV
IVACT
## [1] 0.1403214
#¿Qué podemos decir de la gráfica?
barplot(Mmonto_pagar_R$WOE,space=0,main="WOE monto_pagar_R",ylab="WOE")
lines(Mmonto_pagar_R$WOE)
points(Mmonto_pagar_R$WOE)
# El comportamiento del WOE es decreciente y es aceptable
# Gráfica KS de la variable monto_pagar_R
grfs("monto_pagar_R")
# Y las distribuciones están muy pegadas en algunas partes,
# así que esta variable está en duda para ser considerada en el modelo de regresión.
### En conclusión, por los criterios del WOE y la gráfica del KS, las variables que
### eliminaremos son las siguientes: Saldo, limite, ANTBANCO y ATDC
### Por lo que nos quedaríamos con las variables: PJPAGO, ACT, BKATR, HIST y MPR
############################# Ejercicio 4 ###########################################
MPJPAGO
## Buenos Malos TodDist BuenosDistr MalosDistr Tincmp
## q30 337 96 0.3006944 0.2655634 0.5614035 0.22170901
## q30-55 326 33 0.2493056 0.2568952 0.1929825 0.09192201
## q55-75 264 24 0.2000000 0.2080378 0.1403509 0.08333333
## q75-100 342 18 0.2500000 0.2695035 0.1052632 0.05000000
## WOE
## q30 -0.7485862
## q30-55 0.2860689
## q55-75 0.3935744
## q75-100 0.9401181
base$WPJPAGO<-ifelse(base$PJPAGO<=0.083,MPJPAGO$WOE[1],ifelse(base$PJPAGO<=0.19,MPJPAGO$WOE[2],ifelse(base$PJPAGO<=0.41,MPJPAGO$WOE[3],MPJPAGO$WOE[4])))
MATDC
## Buenos Malos TodDist BuenosDistr MalosDistr Tincmp
## q30 504 74 0.4013889 0.3971631 0.4327485 0.12802768
## q30-60 391 42 0.3006944 0.3081166 0.2456140 0.09699769
## q60-100 374 55 0.2979167 0.2947203 0.3216374 0.12820513
## WOE
## q30 -0.08580974
## q30-60 0.22671703
## q60-100 -0.08739830
base$WATDC<-ifelse(base$ATDC<=18,MATDC$WOE[1],ifelse(base$ATDC<=46,MATDC$WOE[2],MATDC$WOE[3]))
MTANTBANCO
## Buenos Malos TodDist BuenosDistr MalosDistr Tincmp
## q30 384 48 0.3000000 0.3026005 0.2807018 0.1111111
## q30-70 506 67 0.3979167 0.3987392 0.3918129 0.1169284
## q70-100 379 56 0.3020833 0.2986604 0.3274854 0.1287356
## WOE
## q30 0.07512063
## q30-70 0.01752314
## q70-100 -0.09213640
base$WANTBANCO<-ifelse(base$ANTBANCO<=55,MTANTBANCO$WOE[3],ifelse(base$ANTBANCO<=131.3,MTANTBANCO$WOE[2],MTANTBANCO$WOE[1]))
Mact
## Buenos Malos TodDist BuenosDistr MalosDistr Tincmp WOE
## 0 1183 108 0.89652778 0.93223010 0.6315789 0.08365608 0.3893567
## 1 72 25 0.06736111 0.05673759 0.1461988 0.25773196 -0.9465306
## 2:3 14 38 0.03611111 0.01103231 0.2222222 0.73076923 -3.0028497
base$WACT<-ifelse(base$ACT==0,Mact$WOE[1],ifelse(base$ACT==1,Mact$WOE[2],Mact$WOE[3]))
Mbkatr
## Buenos Malos TodDist BuenosDistr MalosDistr Tincmp WOE
## 0-2 240 77 0.2201389 0.1891253 0.4502924 0.24290221 -0.8674874
## 3-12 152 23 0.1215278 0.1197794 0.1345029 0.13142857 -0.1159346
## 13 877 71 0.6583333 0.6910954 0.4152047 0.07489451 0.5095062
base$WBKATR<-ifelse(base$BKATR %in% c(0,1,2),Mbkatr$WOE[1],ifelse(base$BKATR %in% c(3,4,5,6,7,8,9,10,11,12),Mbkatr$WOE[2],Mbkatr$WOE[3]))
Mhist
## Buenos Malos TodDist BuenosDistr MalosDistr Tincmp WOE
## 0 919 66 0.68402778 0.72419228 0.3859649 0.06700508 0.6293105
## 1 244 41 0.19791667 0.19227738 0.2397661 0.14385965 -0.2207248
## 2 75 29 0.07222222 0.05910165 0.1695906 0.27884615 -1.0541286
## 3:5 31 35 0.04583333 0.02442868 0.2046784 0.53030303 -2.1256818
base$WHIST<-ifelse(base$HIST==0,Mhist$WOE[1],ifelse(base$HIST==1,Mhist$WOE[2],ifelse(base$HIST==2,Mhist$WOE[3],Mhist$WOE[4])))
Mlimite0
## Buenos Malos TodDist BuenosDistr MalosDistr Tincmp
## q20 250 40 0.2013889 0.1970055 0.2339181 0.13793103
## q20-50 364 70 0.3013889 0.2868400 0.4093567 0.16129032
## q50-75 264 20 0.1972222 0.2080378 0.1169591 0.07042254
## q75-100 391 41 0.3000000 0.3081166 0.2397661 0.09490741
## WOE
## q20 -0.1717394
## q20-50 -0.3556623
## q50-75 0.5758959
## q75-100 0.2508146
base$Wlimite0<-ifelse(base$limite<18670,Mlimite0$WOE[1],ifelse(base$limite<43200,Mlimite0$WOE[2],Mlimite0$WOE[3]))
Mmonto_pagar_R
## Buenos Malos TodDist BuenosDistr MalosDistr Tincmp WOE
## q30 656 64 0.50 0.5169425 0.3742690 0.08888889 0.3229568
## q30-60 321 39 0.25 0.2529551 0.2280702 0.10833333 0.1035586
## q60-100 292 68 0.25 0.2301024 0.3976608 0.18888889 -0.5470748
base$WMPR<-ifelse(base$monto_pagar_R<=2587.5,Mmonto_pagar_R$WOE[1],ifelse(base$monto_pagar_R<=5714.5,Mmonto_pagar_R$WOE[2],Mmonto_pagar_R$WOE[3]))
Msaldo0
## Buenos Malos TodDist BuenosDistr MalosDistr Tincmp
## q20 253 35 0.2000000 0.1993696 0.2046784 0.12152778
## q20-40 263 26 0.2006944 0.2072498 0.1520468 0.08996540
## q40-60 261 26 0.1993056 0.2056738 0.1520468 0.09059233
## q60-q80 248 40 0.2000000 0.1954295 0.2339181 0.13888889
## q80-q100 244 44 0.2000000 0.1922774 0.2573099 0.15277778
## WOE
## q20 -0.02627948
## q20-40 0.30973658
## q40-60 0.30210296
## q60-q80 -0.17977162
## q80-q100 -0.29134232
base$Wsaldo0<-ifelse(base$saldo<=4962.8,Msaldo0$WOE[1],
ifelse(base$saldo<=10035,Msaldo0$WOE[2],
ifelse(base$saldo<=17595,Msaldo0$WOE[3],
ifelse(base$saldo<=34579,Msaldo0$WOE[4],
Msaldo0$WOE[5]))))
str(base)
## 'data.frame': 1440 obs. of 25 variables:
## $ cuenta : int 1 2 4 5 6 7 8 9 10 11 ...
## $ incumplido : int 1 0 1 0 0 0 0 0 0 0 ...
## $ limite : int 26500 86500 11000 14000 19000 39000 31500 12500 10100 48200 ...
## $ saldo : int 11819 86679 4139 9257 17518 1138 11264 11681 11091 7401 ...
## $ exigible : int 250 3640 2235 250 706 250 444 514 250 610 ...
## $ tasa : num 45.4 45.4 45.4 44 45.4 44 45.4 45.4 45.4 45.4 ...
## $ ACT : int 0 0 3 0 0 0 0 0 0 0 ...
## $ HIST : int 0 3 3 0 0 0 0 2 1 0 ...
## $ ATDC : num 72.1 71.1 70.1 67.1 66.1 ...
## $ PJPAGO : num 0.22 0.0692 0 0.3252 0.1284 ...
## $ PULINEA : num 0.446 1.002 0.376 0.661 0.922 ...
## $ ANTBANCO : num 81 70 69 95 65 126 63 62 62 61 ...
## $ BKATR : int 13 13 0 13 13 13 9 13 0 13 ...
## $ SEGMENTO_RIESGO : chr "Medio" "Bajo" "Medio" "Medio" ...
## $ monto_pagar_R_banco: int 2855 3450 250 580 730 597 480 1648 2320 0 ...
## $ monto_pagar_R : int 2855 3450 45648 3215 2263 1896 1361 3323 12665 12072 ...
## $ WPJPAGO : num 0.394 -0.749 -0.749 0.394 0.286 ...
## $ WATDC : num -0.0874 -0.0874 -0.0874 -0.0874 -0.0874 ...
## $ WANTBANCO : num 0.0175 0.0175 0.0175 0.0175 0.0175 ...
## $ WACT : num 0.389 0.389 -3.003 0.389 0.389 ...
## $ WBKATR : num 0.51 0.51 -0.867 0.51 0.51 ...
## $ WHIST : num 0.629 -2.126 -2.126 0.629 0.629 ...
## $ Wlimite0 : num -0.356 0.576 -0.172 -0.172 -0.356 ...
## $ WMPR : num 0.104 0.104 -0.547 0.104 0.323 ...
## $ Wsaldo0 : num 0.3021 -0.2913 -0.0263 0.3097 0.3021 ...
#Modelo de regresión
base.glm1<-glm(incumplido ~ WACT+WBKATR+WHIST+WMPR+Wsaldo0+Wlimite0+WANTBANCO+WPJPAGO+WATDC,
family = binomial, base)
summary(base.glm1)
##
## Call:
## glm(formula = incumplido ~ WACT + WBKATR + WHIST + WMPR + Wsaldo0 +
## Wlimite0 + WANTBANCO + WPJPAGO + WATDC, family = binomial,
## data = base)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.0243 -0.4613 -0.3416 -0.2768 2.6823
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.96988 0.09312 -21.154 < 2e-16 ***
## WACT -0.59460 0.12318 -4.827 1.39e-06 ***
## WBKATR -0.60550 0.15288 -3.961 7.47e-05 ***
## WHIST -0.39643 0.12982 -3.054 0.00226 **
## WMPR -0.72130 0.26747 -2.697 0.00700 **
## Wsaldo0 -0.50168 0.40891 -1.227 0.21987
## Wlimite0 -0.39168 0.24947 -1.570 0.11640
## WANTBANCO -1.22679 1.52850 -0.803 0.42220
## WPJPAGO -0.32885 0.15766 -2.086 0.03700 *
## WATDC -0.53536 0.70195 -0.763 0.44566
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1049.55 on 1439 degrees of freedom
## Residual deviance: 851.34 on 1430 degrees of freedom
## AIC: 871.34
##
## Number of Fisher Scoring iterations: 5
# En efecto, debemos eliminar las variables Wsaldo, Wlimite0, WATDC y WANTBANCO ya que no cumplen
# el criterio del p value(metodo backwards), de entrada suponemos eso para el modelo.
# Ahora aplicamos el método backwards completo.
#Selección hacia atras
M1<-step(base.glm1,direction = c("backward"))
## Start: AIC=871.34
## incumplido ~ WACT + WBKATR + WHIST + WMPR + Wsaldo0 + Wlimite0 +
## WANTBANCO + WPJPAGO + WATDC
##
## Df Deviance AIC
## - WATDC 1 851.93 869.93
## - WANTBANCO 1 851.98 869.98
## - Wsaldo0 1 852.86 870.86
## <none> 851.34 871.34
## - Wlimite0 1 853.82 871.82
## - WPJPAGO 1 855.65 873.65
## - WMPR 1 858.48 876.48
## - WHIST 1 860.05 878.05
## - WBKATR 1 866.68 884.68
## - WACT 1 876.58 894.58
##
## Step: AIC=869.93
## incumplido ~ WACT + WBKATR + WHIST + WMPR + Wsaldo0 + Wlimite0 +
## WANTBANCO + WPJPAGO
##
## Df Deviance AIC
## - WANTBANCO 1 852.28 868.28
## - Wsaldo0 1 853.51 869.51
## <none> 851.93 869.93
## - Wlimite0 1 854.44 870.44
## - WPJPAGO 1 856.16 872.16
## - WMPR 1 858.75 874.75
## - WHIST 1 860.94 876.94
## - WBKATR 1 867.00 883.00
## - WACT 1 876.94 892.94
##
## Step: AIC=868.28
## incumplido ~ WACT + WBKATR + WHIST + WMPR + Wsaldo0 + Wlimite0 +
## WPJPAGO
##
## Df Deviance AIC
## - Wsaldo0 1 853.81 867.81
## <none> 852.28 868.28
## - Wlimite0 1 855.20 869.20
## - WPJPAGO 1 856.51 870.51
## - WMPR 1 858.75 872.75
## - WHIST 1 861.27 875.27
## - WBKATR 1 867.67 881.67
## - WACT 1 877.58 891.58
##
## Step: AIC=867.81
## incumplido ~ WACT + WBKATR + WHIST + WMPR + Wlimite0 + WPJPAGO
##
## Df Deviance AIC
## - Wlimite0 1 855.79 867.79
## <none> 853.81 867.81
## - WPJPAGO 1 858.43 870.43
## - WMPR 1 862.19 874.19
## - WHIST 1 863.16 875.16
## - WBKATR 1 869.01 881.01
## - WACT 1 879.28 891.28
##
## Step: AIC=867.79
## incumplido ~ WACT + WBKATR + WHIST + WMPR + WPJPAGO
##
## Df Deviance AIC
## <none> 855.79 867.79
## - WPJPAGO 1 860.70 870.70
## - WMPR 1 862.56 872.56
## - WHIST 1 865.59 875.59
## - WBKATR 1 872.90 882.90
## - WACT 1 881.37 891.37
#En efecto, mediante el método backward comprobamos que nuestra elección
#de variables coincidió con las que elegimos por el criterio del p-value
# Finalmente, nuestro modelo propuesto es el siguiente:
base.glm<-glm(incumplido ~ WACT+WBKATR+WHIST+WMPR+WPJPAGO,
family = binomial, base)
summary(base.glm)
##
## Call:
## glm(formula = incumplido ~ WACT + WBKATR + WHIST + WMPR + WPJPAGO,
## family = binomial, data = base)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.0008 -0.4605 -0.3522 -0.2834 2.5961
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.98287 0.09254 -21.428 < 2e-16 ***
## WACT -0.59533 0.12247 -4.861 1.17e-06 ***
## WBKATR -0.63123 0.15065 -4.190 2.79e-05 ***
## WHIST -0.42042 0.12931 -3.251 0.00115 **
## WMPR -0.63849 0.24267 -2.631 0.00851 **
## WPJPAGO -0.34857 0.15644 -2.228 0.02587 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1049.55 on 1439 degrees of freedom
## Residual deviance: 855.79 on 1434 degrees of freedom
## AIC: 867.79
##
## Number of Fisher Scoring iterations: 5
# Se observa una devianza pequeña (diferencia entre la nula y la residual),
# un AIC pequeño y todas las variables significativas.
############################### Ejercicio 5#########################################
T1<-M1$model
T1$pi<-M2$fitted.values
ggplot(T1,aes(x=pi))+geom_density(aes(group=incumplido,colour=incumplido))
z<-M1$fitted.values
#Matriz de confusión:
CM<-table(base$incumplido,ifelse(z>.4,1,0))
#PP=positivos predichos, FP=Negativos predichos
#P=positivos, N=negativos
colnames(CM)<-c("PP","nP")
rownames(CM)<-c("P","n")
CM
##
## PP nP
## P 1243 26
## n 119 52
#Algunos indicadores de la matriz de confusión
#Especificidad
(CM[2,2])/(CM[2,2]+CM[2,1])
## [1] 0.3040936
#Exactitud
(CM[1,1]+CM[2,2])/sum(CM)
## [1] 0.8993056
#Tasa de error
(CM[1,2]+CM[2,1])/sum(CM)
## [1] 0.1006944
#Sensibilidad
(CM[1,1])/(CM[1,1]+CM[1,2])
## [1] 0.9795114
#Curvas ROC y CAP
r<-predict(M2,base)
r<-exp(r)/(1+exp(r))
pred<-prediction(r,base$incumplido)
perf<-performance(pred,"tpr","fpr")
plot(perf,main="Modelo prueba")
abline(a=0,b=1)
auc<-performance(pred,"auc")
#Area bajo curva CAP:
auc@y.values[[1]]
## [1] 0.240932
#Consideramos que arriba de 0.7 es una buena estimación.
#Por lo tanto el modelo nos satisface.
#Bootstrap
MSE<-function(X,index){
M2<-glm(incumplido~WACT+WBKATR+WHIST+WMPR,family = binomial,X,subset =index)
z<-M2$fitted.values
Ta<-table(X$incumplido,ifelse(z>.4,1,0))
return ((Ta[1,1]+Ta[2,2])/sum(Ta))
}
#Error cuadrático estimado
MSE(base,sample(1440,1440,replace =T))
## [1] 0.8423611
boot(base,MSE,R=1000)
##
## ORDINARY NONPARAMETRIC BOOTSTRAP
##
##
## Call:
## boot(data = base, statistic = MSE, R = 1000)
##
##
## Bootstrap Statistics :
## original bias std. error
## t1* 0.9 -0.05885 0.007217964