Задание 1. Пакет caret: список методов и featurePlot()

library(caret)

# Список доступных моделей/методов caret
methods_list <- names(getModelInfo())
length(methods_list)
## [1] 239
head(methods_list, 50)
##  [1] "ada"            "AdaBag"         "AdaBoost.M1"    "adaboost"      
##  [5] "amdai"          "ANFIS"          "avNNet"         "awnb"          
##  [9] "awtan"          "bag"            "bagEarth"       "bagEarthGCV"   
## [13] "bagFDA"         "bagFDAGCV"      "bam"            "bartMachine"   
## [17] "bayesglm"       "binda"          "blackboost"     "blasso"        
## [21] "blassoAveraged" "bridge"         "brnn"           "BstLm"         
## [25] "bstSm"          "bstTree"        "C5.0"           "C5.0Cost"      
## [29] "C5.0Rules"      "C5.0Tree"       "cforest"        "chaid"         
## [33] "CSimca"         "ctree"          "ctree2"         "cubist"        
## [37] "dda"            "deepboost"      "DENFIS"         "dnn"           
## [41] "dwdLinear"      "dwdPoly"        "dwdRadial"      "earth"         
## [45] "elm"            "enet"           "evtree"         "extraTrees"    
## [49] "fda"            "FH.GBML"
# Данные из справочного файла caret
set.seed(123)
x <- matrix(rnorm(50 * 5), ncol = 5)
y <- factor(rep(c("A", "B"), 25))
colnames(x) <- paste0("V", 1:5)
featurePlot(x, y, plot = "pairs", auto.key = list(columns = 2))

featurePlot(x, y, plot = "density",
            scales = list(x = list(relation = "free"), y = list(relation = "free")),
            auto.key = list(columns = 2))

featurePlot(x, y, plot = "box",
            scales = list(y = list(relation = "free")))

# Сохранение графиков в jpg (print() обязателен для lattice-графиков!)
jpeg("feature_pairs.jpg", width = 800, height = 800)
print(featurePlot(x, y, plot = "pairs", auto.key = list(columns = 2)))
dev.off()
## quartz_off_screen 
##                 2
jpeg("feature_density.jpg", width = 800, height = 600)
print(featurePlot(x, y, plot = "density",
                  scales = list(x = list(relation = "free"), y = list(relation = "free")),
                  auto.key = list(columns = 2)))
dev.off()
## quartz_off_screen 
##                 2

Задание 2. Важность признаков с помощью FSelector (iris)

library(FSelector)
data(iris)

ig  <- information.gain(Species ~ ., iris)
gr  <- gain.ratio(Species ~ ., iris)
su  <- symmetrical.uncertainty(Species ~ ., iris)
chi <- chi.squared(Species ~ ., iris)

importance <- data.frame(
  InfoGain   = ig$attr_importance,
  GainRatio  = gr$attr_importance,
  SymUncert  = su$attr_importance,
  ChiSquared = chi$attr_importance,
  row.names  = rownames(ig)
)
importance
##               InfoGain GainRatio SymUncert ChiSquared
## Sepal.Length 0.4521286 0.4196464 0.4155563  0.6288067
## Sepal.Width  0.2672750 0.2472972 0.2452743  0.4922162
## Petal.Length 0.9402853 0.8584937 0.8571872  0.9346311
## Petal.Width  0.9554360 0.8713692 0.8705214  0.9432359
barplot(ig$attr_importance, names.arg = rownames(ig),
        main = "Важность признаков (Information Gain)", col = "steelblue")

# Отбор двух лучших признаков
cutoff.k(ig, 2)
## [1] "Petal.Width"  "Petal.Length"

Задание 3. Дискретизация с помощью discretize() (arules)

