1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
|
checkStack = function(task, method, base, super, bms.pt, sm.pt, use.feat) {
base = lapply(base, makeLearner, predict.type = bms.pt)
if (method %in% c("average", "hill.climb")) {
super = NULL
} else {
super = makeLearner(super, predict.type = sm.pt)
# sm.pt = NULL
}
if (method == "hill.climb" && bms.pt == "response" && inherits(task,
"ClassifTask")) {
return()
}
slrn = makeStackedLearner(base, super, method = method, use.feat = use.feat,
predict.type = sm.pt)
tr = train(slrn, task)
pr = predict(tr, task)
if (sm.pt == "prob") {
expect_equal(ncol(pr$data[, grepl("prob", colnames(pr$data))]),
length(getTaskClassLevels(task)))
}
if (method %nin% c("stack.cv", "hill.climb")) {
expect_equal(
getStackedBaseLearnerPredictions(tr),
getStackedBaseLearnerPredictions(tr, newdata = getTaskData(task))
)
}
}
test_that("Stacking works", {
tasks = list(binaryclass.task, multiclass.task, regr.task)
for (task in tasks) {
td = getTaskDesc(task)
if (inherits(task, "ClassifTask")) {
pts = c("response", "prob")
base = c("classif.rpart", "classif.lda", "classif.svm")
super = "classif.randomForest"
} else {
pts = "response"
base = c("regr.rpart", "regr.lm", "regr.svm")
super = "regr.randomForest"
}
for (method in c("average", "stack.cv", "stack.nocv", "hill.climb")) {
ufs = if (method %in% c("average", "hill.climb")) FALSE else c(FALSE, TRUE)
for (use.feat in ufs) {
for (sm.pt in pts) {
for (bms.pt in pts) {
# cat(td$type, td$id, method, use.feat, sm.pt, bms.pt, fill = TRUE)
checkStack(task, method, base, super, bms.pt, sm.pt, use.feat)
}
}
}
}
}
})
test_that("Stacking works with wrapped learners (#687)", {
base = "classif.rpart"
lrns = lapply(base, makeLearner)
lrns = lapply(lrns, setPredictType, "prob")
lrns[[1]] = makeFilterWrapper(lrns[[1]], fw.abs = 2)
expect_silent(makeStackedLearner(base.learners = lrns, predict.type = "prob",
method = "hill.climb"))
})
test_that("Parameters for hill climb works", {
tsk = binaryclass.task
base = c("classif.rpart", "classif.lda", "classif.svm")
lrns = lapply(base, makeLearner)
lrns = lapply(lrns, setPredictType, "prob")
m = makeStackedLearner(base.learners = lrns, predict.type = "prob",
method = "hill.climb",
parset = list(bagprob = 0.8, bagtime = 5, replace = FALSE))
tmp = train(m, tsk)
res = predict(tmp, tsk)
expect_equal(sum(tmp$learner.model$weights), 1)
metric = function(pred, true) {
pred = colnames(pred)[max.col(pred)]
tb = table(pred, true)
return(1 - sum(diag(tb)) / sum(tb))
}
m = makeStackedLearner(base.learners = lrns, predict.type = "prob",
method = "hill.climb",
parset = list(replace = TRUE, bagprob = 0.7, bagtime = 3, init = 2,
metric = metric))
tmp = train(m, tsk)
res = predict(tmp, tsk)
expect_equal(sum(tmp$learner.model$weights), 1)
})
test_that("Parameters for compress model", {
tsk = binaryclass.task
base = c("classif.rpart", "classif.lda", "classif.svm")
lrns = lapply(base, makeLearner)
lrns = lapply(lrns, setPredictType, "prob")
m = makeStackedLearner(base.learners = lrns, predict.type = "prob",
method = "compress",
parset = list(k = 5, prob = 0.3))
tmp = train(m, tsk)
res = predict(tmp, tsk)
tsk = regr.task
base = c("regr.rpart", "regr.svm")
lrns = lapply(base, makeLearner)
lrns = lapply(lrns, setPredictType, "response")
m = makeStackedLearner(base.learners = lrns, predict.type = "response",
method = "compress", parset = list(k = 5, prob = 0.3))
tmp = train(m, tsk)
expect_silent(predict(tmp, tsk))
})
|
