четверг, 29 марта 2018 г.

Оценка важности предикторов при помощи пакета Boruta

В данном сообщении рассматривается отбор признаков при помощи пакета Boruta на примере конкурса Задача предсказания отклика клиентов ОТП Банка. Также рассмотрены возможности пакета recipes, который удачно дополняет известную библиотеку caret.


Реализацией идеи оценки важности предикторов при помощи случайных перестановок их значений является алгоритм Boruta, реализованный в одноименном пакете на языке R (см. Feature Selection with the Boruta Package). Он состоит из следующих шагов:
  1. Набор данных дополняется копиями всех предикторов - так называемыми “теневыми” предикторами. Их создается как минимум 5, даже если исходных предикторов меньше 5.
  2. Значения добавленных предикторов случайным образом перемешиваются, чтобы они перестали быть связанными с целевой переменной.
  3. Обучается модель типа “случайный лес” (можно использовать и другие модели), из которой извлекаются рассчитанные значения Z-оценок (для задачи классификации Z-оценка получается путем деления среднего уменьшения точности вследствие перестановок на стандартное отклонение уменьшения точности).
  4. Находится максимальное значение Z-оценки для “теневых” предикторов (MZSA - maximum Z-score for shadow attributes). Отмечаются все предикторы, чьи оценки лучше MZSA.
  5. Для каждого предиктора, чья важность неизвестна, выполняется двусторонний тест на равенство с MZSA.
  6. Предикторы с важностью, статистически значимо меньшей MZSA, признаются “неважными” и безвозвратно удаляются из набора данных.
  7. Предикторы с важностью, статистически значимо большей MZSA, признаются “важными”.
  8. Удаляются все “теневые” предикторы.
  9. Процедура повторяется до тех пор, пока в наборе данных не останутся только важные предикторы, или пока не будет достигнуто заданное максимальное число итераций.
На практике этому алгоритму предшествуют три итерации с менее строгими критериями важности. Они нужны для принятия решений в ситуации, когда наблюдается высокая вариабельность Z-оценок при большом числе предикторов в начале процедуры. В ходе этих трех итераций предикторы сравниваются соответственно с пятым, третьим и вторым из лучших “теневых” предикторов; в конце итерации тесты применяются только для исключения предикторов, но не для подтверждения важности.
Сложность описанной процедуры составляет О(P*N), где P - это число предикторов, а N - размер выборки. Таким образом, затраты времени будут значительными для больших наборов данных, но это необходимо для обеспечения отбора релевантных признаков на основании статистической значимости. Также хорошей новостью является то, что алгоритм обладает линейной масштабируемостью и хорошо параллелится в силу параллельного характера лежащего в его основе “случайного леса”.
Рассмотрим возможности пакета Boruta на практике, используя в качестве примера набор данных Credit_OTP (скачать данные, узнать больше о задаче и ознакомиться с более подробным решением можно в репозитории А.Груздева).
Историческая выборка, представленная файлом Credit_OTP.csv, содержит записи о 15223 клиентах, классифицированных на два класса: 0 – отклика не было (13411 клиентов) и 1 – отклик был (1812 клиентов). По каждому наблюдению (клиенту) фиксируются 52 переменные, включая целевую переменную и уникальный идентификатор:
  • AGREEMENT_RK - уникальный идентификатор объекта в выборке;
  • TARGET - целевая переменная: отклик на маркетинговую кампанию (1 - отклик был зарегистрирован, 0 - отклика не было);
  • AGE - возраст клиента;
  • SOCSTATUS_WORK_FL - социальный статус клиента относительно работы (1 - работает, 0 - не работает);
  • SOCSTATUS_PENS_FL - социальный статус клиента относительно пенсии (1 - пенсионер, 0 - не пенсионер);
  • GENDER - пол клиента (1 - мужчина, 0 - женщина);
  • CHILD_TOTAL - количество детей клиента;
  • DEPENDANTS - количество иждивенцев клиента;
  • EDUCATION - образование;
  • MARITAL_STATUS - семейное положение;
  • GEN_INDUSTRY - отрасль работы клиента;
  • GEN_TITLE - должность;
  • ORG_TP_STATE - форма собственности компании;
  • ORG_TP_FCAPITAL - отношение к иностранному капиталу;
  • JOB_DIR - направление деятельности в нутри компании;
  • FAMILY_INCOME - семейный доход (несколько категорий);
  • PERSONAL_INCOME - личный доход клиента (в рублях);
  • REG_ADDRESS_PROVINCE - область регистрации клиента;
  • FACT_ADDRESS_PROVINCE - область фактического пребывания клиента;
  • POSTAL_ADDRESS_PROVINCE - почтовый адрес (область);
  • TP_PROVINCE - область торговой точки, где клиент брал последний кредит;
  • REGION_NM - регион РФ;
  • REG_FACT_FL адрес регистрации и адрес фактического пребывания клиента совпадают(1 - совпадает, 0 - не совпадает);
  • FACT_POST_FL - адрес фактического пребывания клиента и его почтовый адрес совпадают(1 - совпадает, 0 - не совпадает);
  • REG_POST_FL - адрес регистрации клиента и его почтовый адрес совпадают(1 - совпадает, 0 - не совпадает);
  • REG_FACT_POST_FL - почтовый, фактический и адрес регистрации совпадают (1 - совпадают, 0 - не совпадают);
  • REG_FACT_POST_TP_FL - область регистрации, фактического пребывания, почтового адреса и область расположения торговой точки, где клиент брал кредит совпадают (1 - совпадают, 0 - не совпадают);
  • FL_PRESENCE_FL - наличие в собственности квартиры (1 - есть, 0 - нет);
  • OWN_AUTO - количество автомобилей в собственности;
  • AUTO_RUS_FL - наличие в собственности автомобиля российского производства ( 1 - есть, 0 - нет);
  • HS_PRESENCE_FL - наличие в собственности загородного дома (1 - есть, 0 - нет);
  • COT_PRESENCE_FL - наличие в собственности котеджа (1 - есть, 0 - нет);
  • GAR_PRESENCE_FL - наличие в собственности гаража (1 - есть, 0 - нет);
  • LAND_PRESENCE_FL - наличие в собственности земельного участка (1 - есть, 0 - нет);
  • CREDIT - сумма последнего кредита клиента (в рублях);
  • TERM - срок кредита;
  • FST_PAYMENT - первоначальный взнос (в рублях);
  • DL_DOCUMENT_FL - в анкете клиент указал водительское удостоверение (1 - указал, 0 - не указал);
  • GPF_DOCUMENT_FL - в анкете клиен указал ГПФ (1 - указал, 0 - не указал);
  • FACT_LIVING_TERM - количество месяцев проживания по месту фактического пребывания;
  • WORK_TIME - время работы на текущем месте (в месяцах);
  • FACT_PHONE_FL - наличие в заявке телефона по фактическому месту пребывания;
  • REG_PHONE_FL - наличие в заявке телефона по месту регистрации;
  • GEN_PHONE_FL - наличие в заявке рабочего телефона;
  • LOAN_NUM_TOTAL - количество ссуд клиента;
  • LOAN_NUM_CLOSED - количество погашенных ссуд клиента;
  • LOAN_NUM_PAYM - количество платежей, которые сделал клиент;
  • LOAN_DLQ_NUM - количество просрочек, допущенных клиентом;
  • LOAN_MAX_DLQ - номер максимальной просрочки, допущенной клиентом;
  • LOAN_AVG_DLQ_AMT - средняя сумма просрочки (в рублях);
  • LOAN_MAX_DLQ_AMT - максимальная сумма просрочки (в рублях);
  • PREVIOUS_CARD_NUM_UTILIZED - количество уже утилизированных карт ( если пусто - 0).