library(arules)
data(iris)
sl <- iris$Sepal.Length
range(sl)
## [1] 4.3 7.9
d_interval  <- discretize(sl, method = "interval",  breaks = 3)
d_frequency <- discretize(sl, method = "frequency", breaks = 3)
d_cluster   <- discretize(sl, method = "cluster",   breaks = 3)
d_fixed     <- discretize(sl, method = "fixed",
                          breaks = c(-Inf, 5.5, 6.5, Inf),
                          labels = c("short", "medium", "long"))

table(d_interval)
## d_interval
## [4.3,5.5) [5.5,6.7) [6.7,7.9] 
##        52        70        28
table(d_frequency)
## d_frequency
## [4.3,5.4) [5.4,6.3) [6.3,7.9] 
##        46        53        51
table(d_cluster)
## d_cluster
##  [4.3,5.33) [5.33,6.27)  [6.27,7.9] 
##          46          53          51
table(d_fixed)
## d_fixed
##  short medium   long 
##     52     63     35
# Наглядное сравнение: гистограмма с границами интервалов
par(mfrow = c(2, 2))
hist(sl, breaks = 20, main = "interval", xlab = "Sepal.Length")
abline(v = attr(d_interval, "discretized:breaks"), col = "red", lwd = 2)
hist(sl, breaks = 20, main = "frequency", xlab = "Sepal.Length")
abline(v = attr(d_frequency, "discretized:breaks"), col = "red", lwd = 2)
hist(sl, breaks = 20, main = "cluster", xlab = "Sepal.Length")
abline(v = attr(d_cluster, "discretized:breaks"), col = "red", lwd = 2)
hist(sl, breaks = 20, main = "fixed", xlab = "Sepal.Length")
abline(v = c(5.5, 6.5), col = "red", lwd = 2)

par(mfrow = c(1, 1))

Задание 4. Отбор признаков пакетом Boruta (Ozone)

library(Boruta)
library(mlbench)
data(Ozone)

# В Ozone есть пропуски, Boruta с ними не работает — удаляем строки с NA
ozone <- na.omit(Ozone)
dim(ozone)
## [1] 203  13
set.seed(123)
boruta_result <- Boruta(V4 ~ ., data = ozone, doTrace = 0, maxRuns = 200)
print(boruta_result)
## Boruta performed 18 iterations in 0.4594011 secs.
##  9 attributes confirmed important: V1, V10, V11, V12, V13 and 4 more;
##  3 attributes confirmed unimportant: V2, V3, V6;
plot(boruta_result, las = 2, cex.axis = 0.8, xlab = "",
     main = "Важность признаков (Boruta)")

final <- TentativeRoughFix(boruta_result)
getSelectedAttributes(final)
## [1] "V1"  "V5"  "V7"  "V8"  "V9"  "V10" "V11" "V12" "V13"
attStats(final)
##         meanImp   medianImp      minImp     maxImp   normHits  decision
## V1   0.40660229  0.39874710  0.37208192 0.50361585 1.00000000 Confirmed
## V2   0.04391890  0.03169822 -0.02604472 0.13137821 0.11111111  Rejected
## V3  -0.03235907 -0.04528594 -0.08039941 0.03178173 0.00000000  Rejected
## V5   0.37961385  0.37663333  0.33809868 0.42147363 1.00000000 Confirmed
## V6   0.04740489  0.05979747 -0.01572443 0.12718160 0.05555556  Rejected
## V7   0.51883205  0.50588169  0.46725744 0.59114026 1.00000000 Confirmed
## V8   0.77086858  0.76889989  0.73251688 0.81327051 1.00000000 Confirmed
## V9   0.86915268  0.86432645  0.84273725 0.92413075 1.00000000 Confirmed
## V10  0.42389058  0.41739463  0.38164901 0.49245967 1.00000000 Confirmed
## V11  0.55143690  0.54721914  0.49482770 0.61161304 1.00000000 Confirmed
## V12  0.66051279  0.65832222  0.60234621 0.73958611 1.00000000 Confirmed
## V13  0.42761454  0.42057856  0.38618408 0.46920282 1.00000000 Confirmed