API tools faq
paste
Advertisement
monchimon00

9.2.4GLMModel

monchimon00
Apr 24th, 2024
126
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
R 8.55 KB | None | 0 0
raw download clone embed print report
  1. library(pROC)
  2. ## Type 'citation("pROC")' for a citation.
  3. ##
  4. ## Attaching package: 'pROC'
  5. ## The following objects are masked from 'package:stats':
  6. ##
  7. ##     cov, smooth, var
  8. library(readxl)
  9. library(openxlsx)
  10. library(gmodels)
  11. ##
  12. ## Attaching package: 'gmodels'
  13. ## The following object is masked from 'package:pROC':
  14. ##
  15. ##     ci
  16. library(tidyr)
  17. library(ggplot2)
  18. today <- Sys.Date()
  19. modeldatabase <- paste0("C:/Users/SimonSantos/Documents/Integration/SHINY/CALCULODEPROBABILIDAD/FlexiCredit - Datos Modelo ", today, ".csv")
  20. data_flexi <- read.csv(modeldatabase)
  21. C#28
  22. data_flexi$Impago <- as.factor(data_flexi$Impago)
  23. data_flexi$Periodicidad <- as.factor(data_flexi$Periodicidad)
  24. data_flexi$Sexo <- as.factor(data_flexi$Sexo)
  25. data_flexi$Empresa_Pagadora <- as.factor(data_flexi$Empresa_Pagadora)
  26.  
  27. data_flexi <- data_flexi[-which(data_flexi$Edad > 60),]
  28. summary(data_flexi)
  29. ##  Numero_de_Contrato     Periodicidad      Edad       Fecha_de_nacimiento
  30. ##  Length:868         Catorcenal:131   Min.   :18.37   Length:868        
  31. ##  Class :character   Mensual   :  1   1st Qu.:28.50   Class :character  
  32. ##  Mode  :character   Quincenal : 47   Median :35.53   Mode  :character  
  33. ##                     Semanal   :689   Mean   :36.18                      
  34. ##                                      3rd Qu.:43.23                      
  35. ##                                      Max.   :59.96                      
  36. ##                                                                        
  37. ##         Sexo     Pago_Periodico      Antiguedad      Fecha_de_Ingreso  
  38. ##  Femenino :379   Min.   :  54.89   Min.   : 0.3915   Length:868        
  39. ##  Masculino:489   1st Qu.: 212.52   1st Qu.: 2.7981   Class :character  
  40. ##                  Median : 274.47   Median : 5.6920   Mode  :character  
  41. ##                  Mean   : 399.44   Mean   : 7.8038                    
  42. ##                  3rd Qu.: 467.99   3rd Qu.:11.0151                    
  43. ##                  Max.   :3885.05   Max.   :31.0856                    
  44. ##                                                                        
  45. ##  Fecha_de_Desembolso Total_de_Gastos Total_de_Ingresos  Sueldo_Neto  
  46. ##  Length:868          Min.   :    0   Min.   : 4689     Min.   :  870  
  47. ##  Class :character    1st Qu.: 3786   1st Qu.: 9430     1st Qu.: 4188  
  48. ##  Mode  :character    Median : 6123   Median :12080     Median : 6657  
  49. ##                      Mean   : 7034   Mean   :14712     Mean   : 7679  
  50. ##                      3rd Qu.: 8569   3rd Qu.:16793     3rd Qu.: 9441  
  51. ##                      Max.   :39442   Max.   :72800     Max.   :64580  
  52. ##                                                                      
  53. ##  Financiamiento  Numero_de_Periodos    State                 Empresa_Pagadora
  54. ##  Min.   : 1763   Min.   :  2.00     Length:868         Denso         :498    
  55. ##  1st Qu.: 5100   1st Qu.: 26.00     Class :character   MINCO         :196    
  56. ##  Median :10200   Median : 52.00     Mode  :character   Muebles Krill : 57    
  57. ##  Mean   :11835   Mean   : 54.67                        La Tradicional: 53    
  58. ##  3rd Qu.:15300   3rd Qu.: 78.00                        Roan          : 27    
  59. ##  Max.   :88838   Max.   :156.00                        Accionistas   : 19    
  60. ##                                                        (Other)       : 18    
  61. ##  Impago  PeriodicidadDos        DTI        
  62. ##  0:687   Min.   :0.08333   Min.   :0.0000  
  63. ##  1:181   1st Qu.:0.75833   1st Qu.:0.3212  
  64. ##          Median :1.01111   Median :0.4820  
  65. ##          Mean   :1.19214   Mean   :0.4729  
  66. ##          3rd Qu.:1.51667   3rd Qu.:0.6335  
  67. ##          Max.   :5.05556   Max.   :0.9366  
  68. ##
  69. order <- c('Semanal','Catorcenal','Quincenal','Mensual')
  70. data_flexi$Periodicidad <- factor(data_flexi$Periodicidad, levels = order)
  71. levels(data_flexi$Periodicidad)
  72. ## [1] "Semanal"    "Catorcenal" "Quincenal"  "Mensual"
  73. set.seed(450)
  74.     index_train <- cbind(runif(1 : nrow(data_flexi), 0 , 1),c(1 : nrow(data_flexi)))
  75.     index_train <- order(index_train[, 1])
  76.     index_train <- index_train[1: (2/3 * nrow(data_flexi))]
  77.     training_set <- data_flexi[index_train, ]
  78.     test_set <- data_flexi[-index_train, ]
  79. logi_full  <- glm(Impago ~ PeriodicidadDos + Empresa_Pagadora + Edad  + log(Antiguedad) + Sueldo_Neto, family = "binomial",
  80. data = training_set)
  81. pred_logi_full <- predict(logi_full, newdata = test_set,
  82. type = "response")
  83. summary(logi_full)
  84. ##
  85. ## Call:
  86. ## glm(formula = Impago ~ PeriodicidadDos + Empresa_Pagadora + Edad +
  87. ##     log(Antiguedad) + Sueldo_Neto, family = "binomial", data = training_set)
  88. ##
  89. ## Coefficients:
  90. ##                                  Estimate Std. Error z value Pr(>|z|)    
  91. ## (Intercept)                    -1.409e+01  5.739e+02  -0.025 0.980417    
  92. ## PeriodicidadDos                 1.379e+00  1.945e-01   7.089 1.35e-12 ***
  93. ## Empresa_PagadoraDenso           1.359e+01  5.739e+02   0.024 0.981106    
  94. ## Empresa_PagadoraLa Tradicional  1.466e+01  5.739e+02   0.026 0.979624    
  95. ## Empresa_PagadoraMINCO           1.379e+01  5.739e+02   0.024 0.980829    
  96. ## Empresa_PagadoraMuebles Krill   1.523e+01  5.739e+02   0.027 0.978823    
  97. ## Empresa_PagadoraOtros           1.531e+01  5.739e+02   0.027 0.978720    
  98. ## Empresa_PagadoraRoan            1.390e+01  5.739e+02   0.024 0.980674    
  99. ## Empresa_PagadoraSeguridad MG    1.469e+01  5.739e+02   0.026 0.979574    
  100. ## Edad                           -3.916e-02  1.409e-02  -2.778 0.005461 **
  101. ## log(Antiguedad)                -6.421e-01  1.714e-01  -3.747 0.000179 ***
  102. ## Sueldo_Neto                    -7.813e-05  3.739e-05  -2.089 0.036681 *  
  103. ## ---
  104. ## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
  105. ##
  106. ## (Dispersion parameter for binomial family taken to be 1)
  107. ##
  108. ##     Null deviance: 595.77  on 577  degrees of freedom
  109. ## Residual deviance: 479.51  on 566  degrees of freedom
  110. ## AIC: 503.51
  111. ##
  112. ## Number of Fisher Scoring iterations: 15
  113. range(pred_logi_full)
  114. ## [1] 2.706328e-10 8.020608e-01
  115. logi_full$aic
  116. ## [1] 503.5134
  117. pred_logi <- data.frame(cbind(pred_logi_full))
  118.  
  119. pred_logi <- gather(pred_logi, key = "model",  value = "pred")
  120.  
  121. ggplot(pred_logi[pred_logi$model == "pred_logi_full", ],
  122.        aes(x = pred, fill = model)) +
  123.   geom_density(alpha = 0.4) +
  124.   labs(y = "Density", x = "Default prediction") +
  125.   theme(legend.position = "bottom", legend.title = element_blank())
  126.  
  127. cutoff <- quantile(pred_logi_full, .75)
  128. pred_full_20 <- ifelse(pred_logi_full > cutoff, 1, 0)
  129. real_pred_20 <- cbind.data.frame(test_set$Impago, pred_full_20,
  130.                      "Did the model succeed?" = test_set$Impago==pred_full_20)
  131.  
  132. accepted_loans <- real_pred_20[pred_full_20 == 0, 1]
  133.  
  134. bad_rate <- sum(accepted_loans == 1)/length(accepted_loans)
  135.  
  136. bad_rate
  137. ## [1] 0.1013825
  138. bank <- function(prob_of_def){
  139.   cutoff <- rep(NA, 21)
  140.   bad_rate <- rep(NA, 21)
  141.   accept_rate <- seq(1, 0, by = -0.05)
  142.   for (i in 1:21){
  143.     cutoff[i] <- quantile(prob_of_def, accept_rate[i])
  144.     pred_i <- ifelse(prob_of_def > cutoff[i], 1, 0)
  145.     pred_as_good <- test_set$Impago[pred_i == 0]
  146.     bad_rate[i] <- sum(pred_as_good == 1)/length(pred_as_good)}
  147.   table <- cbind(accept_rate, cutoff = round(cutoff, 4),
  148.                  bad_rate = round(bad_rate, 4))
  149.   return(list(table = table, bad_rate = bad_rate,
  150.               accept_rate = accept_rate, cutoff = cutoff))
  151. }
  152.  
  153. bank_logi_full <- bank((pred_logi_full))
  154.  
  155.  
  156. data.frame(accept_rate = bank_logi_full$accept_rate,
  157.            "Good_model_bad_rate)" = bank_logi_full$bad_rate)
  158. ##    accept_rate Good_model_bad_rate.
  159. ## 1         1.00           0.20344828
  160. ## 2         0.95           0.18545455
  161. ## 3         0.90           0.16091954
  162. ## 4         0.85           0.14634146
  163. ## 5         0.80           0.13362069
  164. ## 6         0.75           0.10138249
  165. ## 7         0.70           0.09359606
  166. ## 8         0.65           0.09574468
  167. ## 9         0.60           0.09195402
  168. ## 10        0.55           0.06918239
  169. ## 11        0.50           0.06896552
  170. ## 12        0.45           0.06870229
  171. ## 13        0.40           0.06896552
  172. ## 14        0.35           0.03921569
  173. ## 15        0.30           0.03448276
  174. ## 16        0.25           0.04109589
  175. ## 17        0.20           0.03448276
  176. ## 18        0.15           0.02272727
  177. ## 19        0.10           0.03448276
  178. ## 20        0.05           0.06666667
  179. ## 21        0.00           0.00000000
  180. ROC_logi_full <- roc(test_set$Impago, pred_logi_full)
  181. ## Setting levels: control = 0, case = 1
  182. ## Setting direction: controls < cases
  183. # Draw the ROCs on one plot
  184. plot(ROC_logi_full, col = "red")
  185.  
  186. auc(ROC_logi_full)
  187. ## Area under the curve: 0.7911
  188.  
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!