1. Пакет caret: методы выбора признаков и разведочный анализ

model_names <- names(getModelInfo())
cat("Количество доступных моделей:", length(model_names), "\n")
## Количество доступных моделей: 239
print(model_names)
##   [1] "ada"                 "AdaBag"              "AdaBoost.M1"        
##   [4] "adaboost"            "amdai"               "ANFIS"              
##   [7] "avNNet"              "awnb"                "awtan"              
##  [10] "bag"                 "bagEarth"            "bagEarthGCV"        
##  [13] "bagFDA"              "bagFDAGCV"           "bam"                
##  [16] "bartMachine"         "bayesglm"            "binda"              
##  [19] "blackboost"          "blasso"              "blassoAveraged"     
##  [22] "bridge"              "brnn"                "BstLm"              
##  [25] "bstSm"               "bstTree"             "C5.0"               
##  [28] "C5.0Cost"            "C5.0Rules"           "C5.0Tree"           
##  [31] "cforest"             "chaid"               "CSimca"             
##  [34] "ctree"               "ctree2"              "cubist"             
##  [37] "dda"                 "deepboost"           "DENFIS"             
##  [40] "dnn"                 "dwdLinear"           "dwdPoly"            
##  [43] "dwdRadial"           "earth"               "elm"                
##  [46] "enet"                "evtree"              "extraTrees"         
##  [49] "fda"                 "FH.GBML"             "FIR.DM"             
##  [52] "foba"                "FRBCS.CHI"           "FRBCS.W"            
##  [55] "FS.HGD"              "gam"                 "gamboost"           
##  [58] "gamLoess"            "gamSpline"           "gaussprLinear"      
##  [61] "gaussprPoly"         "gaussprRadial"       "gbm_h2o"            
##  [64] "gbm"                 "gcvEarth"            "GFS.FR.MOGUL"       
##  [67] "GFS.LT.RS"           "GFS.THRIFT"          "glm.nb"             
##  [70] "glm"                 "glmboost"            "glmnet_h2o"         
##  [73] "glmnet"              "glmStepAIC"          "gpls"               
##  [76] "hda"                 "hdda"                "hdrda"              
##  [79] "HYFIS"               "icr"                 "J48"                
##  [82] "JRip"                "kernelpls"           "kknn"               
##  [85] "knn"                 "krlsPoly"            "krlsRadial"         
##  [88] "lars"                "lars2"               "lasso"              
##  [91] "lda"                 "lda2"                "leapBackward"       
##  [94] "leapForward"         "leapSeq"             "Linda"              
##  [97] "lm"                  "lmStepAIC"           "LMT"                
## [100] "loclda"              "logicBag"            "LogitBoost"         
## [103] "logreg"              "lssvmLinear"         "lssvmPoly"          
## [106] "lssvmRadial"         "lvq"                 "M5"                 
## [109] "M5Rules"             "manb"                "mda"                
## [112] "Mlda"                "mlp"                 "mlpKerasDecay"      
## [115] "mlpKerasDecayCost"   "mlpKerasDropout"     "mlpKerasDropoutCost"
## [118] "mlpML"               "mlpSGD"              "mlpWeightDecay"     
## [121] "mlpWeightDecayML"    "monmlp"              "msaenet"            
## [124] "multinom"            "mxnet"               "mxnetAdam"          
## [127] "naive_bayes"         "nb"                  "nbDiscrete"         
## [130] "nbSearch"            "neuralnet"           "nnet"               
## [133] "nnls"                "nodeHarvest"         "null"               
## [136] "OneR"                "ordinalNet"          "ordinalRF"          
## [139] "ORFlog"              "ORFpls"              "ORFridge"           
## [142] "ORFsvm"              "ownn"                "pam"                
## [145] "parRF"               "PART"                "partDSA"            
## [148] "pcaNNet"             "pcr"                 "pda"                
## [151] "pda2"                "penalized"           "PenalizedLDA"       
## [154] "plr"                 "pls"                 "plsRglm"            
## [157] "polr"                "ppr"                 "pre"                
## [160] "PRIM"                "protoclass"          "qda"                
## [163] "QdaCov"              "qrf"                 "qrnn"               
## [166] "randomGLM"           "ranger"              "rbf"                
## [169] "rbfDDA"              "Rborist"             "rda"                
## [172] "regLogistic"         "relaxo"              "rf"                 
## [175] "rFerns"              "RFlda"               "rfRules"            
## [178] "ridge"               "rlda"                "rlm"                
## [181] "rmda"                "rocc"                "rotationForest"     
## [184] "rotationForestCp"    "rpart"               "rpart1SE"           
## [187] "rpart2"              "rpartCost"           "rpartScore"         
## [190] "rqlasso"             "rqnc"                "RRF"                
## [193] "RRFglobal"           "rrlda"               "RSimca"             
## [196] "rvmLinear"           "rvmPoly"             "rvmRadial"          
## [199] "SBC"                 "sda"                 "sdwd"               
## [202] "simpls"              "SLAVE"               "slda"               
## [205] "smda"                "snn"                 "sparseLDA"          
## [208] "spikeslab"           "spls"                "stepLDA"            
## [211] "stepQDA"             "superpc"             "svmBoundrangeString"
## [214] "svmExpoString"       "svmLinear"           "svmLinear2"         
## [217] "svmLinear3"          "svmLinearWeights"    "svmLinearWeights2"  
## [220] "svmPoly"             "svmRadial"           "svmRadialCost"      
## [223] "svmRadialSigma"      "svmRadialWeights"    "svmSpectrumString"  
## [226] "tan"                 "tanSearch"           "treebag"            
## [229] "vbmpRadial"          "vglmAdjCat"          "vglmContRatio"      
## [232] "vglmCumulative"      "widekernelpls"       "WM"                 
## [235] "wsrf"                "xgbDART"             "xgbLinear"          
## [238] "xgbTree"             "xyf"

