grnn.imp.R

Y <- df$bad
X <- scale(df_woe$df[, -1])
set.seed(2019)
i <- sample(seq(length(Y)), length(Y) / 4)
Y1 <- Y[i]
Y2 <- Y[-i]
X1 <- X[i, ]
X2 <- X[-i, ]
net1 <- grnn.fit(x = X1, y = Y1)
rst <- grnn.optmiz_auc(net1, lower = 1, upper = 3)
net2 <- grnn.fit(x = X1, y = Y1, sigma = rst$sigma)
xrank <- grnn.imp(net2)
#idx               var       imp1       imp2
#  9  woe.bureau_score 0.03629427 0.03490435
#  8      woe.rev_util 0.01150345 0.01045408
#  1     woe.tot_derog 0.01033528 0.00925820
# 10           woe.ltv 0.01033330 0.00910178
# 11    woe.tot_income 0.00506666 0.00509438
#  3 woe.age_oldest_tr 0.00430835 0.00476373
#  4   woe.tot_open_tr 0.00392424 0.00523496
#  2        woe.tot_tr 0.00123152 0.00215021
#  5    woe.tot_rev_tr 0.00000000 0.00000000
#  6  woe.tot_rev_debt 0.00000000 0.00000000
#  7  woe.tot_rev_line 0.00000000 0.00000000
excol <- xrank[xrank$imp1 == 0, ]$idx
#[1] 5 6 7
MLmetrics::AUC(y_pred = grnn.parpred(net2, X2), y_true = Y2)
# [1] 0.7584476
MLmetrics::AUC(y_pred = grnn.parpred(grnn.fit(x = X1[, -excol], y = Y1, sigma = net2$sigma), X2[, -excol]), y_true = Y2)
# [1] 0.7626386
barplot(t(as.matrix(xrank[, 3:4])), beside = TRUE, col = c("lightcyan4", "lightcyan2"), border = NA, yaxt = "n",
        names.arg = substring(xrank$var, 5), main = "Variable Importance Rank", cex.names = 1)