Proyecto Riesgos
Shave Gene Chispo
12/2/2020
1. Resumen
2.Introducción
La actividad financiera se ha incrementado enormemente en las últimas décadas, debido a diversos factores como la globalización, el creciente uso de internet o la creación de distintos tipos de productos financieros. Sin embargo, toda rentabilidad trae consigo un riesgo del que las entidades financieras deben protegerse. A medida que los bancos están cada vez más interconectados entre sí , y crece su expansión geográfica, se hace más necesario reforzar la regulación de su actividad. Esta regulación es muy estricta, debido a que las entidades bancarias tienen cada vez más influencia en la sociedad, y su objetivo es mantener una estabilidad monetaria y financiera, así como la protección del cliente. Es por ello que una entidad financiera debe identificar los riesgos a los que está expuesta, debe saber medirlos y ser capaz de minimizarlos o protegerse de ellos en caso de que sea necesario. Los riesgos a los que se enfrenta se agrupan en cuatro grandes bloques: riesgo de mercado, riesgo de crédito, riesgo de liquidez y riesgo operacional. Todos ellos afectan en mayor o menor medida a una entidad bancaria.
El riesgo de crédito es en el que se va a centrar principalmente este trabajo. Se refiere a pérdidas ocasionadas por la imposibilidad del deudor de hacer frente al pago de la deuda que ha contraído con la entidad financiera. Las pérdidas que puede ocasionar este tipo de crédito son muy importantes para un banco, puesto que la concesión de créditos es una de sus fuentes principales de rentabilidad. Para hacer frente a este riesgo, la regulación impone una serie de parámetros que los bancos deben calcular periódicamente, y en función a éstos, almacenar una cantidad de capital, (un colchón) que permita mitigar las posibles pérdidas.
Una de las formas que tiene un banco de protegerse del riesgo de crédito consiste en establecer una política de concesión de préstamos. Un modo de llevar a cabo esta medida es a través de modelos de Scoring, que permiten evaluar al cliente previamente, y tomar una decisión basada en resultados estadísticos.3. Definiciones generales
3.1 Modelo Scoring
Un modelo de scoring (Mester, 1997) es un método de evaluar el riesgo de crédito de solicitudes de préstamos (scoring de admisión) o de préstamos ya concedidos anteriormente (scoring de comportamiento). El objetivo es aislar el efecto de una serie de características personales o propias del producto en la probabilidad de impago del cliente, utilizando datos históricos y técnicas estadísticas. El modelo da como resultado una puntuación o “score” que el banco puede utilizar para calificar al cliente y tomar una decisión respecto a la concesión o no. Para ello se utiliza información histórica de la entidad de créditos concedidos que han resultado en impago, créditos concedidos que han acabado satisfactoriamente y créditos no concedidos a los que se les estimará un comportamiento.
Un buen modelo de scoring es aquel que identifica como buenos a los clientes que no causaron incidencias en el pago del crédito, e identifica como malos a aquellos que no fueron capaces de pagar. Es asumible que el modelo cometa errores y califique como buenos a clientes que han entrado en default. Por ello es importante realizar análisis adecuados que permitan minimizar dichos errores.3.2 Metodologías Scoring
4. Creación del Modelo
4.1 Variable Default
Para poder realizar un modelo de scoring, cuyo objetivo es identificar a clientes malos y separarlos de los buenos, es necesario establecer una definición de qué es bueno y qué es malo. En esta definición, entran en juego dos factores: los días de atraso en un pago para considerar a un cliente como moroso, y el desempeño, que es la ventana temporal en la que se observará la peor situación de dicho cliente. Los días de atraso determinan si un cliente es moroso o no.
En nuestro trabajo la variable default tendrá el valor de 1 si el cliente ha caído en mora y 0 si no.4.2 Descripción de la muestra
La base de datos fue extraida de spss , poseé un total de 850 datos y presenta información personal del cliente (edad, educacion, dirección , ingresos , etc.) . De cada cliente se observa además, en caso de que haya tenido un impago o no. En los 850 datos hay un total de 183 clientes con impagos , y 517 clientes sin impagos, de estos datos se filtraron 150 datos que aún no han sido calificados, estos fueron extraidos de la muestra dando un total de 700 datos para trabajar.
Para la modelación y verificación del modelo se realizo un muestreo estratificado, es decir del total de la muestra se separó todos los clientes con impagos (\(malos\)) y sin impagos (\(buenos\)) y se tomo el 80% de datos de cada uno de ellos, el otro 20 % de estos datos se los tomará para la validación del modelo.
Lo planteado anteriormente se verá implementado en el lenguaje de R con el siguiente código:library(readxl)
Data <- read_excel("bankloan.xlsx")
df<-Data %>% dplyr::filter((is.na(Data$impago)))
Data<-Data %>% dplyr::filter(!(is.na(Data$impago))) # Se eliminan los 150 datos sin calificación de la base
Data$impago <- as.factor(Data$impago) #define a la variable default impago como categórica
Data<-Data%>%select(.,-c(morapred1,morapred2,morapred3))
str(Data)## tibble [700 x 9] (S3: tbl_df/tbl/data.frame)
## $ edad : num [1:700] 41 27 40 41 24 41 39 43 24 36 ...
## $ educ : num [1:700] 3 1 1 1 2 2 1 1 1 1 ...
## $ empleo : num [1:700] 17 10 15 15 2 5 20 12 3 0 ...
## $ direccion: num [1:700] 12 6 14 14 0 5 9 11 4 13 ...
## $ ingresos : num [1:700] 176 31 55 120 28 25 67 38 19 25 ...
## $ deudaingr: num [1:700] 9.3 17.3 5.5 2.9 17.3 10.2 30.6 3.6 24.4 19.7 ...
## $ deudacred: num [1:700] 11.359 1.362 0.856 2.659 1.787 ...
## $ deudaotro: num [1:700] 5.009 4.001 2.169 0.821 3.057 ...
## $ impago : Factor w/ 2 levels "0","1": 2 1 1 1 2 1 1 1 2 1 ...buenos <- Data %>% dplyr::filter(impago==0)
malos <- Data %>% dplyr::filter(impago==1)
#Estratificación de la muestra
sample1 <- sample.split(buenos$edad, SplitRatio = 0.8) # Se toma el 80% de bueno
sample2 <- sample.split(malos$edad, SplitRatio = 0.8) # Se toma el 80% de malos
# mod sera la partición de la base para el modelamiento, junta las submuestras anteriores
mod <- rbind(subset(buenos, sample1 == TRUE),subset(malos,sample2==TRUE))
# val sera la partición de la base usada para la validación del modelo 20%
val <- rbind(subset(buenos, sample1 == FALSE),subset(malos,sample2==FALSE))4.3 Identificación de variables categóricas y numéricas
Se considera la información proporcionada por la base de spss llamada “bankloan”
Vista de variables en SPSS
De aquí se tiene que las variables categóricas son:educación e impago , mientras que las numéricas son :edad, empleo, direccion, ingresos, deudacred, deudangr, deudaotro.
La implementación para esta sección es la siguiente:muestra<-mod
muestra$educ <- as.factor(muestra$educ)
str(muestra)## tibble [562 x 9] (S3: tbl_df/tbl/data.frame)
## $ edad : num [1:562] 27 40 41 41 39 43 36 25 52 37 ...
## $ educ : Factor w/ 5 levels "1","2","3","4",..: 1 1 1 2 1 1 1 1 1 1 ...
## $ empleo : num [1:562] 10 15 15 5 20 12 0 4 24 6 ...
## $ direccion: num [1:562] 6 14 14 5 9 11 13 0 14 9 ...
## $ ingresos : num [1:562] 31 55 120 25 67 38 25 23 64 29 ...
## $ deudaingr: num [1:562] 17.3 5.5 2.9 10.2 30.6 3.6 19.7 5.2 10 16.3 ...
## $ deudacred: num [1:562] 1.362 0.856 2.659 0.393 3.834 ...
## $ deudaotro: num [1:562] 4.001 2.169 0.821 2.157 16.668 ...
## $ impago : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 1 1 1 1 ...#Extraemos el nombre de las variables de la muestra
dvars <- colnames(muestra)
#Las separamos en variables numéricas
vnum <- colnames(muestra[, dvars])[unname(sapply(muestra[, dvars], class))!="factor"]
#Y aquellas variables que sean categóricas
vcat <- colnames(muestra[, dvars])[unname(sapply(muestra[, dvars], class))=="factor"]
#Extraemos la base de solo variables numéricas
dnum <- muestra[, vnum]
dnum$impago <- NULL
dnum## # A tibble: 562 x 7
## edad empleo direccion ingresos deudaingr deudacred deudaotro
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 27 10 6 31 17.3 1.36 4.00
## 2 40 15 14 55 5.5 0.856 2.17
## 3 41 15 14 120 2.9 2.66 0.821
## 4 41 5 5 25 10.2 0.393 2.16
## 5 39 20 9 67 30.6 3.83 16.7
## 6 43 12 11 38 3.6 0.129 1.24
## 7 36 0 13 25 19.7 2.78 2.15
## 8 25 4 0 23 5.2 0.252 0.944
## 9 52 24 14 64 10 3.93 2.47
## 10 37 6 9 29 16.3 1.72 3.01
## # ... with 552 more rows#Extraemos la base con solo las variables categóricas
dcat <- muestra[, vcat]
dcat## # A tibble: 562 x 2
## educ impago
## <fct> <fct>
## 1 1 0
## 2 1 0
## 3 1 0
## 4 2 0
## 5 1 0
## 6 1 0
## 7 1 0
## 8 1 0
## 9 1 0
## 10 1 0
## # ... with 552 more rows4.3 Análisis Univariante
4.3.1 Función valor de información (VI)
El Valor de información es una medida de entropía muy popular en la construcción de scorecards. Con este estadístico se puede medir el poder de predicción de agrupar los atributos de una variable. Además, es un buen indicador a la hora de seleccionar variables para un modelo de regresión logística binario, como es el caso de un modelo de scoring.
Generalmente, se establecen los siguientes criterios en cuanto al valor de informción (VI) :
- Menor a 0,02: La variable no es predictiva.
- Entre 0,02 y 0,1: La variable es débilmente predictiva.
- Entre 0,1 y 0,3: La variable es predictiva media.
- Más de 0,3: La variable es fuertemente predictiva.
# Valor de informacion (IV)
TestVI <- function(x,y){
if(class(x)=="character"){
tc <- table(y,x)
f1 <- tc[1,]
f2 <- tc[2,]
aux1 <- ifelse(f1/sum(f1)==0,0.001,ifelse(f1/sum(f1)==1,0.999, f1/sum(f1)))
aux2 <- ifelse(f2/sum(f2)==0,0.001,ifelse(f2/sum(f2)==1,0.999, f2/sum(f2)))
wof <- log(aux2/aux1)
wof <- ifelse(wof==-Inf,0,wof)
VI <- sum(((f2/sum(f2))-(f1/sum(f1)))*wof)
}else{
VI <- 0
}
return(VI)
}Cálculo de VI sobre las variables categóricas
# Cálculo del VI sobre variables categóricas
VI <- sort(sapply(dcat, TestVI, y=muestra$impago), decreasing = T)
dVI <- data.frame(names(VI), VI)
colnames(dVI) <- c("Variable", "VI"); rownames(dVI) <- NULL
dVI## Variable VI
## 1 educ 0
## 2 impago 0En este caso se conservan las variables categóricas.
4.3.2 Test de Kolmogorov-Smirnov
# Funcion KS
TestKS <- function(x, y){
if(class(x)!="character"){
vars <- data.frame(y,x)
vars_e <- subset(vars,subset=vars[,1]==1)
vars_f <- subset(vars,subset=vars[,1]==0)
ks <- suppressWarnings(ks.test(vars_e[,2],vars_f[,2],alternative="two.sided"))
ks <- round(as.numeric(ks$statistic),4)
} else{
ks <- 0
}
return(ks)
}
# Correlacion superior a un valor dado
DVarCorr <- function(data, corr.max = 0.90){
COR.AUX <- cor(data)
pos <- which(((abs(COR.AUX)>=corr.max) & (row(COR.AUX) < col(COR.AUX))), arr.ind=T)
if(nrow(pos)>0){
col_elim <- numeric(nrow(pos))
for(i in seq(1:nrow(pos))){
aux_col_elim <- c(pos[i,1],pos[i,2])
if (!any(col_elim %in% aux_col_elim)){
col_elim [i] <- pos[i,which.max(c(pos[i,1],
pos[i,2]))]
}
}
if(length(col_elim)>0){
col_elim <- unique(col_elim[col_elim>0])
vars <- names(data)[-(col_elim)]
data <- data.frame(data[,-(col_elim)])
colnames(data) <- vars
}
}
return(data)
}Calculo de K-S sobre variables numéricas
# Cálculo de KS sobre variables numéricas
KS <- sapply(seq_along(dnum), function(i){TestKS(dnum[[i]], muestra$impago)})
dnum <- setDT(DVarCorr(setDF(dnum[, order(KS, decreasing = TRUE)])))
KS <- sapply(seq_along(dnum), function(i){TestKS(dnum[[i]], muestra$impago)})
dKS <- data.frame(colnames(dnum), KS); dKS <- dKS[order(dKS$KS, decreasing = TRUE),]
colnames(dKS) <- c("Variable", "KS"); rownames(dKS) <- NULL
dKS## Variable KS
## 1 deudaingr 0.3983
## 2 empleo 0.3214
## 3 deudacred 0.2531
## 4 direccion 0.1921
## 5 edad 0.1815
## 6 ingresos 0.1812
## 7 deudaotro 0.1811Bajo la función KS debo considerar las 7 variables numéricas, junto con la variable categórica para la construccion del modelo logit.
5. Regresión Logística
Una vez que se han analizado las variables tanto numéricas como categóricas de forma separada y conjunta, serán introducidas en un modelo de regresión logística binaria.
La regresión logística binaria estima la variable dependiente en términos de probabilidad utilizando la función logit, es decir:
Una de las ventajas que presenta esta regresión es que permite que las variables independientes sean cuantitativas, discretas o continuas; o categóricas, sin que hay ninguna restricción. La capacidad predictiva se mide mediante la comparación entre el grupo de pertenencia observado y estimado por el modelo, que clasifica a los individuos en función de un punto de corte establecido, que por defecto será 0,5. Es decir, si la probabilidad estimada es mayor a 0,5, el individuo será clasificado como 1, y viceversa. La capacidad predictiva se mide por el porcentaje de individuos que siendo 0 o 1, el modelo los clasifica como tal. En este caso, la variable dependiente representa el evento de impago:
-Default=1 si el individuo no ha atendido correctamente a los pagos. El cliente se clasifica como malo. -Default=0 si el individuo ha pagado correctamente el crédito. El cliente se clasifica como bueno.
Es decir, el modelo de regresión logística pretenderá predecir la probabilidad de default5.1 Obtención del modelo
En esta sección ,tomando en cuenta los criterios planteados anteriormente, se eliminaran del modelo las variables que no son explicativas hasta obtener uno o varios modelos adecuados, dentro de los cuales se seleccionará el que presente una mejor clasificación.
Dado los resultados de los test de K-S Y VI, el modelo inicia de la siguiente manera:
modelo <- glm(impago ~ edad+empleo+direccion+ingresos+deudaingr+
deudacred+deudaotro,
family = binomial("logit"), data = mod)
summary(modelo)##
## Call:
## glm(formula = impago ~ edad + empleo + direccion + ingresos +
## deudaingr + deudacred + deudaotro, family = binomial("logit"),
## data = mod)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.4034 -0.6332 -0.2959 0.2250 2.7034
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.434874 0.636539 -2.254 0.0242 *
## edad 0.030409 0.019565 1.554 0.1201
## empleo -0.269004 0.036046 -7.463 8.47e-14 ***
## direccion -0.106636 0.026114 -4.083 4.44e-05 ***
## ingresos -0.007563 0.008138 -0.929 0.3527
## deudaingr 0.078919 0.034344 2.298 0.0216 *
## deudacred 0.598180 0.122592 4.879 1.06e-06 ***
## deudaotro 0.089498 0.081483 1.098 0.2720
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 645.95 on 561 degrees of freedom
## Residual deviance: 435.83 on 554 degrees of freedom
## AIC: 451.83
##
## Number of Fisher Scoring iterations: 6Por lo cual se excluye del análisis la variable \(ingresos\) pues se rechaza con una significancia de 0.66
modelo <- glm(impago ~ edad+empleo+direccion+deudaingr+
deudacred+deudaotro,
family = binomial("logit"), data = mod)
summary(modelo)##
## Call:
## glm(formula = impago ~ edad + empleo + direccion + deudaingr +
## deudacred + deudaotro, family = binomial("logit"), data = mod)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.3823 -0.6314 -0.2998 0.2860 2.7100
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.65537 0.58939 -2.809 0.00498 **
## edad 0.02825 0.01942 1.454 0.14587
## empleo -0.26658 0.03562 -7.483 7.26e-14 ***
## direccion -0.10663 0.02603 -4.096 4.20e-05 ***
## deudaingr 0.10029 0.02490 4.028 5.62e-05 ***
## deudacred 0.52964 0.09192 5.762 8.31e-09 ***
## deudaotro 0.04122 0.06103 0.675 0.49939
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 645.95 on 561 degrees of freedom
## Residual deviance: 436.64 on 555 degrees of freedom
## AIC: 450.64
##
## Number of Fisher Scoring iterations: 6Por lo cual se excluye del análisis la variable \(deudaotro\), pues sobrepasa su p valor a 0,5 y es el más alto
modelo <- glm(impago ~ edad+empleo+direccion+deudaingr+
deudacred,
family = binomial("logit"), data = mod)
summary(modelo)##
## Call:
## glm(formula = impago ~ edad + empleo + direccion + deudaingr +
## deudacred, family = binomial("logit"), data = mod)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.4029 -0.6246 -0.2999 0.3100 2.6916
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.74676 0.57432 -3.041 0.00235 **
## edad 0.02975 0.01932 1.540 0.12358
## empleo -0.25879 0.03332 -7.766 8.09e-15 ***
## direccion -0.10562 0.02598 -4.066 4.78e-05 ***
## deudaingr 0.10906 0.02127 5.128 2.92e-07 ***
## deudacred 0.53882 0.09024 5.971 2.36e-09 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 645.95 on 561 degrees of freedom
## Residual deviance: 437.09 on 556 degrees of freedom
## AIC: 449.09
##
## Number of Fisher Scoring iterations: 6modelo1 <- glm(impago ~ empleo+direccion+deudaingr+
deudacred,
family = binomial("logit"), data = mod)
summary(modelo)##
## Call:
## glm(formula = impago ~ edad + empleo + direccion + deudaingr +
## deudacred, family = binomial("logit"), data = mod)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.4029 -0.6246 -0.2999 0.3100 2.6916
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.74676 0.57432 -3.041 0.00235 **
## edad 0.02975 0.01932 1.540 0.12358
## empleo -0.25879 0.03332 -7.766 8.09e-15 ***
## direccion -0.10562 0.02598 -4.066 4.78e-05 ***
## deudaingr 0.10906 0.02127 5.128 2.92e-07 ***
## deudacred 0.53882 0.09024 5.971 2.36e-09 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 645.95 on 561 degrees of freedom
## Residual deviance: 437.09 on 556 degrees of freedom
## AIC: 449.09
##
## Number of Fisher Scoring iterations: 6modelo2 <- glm(impago ~ empleo+direccion+deudaingr+
deudacred-1,
family = binomial("logit"), data = mod)
summary(modelo)##
## Call:
## glm(formula = impago ~ edad + empleo + direccion + deudaingr +
## deudacred, family = binomial("logit"), data = mod)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.4029 -0.6246 -0.2999 0.3100 2.6916
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.74676 0.57432 -3.041 0.00235 **
## edad 0.02975 0.01932 1.540 0.12358
## empleo -0.25879 0.03332 -7.766 8.09e-15 ***
## direccion -0.10562 0.02598 -4.066 4.78e-05 ***
## deudaingr 0.10906 0.02127 5.128 2.92e-07 ***
## deudacred 0.53882 0.09024 5.971 2.36e-09 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 645.95 on 561 degrees of freedom
## Residual deviance: 437.09 on 556 degrees of freedom
## AIC: 449.09
##
## Number of Fisher Scoring iterations: 65.2 Predicción del modelo
#Predicciones del modelo con la data de modelamiento (mod)
res <- predict(modelo, mod, type="response")
res <- ifelse(res > 0.5, 1, 0) # Punto de corte en 0.55.3 Validación y estabilidad del modelo
Matriz de confusión
Una matriz de confusión es una herramienta que permite la visualización del desempeño de un algoritmo que se emplea en aprendizaje supervisado. Cada columna de la matriz representa el número de predicciones de cada clase, mientras que cada fila representa a las instancias en la clase real. Uno de los beneficios de las matrices de confusión es que facilitan ver si el sistema está confundiendo dos clases.
# Matriz de confusión (Proporción de predicciones correctas)
mc <- table(res, mod$impago)
mc[1,1] # Verdaderos positivos## [1] 384mc[2,2] # Verdaderos negativos## [1] 76mc[1,2] # Falsos positivos## [1] 71mc[2,1] # Falsos negativos## [1] 31mc##
## res 0 1
## 0 384 71
## 1 31 76mc/sum(mc)##
## res 0 1
## 0 0.68327402 0.12633452
## 1 0.05516014 0.13523132Interpretación: Bajo nuestro modelo logit; resulta que hemos calificado como buenos a 371 clientes que en efecto coincidian con ser buenos clientes, sin embargo nuestro modelo se equivoca dando falsos positivos para 68 clientes es decir, las caracteristicas de estos 68 clientes hacen que el modelo logit propuesto los califique como buenos sin embargo eran clientes que entraron en mora.
Por otra parte, el modelo considera 104 clientes como malos de los cuales: 30 resultaron ser buenos clientes y los 74 restantes en efecto coincidieron en ser malos clientes.
Estadístico R cuadrado
# R cuadrado
(mc[1,1]+mc[2,2])/sum(mc)## [1] 0.8185053Interpretación: El estadístico R cuadrado determina la calidad del modelo para replicar los resultados, y la proporción de variación de los resultados que puede explicarse por la regresión. Dado que nuestro valor es cercano a 0.82 tenemos un ajuste adecuado para la variable Default
Curva ROC
Es una representación gráfica de la sensibilidad frente a la especificidad para un sistema clasificador binario según se varía el umbral de discriminación. Otra interpretación de este gráfico es la representación de la razón o ratio de verdaderos positivos (VPR = Razón de Verdaderos Positivos) frente a la razón o ratio de falsos positivos (FPR = Razón de Falsos Positivos) también según se varía el umbral de discriminación (valor a partir del cual decidimos que un caso es un positivo).
Para nuestro modelo el gráfico de la curva Roc es el siguiente
###### Curva ROC MODELAMIENTO
dres <- data.frame(pred=predict(modelo, mod, type="response"), var=mod$impago)
ROC <- rocit(score=dres$pred, class=dres$var)
plot(ROC)
ksplot(ROC)
Interpretación: Dado que la sensibilidad es la fracción de verdaderos positivos y la especificidad la fracción de verdaderos negativos, nuestra curva ROC representa la sensibilidad del modelo frente al valor que se obtiene al restar la especificidad a la unidad (1-especificidad). Lo esperado en una curva ROC es que crezca rapidamente hacia el valor de sensibilidad 1 y dado que nuestro punto optimo se encuentra cerca del valor de especificidad del 0,2 se puede afirmar que el modelo es adecuado.
Validación modelo original
Realizamos la validación de nuestro modelo con los datos apartados para la validación \(val\) y tenemos los siguientes resultados:
#Predicciones del modelo con la data de validación (val)
res <- predict(modelo, val, type="response")
res <- ifelse(res > 0.5, 1, 0) # Punto de corte en 0.5
# Matriz de confusión (Proporción de predicciones correctas)
mc <- table(res, val$impago)
mc[1,1] # Verdaderos positivos## [1] 94mc[2,2] # Verdaderos negativos## [1] 16mc[1,2] # Falsos positivos## [1] 20mc[2,1] # Falsos negativos## [1] 8mc##
## res 0 1
## 0 94 20
## 1 8 16mc/sum(mc)##
## res 0 1
## 0 0.68115942 0.14492754
## 1 0.05797101 0.11594203# R cuadrado
(mc[1,1]+mc[2,2])/sum(mc)## [1] 0.7971014dres <- data.frame(pred=predict(modelo, val, type="response"), var=val$impago)
ROC <- rocit(score=dres$pred, class=dres$var)
plot(ROC)
ksplot(ROC)
Comparación:
Tras la validación del modelo, se evidencia que continua discriminando de forma correcta los clientes que verdaderamende son buenos sin embargo tenemos un porcentaje de falsos positivos del 14\(\%\) es decir que los califica como buenos pero en realidad resultan ser malos, lo cual puede ser de alto riesgo para una entidad bancaria. Sin embargo, observamos que la discriminación de los clientes malos continua siendo aceptable y ademas en la validación tenemos un \(R^2\) de 0.796 lo cual continua siendo un ajuste adecuado del modelo.
Predicciones del modelo con la data apartada de 150 clientes para calificar (val)
pronostico <- round(predict(modelo, df, type="response"),3)
calificacion <- ifelse(pronostico > 0.5, 1, 0) # Punto de corte en 0.5
resultado<-data.frame(df,pronostico,calificacion)
resultado<-resultado%>%select(.,-c(educ,ingresos,deudaotro))
resultado## edad empleo direccion deudaingr deudacred impago morapred1 morapred2
## 1 36 16 13 10.9 0.544128 NA 0.0114875528 3.228062e-03
## 2 50 6 27 12.9 1.316574 NA 0.0726114465 3.273090e-02
## 3 40 9 9 17.0 4.880700 NA 0.6437104595 8.342151e-01
## 4 31 5 7 2.0 0.046000 NA 0.0854981599 6.648935e-02
## 5 29 4 0 7.8 0.866736 NA 0.3597747991 3.292229e-01
## 6 25 1 3 9.9 0.232848 NA 0.4328725167 4.575417e-01
## 7 34 4 3 9.4 1.058064 NA 0.3614165848 3.972092e-01
## 8 50 30 8 32.5 13.552500 NA 0.8716077403 9.793148e-01
## 9 27 5 5 1.2 0.130416 NA 0.0971204932 3.352039e-02
## 10 31 7 12 6.0 1.827480 NA 0.1315346906 5.777194e-02
## 11 45 8 25 2.6 0.415584 NA 0.0134482517 9.780870e-03
## 12 35 10 8 1.3 0.109928 NA 0.0243808005 8.725715e-03
## 13 47 27 7 6.1 1.638277 NA 0.0016053977 1.027071e-03
## 14 50 25 7 5.3 1.733736 NA 0.0025643147 3.550368e-03
## 15 37 15 11 11.8 5.250528 NA 0.2186331609 2.377118e-01
## 16 46 7 6 23.4 0.585234 NA 0.3598649771 2.981305e-01
## 17 26 1 5 13.0 6.506240 NA 0.9687999028 9.737350e-01
## 18 33 16 12 8.1 2.399544 NA 0.0277146526 1.365946e-02
## 19 43 8 0 19.0 1.234240 NA 0.4139720393 4.598981e-01
## 20 49 14 26 15.8 0.935676 NA 0.0125046673 1.436401e-02
## 21 44 2 15 9.6 1.091904 NA 0.2646521753 1.908092e-01
## 22 32 12 10 11.2 0.794640 NA 0.0443285369 8.196621e-02
## 23 38 5 4 1.5 0.091500 NA 0.1048735141 1.340376e-01
## 24 52 33 23 5.6 2.288496 NA 0.0001419559 4.305332e-05
## 25 35 10 3 21.3 1.083744 NA 0.2769337701 5.231769e-01
## 26 33 4 12 5.5 0.566280 NA 0.1271427609 1.573154e-01
## 27 35 11 12 4.7 1.100176 NA 0.0326302918 1.819949e-02
## 28 34 9 3 1.6 0.373760 NA 0.0540236499 7.655874e-02
## 29 39 19 16 3.7 0.190217 NA 0.0018985252 1.120268e-03
## 30 31 8 4 5.4 0.673596 NA 0.1002703243 3.835573e-02
## 31 37 5 11 9.4 0.418770 NA 0.1384650936 1.430207e-01
## 32 44 19 9 10.9 0.344440 NA 0.0068804278 3.380176e-03
## 33 30 1 1 12.3 1.275264 NA 0.6685185768 6.988408e-01
## 34 37 18 9 10.3 2.867520 NA 0.0343296919 2.454195e-02
## 35 35 11 9 2.9 0.571880 NA 0.0264113321 1.763571e-02
## 36 43 4 11 7.1 0.751322 NA 0.1682668280 9.832445e-02
## 37 26 0 5 5.0 0.141950 NA 0.3374621297 2.470319e-01
## 38 35 13 4 17.6 0.768768 NA 0.0931446622 7.974093e-02
## 39 24 4 0 11.0 1.185030 NA 0.4721521600 4.315577e-01
## 40 24 4 1 4.9 0.242305 NA 0.2190248507 8.604796e-02
## 41 26 3 1 10.8 1.896480 NA 0.6082237806 5.593057e-01
## 42 34 10 12 5.1 0.264384 NA 0.0268481737 5.092321e-02
## 43 44 18 23 1.0 0.564720 NA 0.0013388184 1.007166e-03
## 44 46 9 6 5.0 0.828000 NA 0.0726857581 7.982460e-02
## 45 40 17 5 11.4 2.125530 NA 0.0432188672 2.099833e-02
## 46 37 2 1 15.4 2.782318 NA 0.8314669941 9.129169e-01
## 47 35 5 13 10.6 1.526400 NA 0.2227004170 1.863700e-01
## 48 46 18 18 4.4 0.418660 NA 0.0024924677 2.305664e-03
## 49 40 5 18 10.0 1.262800 NA 0.1346764664 1.869276e-01
## 50 48 21 14 1.2 0.145512 NA 0.0010756380 9.163776e-04
## 51 53 33 25 7.0 7.053480 NA 0.0020901174 5.154414e-04
## 52 45 9 0 13.1 1.276464 NA 0.2522315788 4.937969e-01
## 53 32 6 12 6.7 0.384714 NA 0.0824303600 6.109703e-02
## 54 43 15 21 9.4 0.693532 NA 0.0073251128 5.348534e-03
## 55 29 3 9 9.0 1.071360 NA 0.3011591947 3.539541e-01
## 56 47 7 24 0.9 0.253575 NA 0.0145657837 1.118115e-02
## 57 21 1 0 10.5 0.555135 NA 0.5526108954 5.557205e-01
## 58 30 0 2 5.4 0.622080 NA 0.4699194441 5.060070e-01
## 59 25 3 2 7.4 1.162836 NA 0.4105053948 4.693601e-01
## 60 27 6 2 13.8 1.901640 NA 0.4746639252 4.013533e-01
## 61 36 4 17 4.0 0.144000 NA 0.0625583702 5.411031e-02
## 62 35 12 3 15.4 1.898820 NA 0.1826263109 8.083308e-02
## 63 33 11 6 15.9 0.506415 NA 0.0950475595 6.181068e-02
## 64 21 0 1 19.5 2.366520 NA 0.9006884561 8.777883e-01
## 65 44 18 0 10.8 2.806488 NA 0.0693678625 3.545297e-02
## 66 37 19 7 13.5 2.590650 NA 0.0358082501 1.932869e-02
## 67 27 5 7 6.8 0.548080 NA 0.1599615643 5.546427e-02
## 68 37 11 11 9.6 1.597248 NA 0.0697350368 5.138225e-02
## 69 48 9 22 5.9 2.133912 NA 0.0466037460 5.386134e-02
## 70 30 4 2 3.5 0.228585 NA 0.1848182213 1.901935e-01
## 71 22 0 1 12.2 1.491450 NA 0.7425257822 6.211830e-01
## 72 39 18 18 7.6 1.564536 NA 0.0063498847 5.851849e-03
## 73 26 5 6 15.5 0.574740 NA 0.3112947494 1.953438e-01
## 74 29 9 8 21.7 3.645600 NA 0.5938474590 4.749341e-01
## 75 47 29 20 2.2 0.349492 NA 0.0001165731 3.868724e-05
## 76 33 5 2 8.4 1.028748 NA 0.3024542212 3.674287e-01
## 77 23 2 2 7.5 0.511200 NA 0.3813462403 4.302532e-01
## 78 25 5 5 16.5 1.969275 NA 0.5435158612 4.399791e-01
## 79 34 4 6 5.6 0.616952 NA 0.1976373491 1.822759e-01
## 80 56 19 26 3.3 0.847242 NA 0.0011859021 8.230246e-04
## 81 32 7 10 9.8 0.861028 NA 0.1252826664 8.968809e-02
## 82 27 0 4 14.7 1.043700 NA 0.6855740801 6.688731e-01
## 83 41 6 7 13.9 1.486188 NA 0.3236856401 4.370958e-01
## 84 30 8 11 20.3 3.743523 NA 0.5772005330 4.422370e-01
## 85 38 13 2 13.7 7.612542 NA 0.8121272695 7.265397e-01
## 86 31 6 1 7.3 0.584730 NA 0.2061148050 2.068312e-01
## 87 37 16 8 0.1 0.022050 NA 0.0049611778 4.876856e-03
## 88 30 2 2 3.8 0.248976 NA 0.2767424134 3.896656e-01
## 89 44 8 18 5.0 0.554700 NA 0.0312164736 2.623458e-02
## 90 25 5 3 15.5 3.365670 NA 0.7405561470 6.590064e-01
## 91 33 10 2 3.0 0.119880 NA 0.0453884086 3.457659e-02
## 92 25 3 5 8.1 0.881361 NA 0.3306800249 2.455100e-01
## 93 45 14 26 5.1 1.262148 NA 0.0059025287 1.583308e-03
## 94 23 6 2 12.7 1.375410 NA 0.3775281534 2.343052e-01
## 95 43 24 22 7.7 7.001764 NA 0.0239120469 6.901735e-03
## 96 38 12 14 5.1 0.897600 NA 0.0203284142 2.383510e-02
## 97 24 1 4 7.2 0.877824 NA 0.4451871649 2.125262e-01
## 98 29 2 4 10.5 0.433440 NA 0.3950614422 4.433008e-01
## 99 40 23 16 10.9 0.997677 NA 0.0021567854 1.101621e-03
## 100 47 3 1 15.4 0.067914 NA 0.4496990669 4.751539e-01
## 101 24 1 5 9.2 0.185472 NA 0.3724864044 2.550512e-01
## 102 35 0 6 12.4 2.382660 NA 0.7651680990 8.296917e-01
## 103 38 1 9 9.1 0.890526 NA 0.3890330088 4.429954e-01
## 104 48 10 0 28.2 10.679340 NA 0.9954646739 9.976036e-01
## 105 35 12 12 15.0 1.449600 NA 0.0742908288 9.234218e-02
## 106 27 11 1 11.4 0.914508 NA 0.1180902422 2.173120e-01
## 107 47 16 7 2.0 2.191840 NA 0.0216915797 8.642897e-03
## 108 31 3 5 32.3 3.064624 NA 0.9359528815 9.206849e-01
## 109 30 12 4 7.0 1.248800 NA 0.0633402310 4.750277e-02
## 110 29 10 3 6.2 0.798002 NA 0.0789806962 8.934210e-02
## 111 26 1 6 23.3 7.754240 NA 0.9931636329 9.891066e-01
## 112 38 21 17 16.8 2.533440 NA 0.0129674025 6.919418e-03
## 113 45 7 17 6.1 0.739442 NA 0.0517447074 4.068653e-02
## 114 29 3 10 9.3 1.103724 NA 0.2935913712 2.507166e-01
## 115 52 17 4 8.7 1.054266 NA 0.0204681616 1.282227e-02
## 116 24 1 0 4.1 0.324720 NA 0.3809051519 3.269366e-01
## 117 33 8 13 9.8 1.645812 NA 0.1213206525 8.115888e-02
## 118 38 0 18 4.6 0.612444 NA 0.1829436048 2.163164e-01
## 119 26 0 2 5.4 0.385560 NA 0.4363489134 2.776977e-01
## 120 26 2 5 6.4 0.236544 NA 0.2724861734 2.435870e-01
## 121 35 16 0 17.2 4.212968 NA 0.3229106408 2.696122e-01
## 122 43 9 8 8.8 2.340624 NA 0.1814589396 9.483224e-02
## 123 45 8 1 13.9 4.183900 NA 0.6923599858 8.702196e-01
## 124 24 5 1 3.8 0.529644 NA 0.1905555018 1.487809e-01
## 125 44 7 16 10.5 3.153150 NA 0.2581449129 2.482617e-01
## 126 29 0 7 8.0 1.242000 NA 0.5144986894 5.496712e-01
## 127 22 0 0 17.1 0.241794 NA 0.7019998342 7.184678e-01
## 128 38 16 8 8.6 0.082732 NA 0.0108133460 6.490613e-03
## 129 46 6 19 17.6 1.415040 NA 0.1937207647 4.337676e-01
## 130 46 7 16 1.1 0.555676 NA 0.0331280205 2.135814e-02
## 131 32 13 11 7.5 0.596250 NA 0.0211468106 9.984135e-03
## 132 39 16 10 6.8 1.405152 NA 0.0166307959 1.758824e-02
## 133 40 15 19 4.1 1.222128 NA 0.0073074109 5.360102e-03
## 134 47 16 19 12.6 5.821200 NA 0.1457160024 1.093147e-01
## 135 28 10 1 8.6 1.047480 NA 0.1257581648 4.430985e-02
## 136 36 19 8 12.1 0.920205 NA 0.0114857883 8.473357e-03
## 137 41 13 1 14.7 9.542358 NA 0.9392996713 9.394836e-01
## 138 31 12 8 9.6 1.867008 NA 0.0805382525 6.866764e-02
## 139 39 20 8 4.1 2.240076 NA 0.0094941535 4.498487e-03
## 140 37 4 10 14.2 0.419184 NA 0.2534422601 5.056272e-01
## 141 35 11 1 32.4 9.702504 NA 0.9924487592 9.962953e-01
## 142 35 10 12 8.5 1.040400 NA 0.0549102350 2.925374e-02
## 143 51 15 30 13.6 2.011984 NA 0.0108346330 1.243931e-02
## 144 36 5 2 7.0 0.723870 NA 0.2434409874 2.207077e-01
## 145 23 3 4 3.1 0.045539 NA 0.1759367178 3.111210e-01
## 146 34 12 15 2.7 0.239328 NA 0.0105036658 5.716419e-03
## 147 32 12 11 5.7 4.026708 NA 0.1436218639 1.148851e-01
## 148 48 13 11 10.8 0.722304 NA 0.0301374981 3.257026e-02
## 149 35 1 11 7.8 0.417456 NA 0.2690034510 3.785465e-01
## 150 37 20 13 12.9 0.899130 NA 0.0063978129 1.117312e-02
## morapred3 pronostico calificacion
## 1 0.25047323 0.009 0
## 2 0.30304156 0.073 0
## 3 0.42721432 0.656 1
## 4 0.09385213 0.068 0
## 5 0.18181438 0.354 0
## 6 0.22658299 0.408 0
## 7 0.21525835 0.379 0
## 8 0.85155366 0.879 1
## 9 0.08527238 0.071 0
## 10 0.14918422 0.094 0
## 11 0.10078689 0.010 0
## 12 0.08630463 0.019 0
## 13 0.15086254 0.001 0
## 14 0.13786396 0.003 0
## 15 0.27336138 0.172 0
## 16 0.63393222 0.511 1
## 17 0.30582859 0.959 1
## 18 0.18776205 0.018 0
## 19 0.49250265 0.550 1
## 20 0.38908350 0.012 0
## 21 0.21973828 0.288 0
## 22 0.25795880 0.035 0
## 23 0.08840312 0.107 0
## 24 0.14262452 0.000 0
## 25 0.56776242 0.331 0
## 26 0.14102262 0.103 0
## 27 0.12874333 0.024 0
## 28 0.08946956 0.047 0
## 29 0.11468716 0.001 0
## 30 0.13943580 0.086 0
## 31 0.21525835 0.136 0
## 32 0.25047323 0.007 0
## 33 0.28662631 0.692 1
## 34 0.23594154 0.027 0
## 35 0.10442221 0.020 0
## 36 0.16850849 0.185 0
## 37 0.13323761 0.293 0
## 38 0.44664008 0.104 0
## 39 0.25295226 0.443 0
## 40 0.13172495 0.181 0
## 41 0.24801042 0.585 1
## 42 0.13476495 0.020 0
## 43 0.08324142 0.001 0
## 44 0.13323761 0.087 0
## 45 0.26302954 0.043 0
## 46 0.37664499 0.871 1
## 47 0.24313370 0.199 0
## 48 0.12437889 0.002 0
## 49 0.22889779 0.121 0
## 50 0.08527238 0.001 0
## 51 0.16667240 0.001 0
## 52 0.30862991 0.350 0
## 53 0.16126014 0.064 0
## 54 0.21525835 0.006 0
## 55 0.20649847 0.259 0
## 56 0.08224251 0.011 0
## 57 0.24071988 0.516 1
## 58 0.13943580 0.465 0
## 59 0.17411352 0.364 0
## 60 0.32862723 0.456 0
## 61 0.11875764 0.048 0
## 62 0.37664499 0.194 0
## 63 0.39221654 0.096 0
## 64 0.50895327 0.898 1
## 65 0.24801042 0.083 0
## 66 0.31997524 0.031 0
## 67 0.16304828 0.126 0
## 68 0.21973828 0.060 0
## 69 0.14752133 0.040 0
## 70 0.11204143 0.169 0
## 71 0.28394269 0.718 1
## 72 0.17793131 0.004 0
## 73 0.37974012 0.289 0
## 74 0.58063349 0.568 1
## 75 0.09611484 0.000 0
## 76 0.19385820 0.310 0
## 77 0.17601428 0.332 0
## 78 0.41119334 0.509 1
## 79 0.14262452 0.188 0
## 80 0.10944918 0.001 0
## 81 0.22428479 0.106 0
## 82 0.35527194 0.690 1
## 83 0.33153764 0.377 0
## 84 0.53521922 0.536 1
## 85 0.32572992 0.803 1
## 86 0.17222901 0.202 0
## 87 0.07463667 0.004 0
## 88 0.11603031 0.262 0
## 89 0.13323761 0.028 0
## 90 0.37974012 0.709 1
## 91 0.10565950 0.040 0
## 92 0.18776205 0.279 0
## 93 0.13476495 0.004 0
## 94 0.29751085 0.332 0
## 95 0.17986466 0.012 0
## 96 0.13476495 0.015 0
## 97 0.17036068 0.388 0
## 98 0.24071988 0.390 0
## 99 0.25047323 0.002 0
## 100 0.37664499 0.619 1
## 101 0.21084507 0.328 0
## 102 0.28932504 0.785 1
## 103 0.20866344 0.413 0
## 104 0.76510699 0.997 1
## 105 0.36436695 0.065 0
## 106 0.26302954 0.103 0
## 107 0.09385213 0.021 0
## 108 0.84819523 0.955 1
## 109 0.16667240 0.050 0
## 110 0.15255635 0.064 0
## 111 0.63087253 0.992 1
## 112 0.42078561 0.009 0
## 113 0.15086254 0.050 0
## 114 0.21304338 0.248 0
## 115 0.20010350 0.029 0
## 116 0.12014200 0.339 0
## 117 0.22428479 0.095 0
## 118 0.12727420 0.156 0
## 119 0.13943580 0.404 0
## 120 0.15599073 0.233 0
## 121 0.43366771 0.332 0
## 122 0.20221851 0.195 0
## 123 0.33153764 0.766 1
## 124 0.11603031 0.150 0
## 125 0.24071988 0.251 0
## 126 0.18576304 0.480 0
## 127 0.43043806 0.712 1
## 128 0.19800513 0.010 0
## 129 0.44664008 0.222 0
## 130 0.08425134 0.030 0
## 131 0.17601428 0.015 0
## 132 0.16304828 0.014 0
## 133 0.12014200 0.005 0
## 134 0.29476743 0.121 0
## 135 0.19800513 0.109 0
## 136 0.28127428 0.010 0
## 137 0.35527194 0.940 1
## 138 0.21973828 0.062 0
## 139 0.12014200 0.007 0
## 140 0.34034579 0.276 0
## 141 0.84988218 0.994 1
## 142 0.19592336 0.044 0
## 143 0.32284587 0.009 0
## 144 0.16667240 0.264 0
## 145 0.10690969 0.130 0
## 146 0.10198600 0.007 0
## 147 0.14424155 0.094 0
## 148 0.24801042 0.036 0
## 149 0.18181438 0.259 0
## 150 0.30304156 0.005 0Conclusiones Generales
El uso de modelos de scoring para evaluar clientes y operaciones destaca el ahorro de tiempo y recursos, garantiza que se está aplicando la misma política de aceptación para todos los clientes, independientemente de sus características personales. En cuanto al ahorro de tiempo, un modelo de scoring eficiente puede reducir considerablemente el tiempo requerido para tomar una decisión sobre la admisión o no de un préstamo. El tiempo que ahorre el modelo dependerá de cuánto confíe el banco en él, y qué grado de atención quiera emplear en aquellos clientes que se acercan al punto de corte.
Respecto a la objetividad, de cara a la regulación, es importante justificar que no se establecen criterios de aceptación en base a características personales de índole racial, familiar, de género o cualquier aspecto con una sensibilidad especial. Un modelo de scoring permite demostrar a la entidad bancaria, en caso de usar un factor que perjudique en mayor medida a una población determinada, que dicho factor se está utilizando por motivos de negocio.Limitaciones del modelo Scoring
La precisión de sus predicciones dependerá del cuidado con el que se haya construido el modelo. Si el modelo no se ha calibrado con precisión, las consecuencias de su uso puede ser muy perjudiciales. La muestra sobre la que se debe desarrollar debe ser rica en buenos y malos (préstamos que han pagado exitosamente y préstamos fallidos, respectivamente). Los datos deben ser lo más actuales posibles, y el modelo debe ser revisado periódicamente para analizar si las relaciones entre variables son similares a las existentes en el momento inicial.
Schreiner (2002) añade que una de las limitaciones del scoring es que asume que gran parte del riesgo está relacionado con características observables o cuantificables, como la edad del cliente, tipo de empleo, etc. En línea con este argumento, según la metodología que se utilice para calibrar el modelo, se asume que las relaciones entre variables son lineales. Poder capturar relaciones no lineales entre variables es costoso de llevar a cabo, y el resultado no es tan comprensible como una tarjeta de puntuación.6. Árboles de clasificación
Es un árbol de desición en donde los nodos representan datos en lugar de decisiones. Cada ramificación contiene un conjunto de atributos o reglas de clasificación asociadas a una etiqueta de clase específica, que se halla al final de la ramificación. Cada dato adicional ayuda a que el modelo prediga de forma más precisa a qué conjunto finito de valores pertenece el asunto en cuestión. Esa información se puede usar posteriormente como una entrada en un modelo más grande de toma de decisiones.
arbol <- ctree(impago ~ edad+empleo+direccion+deudaingr+
deudacred, data=mod)
plot(arbol, type="simple")