Res_Ayud3
Matthias Ueberrhein
2022-07-13
Por efectos de practicidad, puse los mismos codigos de la pauta para la ayudantía 1 y 2, de esta manera me centro unicamente en la ayuadntía 3-
Paquetes necesarios:
library(readxl)
library(tidyverse)
library(lubridate)
library(dplyr)
library(caTools)
library(tidyr)
library(ROCR)
library(plyr)
library(zoo)
library(InformationValue)Cargamos base:
data <- read_excel('C:/Users/matir/OneDrive/Escritorio/Mati/Universidad/2022/Segundo Trimestre/Analitica aplicada a Negocios-Finanzas/Bases/creditos_consumo_A1.xlsx',
skip = 0,
col_names = TRUE,
col_types = c("date","numeric", "numeric",
"numeric", "text", "numeric", "date",
"numeric", "numeric"))data <- data[with(data, order(data$iColocacion), order(data$Fechaproceso)), ] # Orden de datos
data$MI <- ifelse(data$DiasMora <= 90, 0, 1)MI_0 <- subset(data, MI == 0)
MI_1 <- subset(data, MI == 1)
Saldos_0 <- aggregate(x = MI_0$SaldoMonto, by = list(MI_0$FechaProceso), FUN = sum)
Saldos_1 <- aggregate(x = MI_1$SaldoMonto, by = list(MI_1$FechaProceso), FUN = sum)
SaldoMonto_0_ts <- ts(Saldos_0[,2], start = 2017, frequency = 12) # Suma Saldo Monto en cumplimiento serie de tiempo
SaldoMonto_1_ts <- ts(Saldos_1[,2], start = 2017, frequency = 12) # Suma Saldo Monto en incumplimiento serie de tiempo
SaldoMonto_0_ts=zoo(SaldoMonto_0_ts) # Gr?fico Saldos Montos por MI
SaldoMonto_1_ts=zoo(SaldoMonto_1_ts)
SaldoMonto_MI=merge(SaldoMonto_0_ts,SaldoMonto_1_ts)vigentes <- MI_0
incumplimiento <- MI_1 incumplimiento_1 <- aggregate(x = incumplimiento$FechaProceso, by = list(incumplimiento$iColocacion), FUN = min)
names (incumplimiento_1)[1] = "iColocacion"
names (incumplimiento_1)[2] = "Fecha_Incum"
vigentes <- left_join(vigentes, incumplimiento_1, by = c("iColocacion"))
vigentes$Fecha_Incum <- replace(vigentes$Fecha_Incum, vigentes$Fecha_Incum <= vigentes$FechaProceso, NA)vigentes$FechaProceso <- as.Date( vigentes$FechaProceso, tryFormats=c("%d/%m/%Y"))
vigentes$Fecha_Incum <- as.Date( vigentes$Fecha_Incum, tryFormats=c("%d/%m/%Y"))
vigentes$Meses <- interval(vigentes$FechaProceso, vigentes$Fecha_Incum) %/% months(1) vigentes$TR12m <- c(vigentes$Meses <= 12 )
vigentes$TR12m <- replace(vigentes$TR12m, is.na(vigentes$TR12m), 0)FP_06_17 <- subset(vigentes, FechaProceso <= "2017-06-30")
Prom_TR12m<- aggregate(x = FP_06_17$TR12m, by = list(FP_06_17$FechaProceso), FUN = mean)
Prom_TR12m_ts <- ts(Prom_TR12m[,2], start = 2017, frequency = 12) vigentes$FechaActivacion <- as.Date( vigentes$FechaActivacion, tryFormats=c("%d/%m/%Y"))
vigentes$Antiguedad <- interval(vigentes$FechaActivacion, vigentes$FechaProceso) %/% months(1)
vigentes$Tramo_antiguedad <- ifelse (vigentes$Antiguedad <= 4, "ANTIG <=4",
ifelse (vigentes$Antiguedad <= 13, "ANTIG [5,13]",
ifelse (vigentes$Antiguedad <= 16, "ANTIG [14,16]",
ifelse (vigentes$Antiguedad <= 21, "ANTIG [17,21]", "ANTIG > 21"))))vigentes$Porc_pagado <-round((1-(vigentes$SaldoMonto/vigentes$MontoCredito))*100,0)
vigentes$Tramo_Porc_pagado <- ifelse (vigentes$Porc_pagado <= 7, "PORC <=7%",
ifelse (vigentes$Porc_pagado <= 25, "PORC (7%,25%]",
ifelse (vigentes$Porc_pagado <= 40, "PORC (25%,40%]", "PORC > 40%")))vigentes$Estado_credito <- ifelse (vigentes$DiasMora == 0, "Al dia",
ifelse (vigentes$DiasMora <= 14, "MORA [1,14]", "MORA > =15"))id <- count(vigentes, "iColocacion")
set.seed(1)
spl <-sample.split(id$iColocacion, 0.8)
train <- subset(id, spl == TRUE)
test <- subset(id, spl == FALSE)
# Muestra de vigentes con marca de entrenamiento y prueba
names (train)[2] = "muestra_ent"
vigentes <- left_join(vigentes, train, by = c("iColocacion"))
vigentes$muestra_ent <- replace(vigentes$muestra_ent, vigentes$muestra_ent != "NA", TRUE)
vigentes$muestra_ent <- replace(vigentes$muestra_ent, is.na(vigentes$muestra_ent), FALSE)
entrenamiento <- subset(vigentes, muestra_ent == TRUE) # Separa muestra de entrenamiento y prueba para calibrar
prueba <- subset(vigentes, muestra_ent == FALSE)FP_06_17_prueba <- subset(vigentes, FechaProceso <= "2017-06-30" & muestra_ent ==0)
FP_06_17_entren <- subset(vigentes, FechaProceso <= "2017-06-30" & muestra_ent ==1) – AYUDANTÍA 3 –
PARTE C. SELECCIÓN DE VARIABLES
- Obtenga el Weight Of Evidence (WOE) de las variables antigüedad, porcentaje pagado y estado del crédito. Este indicador se utiliza para determinar la fuerza predictiva de cada una de las categorías de las variables en la discriminación entre buenos y malos clientes. Para calcularlo se debe tener el total de observaciones de cada tramo de la variable en la muestra de entrenamiento, diferenciando entre la proporción que no cae en incumplimiento (“buenos clientes”) y aquellos que si se encuentran en incumplimiento (“malos clientes”).
Los números negativos implican que el atributo particular está prediciendo una mayor proporción de clientes malos que de clientes buenos, es decir, mayor es el riesgo de incumplimiento.
Para sacar el WOE, se debe siempre trabajar con la muestra de entrenamiento, en este caso: “FP_06_17_entren”
#Forma alternativa y rapida de hacerlo:
tab <- table(FP_06_17_entren$Tramo_antiguedad, FP_06_17_entren$TR12m)
ptab <- prop.table(as.matrix(tab), margin=2)
ptab##
## 0 1
## ANTIG [14,16] 0.08400738 0.11426640
## ANTIG [17,21] 0.09195402 0.10480054
## ANTIG [5,13] 0.39350078 0.42055443
## ANTIG <=4 0.32410955 0.26842461
## ANTIG > 21 0.10642827 0.09195402df1 <- as.data.frame.matrix(ptab)
#forma larga:
#primero crearé una variable que me indique con 1 si es buen cliente y otra variable que me indique también con 1 si es mal cliente. De esta manera podré aplicar la funcion sum() y tendré cuantos buenos/malos clientes hay POR TRAMO.:
FP_06_17_entren$n_buen_cliente <- ifelse(FP_06_17_entren$TR12m == 0, 1,0)
FP_06_17_entren$n_mal_cliente <- ifelse(FP_06_17_entren$TR12m == 1, 1,0)
# Genero una matriz donde tendré a los buenos clientes:
matriz1 <- aggregate(FP_06_17_entren$n_buen_cliente, list(FP_06_17_entren$Tramo_antiguedad), FUN=sum)
names(matriz1)[2] <- 'buenos'
names(matriz1)[1] <- 'Tramo_antiguedad'
# Genero una matriz donde tendré a los malos clientes:
matriz2 <- aggregate(FP_06_17_entren$n_mal_cliente, list(FP_06_17_entren$Tramo_antiguedad), FUN=sum)
names(matriz2)[2] <- 'malos'
names(matriz2)[1] <- 'Tramo_antiguedad'
#Junto ambas matrices:
matriz <- merge(matriz1,matriz2, by="Tramo_antiguedad")
#creamos las proporciones:
matriz$proporcion_buenos <- (matriz$buenos/ sum(matriz[, 'buenos']))*100
matriz$proporcion_malos <- (matriz$malos / sum(matriz[, 'malos']))*100
# finalmente podemos crear la variable WOE:
matriz$WOE <- log(matriz$proporcion_buenos / matriz$proporcion_malos) * 100Hacemos lo mismo con las otras 2 variables:
matriz3 <- aggregate(FP_06_17_entren$n_buen_cliente, list(FP_06_17_entren$Tramo_Porc_pagado), FUN=sum)
names(matriz3)[2] <- 'buenos'
names(matriz3)[1] <- 'Tramo_Porc_pagado'
matriz4 <- aggregate(FP_06_17_entren$n_mal_cliente, list(FP_06_17_entren$Tramo_Porc_pagado), FUN=sum)
names(matriz4)[2] <- 'malos'
names(matriz4)[1] <- 'Tramo_Porc_pagado'
matriz_porc_pagado <- merge(matriz3,matriz4, by="Tramo_Porc_pagado")
#creamos las proporciones:
matriz_porc_pagado$proporcion_buenos <- (matriz_porc_pagado$buenos/ sum(matriz_porc_pagado[, 'buenos'])) * 100
matriz_porc_pagado$proporcion_malos <- (matriz_porc_pagado$malos / sum(matriz_porc_pagado[, 'malos'])) * 100
# finalmente podemos crear la variable WOE:
matriz_porc_pagado$WOE <- (log(matriz_porc_pagado$proporcion_buenos / matriz_porc_pagado$proporcion_malos)) * 100
# con la otra variable:
matriz5 <- aggregate(FP_06_17_entren$n_buen_cliente, list(FP_06_17_entren$Estado_credito), FUN=sum)
names(matriz5)[2] <- 'buenos'
names(matriz5)[1] <- 'Estado_credito'
matriz6 <- aggregate(FP_06_17_entren$n_mal_cliente, list(FP_06_17_entren$Estado_credito), FUN=sum)
names(matriz6)[2] <- 'malos'
names(matriz6)[1] <- 'Estado_credito'
matriz_estado_credito <- merge(matriz5,matriz6, by="Estado_credito")
#creamos las proporciones:
matriz_estado_credito$proporcion_buenos <- (matriz_estado_credito$buenos/ sum(matriz_estado_credito[, 'buenos']))*100
matriz_estado_credito$proporcion_malos <- (matriz_estado_credito$malos / sum(matriz_estado_credito[, 'malos']))*100
# finalmente podemos crear la variable WOE:
matriz_estado_credito$WOE <- log(matriz_estado_credito$proporcion_buenos / matriz_estado_credito$proporcion_malos) *100Para sacar el IV (info. vaulue):
matriz$IV <- (matriz$proporcion_buenos - matriz$proporcion_malos)*matriz$WOE
matriz_estado_credito$IV <- (matriz_estado_credito$proporcion_buenos - matriz_estado_credito$proporcion_malos)*matriz_estado_credito$WOE
matriz_porc_pagado$IV <- (matriz_porc_pagado$proporcion_buenos - matriz_porc_pagado$proporcion_malos)*matriz_porc_pagado$WOERealizamos grafico de correlaciones con las variables pedidas:
library(corrplot)
correlaciones <- FP_06_17_entren[,c("Antiguedad","Porc_pagado", "DiasMora")]
cor_plot_1 = cor(correlaciones)
corrplot(cor_plot_1, method = 'color', order = 'alphabet', ,number.cex = 0.35, tl.cex = 0.7)
PLOTEO DE WOE´s:
ggplot(matriz, aes(x=Tramo_antiguedad, y=WOE,group = 1))+ geom_line() +
geom_point(size=5, colour="white") +
geom_point(size=2) +
theme_classic() +
theme(panel.background = element_rect(colour = "black"))
ggplot(matriz_porc_pagado, aes(x=Tramo_Porc_pagado, y=WOE,group = 1))+ geom_line() +
geom_point(size=5, colour="white") +
geom_point(size=2) +
theme_classic() +
theme(panel.background = element_rect(colour = "black"))
ggplot(matriz_estado_credito, aes(x=Estado_credito, y=WOE,group = 1))+ geom_line() +
geom_point(size=5, colour="white") +
geom_point(size=2) +
theme_classic() +
theme(panel.background = element_rect(colour = "black"))
Antiguedad - Porcentaje Pagado
ggplot(FP_06_17_entren, aes(x=Antiguedad, y=Porc_pagado, colour = Estado_credito)) + geom_point()
Antiguedad - Dias Mora
ggplot(FP_06_17_entren, aes(x=Antiguedad, y=DiasMora, colour= Tramo_Porc_pagado)) + geom_point()
Porcentaje pagado - Mora
ggplot(FP_06_17_entren, aes(x=Porc_pagado, y=DiasMora, colour= Antiguedad)) + geom_point()
- En el primer grafico podemos observar una clara relacion entre la Antiguedad del credito y su procentaje pagado. Hay una tendencia donde se ve que (normalmente) a mayor antiguedad el porcentaje pagado aumenta (a pesar de tener mora).
D. ESTIMACION MODELO LOGISTICO
# usamos objeto "entrenamiento"
#antes le cambiamos el nombre del WOE a cada matriz solicitada, de lo contrario arrojará error.
names(matriz)[6] <- "WOE_antiguedad"
names(matriz_estado_credito)[6] <- "WOE_estado_credito"
entrenamiento <- merge(entrenamiento, matriz, by="Tramo_antiguedad")
entrenamiento <- merge(entrenamiento, matriz_estado_credito, by="Estado_credito")Creamos el modelo:
logistic_model <- glm(entrenamiento$TR12m ~ entrenamiento$WOE_antiguedad + entrenamiento$WOE_estado_credito,
data = entrenamiento,
family = "binomial")
logistic_model##
## Call: glm(formula = entrenamiento$TR12m ~ entrenamiento$WOE_antiguedad +
## entrenamiento$WOE_estado_credito, family = "binomial", data = entrenamiento)
##
## Coefficients:
## (Intercept) entrenamiento$WOE_antiguedad
## -2.222914 -0.005181
## entrenamiento$WOE_estado_credito
## -0.011656
##
## Degrees of Freedom: 31779 Total (i.e. Null); 31777 Residual
## Null Deviance: 22100
## Residual Deviance: 19230 AIC: 19240summary(logistic_model)##
## Call:
## glm(formula = entrenamiento$TR12m ~ entrenamiento$WOE_antiguedad +
## entrenamiento$WOE_estado_credito, family = "binomial", data = entrenamiento)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.0819 -0.3794 -0.3794 -0.3559 2.3625
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.2229142 0.0204634 -108.629 < 2e-16 ***
## entrenamiento$WOE_antiguedad -0.0051807 0.0012597 -4.113 3.91e-05 ***
## entrenamiento$WOE_estado_credito -0.0116557 0.0002175 -53.599 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 22101 on 31779 degrees of freedom
## Residual deviance: 19233 on 31777 degrees of freedom
## AIC: 19239
##
## Number of Fisher Scoring iterations: 5Predicciones:
predict_reg <- predict(logistic_model,
entrenamiento, type = "response")
entrenamiento$prediccion <- predict_reg <- predict(logistic_model,
entrenamiento, type = "response")
entrenamiento$prediccion_observaciones <- -2.222914 + entrenamiento$WOE_antiguedad*-0.005181 + entrenamiento$WOE_estado_credito*-0.011656Creacion umbrales:
entrenamiento$umbral_0.3 <- ifelse(entrenamiento$prediccion > 0.3, "incumplimiento", "cumplimiento")
entrenamiento$umbral_0.5 <- ifelse(entrenamiento$prediccion > 0.5, "incumplimiento", "cumplimiento")
library(janitor)
frec_umbral_0.3 <- tabyl(entrenamiento, umbral_0.3)
tabla1 <- as.data.frame.matrix(frec_umbral_0.3)
tabla1## umbral_0.3 n percent
## 1 cumplimiento 27611 0.8688169
## 2 incumplimiento 4169 0.1311831frec_umbral_0.5 <- tabyl(entrenamiento, umbral_0.5)
tabla2 <- as.data.frame.matrix(frec_umbral_0.5)
tabla2## umbral_0.5 n percent
## 1 cumplimiento 31780 1E. ESTIMACIÓN DEL MODELO MATRIZ DE TRANSICION
library(markovchain)
library(msm)
PE = c(FP_06_17_entren$Tramo_antiguedad)
P1 = createSequenceMatrix(PE)
statetable.msm(Tramo_antiguedad, Estado_credito, data=FP_06_17_entren)## to
## from ANTIG [14,16] ANTIG [17,21] ANTIG [5,13] ANTIG <=4 ANTIG > 21
## ANTIG [14,16] 306 170 103 0 0
## ANTIG [17,21] 82 406 41 0 93
## ANTIG [5,13] 205 0 2306 359 0
## ANTIG <=4 0 0 397 2172 0
## ANTIG > 21 1 69 0 0 647# CREAMOS LA MATRIZ:
mat_trans <- matrix(,nrow = 3, ncol = 5, byrow = TRUE)
colnames(mat_trans) <- c("ANTIG <=4", "ANTIG [5,13]", "ANTIG [14,16]","ANTIG [17,21]", "ANTIG > 21")
rownames(mat_trans) <- c("Al dia", "MORA [1,14]", "MORA > =15")
print(mat_trans)## ANTIG <=4 ANTIG [5,13] ANTIG [14,16] ANTIG [17,21] ANTIG > 21
## Al dia NA NA NA NA NA
## MORA [1,14] NA NA NA NA NA
## MORA > =15 NA NA NA NA NAAPUNTES AYUDANTÍA:
CADA VEZ QUE SE QUIERA CALIBRAR UN MODELO SE HACE CON LA MUESTRA DE ENTRENAMIENTO!
DESDE AQUI SE TRABAJA CON LA MUESTRA DE ENTRENAMIENTO.
EN ESTA CASO USAMOS: “FP_06_17_entren”
- la variable TR12m significa que en los proximos 12 meses VA O NO VA a incumplir.
# WOE capacidad de discriminante de la variable
# me indicará si cierta agrupacion es muy riesgosa o no, necesitaré el poder predictivo
# si cierta ramificacion de variables es realmente discriminante para la clasificacion de clientes (probabilidad de incumplimiento agrupado por caracteristicas del cliente (antiguedad, tramo del pago, mora, etc TODAS RAMIFICADAS))
#1 Creamos base de antiguedad (contando de la base de entreno)Interpretacion: QUE TAN DISCRIMINANTE ES CADA UNO DE LOS TRAMOS DE MI VARIABLE. Mientras mas negativo sea el WOE, será mayor el riesgo. En este caso me dice que todos los creditos en el tramo de 14 y 16 meses, los creditos mas riesgosso se encuentran en este tramo (los mas propensos a caer en default en los proximos 12 meses).
Es para verificar si la tramificacion que hice para una variable, tiene efectivamente sentido.
Si un WOE = (ej: 0,019) significa que no me será util esa tramificacion.
Debo quedarme con las variables mas discriminantes (en este caso MORA y ANTIGUEDAD). aNTIGUEDAD es un proyecto debil pero eso no implica que no me entregue info (una tramificacion explica la mayoria del modelo a pesar de que las demas no). A medida que aumenta el credito, se hace mas riesgoso PERO hasta cierto punto (14) luego va disminuyendo.EN OTRAS PALABRAS, La gente tiene mayor probabilidad de incumplir estando al medio (de la fecha del credito).
el ods run es para darle forma a la regresion logistica.
El modelo probabilistico girará en torno a las TR12m, que tan probable es que caiga en 1. Ver si mi modelo le achunta o no a los valores reales. La probabilidad estará entonces entre 0 y 1.
woe mientras mas positivo mas riesgoso.
Despues hago un limite para decir si le daré o no un credito. por ejemplo, si la probabilidad es mayor a 30% será MALO entonces no le daré.
Si quiero ser conservador (fallar menos) tendré que poner un umbral mas alto.
matriz de transicion: cómo se mueve mi variable para cierta agrupacion de clientes (tramos que tenía). Dependiendo de esta combinatoria calcularé tasas promedio de transicion en los proximos 12 meses.
Dividiré el nr de los que incumplen de la relacion de variables CON el numero total de observaciones.
PD_matriz = todos creditos que estén al día y tengan una antieugdad(x,y) <- tramo tendrán la probabilidad de incumplimiento de z%
A MI BASE DE PRUEBA le pego mis valores de WOE. De esta forma podré hacer la prediccion
grafico de la curva ROC: si mi modelo no me sirve para determinar nada y es totalmente aleatorio esperaría tener una linea diagonal. eSTE grafico se puede hacer para la matriz de transicion o para el modelo logistico. Tambien se pueden calcular los promedios en el tiempo de todas mis predicciones.
El modelo que mejor se adapta en el tiempo es el de la matriz, comparado con el LOGIT.