library(data.table)
# Пропуски представлены пустыми строками, na.strings = ""
# Десятичный разделитель - запятая, используем dec = ","
df <- fread("data/Credit_OTP.csv", na.strings = "", dec = ",")

# Пропуски для переменной PREVIOUS_CARD_NUM_UTILIZED соответствуют нулевым значениям
# Заменим NA на 0:
df[is.na(PREVIOUS_CARD_NUM_UTILIZED), PREVIOUS_CARD_NUM_UTILIZED := 0]
Представим категориальные переменные как факторы:
cat_variables <- c("SOCSTATUS_WORK_FL",
                   "SOCSTATUS_PENS_FL", 
                   "GENDER",
                   "EDUCATION",
                   "MARITAL_STATUS",
                   "GEN_INDUSTRY",
                   "GEN_TITLE",
                   "ORG_TP_STATE",
                   "ORG_TP_FCAPITAL",
                   "JOB_DIR",
                   "FAMILY_INCOME",
                   "REG_ADDRESS_PROVINCE",
                   "FACT_ADDRESS_PROVINCE",
                   "POSTAL_ADDRESS_PROVINCE",
                   "TP_PROVINCE",
                   "REGION_NM",
                   "REG_FACT_FL",
                   "FACT_POST_FL",
                   "REG_POST_FL",
                   "REG_FACT_POST_FL",
                   "REG_FACT_POST_TP_FL",
                   "FL_PRESENCE_FL",
                   "AUTO_RUS_FL",
                   "HS_PRESENCE_FL",
                   "COT_PRESENCE_FL",
                   "GAR_PRESENCE_FL",
                   "LAND_PRESENCE_FL",
                   "DL_DOCUMENT_FL",
                   "GPF_DOCUMENT_FL",
                   "FACT_PHONE_FL",
                   "REG_PHONE_FL",
                   "GEN_PHONE_FL",
                   "PREVIOUS_CARD_NUM_UTILIZED"
                   )

df[, 
   c(cat_variables) := lapply(.SD, as.factor), 
   .SDcols = cat_variables]

df$TARGET <- factor(df$TARGET, 
                    levels = c(0, 1),
                    labels = c("no", "yes"))