Функция getModelInfo() возвращает сведения о моделях, поддерживаемых caret. Для отбора признаков пакет также предоставляет инструменты rfe(), sbf() и varImp().

x <- matrix(rnorm(50 * 5), ncol = 5)
colnames(x) <- paste0("X", 1:5)
y <- factor(rep(c("A", "B"), 25))
head(data.frame(x, Class = y))
##            X1          X2          X3         X4         X5 Class
## 1 -0.56047565  0.25331851 -0.71040656  0.7877388  2.1988103     A
## 2 -0.23017749 -0.02854676  0.25688371  0.7690422  1.3124130     B
## 3  1.55870831 -0.04287046 -0.24669188  0.3322026 -0.2651451     A
## 4  0.07050839  1.36860228 -0.34754260 -1.0083766  0.5431941     B
## 5  0.12928774 -0.22577099 -0.95161857 -0.1194526 -0.4143399     A
## 6  1.71506499  1.51647060 -0.04502772 -0.2803953 -0.4762469     B
plot_types <- c("pairs", "box", "density")
for (plot_type in plot_types) {
  p <- featurePlot(x = x, y = y, plot = plot_type)
  print(p)
  jpeg(filename = file.path("graphs", paste0("caret_", plot_type, ".jpg")),
       width = 1800, height = 1200, res = 150)
  print(p)
  dev.off()
}

Вывод. Поскольку признаки x сгенерированы независимо от классов A и B, выраженного устойчивого разделения классов на диаграммах ожидать не следует. Графики пар, распределений и размахов позволяют сравнить признаки и визуально оценить их возможную информативность. Результаты сохранены в файлы graphs/caret_pairs.jpg, graphs/caret_box.jpg и graphs/caret_density.jpg.

2. Оценка важности признаков iris с помощью FSelector

data(iris)
importance <- FSelector::information.gain(Species ~ ., data = iris)
importance <- importance[order(importance$attr_importance, decreasing = TRUE),
                         , drop = FALSE]
knitr::kable(data.frame(Признак = rownames(importance),
                        Важность = round(importance$attr_importance, 4)),
             row.names = FALSE)
Признак Важность
Petal.Width 0.9554
Petal.Length 0.9403
Sepal.Length 0.4521
Sepal.Width 0.2673

Вывод. По информационному выигрышу самый важный признак — Petal.Width, а наименее важный — Sepal.Width. Высокое значение информационного выигрыша означает, что признак лучше помогает различать виды ирисов при классификации.

3. Дискретизация непрерывной переменной iris с помощью arules

Для сравнения четырёх методов используется переменная Sepal.Length.

z <- iris$Sepal.Length
set.seed(123)
disc <- list(
  interval  = arules::discretize(z, method = "interval", breaks = 3),
  frequency = arules::discretize(z, method = "frequency", breaks = 3),
  cluster   = arules::discretize(z, method = "cluster", breaks = 3),
  fixed     = arules::discretize(z, method = "fixed",
                                breaks = c(-Inf, 5.5, 6.5, Inf))
)
for (method in names(disc)) {
  cat("\nМетод:", method, "\n")
  print(table(disc[[method]], useNA = "ifany"))
}
## 
## Метод: interval 
## 
## [4.3,5.5) [5.5,6.7) [6.7,7.9] 
##        52        70        28 
## 
## Метод: frequency 
## 
## [4.3,5.4) [5.4,6.3) [6.3,7.9] 
##        46        53        51 
## 
## Метод: cluster 
## 
##  [4.3,5.37) [5.37,6.36)  [6.36,7.9] 
##          46          62          42 
## 
## Метод: fixed 
## 
## [-Inf,5.5)  [5.5,6.5) [6.5, Inf] 
##         52         63         35

