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
|
context('Dummy Variables')
## Test cases by Josh Brady (doublej2) from issue #344
check_dummies <- function(x, expected = NULL) {
dfTrain <- data.frame(xf = c('a','b','c'))
dfTest <- data.frame(xf = c('a','b'))
dummyObj1 <- dummyVars(~., dfTrain)
expected_train <- diag(3)
colnames(expected_train) <- paste0("xf.", letters[1:3])
rownames(expected_train) <- paste(1:3)
expected_test <- expected_train[1:2,]
expect_equal(predict(dummyObj1, newdata = dfTrain),
expected_train)
expect_equal(predict(dummyObj1, newdata = dfTest),
expected_test)
###################################################################
## tests related to issue #390
## from ?dummyVars
when <- data.frame(time = c("afternoon", "night", "afternoon",
"morning", "morning", "morning",
"morning", "afternoon", "afternoon"),
day = c("Mon", "Mon", "Mon",
"Wed", "Wed", "Fri",
"Sat", "Sat", "Fri"))
levels(when$time) <- list(morning="morning",
afternoon="afternoon",
night="night")
levels(when$day) <- list(Mon="Mon", Tue="Tue", Wed="Wed", Thu="Thu",
Fri="Fri", Sat="Sat", Sun="Sun")
mainEffects <- dummyVars(~ day + time, data = when)
interactionModel <- dummyVars(~ day + time + day:time,
data = when,
sep = ".")
noNames <- dummyVars(~ day + time + day:time,
data = when,
levelsOnly = TRUE)
exp_main_nomissing <- structure(c(1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 1, 0, 1, 0, 0, 0, 0, 1,
1, 0, 1, 0, 0, 0, 0, 0, 0, 0),
.Dim = 9:10,
.Dimnames = list(
c("1", "2", "3", "4", "5", "6", "7", "8", "9"),
c("day.Mon", "day.Tue", "day.Wed", "day.Thu", "day.Fri",
"day.Sat", "day.Sun", "time.morning", "time.afternoon", "time.night")))
res_main_nomissing <- predict(mainEffects, when)
expect_equal(res_main_nomissing, exp_main_nomissing)
when2 <- when
when2[1, 1] <- NA
exp_main_missing <- structure(c(1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, NA, 0, 0, 1, 1, 1, 1, 0, 0, NA, 0, 1, 0, 0, 0, 0,
1, 1, NA, 1, 0, 0, 0, 0, 0, 0, 0),
.Dim = 9:10,
.Dimnames = list(
c("1", "2", "3", "4", "5", "6", "7", "8", "9"),
c("day.Mon", "day.Tue", "day.Wed", "day.Thu",
"day.Fri", "day.Sat", "day.Sun", "time.morning",
"time.afternoon", "time.night")))
res_main_missing <- predict(mainEffects, when2)
expect_equal(res_main_missing, exp_main_missing)
exp_main_omit <- structure(c(1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0,
0, 1, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1,
1, 1, 1, 0, 0, 0, 1, 0, 0, 0, 0, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0),
.Dim = c(8L, 10L),
.Dimnames = list(c("2", "3", "4", "5", "6", "7", "8", "9"),
c("day.Mon", "day.Tue", "day.Wed", "day.Thu",
"day.Fri", "day.Sat", "day.Sun", "time.morning",
"time.afternoon", "time.night")))
res_main_omit <- predict(mainEffects, when2, na.action = na.omit)
expect_equal(res_main_omit, exp_main_omit)
###################################################################
## tests related to issue #390
test_data <- data.frame('id' = seq(1,30,1),
'fooFactor' = factor(c(rep(1,10), rep(2,10), rep(3,10))),
'fooFactorBar' = factor(c(rep(4,10), rep(5,10), rep(6,10))),
'fooBarFactor' = factor(c(rep(7,10), rep(8,10), rep(9,10))))
foosbars <- dummies <- dummyVars(formula = id ~.,
data = test_data,
sep = '-')
exp_names <- c(paste("fooFactor", 1:3, sep = "-"),
paste("fooFactorBar", 4:6, sep = "-"),
paste("fooBarFactor", 7:9, sep = "-"))
res_names <- colnames(predict(foosbars, test_data))
expect_equal(exp_names, res_names)
foosbarsbars <- dummies <- dummyVars(formula = id ~.,
data = test_data,
sep = '-',
levelsOnly = TRUE)
exp_names_lvls <- paste(1:9)
res_names_lvls <- colnames(predict(foosbarsbars, test_data))
expect_equal(exp_names_lvls, res_names_lvls)
}
|
