Задание 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