Вывод. Метод interval формирует интервалы одинаковой ширины, frequency стремится получить примерно равные по численности группы, cluster выделяет группы по результатам кластеризации, а fixed применяет заданные границы (5.5 и 6.5). Распределение наблюдений по категориям отличается, так как методы используют разные правила разбиения; при совпадающих значениях частоты могут быть неравными.

4. Отбор признаков набора Ozone с помощью Boruta

data("Ozone", package = "mlbench")
ozone_clean <- na.omit(Ozone)
cat("Наблюдений после удаления пропусков:", nrow(ozone_clean), "\n")
## Наблюдений после удаления пропусков: 203
set.seed(123)
boruta_result <- Boruta::Boruta(V4 ~ ., data = ozone_clean, doTrace = 0)
print(boruta_result)
## Boruta performed 18 iterations in 0.544275 secs.
##  9 attributes confirmed important: V1, V10, V11, V12, V13 and 4 more;
##  3 attributes confirmed unimportant: V2, V3, V6;
boruta_stats <- Boruta::attStats(boruta_result)
knitr::kable(data.frame(Признак = rownames(boruta_stats), boruta_stats,
                        row.names = NULL), digits = 3)
Признак meanImp medianImp minImp maxImp normHits decision
V1 0.407 0.399 0.372 0.504 1.000 Confirmed
V2 0.044 0.032 -0.026 0.131 0.111 Rejected
V3 -0.032 -0.045 -0.080 0.032 0.000 Rejected
V5 0.380 0.377 0.338 0.421 1.000 Confirmed
V6 0.047 0.060 -0.016 0.127 0.056 Rejected
V7 0.519 0.506 0.467 0.591 1.000 Confirmed
V8 0.771 0.769 0.733 0.813 1.000 Confirmed
V9 0.869 0.864 0.843 0.924 1.000 Confirmed
V10 0.424 0.417 0.382 0.492 1.000 Confirmed
V11 0.551 0.547 0.495 0.612 1.000 Confirmed
V12 0.661 0.658 0.602 0.740 1.000 Confirmed
V13 0.428 0.421 0.386 0.469 1.000 Confirmed
plot(boruta_result, sort = TRUE, las = 2,
     main = "Boruta: важность признаков Ozone")

jpeg("graphs/boruta_ozone_boxplot.jpg", width = 2400, height = 1500, res = 150)
plot(boruta_result, sort = TRUE, las = 2,
     main = "Boruta: важность признаков Ozone")
dev.off()
## png 
##   2
selected <- Boruta::getSelectedAttributes(boruta_result, withTentative = FALSE)
rejected <- rownames(boruta_stats)[boruta_stats$decision == "Rejected"]
tentative <- rownames(boruta_stats)[boruta_stats$decision == "Tentative"]
cat("Подтверждённые признаки:",
    if (length(selected)) paste(selected, collapse = ", ") else "нет", "\n")
## Подтверждённые признаки: V1, V5, V7, V8, V9, V10, V11, V12, V13
cat("Отклонённые признаки:",
    if (length(rejected)) paste(rejected, collapse = ", ") else "нет", "\n")
## Отклонённые признаки: V2, V3, V6
cat("Неопределённые признаки:",
    if (length(tentative)) paste(tentative, collapse = ", ") else "нет", "\n")
## Неопределённые признаки: нет

Вывод. Алгоритм Boruta сравнивает важность исходных переменных с важностью случайно перемешанных «теневых» признаков. Для прогноза V4 подтверждено 9 признаков, отклонено 3, осталось неопределёнными 0. На boxplot представлены распределения оценок важности, позволяющие сравнить существенные и несущественные признаки. График сохранён в graphs/boruta_ozone_boxplot.jpg.

Общий вывод

В работе изучены перечень моделей caret и разведочная визуализация featurePlot(), выполнено ранжирование признаков iris методом информационного выигрыша из FSelector, сопоставлены четыре способа дискретизации из arules и проведён отбор признаков Ozone алгоритмом Boruta. Получены графики исследования признаков и boxplot важности, графики сохранены в формате JPG.