Skip to content

Commit a466fc4

Browse files
simonpcouchsimonpcouch
committed
fix svm tests
The fourth factor level in hpc_data was preserved in some tests. Also, some manually entered predictions needed to be rewritten.
1 parent 5ae33c5 commit a466fc4

File tree

2 files changed

+60
-62
lines changed

2 files changed

+60
-62
lines changed

‎tests/testthat/test_svm_poly.R

Lines changed: 23 additions & 27 deletions
Original file line numberDiff line numberDiff line change
@@ -6,7 +6,7 @@ library(tibble)
66
# ------------------------------------------------------------------------------
77

88
context("RBF SVM")
9-
source("helpers.R")
9+
source(test_path("helpers.R"))
1010
source(test_path("helper-objects.R"))
1111
hpc <- hpc_data[1:150, c(2:5, 8)]
1212

@@ -175,13 +175,15 @@ test_that('svm poly regression prediction', {
175175
kern_pred <-
176176
structure(
177177
list(
178-
.pred = c(5.02154233477783, 4.71496213707127, 4.78370369917621)),
178+
.pred = c(164.4739, 139.8284, 133.8760)),
179179
row.names = c(NA,-3L),
180180
class = c("tbl_df", "tbl", "data.frame")
181181
)
182182

183183
parsnip_pred <- predict(reg_form, hpc[1:3, -c(1, 5)])
184-
expect_equal(as.data.frame(kern_pred), as.data.frame(parsnip_pred))
184+
expect_equal(as.data.frame(kern_pred),
185+
as.data.frame(parsnip_pred),
186+
tolerance = .0001)
185187

186188

187189
reg_xy_form <-
@@ -194,7 +196,9 @@ test_that('svm poly regression prediction', {
194196
expect_equal(reg_form$fit@alphaindex, reg_xy_form$fit@alphaindex)
195197

196198
parsnip_xy_pred <- predict(reg_xy_form, hpc[1:3, -c(1, 5)])
197-
expect_equal(as.data.frame(kern_pred), as.data.frame(parsnip_xy_pred))
199+
expect_equal(as.data.frame(kern_pred),
200+
as.data.frame(parsnip_xy_pred),
201+
tolerance = .0001)
198202
})
199203

200204
# ------------------------------------------------------------------------------
@@ -230,58 +234,50 @@ test_that('svm poly classification probabilities', {
230234

231235
skip_if_not_installed("kernlab")
232236

233-
ind <- c(1, 51, 101)
237+
hpc_no_m <- hpc[-c(84, 85, 86, 87, 88, 109, 128),] %>%
238+
droplevels()
239+
240+
ind <- c(1, 2, 143)
234241

235242
set.seed(34562)
236243
cls_form <-
237244
fit(
238245
cls_mod,
239246
class ~ .,
240-
data = hpc,
247+
data = hpc_no_m,
241248
control = ctrl
242249
)
243250

244-
# kern_class <-
245-
# tibble(.pred_class = predict(cls_form$fit, hpc[ind, -5]))
251+
.pred_factor <- factor(c("F", "VF", "L"), levels = c("VF", "F", "L"))
246252

247253
kern_class <-
248254
structure(
249255
list(
250-
.pred_class =
251-
structure(1:3, .Label = c("setosa", "versicolor", "virginica"), class = "factor")),
256+
.pred_class = .pred_factor),
252257
row.names = c(NA, -3L), class = c("tbl_df", "tbl", "data.frame"))
253258

254-
parsnip_class <- predict(cls_form, hpc[ind, -5])
259+
parsnip_class <- predict(cls_form, hpc_no_m[ind, -5])
255260
expect_equal(kern_class, parsnip_class)
256261

257262
set.seed(34562)
258263
cls_xy_form <-
259264
fit_xy(
260265
cls_mod,
261-
x = hpc[, 1:4],
262-
y = hpc$class,
266+
x = hpc_no_m[, 1:4],
267+
y = hpc_no_m$class,
263268
control = ctrl
264269
)
265270
expect_equal(cls_form$fit@alphaindex, cls_xy_form$fit@alphaindex)
266271

267272
library(kernlab)
268273
kern_probs <-
269-
kernlab::predict(cls_form$fit, hpc[ind, -5], type = "probabilities") %>%
274+
kernlab::predict(cls_form$fit, hpc_no_m[ind, -5], type = "probabilities") %>%
270275
as_tibble() %>%
271-
setNames(c('.pred_setosa', '.pred_versicolor', '.pred_virginica'))
272-
273-
# kern_probs <-
274-
# structure(
275-
# list(
276-
# .pred_setosa = c(0.982990083267231, 0.0167077303224448, 0.00930879923686657),
277-
# .pred_versicolor = c(0.00417116710624842, 0.946131931665357, 0.0015524073332013),
278-
# .pred_virginica = c(0.0128387496265202, 0.0371603380121978, 0.989138793429932)),
279-
# row.names = c(NA,-3L),
280-
# class = c("tbl_df", "tbl", "data.frame"))
281-
282-
parsnip_probs <- predict(cls_form, hpc[ind, -5], type = "prob")
276+
setNames(c('.pred_VF', '.pred_F', '.pred_L'))
277+
278+
parsnip_probs <- predict(cls_form, hpc_no_m[ind, -5], type = "prob")
283279
expect_equal(as.data.frame(kern_probs), as.data.frame(parsnip_probs))
284280

285-
parsnip_xy_probs <- predict(cls_xy_form, hpc[ind, -5], type = "prob")
281+
parsnip_xy_probs <- predict(cls_xy_form, hpc_no_m[ind, -5], type = "prob")
286282
expect_equal(as.data.frame(kern_probs), as.data.frame(parsnip_xy_probs))
287283
})