Удостоверимся, что данные в таблице теперь представлены в правильной форме:
str(df)
## Classes 'data.table' and 'data.frame':   15223 obs. of  52 variables:
##  $ AGREEMENT_RK              : int  59910150 59910230 59910525 59910803 59911781 59911784 59911832 59912034 59912560 59912659 ...
##  $ TARGET                    : Factor w/ 2 levels "no","yes": 1 1 1 1 1 1 1 1 1 1 ...
##  $ AGE                       : int  49 32 52 39 30 29 35 41 53 43 ...
##  $ SOCSTATUS_WORK_FL         : Factor w/ 2 levels "0","1": 2 2 2 2 2 2 2 2 2 2 ...
##  $ SOCSTATUS_PENS_FL         : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 1 1 1 1 ...
##  $ GENDER                    : Factor w/ 2 levels "0","1": 2 2 2 2 1 1 1 2 1 2 ...
##  $ CHILD_TOTAL               : int  2 3 4 1 0 0 1 0 2 0 ...
##  $ DEPENDANTS                : int  1 3 0 1 0 0 1 0 0 0 ...
##  $ EDUCATION                 : Factor w/ 7 levels "Высшее","Два и более высших образования",..: 6 5 4 1 5 5 1 5 1 6 ...
##  $ MARITAL_STATUS            : Factor w/ 5 levels "Вдовец/Вдова",..: 5 5 5 5 5 2 4 5 5 5 ...
##  $ GEN_INDUSTRY              : Factor w/ 31 levels "Банк/Финансы",..: 24 24 5 14 2 24 3 20 4 14 ...
##  $ GEN_TITLE                 : Factor w/ 12 levels "Военнослужащий по контракту",..: 7 7 12 10 12 12 12 7 8 12 ...
##  $ ORG_TP_STATE              : Factor w/ 5 levels "Государственная комп./учреж.",..: 5 2 1 1 1 5 1 5 5 1 ...
##  $ ORG_TP_FCAPITAL           : Factor w/ 2 levels "Без участия",..: 1 1 1 1 1 1 1 1 1 1 ...
##  $ JOB_DIR                   : Factor w/ 10 levels "Адм-хоз. и трансп. службы",..: 3 9 9 9 9 1 9 9 9 9 ...
##  $ FAMILY_INCOME             : Factor w/ 5 levels "до 5000 руб.",..: 2 2 2 3 2 3 3 2 5 2 ...
##  $ PERSONAL_INCOME           : num  5000 12000 9000 25000 12000 12000 15000 6000 100000 7000 ...
##  $ REG_ADDRESS_PROVINCE      : Factor w/ 81 levels "Агинский Бурятский АО",..: 47 20 19 53 20 8 13 12 81 31 ...
##  $ FACT_ADDRESS_PROVINCE     : Factor w/ 81 levels "Агинский Бурятский АО",..: 47 20 19 53 20 8 13 12 81 31 ...
##  $ POSTAL_ADDRESS_PROVINCE   : Factor w/ 80 levels "Агинский Бурятский АО",..: 46 19 18 52 19 8 13 12 80 30 ...
##  $ TP_PROVINCE               : Factor w/ 70 levels "Адыгея","Алтайский край",..: 41 55 17 47 55 7 12 11 70 27 ...
##  $ REGION_NM                 : Factor w/ 11 levels "ВОСТОЧНО-СИБИРСКИЙ",..: 4 11 1 11 11 8 9 11 9 11 ...
##  $ REG_FACT_FL               : Factor w/ 2 levels "0","1": 2 2 2 1 2 2 2 2 2 2 ...
##  $ FACT_POST_FL              : Factor w/ 2 levels "0","1": 2 2 2 2 2 2 2 2 2 2 ...
##  $ REG_POST_FL               : Factor w/ 2 levels "0","1": 2 2 2 1 2 2 2 2 2 2 ...
##  $ REG_FACT_POST_FL          : Factor w/ 2 levels "0","1": 2 2 2 1 2 2 2 2 2 2 ...
##  $ REG_FACT_POST_TP_FL       : Factor w/ 2 levels "0","1": 2 1 2 2 1 2 2 2 2 2 ...
##  $ FL_PRESENCE_FL            : Factor w/ 2 levels "0","1": 1 1 1 2 1 1 2 2 1 2 ...
##  $ OWN_AUTO                  : int  0 0 0 0 0 1 0 0 0 0 ...
##  $ AUTO_RUS_FL               : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 1 1 1 1 ...
##  $ HS_PRESENCE_FL            : Factor w/ 2 levels "0","1": 1 1 2 1 2 1 1 1 1 1 ...
##  $ COT_PRESENCE_FL           : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 1 1 1 1 ...
##  $ GAR_PRESENCE_FL           : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 1 1 1 1 ...
##  $ LAND_PRESENCE_FL          : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 1 1 1 1 ...
##  $ CREDIT                    : num  8000 21650 33126 8492 21990 ...
##  $ TERM                      : int  6 6 12 6 12 12 3 10 4 6 ...
##  $ FST_PAYMENT               : num  8650 4000 4000 5000 4000 ...
##  $ DL_DOCUMENT_FL            : Factor w/ 1 level "0": 1 1 1 1 1 1 1 1 1 1 ...
##  $ GPF_DOCUMENT_FL           : Factor w/ 2 levels "0","1": 2 2 2 1 2 1 2 2 1 1 ...
##  $ FACT_LIVING_TERM          : int  220 137 251 36 83 108 48 204 228 279 ...
##  $ WORK_TIME                 : int  18 97 84 168 101 40 6 6 156 72 ...
##  $ FACT_PHONE_FL             : Factor w/ 2 levels "0","1": 1 2 1 2 2 2 1 2 2 1 ...
##  $ REG_PHONE_FL              : Factor w/ 2 levels "0","1": 1 1 1 2 1 1 1 2 1 1 ...
##  $ GEN_PHONE_FL              : Factor w/ 2 levels "0","1": 2 2 2 2 2 2 2 2 2 2 ...
##  $ LOAN_NUM_TOTAL            : int  1 1 2 1 2 2 2 2 1 1 ...
##  $ LOAN_NUM_CLOSED           : int  1 1 1 1 1 1 2 1 1 1 ...
##  $ LOAN_NUM_PAYM             : int  6 6 11 6 16 11 14 11 3 6 ...
##  $ LOAN_DLQ_NUM              : int  2 1 0 3 2 0 0 0 0 0 ...
##  $ LOAN_MAX_DLQ              : int  1 1 0 1 1 0 0 0 0 0 ...
##  $ LOAN_AVG_DLQ_AMT          : num  1580 4020 0 1590 1152 ...
##  $ LOAN_MAX_DLQ_AMT          : num  1580 4020 0 1590 2230 0 0 0 0 0 ...
##  $ PREVIOUS_CARD_NUM_UTILIZED: Factor w/ 3 levels "0","1","2": 1 1 1 1 1 1 1 1 1 1 ...
##  - attr(*, ".internal.selfref")=<externalptr>
Удаляем переменную-идентификатор, а также переменную DL_DOCUMENT_FL, значения которой одинаковы для всех объектов:
df <- df[, -c("AGREEMENT_RK", "DL_DOCUMENT_FL")]
Выполним наиболее простые очевидные преобразования данных, которые могут увеличить качество построенных нами моделей:
  1. Восполним пропуски в количественных переменных при помощи средних значений.
  2. Восполним пропуски в категориальнымх переменных при помощи самой частой категории.
  3. Для категориальных предикторов с большим количеством категорий объединим редкие категории в одну ("other").
  4. Нормализуем количественные переменные.
