2) Crear conjunto de datos aleatorios
# Definir el número de registros (transacciones)
set.seed(123)
n <- 1000
# Simular un dataframe con datos ficticios relacionados con SARLAFT
df_sarlaft <- data.frame(
cliente_id = sample(1:100, n, replace = TRUE), # IDs de clientes
monto_transaccion = rnorm(n, mean = 50000, sd = 20000), # Monto de la transacción en COP
pais_origen = sample(c("Colombia", "Panama", "Venezuela", "USA"), n, replace = TRUE),
tipo_transaccion = sample(c("Transferencia", "Depósito", "Retiro", "Compra"), n, replace = TRUE),
tipo_cliente = sample(c("Persona Natural", "Empresa"), n, replace = TRUE),
es_pep = sample(c(TRUE, FALSE), n, replace = TRUE, prob = c(0.05, 0.95)), # PEP: Persona Expuesta PolÃticamente
fecha_transaccion = sample(seq(as.Date('2023-01-01'), as.Date('2023-12-31'), by="day"), n, replace = TRUE)
)
# Revisar las primeras filas del dataframe
head(df_sarlaft)
## cliente_id monto_transaccion pais_origen tipo_transaccion tipo_cliente
## 1 31 91734.35 USA Depósito Empresa
## 2 79 36429.94 Panama Depósito Persona Natural
## 3 51 12888.57 Panama Transferencia Persona Natural
## 4 14 60665.19 Panama Compra Empresa
## 5 67 56204.61 Panama Depósito Empresa
## 6 42 22923.31 Venezuela Depósito Persona Natural
## es_pep fecha_transaccion
## 1 FALSE 2023-06-04
## 2 FALSE 2023-06-05
## 3 FALSE 2023-11-01
## 4 FALSE 2023-03-23
## 5 FALSE 2023-08-28
## 6 FALSE 2023-06-10
3) Simular analisis de riesgo
# 1. Detectar transacciones de alto riesgo (monto elevado y paÃs de alto riesgo)
# Definir que transacciones superiores a 100,000 COP y de Venezuela o Panamá son de alto riesgo
df_sarlaft <- df_sarlaft %>%
mutate(riesgo_alto = ifelse(monto_transaccion > 100000 & pais_origen %in% c("Venezuela", "Panama"), TRUE, FALSE))
# 2. Identificar transacciones inusuales por cliente y tipo de transacción
# Calcular la desviación estándar de los montos por cliente
df_riesgo_cliente <- df_sarlaft %>%
group_by(cliente_id) %>%
summarize(media_monto = mean(monto_transaccion),
sd_monto = sd(monto_transaccion),
transacciones = n()) %>%
ungroup()
# Unir la información de riesgo por cliente al dataframe original
df_sarlaft <- df_sarlaft %>%
left_join(df_riesgo_cliente, by = "cliente_id")
# 3. Generar una alerta para las transacciones que están fuera de 2 desviaciones estándar
df_sarlaft <- df_sarlaft %>%
mutate(alerta_inusual = ifelse(monto_transaccion > (media_monto + 2 * sd_monto), TRUE, FALSE))
# Visualización: Distribución de montos por paÃs
ggplot(df_sarlaft, aes(x = pais_origen, y = monto_transaccion)) +
geom_boxplot() +
theme_minimal() +
labs(title = "Distribución de Monto de Transacciones por PaÃs",
x = "PaÃs de Origen",
y = "Monto de Transacción (COP)")
# 4. Filtrar transacciones de alto riesgo o inusuales
transacciones_sospechosas <- df_sarlaft %>%
filter(riesgo_alto == TRUE | alerta_inusual == TRUE)
# Mostrar las primeras filas de transacciones sospechosas
head(transacciones_sospechosas)
## cliente_id monto_transaccion pais_origen tipo_transaccion tipo_cliente
## 1 9 89324.96 Panama Depósito Persona Natural
## 2 94 99161.21 Colombia Depósito Empresa
## 3 81 101060.52 USA Retiro Empresa
## 4 53 101509.00 USA Depósito Empresa
## 5 23 90133.61 Venezuela Depósito Persona Natural
## 6 74 105947.82 Colombia Compra Persona Natural
## es_pep fecha_transaccion riesgo_alto media_monto sd_monto transacciones
## 1 FALSE 2023-10-02 FALSE 48440.54 20431.45 13
## 2 FALSE 2023-05-18 FALSE 54727.13 16555.36 19
## 3 FALSE 2023-09-25 FALSE 41088.36 28746.07 11
## 4 FALSE 2023-04-04 FALSE 50226.41 24055.30 13
## 5 FALSE 2023-05-25 FALSE 54343.08 17528.60 14
## 6 FALSE 2023-05-26 FALSE 48051.55 24286.57 19
## alerta_inusual
## 1 TRUE
## 2 TRUE
## 3 TRUE
## 4 TRUE
## 5 TRUE
## 6 TRUE
# Resumen de transacciones sospechosas
summary(transacciones_sospechosas)
## cliente_id monto_transaccion pais_origen tipo_transaccion
## Min. : 9.00 Min. : 79639 Length:12 Length:12
## 1st Qu.:31.25 1st Qu.: 89931 Class :character Class :character
## Median :68.50 Median :101285 Mode :character Mode :character
## Mean :57.67 Mean :100730
## 3rd Qu.:76.50 3rd Qu.:108404
## Max. :96.00 Max. :117807
## tipo_cliente es_pep fecha_transaccion riesgo_alto
## Length:12 Mode :logical Min. :2023-01-18 Mode :logical
## Class :character FALSE:12 1st Qu.:2023-05-07 FALSE:9
## Mode :character Median :2023-05-25 TRUE :3
## Mean :2023-06-07
## 3rd Qu.:2023-08-02
## Max. :2023-10-02
## media_monto sd_monto transacciones alerta_inusual
## Min. :41088 Min. :15614 Min. : 6.00 Mode :logical
## 1st Qu.:47692 1st Qu.:17285 1st Qu.: 9.50 FALSE:3
## Median :50144 Median :23355 Median :12.50 TRUE :9
## Mean :52210 Mean :23659 Mean :12.33
## 3rd Qu.:54439 3rd Qu.:29074 3rd Qu.:14.50
## Max. :75933 Max. :37314 Max. :19.00
4) Modelo de regresion probabilistico
- Simulamos los datos nuevamente
# Simular los datos como en el código anterior
set.seed(123)
n <- 1000
df_sarlaft <- data.frame(
cliente_id = sample(1:100, n, replace = TRUE),
monto_transaccion = rnorm(n, mean = 50000, sd = 20000),
pais_origen = sample(c("Colombia", "Panama", "Venezuela", "USA"), n, replace = TRUE),
tipo_transaccion = sample(c("Transferencia", "Depósito", "Retiro", "Compra"), n, replace = TRUE),
tipo_cliente = sample(c("Persona Natural", "Empresa"), n, replace = TRUE),
es_pep = sample(c(TRUE, FALSE), n, replace = TRUE, prob = c(0.05, 0.95)),
fecha_transaccion = sample(seq(as.Date('2023-01-01'), as.Date('2023-12-31'), by="day"), n, replace = TRUE)
)
# Etiquetar las transacciones como de alto riesgo (monto alto y paÃs de riesgo)
df_sarlaft <- df_sarlaft %>%
mutate(riesgo_alto = ifelse(monto_transaccion > 100000 & pais_origen %in% c("Venezuela", "Panama"), 1, 0))
- Ajustes del modelo
# Convertir las variables categóricas en factores para el modelo de regresión logÃstica
df_sarlaft$pais_origen <- as.factor(df_sarlaft$pais_origen)
df_sarlaft$tipo_transaccion <- as.factor(df_sarlaft$tipo_transaccion)
df_sarlaft$tipo_cliente <- as.factor(df_sarlaft$tipo_cliente)
df_sarlaft$es_pep <- as.factor(df_sarlaft$es_pep)
# Dividir los datos en entrenamiento (70%) y prueba (30%)
set.seed(123)
trainIndex <- createDataPartition(df_sarlaft$riesgo_alto, p = 0.7, list = FALSE)
df_train <- df_sarlaft[trainIndex, ]
df_test <- df_sarlaft[-trainIndex, ]
# Ajustar un modelo de regresión logÃstica
modelo_logistico <- glm(riesgo_alto ~ monto_transaccion + pais_origen + tipo_transaccion + tipo_cliente + es_pep,
data = df_train,
family = "binomial")
- estadisticos del modelo
# Resumen del modelo para ver los coeficientes
summary(modelo_logistico)
##
## Call:
## glm(formula = riesgo_alto ~ monto_transaccion + pais_origen +
## tipo_transaccion + tipo_cliente + es_pep, family = "binomial",
## data = df_train)
##
## Coefficients:
## Estimate
## (Intercept) -26.5660685235379325774829
## monto_transaccion -0.0000000000000000006655
## pais_origenPanama 0.0000000000000538586065
## pais_origenUSA 0.0000000000000000390072
## pais_origenVenezuela -0.0000000000000002015906
## tipo_transaccionDepósito 0.0000000000000572583436
## tipo_transaccionRetiro -0.0000000000000038211323
## tipo_transaccionTransferencia -0.0000000000000002425872
## tipo_clientePersona Natural 0.0000000000000379251799
## es_pepTRUE -0.0000000000000123739696
## Std. Error z value Pr(>|z|)
## (Intercept) 51958.7238282018151949159801 -0.001 1
## monto_transaccion 0.6985233125235620343929 0.000 1
## pais_origenPanama 37131.3014187472435878589749 0.000 1
## pais_origenUSA 39454.6978392090313718654215 0.000 1
## pais_origenVenezuela 38560.2774052088498137891293 0.000 1
## tipo_transaccionDepósito 37305.2900131711940048262477 0.000 1
## tipo_transaccionRetiro 39256.0959390596617595292628 0.000 1
## tipo_transaccionTransferencia 38946.1119915975868934765458 0.000 1
## tipo_clientePersona Natural 27147.8478019907197449356318 0.000 1
## es_pepTRUE 58830.2118678719416493549943 0.000 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 0.0000000000000 on 699 degrees of freedom
## Residual deviance: 0.0000000040611 on 690 degrees of freedom
## AIC: 20
##
## Number of Fisher Scoring iterations: 25
# Calcular los Odds Ratios para interpretar los coeficientes
#Un odds ratio mayor a 1 indica que a medida que aumenta la variable independiente, la probabilidad del evento (en este caso, ser una transacción de alto riesgo) aumenta.
#Un odds ratio igual a 1 significa que la variable no tiene un efecto significativo sobre la probabilidad del evento.
#Un odds ratio menor a 1 indica que a medida que aumenta la variable independiente, la probabilidad del evento disminuye.
odds_ratios <- exp(coef(modelo_logistico)) # exponencial de base "e"
odds_ratios
## (Intercept) monto_transaccion
## 0.000000000002900701 1.000000000000000000
## pais_origenPanama pais_origenUSA
## 1.000000000000053957 1.000000000000000000
## pais_origenVenezuela tipo_transaccionDepósito
## 0.999999999999999778 1.000000000000057288
## tipo_transaccionRetiro tipo_transaccionTransferencia
## 0.999999999999996225 0.999999999999999778
## tipo_clientePersona Natural es_pepTRUE
## 1.000000000000037970 0.999999999999987677
# Interpretación de los odds ratios
interpretacion_odds <- data.frame(Variable = names(odds_ratios), Odds_Ratio = odds_ratios)
interpretacion_odds
## Variable
## (Intercept) (Intercept)
## monto_transaccion monto_transaccion
## pais_origenPanama pais_origenPanama
## pais_origenUSA pais_origenUSA
## pais_origenVenezuela pais_origenVenezuela
## tipo_transaccionDepósito tipo_transaccionDepósito
## tipo_transaccionRetiro tipo_transaccionRetiro
## tipo_transaccionTransferencia tipo_transaccionTransferencia
## tipo_clientePersona Natural tipo_clientePersona Natural
## es_pepTRUE es_pepTRUE
## Odds_Ratio
## (Intercept) 0.000000000002900701
## monto_transaccion 1.000000000000000000
## pais_origenPanama 1.000000000000053957
## pais_origenUSA 1.000000000000000000
## pais_origenVenezuela 0.999999999999999778
## tipo_transaccionDepósito 1.000000000000057288
## tipo_transaccionRetiro 0.999999999999996225
## tipo_transaccionTransferencia 0.999999999999999778
## tipo_clientePersona Natural 1.000000000000037970
## es_pepTRUE 0.999999999999987677
- Evaluacion del modelo
# Predecir el riesgo en el conjunto de prueba
predicciones <- predict(modelo_logistico, df_test, type = "response")
df_test$pred_riesgo <- ifelse(predicciones > 0.5, 1, 0)
# Evaluar el desempeño del modelo
confusionMatrix(as.factor(df_test$pred_riesgo), as.factor(df_test$riesgo_alto))
## Warning in confusionMatrix.default(as.factor(df_test$pred_riesgo),
## as.factor(df_test$riesgo_alto)): Levels are not in the same order for reference
## and data. Refactoring data to match.
## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 297 3
## 1 0 0
##
## Accuracy : 0.99
## 95% CI : (0.9711, 0.9979)
## No Information Rate : 0.99
## P-Value [Acc > NIR] : 0.6472
##
## Kappa : 0
##
## Mcnemar's Test P-Value : 0.2482
##
## Sensitivity : 1.00
## Specificity : 0.00
## Pos Pred Value : 0.99
## Neg Pred Value : NaN
## Prevalence : 0.99
## Detection Rate : 0.99
## Detection Prevalence : 1.00
## Balanced Accuracy : 0.50
##
## 'Positive' Class : 0
##
# Visualización de los Odds Ratios
ggplot(interpretacion_odds, aes(x = Variable, y = Odds_Ratio)) +
geom_bar(stat = "identity", fill = "skyblue") +
coord_flip() +
labs(title = "Odds Ratios para las Variables del Modelo de Regresión LogÃstica",
x = "Variables", y = "Odds Ratio") +
theme_minimal()
# Visualización de la matriz de confusión
cm <- confusionMatrix(as.factor(df_test$pred_riesgo), as.factor(df_test$riesgo_alto))
## Warning in confusionMatrix.default(as.factor(df_test$pred_riesgo),
## as.factor(df_test$riesgo_alto)): Levels are not in the same order for reference
## and data. Refactoring data to match.
cm_table <- as.data.frame(cm$table)
ggplot(data = cm_table, aes(x = Prediction, y = Reference, fill = Freq)) +
geom_tile() +
geom_text(aes(label = Freq), color = "white", size = 6) +
scale_fill_gradient(low = "blue", high = "red") +
labs(title = "Matriz de Confusión", x = "Predicción", y = "Valor Real") +
theme_minimal()