‎tests/testthat/test_svm_rbf.R

Lines changed: 37 additions & 35 deletions
Original file line numberDiff line numberDiff line change
@@ -138,6 +138,11 @@ test_that('svm rbf regression prediction', {
138138

139139
skip_if_not_installed("kernlab")
140140

141+
hpc_no_m <- hpc[-c(84, 85, 86, 87, 88, 109, 128),] %>%
142+
droplevels()
143+
144+
ind <- c(2, 1, 143)
145+
141146
reg_form <-
142147
fit(
143148
reg_mod,
@@ -146,30 +151,30 @@ test_that('svm rbf regression prediction', {
146151
control = ctrl
147152
)
148153

149-
# kern_pred <-
150-
# predict(reg_form$fit, hpc[1:3, -c(1, 5)]) %>%
151-
# as_tibble() %>%
152-
# setNames(".pred")
153154
kern_pred <-
154155
structure(
155-
list(.pred = c(5.02786147259765, 4.81715220026091, 4.86817852816449)),
156+
list(.pred = c(131.7743, 372.0932, 902.0633)),
156157
row.names = c(NA, -3L), class = c("tbl_df", "tbl", "data.frame"))
157158

158-
parsnip_pred <- predict(reg_form, hpc[1:3, -c(1, 5)])
159-
expect_equal(as.data.frame(kern_pred), as.data.frame(parsnip_pred))
159+
parsnip_pred <- predict(reg_form, hpc[ind, -c(2, 5)])
160+
expect_equal(as.data.frame(kern_pred),
161+
as.data.frame(parsnip_pred),
162+
tolerance = .0001)
160163

161164

162165
reg_xy_form <-
163166
fit_xy(
164167
reg_mod,
165-
x = hpc[, 2:4],
168+
x = hpc[, c(1, 3, 4)],
166169
y = hpc$input_fields,
167170
control = ctrl
168171
)
169172
expect_equal(reg_form$fit@alphaindex, reg_xy_form$fit@alphaindex)
170173

171-
parsnip_xy_pred <- predict(reg_xy_form, hpc[1:3, -c(1, 5)])
172-
expect_equal(as.data.frame(kern_pred), as.data.frame(parsnip_xy_pred))
174+
parsnip_xy_pred <- predict(reg_xy_form, hpc[ind, -c(2, 5)])
175+
expect_equal(as.data.frame(kern_pred),
176+
as.data.frame(parsnip_xy_pred),
177+
tolerance = .0001)
173178
})
174179

175180
# ------------------------------------------------------------------------------
@@ -178,12 +183,17 @@ test_that('svm rbf classification', {
178183

179184
skip_if_not_installed("kernlab")
180185

186+
hpc_no_m <- hpc[-c(84, 85, 86, 87, 88, 109, 128),] %>%
187+
droplevels()
188+
189+
ind <- c(2, 1, 143)
190+
181191
expect_error(
182192
fit_xy(
183193
cls_mod,
184194
control = ctrl,
185-
x = hpc[, -5],
186-
y = hpc$class
195+
x = hpc_no_m[, -5],
196+
y = hpc_no_m$class
187197
),
188198
regexp = NA
189199
)
@@ -192,7 +202,7 @@ test_that('svm rbf classification', {
192202
fit(
193203
cls_mod,
194204
class ~ .,
195-
data = hpc,
205+
data = hpc_no_m,
196206
control = ctrl
197207
),
198208
regexp = NA
@@ -205,58 +215,50 @@ test_that('svm rbf classification probabilities', {
205215

206216
skip_if_not_installed("kernlab")
207217

208-
ind <- c(1, 51, 101)
218+
hpc_no_m <- hpc[-c(84, 85, 86, 87, 88, 109, 128),] %>%
219+
droplevels()
220+
221+
ind <- c(4, 55, 143)
209222

210223
set.seed(34562)
211224
cls_form <-
212225
fit(
213226
cls_mod,
214227
class ~ .,
215-
data = hpc,
228+
data = hpc_no_m,
216229
control = ctrl
217230
)
218231

219-
# kern_class <-
220-
# tibble(.pred_class = predict(cls_form$fit, hpc[ind, -5]))
221-
222232
kern_class <-
223233
structure(list(
224234
.pred_class = structure(
225-
c(1L, 3L, 3L),
226-
.Label = c("setosa", "versicolor", "virginica"), class = "factor")),
235+
c(1L, 1L, 3L),
236+
.Label = c("VF", "F", "L"), class = "factor")),
227237
row.names = c(NA, -3L), class = c("tbl_df", "tbl", "data.frame"))
228238

229-
parsnip_class <- predict(cls_form, hpc[ind, -5])
239+
parsnip_class <- predict(cls_form, hpc_no_m[ind, -5])
230240
expect_equal(kern_class, parsnip_class)
231241

232242
set.seed(34562)
233243
cls_xy_form <-
234244
fit_xy(
235245
cls_mod,
236-
x = hpc[, 1:4],
237-
y = hpc$class,
246+
x = hpc_no_m[, 1:4],
247+
y = hpc_no_m$class,
238248
control = ctrl
239249
)
240250
expect_equal(cls_form$fit@alphaindex, cls_xy_form$fit@alphaindex)
241251

242252
library(kernlab)
243253
kern_probs <-
244-
kernlab::predict(cls_form$fit, hpc[ind, -5], type = "probabilities") %>%
254+
kernlab::predict(cls_form$fit, hpc_no_m[ind, -5], type = "probabilities") %>%
245255
as_tibble() %>%
246-
setNames(c('.pred_setosa', '.pred_versicolor', '.pred_virginica'))
247-
248-
# kern_probs <-
249-
# structure(
250-
# list(
251-
# .pred_setosa = c(0.985403715135807, 0.0158818274678279, 0.00633995479908973),
252-
# .pred_versicolor = c(0.00818691538722139, 0.359005663318986, 0.0173471664171275),
253-
# .pred_virginica = c(0.00640936947697121, 0.625112509213187, 0.976312878783783)),
254-
# row.names = c(NA,-3L), class = c("tbl_df", "tbl", "data.frame"))
256+
setNames(c('.pred_VF', '.pred_F', '.pred_L'))
255257

256-
parsnip_probs <- predict(cls_form, hpc[ind, -5], type = "prob")
258+
parsnip_probs <- predict(cls_form, hpc_no_m[ind, -5], type = "prob")
257259
expect_equal(as.data.frame(kern_probs), as.data.frame(parsnip_probs))
258260

259-
parsnip_xy_probs <- predict(cls_xy_form, hpc[ind, -5], type = "prob")
261+
parsnip_xy_probs <- predict(cls_xy_form, hpc_no_m[ind, -5], type = "prob")
260262
expect_equal(as.data.frame(kern_probs), as.data.frame(parsnip_xy_probs))
261263
})
262264

0 commit comments

Comments
 (0)