Для этого воспользуемся возможностями пакета recipes (https://topepo.github.io/recipes/):
library(recipes)
## Loading required package: dplyr
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:data.table':
## 
##     between, first, last
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
## Loading required package: broom
## 
## Attaching package: 'recipes'
## The following object is masked from 'package:stats':
## 
##     step
rec <- recipe(TARGET ~ ., data = df) %>%
    # Импутация пропусков в количественных переменных
    step_meanimpute(all_numeric()) %>%
    # Импутация пропусков в категориальных переменных
    step_modeimpute(all_nominal()) %>%
    # Укрупнение категорий
    step_other(GEN_INDUSTRY,
               REG_ADDRESS_PROVINCE,
               FACT_ADDRESS_PROVINCE,
               POSTAL_ADDRESS_PROVINCE,
               TP_PROVINCE,
               # Порог объединения выбран исходя из частот в выборке,
               # но без каких-либо формальных критериев
               threshold = 0.005) %>%
    # Нормализация
    step_center(all_numeric()) %>%
    step_scale(all_numeric()) 
rec
## Data Recipe
## 
## Inputs:
## 
##       role #variables
##    outcome          1
##  predictor         49
## 
## Operations:
## 
## Mean Imputation for all_numeric()
## Mode Imputation for all_nominal()
## Collapsing factor levels for GEN_INDUSTRY, ...
## Centering for all_numeric()
## Scaling for all_numeric()
Полученный объект rec содержит информацию о требуемых преобразованиях и о том, какие именно перенные должны быть преобразованы в заданном порядке; этот рецепт можно затем применить к любому набору данных с теми же переменными, в том числе при реализации перекрестной проверки (в этом случае необходимые для преобразования вычисления будут выполнены на обучающей части выборки, а затем применены к оставшимся наблюдениям).
Запустим преобразования для всего набора данных:
df_rec <- prep(rec, training = df, retain = TRUE, verbose = TRUE) %>%
    bake(newdata = df)
## oper 1 step meanimpute [training] 
## oper 2 step modeimpute [training] 
## oper 3 step other [training] 
## oper 4 step center [training] 
## oper 5 step scale [training]
Обратите внимание на сократившееся число факторов в преобразованных переменных:
str(df_rec)
## Classes 'tbl_df', 'tbl' and 'data.frame':    15223 obs. of  50 variables:
##  $ TARGET                    : Factor w/ 2 levels "no","yes": 1 1 1 1 1 1 1 1 1 1 ...
##  $ AGE                       : num  0.741 -0.725 0.999 -0.121 -0.897 ...
##  $ SOCSTATUS_WORK_FL         : Factor w/ 2 levels "0","1": 2 2 2 2 2 2 2 2 2 2 ...
##  $ SOCSTATUS_PENS_FL         : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 1 1 1 1 ...
##  $ GENDER                    : Factor w/ 2 levels "0","1": 2 2 2 2 1 1 1 2 1 2 ...
##  $ CHILD_TOTAL               : num  0.9048 1.9094 2.914 -0.0998 -1.1045 ...
##  $ DEPENDANTS                : num  0.437 2.899 -0.794 0.437 -0.794 ...
##  $ EDUCATION                 : Factor w/ 7 levels "Высшее","Два и более высших образования",..: 6 5 4 1 5 5 1 5 1 6 ...
##  $ MARITAL_STATUS            : Factor w/ 5 levels "Вдовец/Вдова",..: 5 5 5 5 5 2 4 5 5 5 ...
##  $ GEN_INDUSTRY              : Factor w/ 22 levels "Банк/Финансы",..: 18 18 5 11 2 18 3 16 4 11 ...
##  $ GEN_TITLE                 : Factor w/ 12 levels "Военнослужащий по контракту",..: 7 7 12 10 12 12 12 7 8 12 ...
##  $ ORG_TP_STATE              : Factor w/ 5 levels "Государственная комп./учреж.",..: 5 2 1 1 1 5 1 5 5 1 ...
##  $ ORG_TP_FCAPITAL           : Factor w/ 2 levels "Без участия",..: 1 1 1 1 1 1 1 1 1 1 ...
##  $ JOB_DIR                   : Factor w/ 10 levels "Адм-хоз. и трансп. службы",..: 3 9 9 9 9 1 9 9 9 9 ...
##  $ FAMILY_INCOME             : Factor w/ 5 levels "до 5000 руб.",..: 2 2 2 3 2 3 3 2 5 2 ...
##  $ PERSONAL_INCOME           : num  -0.982 -0.206 -0.538 1.236 -0.206 ...
##  $ REG_ADDRESS_PROVINCE      : Factor w/ 70 levels "Адыгея","Алтайский край",..: 40 16 15 46 16 7 12 11 69 26 ...
##  $ FACT_ADDRESS_PROVINCE     : Factor w/ 71 levels "Адыгея","Алтайский край",..: 41 16 15 47 16 7 12 11 70 26 ...
##  $ POSTAL_ADDRESS_PROVINCE   : Factor w/ 71 levels "Адыгея","Алтайский край",..: 41 16 15 47 16 7 12 11 70 26 ...
##  $ TP_PROVINCE               : Factor w/ 66 levels "Адыгея","Алтайский край",..: 37 50 16 43 50 7 12 11 65 25 ...
##  $ REGION_NM                 : Factor w/ 11 levels "ВОСТОЧНО-СИБИРСКИЙ",..: 4 11 1 11 11 8 9 11 9 11 ...
##  $ REG_FACT_FL               : Factor w/ 2 levels "0","1": 2 2 2 1 2 2 2 2 2 2 ...
##  $ FACT_POST_FL              : Factor w/ 2 levels "0","1": 2 2 2 2 2 2 2 2 2 2 ...
##  $ REG_POST_FL               : Factor w/ 2 levels "0","1": 2 2 2 1 2 2 2 2 2 2 ...
##  $ REG_FACT_POST_FL          : Factor w/ 2 levels "0","1": 2 2 2 1 2 2 2 2 2 2 ...
##  $ REG_FACT_POST_TP_FL       : Factor w/ 2 levels "0","1": 2 1 2 2 1 2 2 2 2 2 ...
##  $ FL_PRESENCE_FL            : Factor w/ 2 levels "0","1": 1 1 1 2 1 1 2 2 1 2 ...
##  $ OWN_AUTO                  : num  -0.363 -0.363 -0.363 -0.363 -0.363 ...
##  $ AUTO_RUS_FL               : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 1 1 1 1 ...
##  $ HS_PRESENCE_FL            : Factor w/ 2 levels "0","1": 1 1 2 1 2 1 1 1 1 1 ...
##  $ COT_PRESENCE_FL           : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 1 1 1 1 ...
##  $ GAR_PRESENCE_FL           : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 1 1 1 1 ...
##  $ LAND_PRESENCE_FL          : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 1 1 1 1 ...
##  $ CREDIT                    : num  -0.549 0.575 1.519 -0.508 0.603 ...
##  $ TERM                      : num  -0.513 -0.513 0.952 -0.513 0.952 ...
##  $ FST_PAYMENT               : num  1.018 0.117 0.117 0.31 0.117 ...
##  $ GPF_DOCUMENT_FL           : Factor w/ 2 levels "0","1": 2 2 2 1 2 1 2 2 1 1 ...
##  $ FACT_LIVING_TERM          : num  -0.0107 -0.0111 -0.0106 -0.0114 -0.0113 ...
##  $ WORK_TIME                 : num  -0.0118 -0.0084 -0.00896 -0.00534 -0.00823 ...
##  $ FACT_PHONE_FL             : Factor w/ 2 levels "0","1": 1 2 1 2 2 2 1 2 2 1 ...
##  $ REG_PHONE_FL              : Factor w/ 2 levels "0","1": 1 1 1 2 1 1 1 2 1 1 ...
##  $ GEN_PHONE_FL              : Factor w/ 2 levels "0","1": 2 2 2 2 2 2 2 2 2 2 ...
##  $ LOAN_NUM_TOTAL            : num  -0.489 -0.489 0.771 -0.489 0.771 ...
##  $ LOAN_NUM_CLOSED           : num  0.251 0.251 0.251 0.251 0.251 ...
##  $ LOAN_NUM_PAYM             : num  -0.236 -0.236 0.393 -0.236 1.021 ...
##  $ LOAN_DLQ_NUM              : num  2.634 1.175 -0.285 4.094 2.634 ...
##  $ LOAN_MAX_DLQ              : num  2.445 2.445 -0.366 2.445 2.445 ...
##  $ LOAN_AVG_DLQ_AMT          : num  1.62 4.568 -0.289 1.632 1.103 ...
##  $ LOAN_MAX_DLQ_AMT          : num  1.599 4.517 -0.291 1.611 2.376 ...
##  $ PREVIOUS_CARD_NUM_UTILIZED: Factor w/ 3 levels "0","1","2": 1 1 1 1 1 1 1 1 1 1 ...
Запустим основную функцию для оценки важности предикторов. Интуитивно можно ожидать, что многочисленные географические признаки окажутся избыточными и слабо связанными с целевой переменной, в то время как производные признаки (такие как REG_FACT_POST_TP_FL) будут более полезными. Ограничим количество итераций (maxRuns = 50) и используем ntree = 400:
library(Boruta)
## Loading required package: ranger
set.seed(42)
boruta_credit <- Boruta(TARGET ~ ., 
                        data = df_rec, 
                        doTrace = 2, 
                        ntree = 400,
                        maxRuns = 50)
saveRDS(boruta_credit,  "boruta_credit.rds")
boruta_credit <- readRDS("boruta_credit.rds")
boruta_credit
## Boruta performed 49 iterations in 15.85083 mins.
##  35 attributes confirmed important: AGE, CHILD_TOTAL, CREDIT,
## DEPENDANTS, EDUCATION and 30 more;
##  9 attributes confirmed unimportant: AUTO_RUS_FL, COT_PRESENCE_FL,
## FACT_PHONE_FL, FL_PRESENCE_FL, GAR_PRESENCE_FL and 4 more;
##  5 tentative attributes left: GENDER, LAND_PRESENCE_FL, OWN_AUTO,
## REG_FACT_POST_TP_FL, REG_POST_FL;
plot(boruta_credit)

Большинство признаков были классифицированы как важные или неважные, но для 5 признаков вывод о важности сделать не удалось: 5 tentative attributes left: GENDER, LAND_PRESENCE_FL, OWN_AUTO, REG_FACT_POST_TP_FL, REG_POST_FL. Функция TentativeRoughFix() позволяет принять решение для таких сомнительных предикторов путем сравнения медианного значения Z-оценки с соответствующим значением для наиболее важного “теневого” предиктора:
boruta_credit <- TentativeRoughFix(boruta_credit)
boruta_credit
## Boruta performed 49 iterations in 15.85083 mins.
## Tentatives roughfixed over the last 49 iterations.
##  40 attributes confirmed important: AGE, CHILD_TOTAL, CREDIT,
## DEPENDANTS, EDUCATION and 35 more;
##  9 attributes confirmed unimportant: AUTO_RUS_FL, COT_PRESENCE_FL,
## FACT_PHONE_FL, FL_PRESENCE_FL, GAR_PRESENCE_FL and 4 more;
Теперь все признаки классифицированы, и мы можем получить спецификацию модели, включающей только те из них, которые признаны важными:
model_formula <- getConfirmedFormula(boruta_credit)
model_formula
## TARGET ~ AGE + SOCSTATUS_WORK_FL + SOCSTATUS_PENS_FL + GENDER + 
##     CHILD_TOTAL + DEPENDANTS + EDUCATION + MARITAL_STATUS + GEN_INDUSTRY + 
##     GEN_TITLE + ORG_TP_STATE + FAMILY_INCOME + PERSONAL_INCOME + 
##     REG_ADDRESS_PROVINCE + FACT_ADDRESS_PROVINCE + POSTAL_ADDRESS_PROVINCE + 
##     TP_PROVINCE + REGION_NM + REG_FACT_FL + FACT_POST_FL + REG_POST_FL + 
##     REG_FACT_POST_FL + REG_FACT_POST_TP_FL + OWN_AUTO + HS_PRESENCE_FL + 
##     LAND_PRESENCE_FL + CREDIT + TERM + FST_PAYMENT + FACT_LIVING_TERM + 
##     WORK_TIME + GEN_PHONE_FL + LOAN_NUM_TOTAL + LOAN_NUM_CLOSED + 
##     LOAN_NUM_PAYM + LOAN_DLQ_NUM + LOAN_MAX_DLQ + LOAN_AVG_DLQ_AMT + 
##     LOAN_MAX_DLQ_AMT + PREVIOUS_CARD_NUM_UTILIZED
## <environment: 0x0000000022a864a8>
Функция attStats() выводит таблицу с Z-оценками и долей построенных моделей, в которых переменная была важнее самого важного “теневого” предиктора:
knitr::kable(attStats(boruta_credit))
meanImp medianImp minImp maxImp normHits decision
AGE 20.7096375 20.6627969 18.2756194 22.6347564 1.0000000 Confirmed
SOCSTATUS_WORK_FL 8.6548067 8.6939894 7.8416574 9.4854320 1.0000000 Confirmed
SOCSTATUS_PENS_FL 8.4983425 8.4473403 7.0674574 10.5559807 1.0000000 Confirmed
GENDER 3.0990163 3.2686684 -0.4727363 5.1363919 0.7346939 Confirmed
CHILD_TOTAL 7.3571376 7.2943908 5.3030824 9.1715692 1.0000000 Confirmed
DEPENDANTS 8.3242329 8.3296483 6.3006046 10.6274032 1.0000000 Confirmed
EDUCATION 5.7463875 5.5839868 3.6494640 8.4369554 1.0000000 Confirmed
MARITAL_STATUS 4.5775609 4.7426250 1.7787790 6.4544319 0.9387755 Confirmed
GEN_INDUSTRY 5.8701516 5.9126351 4.5696258 7.3414620 1.0000000 Confirmed
GEN_TITLE 5.1121183 4.9933949 3.3873886 6.7685029 1.0000000 Confirmed
ORG_TP_STATE 5.3408649 5.5113346 3.7489345 6.8364244 1.0000000 Confirmed
ORG_TP_FCAPITAL 0.4678288 0.5372528 -1.6031459 2.1961436 0.0204082 Rejected
JOB_DIR 1.4447798 1.4489697 0.1061169 3.3557212 0.0612245 Rejected
FAMILY_INCOME 8.0516529 8.0189909 6.0548242 9.7718398 1.0000000 Confirmed
PERSONAL_INCOME 13.2528349 13.1636712 12.0331779 16.0419238 1.0000000 Confirmed
REG_ADDRESS_PROVINCE 16.6883729 16.8119672 12.7801136 19.9026693 1.0000000 Confirmed
FACT_ADDRESS_PROVINCE 16.3889883 16.2640406 11.9446699 20.0398122 1.0000000 Confirmed
POSTAL_ADDRESS_PROVINCE 16.0104570 16.2605317 12.1769237 19.3700414 1.0000000 Confirmed
TP_PROVINCE 18.7653930 19.1352893 14.8158151 21.4063973 1.0000000 Confirmed
REGION_NM 6.7337431 6.7491269 4.7884686 9.2674335 1.0000000 Confirmed
REG_FACT_FL 3.3307630 3.3343206 0.9612639 5.9418944 0.8775510 Confirmed
FACT_POST_FL 3.1105703 3.0820172 1.5254150 5.8548346 0.7959184 Confirmed
REG_POST_FL 1.6300924 1.6441348 -0.4427953 3.9295826 0.3061224 Confirmed
REG_FACT_POST_FL 3.6216741 3.7122198 0.9156645 5.4131162 0.8979592 Confirmed
REG_FACT_POST_TP_FL 2.4000608 2.2459411 0.7082823 4.8071545 0.5102041 Confirmed
FL_PRESENCE_FL 0.5455356 0.5555039 -1.1432566 2.3673189 0.0408163 Rejected
OWN_AUTO 2.0007559 2.0517385 -0.0027658 4.1932542 0.3877551 Confirmed
AUTO_RUS_FL 1.2419783 1.2321956 -0.4456827 2.4687516 0.0816327 Rejected
HS_PRESENCE_FL 3.4716035 3.4989169 1.1659150 5.8763687 0.8367347 Confirmed
COT_PRESENCE_FL 1.4956825 1.4409472 -0.7669978 3.7407182 0.1224490 Rejected
GAR_PRESENCE_FL -0.9769936 -1.0836353 -2.6439961 0.6989749 0.0000000 Rejected
LAND_PRESENCE_FL 2.7901920 2.9286109 1.0133081 4.3042647 0.7551020 Confirmed
CREDIT 13.5590166 13.5606132 11.0744696 17.2808776 1.0000000 Confirmed
TERM 11.1229995 11.1528005 8.9397697 13.2364663 1.0000000 Confirmed
FST_PAYMENT 8.5565790 8.6909867 6.3294932 10.7385771 1.0000000 Confirmed
GPF_DOCUMENT_FL 1.1179748 0.9522345 -0.8174420 3.6398974 0.1428571 Rejected
FACT_LIVING_TERM 7.8462965 7.9233160 5.8665817 10.0807110 1.0000000 Confirmed
WORK_TIME 11.0203579 11.0386126 9.2361605 12.5355876 1.0000000 Confirmed
FACT_PHONE_FL 0.9342074 0.9283116 -0.6754820 2.5517345 0.1020408 Rejected
REG_PHONE_FL 0.7572083 0.7560811 -0.7665342 2.1113343 0.0408163 Rejected
GEN_PHONE_FL 5.1733052 5.0869914 3.7253784 6.5063906 1.0000000 Confirmed
LOAN_NUM_TOTAL 10.2998706 10.4224284 7.5556934 12.1554906 1.0000000 Confirmed
LOAN_NUM_CLOSED 12.6843904 12.7573278 10.9422259 14.8044616 1.0000000 Confirmed
LOAN_NUM_PAYM 15.2474818 15.3402702 13.2782366 18.0805795 1.0000000 Confirmed
LOAN_DLQ_NUM 8.0115917 8.0422883 6.7469697 9.1204229 1.0000000 Confirmed
LOAN_MAX_DLQ 7.9753030 7.9814671 6.7996328 9.0803906 1.0000000 Confirmed
LOAN_AVG_DLQ_AMT 12.2306907 12.2703791 10.1782415 15.3844612 1.0000000 Confirmed
LOAN_MAX_DLQ_AMT 12.6779555 12.6074731 11.0011425 14.6834075 1.0000000 Confirmed
PREVIOUS_CARD_NUM_UTILIZED 9.9717239 10.0507029 8.2556916 11.3320532 1.0000000 Confirmed
Также мы можем вывести изменения Z-оценок по итерациям алгоритма. Зеленые линии соответствуют подтвержденным признакам, красные - исключенным, а синие показывают минимальные, средние и максимальные важности “теневых” предикторов:
plotImpHistory(boruta_credit)

Рассмотрим на примере линейной модели с регуляризацией, получится ли повысить качество модели, оставив лишь выбранные при помощи Boruta предикторы. Построим модель с использованием всех предикторов и с балансировкой классов по методу SMOTE:
library(caret)
## Loading required package: lattice
## Loading required package: ggplot2
library(doParallel) 
cl <- makeCluster(6)
registerDoParallel(cl) 

fitControl <- trainControl(method = "repeatedcv", 
                           number = 5, 
                           repeats = 5,
                           classProbs = TRUE, 
                           summaryFunction = twoClassSummary,
                           sampling = "smote")

set.seed(100)
fit1 <- train(TARGET ~ ., 
              data = df_rec, 
              method = "glmnet", 
              trControl = fitControl,
              metric = "ROC",
              tuneGrid = expand.grid(alpha = c(0.1, 0.5, 1),
                                     lambda = c(0.005, 0.01, 0.02)))
saveRDS(fit1,  "fit1.rds")
fit1 <- readRDS("fit1.rds")
fit1$results[order(-fit1$results$ROC), ]
##   alpha lambda       ROC      Sens      Spec      ROCSD     SensSD
## 4   0.5  0.005 0.6503514 0.8704800 0.2562851 0.01773399 0.01712177
## 7   1.0  0.005 0.6497918 0.8774296 0.2361980 0.01989627 0.01597116
## 5   0.5  0.010 0.6482344 0.8764152 0.2365314 0.01806491 0.01528983
## 2   0.1  0.010 0.6481599 0.8632173 0.2683156 0.01870433 0.01553562
## 1   0.1  0.005 0.6481278 0.8603539 0.2750495 0.01903856 0.01602243
## 3   0.1  0.020 0.6477692 0.8694807 0.2563989 0.01833568 0.01438795
## 8   1.0  0.010 0.6415976 0.8836033 0.2130235 0.01870479 0.01265496
## 6   0.5  0.020 0.6411208 0.8863024 0.2076137 0.01803476 0.01348597
## 9   1.0  0.020 0.6283342 0.8938782 0.1879735 0.01701037 0.01104558
##       SpecSD
## 4 0.02051439
## 7 0.02405942
## 5 0.01922492
## 2 0.02537087
## 1 0.02164233
## 3 0.02527973
## 8 0.02084642
## 6 0.01761795
## 9 0.02446512
#   alpha lambda       ROC      Sens      Spec      ROCSD     SensSD     SpecSD
# 4   0.5  0.005 0.6503514 0.8704800 0.2562851 0.01773399 0.01712177 0.02051439
# 7   1.0  0.005 0.6497918 0.8774296 0.2361980 0.01989627 0.01597116 0.02405942
# 5   0.5  0.010 0.6482344 0.8764152 0.2365314 0.01806491 0.01528983 0.01922492
# 2   0.1  0.010 0.6481599 0.8632173 0.2683156 0.01870433 0.01553562 0.02537087
# 1   0.1  0.005 0.6481278 0.8603539 0.2750495 0.01903856 0.01602243 0.02164233
# 3   0.1  0.020 0.6477692 0.8694807 0.2563989 0.01833568 0.01438795 0.02527973
# 8   1.0  0.010 0.6415976 0.8836033 0.2130235 0.01870479 0.01265496 0.02084642
# 6   0.5  0.020 0.6411208 0.8863024 0.2076137 0.01803476 0.01348597 0.01761795
# 9   1.0  0.020 0.6283342 0.8938782 0.1879735 0.01701037 0.01104558 0.02446512
И модель с использованием только важных предикторов:
set.seed(100)
fit2 <- train(model_formula,
              data = df_rec, 
              method = "glmnet", 
              trControl = fitControl,
              metric = "ROC",
              tuneGrid = expand.grid(alpha = c(0.1, 0.5, 1),
                                     lambda = c(0.005, 0.01, 0.02)))
saveRDS(fit2,  "fit2.rds")

stopCluster(cl)
registerDoSEQ()
fit2 <- readRDS("fit2.rds")
fit2$results[order(-fit2$results$ROC), ]
##   alpha lambda       ROC      Sens      Spec      ROCSD     SensSD
## 4   0.5  0.005 0.6484806 0.8711360 0.2511027 0.01566550 0.01661926
## 7   1.0  0.005 0.6475618 0.8780111 0.2364212 0.01797399 0.01526259
## 1   0.1  0.005 0.6467787 0.8622179 0.2702001 0.01712642 0.01655086
## 2   0.1  0.010 0.6465454 0.8654391 0.2628014 0.01676874 0.01620963
## 3   0.1  0.020 0.6459140 0.8702112 0.2505478 0.01644440 0.01528026
## 5   0.5  0.010 0.6458832 0.8772055 0.2330012 0.01610719 0.01548662
## 8   1.0  0.010 0.6390629 0.8829022 0.2135753 0.01742186 0.01263582
## 6   0.5  0.020 0.6388762 0.8849750 0.2088325 0.01604394 0.01422487
## 9   1.0  0.020 0.6262622 0.8925358 0.1870886 0.01659742 0.01167559
##       SpecSD
## 4 0.01732735
## 7 0.02401079
## 1 0.02112067
## 2 0.02331063
## 3 0.02247979
## 5 0.01658955
## 8 0.02022964
## 6 0.01468204
## 9 0.02297930
#   alpha lambda       ROC      Sens      Spec      ROCSD     SensSD     SpecSD
# 4   0.5  0.005 0.6484806 0.8711360 0.2511027 0.01566550 0.01661926 0.01732735
# 7   1.0  0.005 0.6475618 0.8780111 0.2364212 0.01797399 0.01526259 0.02401079
# 1   0.1  0.005 0.6467787 0.8622179 0.2702001 0.01712642 0.01655086 0.02112067
# 2   0.1  0.010 0.6465454 0.8654391 0.2628014 0.01676874 0.01620963 0.02331063
# 3   0.1  0.020 0.6459140 0.8702112 0.2505478 0.01644440 0.01528026 0.02247979
# 5   0.5  0.010 0.6458832 0.8772055 0.2330012 0.01610719 0.01548662 0.01658955
# 8   1.0  0.010 0.6390629 0.8829022 0.2135753 0.01742186 0.01263582 0.02022964
# 6   0.5  0.020 0.6388762 0.8849750 0.2088325 0.01604394 0.01422487 0.01468204
# 9   1.0  0.020 0.6262622 0.8925358 0.1870886 0.01659742 0.01167559 0.02297930
Сравним полученные модели:
resamps <- resamples(list(all_vars = fit1,
                          selected_vars = fit2))
summary(resamps)
## 
## Call:
## summary.resamples(object = resamps)
## 
## Models: all_vars, selected_vars 
## Number of resamples: 25 
## 
## ROC 
##                    Min.   1st Qu.    Median      Mean   3rd Qu.      Max.
## all_vars      0.6130847 0.6394615 0.6503341 0.6503514 0.6642559 0.6900610
## selected_vars 0.6173150 0.6369972 0.6492030 0.6484806 0.6601757 0.6843951
##               NA's
## all_vars         0
## selected_vars    0
## 
## Sens 
##                    Min.   1st Qu.    Median     Mean   3rd Qu.      Max.
## all_vars      0.8199776 0.8627890 0.8743475 0.870480 0.8836689 0.8907532
## selected_vars 0.8225867 0.8650261 0.8762118 0.871136 0.8818046 0.8907532
##               NA's
## all_vars         0
## selected_vars    0
## 
## Spec 
##                    Min.   1st Qu.    Median      Mean   3rd Qu.      Max.
## all_vars      0.2044199 0.2424242 0.2569061 0.2562851 0.2734807 0.2845304
## selected_vars 0.2154696 0.2403315 0.2541436 0.2511027 0.2644628 0.2762431
##               NA's
## all_vars         0
## selected_vars    0
dotplot(resamps, metric = "ROC")

Как видим, качество модели с использованием отобранных предикторов оказалось чуть ниже, хотя эти различия и являются статистически незначимыми. Это именно та ситуация, к которой нужно быть готовым при работе над реальными задачами: не все методы дают ожидаемый результат, но это не повод от них оказываться, не испытав в деле.
Тем не менее, радует сама возможность получить конкурентоспособные результаты, использовав меньший по числу переменных набор данных. Возможно, в некоторых случаях это поможет сэкономить на покупке дополнительного объема ОЗУ или на аренде сервера для расчетов.
Кроме того, на редуцированном наборе данных получено меньшее значение стандартного отклонения для выбранных метрик качества, что также является положительным аспектом: полученные значения метрик являются оценками истинного значения, и чем ниже степень неопределенности наших оценок, тем лучше.
В завершение проведем еще один эксперимент. Используем one-hot кодирование категориальных переменных, количественные предикторы нормализовывать не будем, а также откажемся от балансировки классов:
rec <- recipe(TARGET ~ ., data = df) %>%
    # Импутация пропусков в количественных переменных
    step_meanimpute(all_numeric()) %>%
    # Импутация пропусков в категориальных переменных
    step_modeimpute(all_nominal()) %>%
    # Укрупнение категорий
    step_other(GEN_INDUSTRY,
               REG_ADDRESS_PROVINCE,
               FACT_ADDRESS_PROVINCE,
               POSTAL_ADDRESS_PROVINCE,
               TP_PROVINCE,
               # Порог объединения выбран исходя из частот в выборке,
               # но без каких-либо формальных критериев
               threshold = 0.005) %>%
    step_dummy(all_nominal(), -all_outcomes())
rec

df_rec <- prep(rec, training = df, retain = TRUE, verbose = TRUE) %>%
    bake(newdata = df)


fitControl <- trainControl(method = "repeatedcv", 
                           number = 5, 
                           repeats = 5,
                           classProbs = TRUE, 
                           summaryFunction = twoClassSummary)

set.seed(100)
fit <- train(TARGET ~ ., 
             data = df_rec, 
             method = "glmnet", 
             trControl = fitControl,
             metric = "ROC",
             tuneGrid = expand.grid(alpha = c(0.5),
                                    lambda = c(0.01)))

fit
# glmnet 
# 
# 15223 samples
#   381 predictor
#     2 classes: 'no', 'yes' 
# 
# No pre-processing
# Resampling: Cross-Validated (5 fold, repeated 5 times) 
# Summary of sample sizes: 12179, 12178, 12179, 12178, 12178, 12178, ... 
# Resampling results:
# 
#   ROC        Sens       Spec       
#   0.6832137  0.9992991  0.001103755
# 
# Tuning parameter 'alpha' was held constant at a value of 0.5
# Tuning parameter 'lambda' was
#  held constant at a value of 0.01
Полученная модель превзошла по качеству все предыдущие, хотя в ней использованы самые простые подходы.
Автор: на

3 комментария:

  1. Edward1 мая 2018 г. в 09:29

    Андрей, а почему вы использовали recipe?
    в caret же есть свой препроцессинг. recipe лучше / удобнее чем -то или вы просто показали альтернативу?

    ОтветитьУдалить
    Ответы
    1. ogurtsov1 мая 2018 г. в 09:47

      Это разработка все того же M. Kuhn-а. Дальнейшее развитие того, что есть в caret. Вот же ключевая особенность, которой не хватало: "Полученный объект rec содержит информацию о требуемых преобразованиях и о том, какие именно перенные должны быть преобразованы в заданном порядке; этот рецепт можно затем применить к любому набору данных с теми же переменными, в том числе при реализации перекрестной проверки (в этом случае необходимые для преобразования вычисления будут выполнены на обучающей части выборки, а затем применены к оставшимся наблюдениям)."

      Удалить
    2. Edward1 мая 2018 г. в 10:24

      спасибо

      Удалить

Подписаться на: Комментарии к сообщению (Atom)