Merge pull request #79 from crowding/issue79

rbind.fill should respect empty data frames

NEWS

@@ -18,6 +18,9 @@ Version 1.7.1.99
 * `idata.frame`: Subsetting immutable data frames with `[.idf` is now
   faster (Peter Meilstrup)
 
+* `rbind.fill` and `rbind.fill.matrix` work consistently with matrices
+  and data frames with zero rows. Fixes #79. (Peter Meilstrup)
+
 Version 1.7.1
 ------------------------------------------------------------------------------
 

R/rbind-matrix.r

@@ -60,12 +60,12 @@ rbind.fill.matrix <- function(...) {
   output <- matrix(NA, nrow = nrows, ncol = length(cols))
   colnames(output) <- cols
 
-  # Compute start and end positions for each matrix
-  pos <- matrix(cumsum(rbind(1, rows - 1)), ncol = 2, byrow = TRUE)
+  # Compute start and length for each matrix
+  pos <- matrix(c(cumsum(rows) - rows + 1, rows), ncol = 2)
 
   ## fill in the new matrix
   for(i in seq_along(rows)) {
-    rng <- pos[i, 1]:pos[i, 2]
+    rng <- seq(pos[i, 1], length = pos[i, 2])
     output[rng, lcols[[i]]] <- matrices[[i]]
   }
 

R/rbind.r

@@ -23,7 +23,6 @@ rbind.fill <- function(...) {
   if (is.list(dfs[[1]]) && !is.data.frame(dfs[[1]])) {
     dfs <- dfs[[1]]
   }
-  dfs <- Filter(Negate(empty), dfs)
 
   if (length(dfs) == 0) return()
   if (length(dfs) == 1) return(dfs[[1]])
@@ -36,12 +35,12 @@ rbind.fill <- function(...) {
   # Generate output template
   output <- output_template(dfs, nrows)
 
-  # Compute start and end positions for each data frame
-  pos <- matrix(cumsum(rbind(1, rows - 1)), ncol = 2, byrow = TRUE)
+  # Compute start and length for each data frame
+  pos <- matrix(c(cumsum(rows) - rows + 1, rows), ncol = 2)
 
   # Copy inputs into output
   for(i in seq_along(rows)) {
-    rng <- pos[i, 1]:pos[i, 2]
+    rng <- seq(pos[i, 1], length = pos[i, 2])
     df <- dfs[[i]]
 
     for(var in names(df)) {

inst/tests/test-rbind.matrix.r

@@ -112,5 +112,28 @@ test_that ("vector: uses as.matrix",{
   expect_that(new, equals (new))
 })
 
+test_that("zero-row matrices", {
+  m1 <- matrix(nrow=0, ncol=2, dimnames=list(NULL, c("x", "y")))
+  m2 <- matrix(nrow=0, ncol=2, dimnames=list(NULL, c("y", "z")))
+  m3 <- matrix(c(1,2), nrow=2, ncol=1, dimnames=list(NULL, "y"))
+
+  ba <- rbind.fill.matrix(m1)
+  bb <- rbind.fill.matrix(m2, m3)
+  bc <- rbind.fill.matrix(m1, m2)
+
+  expect_equal(class(ba), "matrix")
+  expect_equal(nrow(ba), 0)
+  expect_true(all(colnames(ba) %in% c("x", "y")))
+
+  expect_equal(class(bb), "matrix")
+  expect_equal(nrow(bb), 2)
+  expect_true(all(names(bb) %in% c("x", "y", "z")))
+  expect_equal(bb[,"y"], m3[,"y"])
+  expect_equal(bb[,"z"], rep(as.numeric(NA), nrow(m3)))
+
+  expect_equal(class(bc), "matrix")
+  expect_equal(nrow(bc), 0)
+  expect_true(all(colnames(bc) %in% c("x", "y", "z")))
+})
 
 

inst/tests/test-rbind.r

@@ -117,3 +117,26 @@ test_that("characters override factors", {
   expect_that(d3a$x, is_a("character"))
   expect_that(d3b$x, is_a("character"))
 })
+
+test_that("empty data frames ok", {
+  d1 <- data.frame(x = 1:2, y = 2:3)
+  d2 <- data.frame(y = 3:4, z = 5:6)
+
+  za <- rbind.fill(subset(d1, FALSE))
+  zb <- rbind.fill(d1, subset(d2, FALSE))
+  zc <- rbind.fill(subset(d1, FALSE), subset(d2, FALSE))
+
+  expect_equal(class(za), "data.frame")
+  expect_equal(nrow(za), 0)
+  expect_true(all(names(za) %in% c("x", "y")))
+
+  expect_equal(class(zb), "data.frame")
+  expect_equal(nrow(zb), 2)
+  expect_true(all(names(zb) %in% c("x", "y", "z")))
+  expect_equal(zb$y, d1$y)
+  expect_equal(zb$z, rep(as.numeric(NA), nrow(d1)))
+
+  expect_equal(class(zc), "data.frame")
+  expect_equal(nrow(zc), 0)
+  expect_true(all(names(zc) %in% c("x", "y", "z")))
+})