1context("rbind.fill")
2
3test_that("variable classes are preserved", {
4  a <- data.frame(
5    a = factor(letters[1:3]),
6    b = 1:3,
7    c = date(),
8    stringsAsFactors = TRUE
9  )
10  b <- data.frame(
11    a = factor(letters[3:5]),
12    d = as.Date(c("2008-01-01", "2009-01-01", "2010-01-01")))
13  b$e <- as.POSIXlt(as.Date(c("2008-01-01", "2009-01-01", "2010-01-01")))
14  b$f <- matrix (1:6, nrow = 3)
15
16  ab1 <- rbind.fill(a, b)[, letters[1:6]]
17  ab2 <- rbind.fill(b, a)[c(4:6, 1:3), letters[1:6]]
18  ab2$a <- factor(ab2$a, levels(ab1$a))
19  rownames(ab2) <- NULL
20
21  expect_that(ab1, equals(ab2))
22
23  expect_s3_class(ab1$a, "factor")
24  expect_type(ab1$b, "integer")
25  expect_s3_class(ab1$c, "factor")
26  expect_s3_class(ab1$d, "Date")
27  expect_s3_class(ab1$e, "POSIXct")
28  expect_equal(dim(ab1$f), c(6, 2))
29})
30
31test_that("same as rbind for simple cases", {
32  bsmall <- baseball[1:1000, ]
33  bplayer <- split(bsmall, bsmall$id)
34  b1 <- do.call("rbind", bplayer)
35  rownames(b1) <- NULL
36  b2 <- rbind.fill(bplayer)
37
38  expect_that(b1, equals(b2))
39})
40
41test_that("columns are in expected order", {
42  a <- data.frame(a = 1, b = 2, c = 3)
43  b <- data.frame(b = 2, d = 4, e = 4)
44  c <- data.frame(c = 1, b = 2, a = 1)
45
46  expect_that(names(rbind.fill(a, b)), equals(c("a", "b", "c", "d", "e")))
47  expect_that(names(rbind.fill(a, c)), equals(c("a", "b", "c")))
48  expect_that(names(rbind.fill(c, a)), equals(c("c", "b", "a")))
49})
50
51test_that("matrices are preserved", {
52  a <- data.frame(a = factor(letters[3:5]))
53  a$b <- matrix(1:6, nrow = 3)
54
55  expect_that(rbind.fill(a, a)$b, is_equivalent_to(rbind(a, a)$b))
56
57  b <- data.frame(c = 1:3)
58
59  ab1 <- rbind.fill(a, b) [           , letters[1:3]]
60  ab2 <- rbind.fill(b, a) [c(4:6, 1:3), letters[1:3]]
61  ab2$a <- factor(ab2$a, levels(ab1$a))
62  rownames(ab2) <- NULL
63
64  expect_that(ab1, equals(ab2))
65})
66
67test_that("character or factor or list-matrices are preserved", {
68  d1 <- data.frame(a=1:2,
69                   x=I(matrix(c('a', 'b', 'c', 'd'), nrow=2)))
70  d2 <- data.frame(b=1:2,
71                   x=I(`dim<-`(factor(c('a', 'b', 'c', 'd')), c(2,2))))
72  d3 <- data.frame(b=1:2,
73                   x=I(array(as.list(1:4), c(2,2))))
74
75  b1 <- rbind.fill(d1, d1)
76  b2 <- rbind.fill(d2, d2)
77  b3 <- rbind.fill(d3, d3)
78
79  expect_equal(dim(b1$x), c(4,2))
80  expect_equal(typeof(b1$x), "character")
81
82  expect_equal(dim(b2$x), c(4,2))
83  expect_is(b2$x, "factor")
84
85  expect_equal(dim(b3$x), c(4,2))
86  expect_equal(typeof(b3$x), "list")
87})
88
89test_that("missing levels in factors preserved", {
90  f <- addNA(factor(c("a", "b", NA)))
91  df1 <- data.frame(a = f, c = f)
92  df2 <- data.frame(b = f, c = f)
93  out <- rbind.fill(df1, df2)
94  expect_equal(levels(out$a), levels(f))
95  expect_equal(levels(out$b), levels(f))
96  expect_equal(levels(out$c), levels(f))
97})
98
99test_that("time zones are preserved", {
100  dstart <- "2011-01-01 00:01"
101  dstop <- "2011-01-02 04:15"
102
103  get_tz <- function(x) attr(as.POSIXlt(x), "tz")
104
105  tzs <- c("CET", "UTC")
106  for (tz in tzs) {
107    start <- data.frame(x = as.POSIXct(dstart, tz = tz))
108    end <- data.frame(x = as.POSIXct(dstop, tz = tz))
109
110    both <- rbind.fill(start, end)
111    expect_that(get_tz(both$x)[1], equals(tz), label = tz)
112  }
113
114})
115
116test_that("1d arrays treated as vectors", {
117  df <- data.frame(x = 1)
118  df$x <- array(1, 1)
119
120  #1d arrays converted into vectors
121  df2 <- rbind.fill(df, df)
122  expect_that(df2$x, is_equivalent_to(rbind(df, df)$x))
123  expect_that(dim(df2$x), equals(dim(rbind(df, df)$x)))
124
125  #if dims are stripped, dimnames should be also
126  df <- data.frame(x = 1)
127  df$x <- array(2, 1, list(x="one"))
128  df2 <- rbind.fill(df, df)
129  expect_null(dimnames(df2$x))
130
131  #can bind 1d array to vector
132  dfV <- data.frame(x=3)
133  dfO1 <- rbind.fill(df, dfV)
134  dfO2 <- rbind.fill(dfV, df)
135  expect_equal(dfO1, data.frame(x=c(2, 3)))
136  expect_equal(dfO2, data.frame(x=c(3, 2)))
137})
138
139test_that("multidim arrays ok", {
140  library(abind)
141  df <- data.frame(x = 1:3)
142  df$x <- array(1:27, c(3,3,3))
143
144  df2 <- rbind.fill(df, df)
145  expect_equal(dim(df2$x), dim(abind(along=1, df$x, df$x)))
146  expect_that(df2$x, is_equivalent_to(abind(along=1, df$x, df$x)))
147 })
148
149test_that("Array column names preserved", {
150  x <- data.frame(hair.color = dimnames(HairEyeColor)[[1]])
151  x$obs <- unclass(HairEyeColor[,,1])
152
153  xx1 <- rbind(x, x)
154  xx2 <- rbind.fill(x, x)
155
156  #plyr is against row names, but should respect col names like rbind
157  rownames(xx1) <- NULL
158  rownames(xx1$obs) <- NULL
159
160  #but unlike rbind it should also preserve names-of-dimnames.
161  names(dimnames(xx1$obs)) <- c("", "Eye")
162
163  expect_equal(xx1, xx2)
164})
165
166test_that("attributes are preserved", {
167  d1 <- data.frame(a = runif(10), b = runif(10))
168  d2 <- data.frame(a = runif(10), b = runif(10))
169
170  attr(d1$b, "foo") <- "one"
171  attr(d1$b, "bar") <- "bar"
172  attr(d2$b, "foo") <- "two"
173  attr(d2$b, "baz") <- "baz"
174
175  d12 <- rbind.fill(d1, d2)
176  d21 <- rbind.fill(d2, d1)
177
178  expect_that(attr(d12$b, "foo"), equals("one"))
179  expect_that(attr(d21$b, "foo"), equals("two"))
180})
181
182test_that("characters override and convert factors", {
183  d1a <- data.frame(x=c('a','b'), y=1:2)
184  d2a <- data.frame(x=c('c','d'), z=1:2, stringsAsFactors=F)
185
186  d1b <- data.frame(x=c('a','b'), y=1:2, stringsAsFactors=F)
187  d2b <- data.frame(x=c('c','d'), z=1:2)
188
189  d3a <- rbind.fill(d1a,d2a)
190  d3b <- rbind.fill(d1b,d2b)
191
192  expect_equal(d3a$x, c("a", "b", "c", "d"))
193  expect_equal(d3b$x, c("a", "b", "c", "d"))
194})
195
196test_that("factor to character conversion preserves attributes", {
197  d1 <- data.frame(a = letters[1:10], b = factor(letters[11:20]),
198                   stringsAsFactors=FALSE)
199  d2 <- data.frame(a = factor(letters[11:20]), b = letters[11:20],
200                   stringsAsFactors=FALSE)
201
202  attr(d1$a, "foo") <- "one"
203  attr(d1$b, "foo") <- "two"
204  attr(d2$a, "foo") <- "bar"
205  attr(d2$b, "foo") <- "baz"
206
207  d12 <- rbind.fill(d1, d2)
208
209  expect_equal(attr(d12$a, "foo"), "one")
210  expect_equal(attr(d12$b, "foo"), "two")
211})
212
213test_that("zero row data frames ok", {
214  d1 <- data.frame(x = 1:2, y = 2:3)
215  d2 <- data.frame(y = 3:4, z = 5:6)
216
217  za <- rbind.fill(subset(d1, FALSE))
218  zb <- rbind.fill(d1, subset(d2, FALSE))
219  zc <- rbind.fill(subset(d1, FALSE), subset(d2, FALSE))
220
221  expect_equal(class(za), "data.frame")
222  expect_equal(nrow(za), 0)
223  expect_true(all(names(za) %in% c("x", "y")))
224
225  expect_equal(class(zb), "data.frame")
226  expect_equal(nrow(zb), 2)
227  expect_true(all(names(zb) %in% c("x", "y", "z")))
228  expect_equal(zb$y, d1$y)
229  expect_equal(zb$z, rep(as.numeric(NA), nrow(d1)))
230
231  expect_equal(class(zc), "data.frame")
232  expect_equal(nrow(zc), 0)
233  expect_true(all(names(zc) %in% c("x", "y", "z")))
234})
235
236test_that("zero col data frames ok", {
237  d1 <- data.frame(x = "a", y = 1L)
238  d2 <- data.frame(y = 2L, z = 3L)
239
240  za <- rbind.fill(d1[0, ], d2[0, ])
241  zb <- rbind.fill(d1[0, ], d2)
242  zc <- rbind.fill(d1, d2[0, ])
243
244  expect_equal(names(za), c("x", "y", "z"))
245  expect_equal(names(zb), c("x", "y", "z"))
246  expect_equal(names(zc), c("x", "y", "z"))
247
248  expect_equal(nrow(za), 0)
249  expect_equal(nrow(zb), 1)
250  expect_equal(nrow(zc), 1)
251})
252
253test_that("rbind.fill rejects non-vector columns", {
254  a <- list(a=list(1), b=c(3), c="d", f=function() NULL)
255  attr(a, "row.names") <- c(NA_integer_, -1)
256  class(a) <- "data.frame"
257  expect_error(rbind.fill(a,a), "cannot make")
258})
259
260test_that("rbind.fill rejects data frame columns", {
261  a <- data.frame(a=1:3, b=2:4, c=3:5)
262  a$c <- data.frame(x=10:12, y=11:13)
263  rownames(a) <- NULL
264  rownames(a$c) <- NULL
265  expect_error(rbind.fill(a,a), "not supported")
266})
267
268rbind_time <- function(size,
269                       classes = c("numeric", "character",
270                                   "array", "factor", "time")) {
271  unit <- quickdf(list(numeric = 1:3,
272                       character = c("a", "b", "c"),
273                       array = array(1:6, c(3,2)),
274                       factor = factor(c("a", "b", "c")),
275                       time = as.POSIXct(Sys.time()) + 1:3))
276  args <- rep(list(unit[classes]), size)
277  system.time(do.call(rbind.fill, args))
278}
279
280get_rbind_times <- function(...) {
281  # nolint start
282  rbind_time(10) #warm up/JIT
283  mdply(.fun = rbind_time, ...)
284  # nolint end
285}
286
287if (identical(Sys.getenv("NOT_CRAN"), "true") &&
288    !identical(Sys.getenv("TRAVIS"), "true")) {
289
290expect_linear_enough <- function(timings, threshold=0.1) {
291  #expect that no more than `threshold` of a `size` input's runtime is
292  #accounted for by quadratic behavior
293  model <- lm(I(user.self / size) ~ size, timings)
294  expect_lt(threshold, summary(model)$coefficients[2,4])
295}
296
297test_that("rbind.fill performance linear", {
298  timings <- get_rbind_times(data.frame(size = 2 ^ (1:10)),
299                             classes=c("numeric", "character", "array"))
300  expect_linear_enough(timings)
301})
302
303test_that("rbind.fill performance linear with factors", {
304  timings <- get_rbind_times(data.frame(size = 2 ^ (1:10)),
305                             classes=c("factor"))
306  expect_linear_enough(timings)
307})
308
309test_that("rbind.fill performance linear with times", {
310  timings <- get_rbind_times(data.frame(size = 2 ^ (1:10)),
311                             classes=c("time"))
312  expect_linear_enough(timings)
313})
314
315test_that("NULLs silently dropped", {
316  expect_equal(rbind.fill(mtcars, NULL), mtcars)
317  expect_equal(rbind.fill(NULL, mtcars), mtcars)
318  expect_equal(rbind.fill(NULL, NULL), NULL)
319
320})
321
322}
323