Permalink
Browse files

rbind.fill 1d arrays to vectors

  • Loading branch information...
1 parent 68617ea commit 37e60ae64b8bc3f1752d86dee674ed851af9da29 @crowding crowding committed Feb 21, 2014
Showing with 25 additions and 21 deletions.
  1. +16 −17 R/rbind-fill.r
  2. +9 −4 inst/tests/test-rbind.r
View
@@ -127,28 +127,27 @@ allocate_column <- function(example, nrows, dfs, var) {
}
if (is.array(example)) {
+ if (length(dim(example)) > 1) {
+ if ("dimnames" %in% names(a)) {
+ a$dimnames[1] <- list(NULL)
+ if (!is.null(names(a$dimnames)))
+ names(a$dimnames)[1] <- ""
+ }
+
+ # Check that all other args have consistent dims
+ df_has <- vapply(dfs, function(df) var %in% names(df), FALSE)
+ dims <- unique(lapply(dfs[df_has], function(df) dim(df[[var]])[-1]))
+ if (length(dims) > 1)
+ stop("Array variable ", var, " has inconsistent dims")
- if ("dimnames" %in% names(a)) {
- a$dimnames[1] <- list(NULL)
- if (!is.null(names(a$dimnames)))
- names(a$dimnames)[1] <- ""
- }
-
- # Check that all other args have consistent dims
- df_has <- vapply(dfs, function(df) var %in% names(df), FALSE)
- dims <- unique(lapply(dfs[df_has], function(df) dim(df[[var]])[-1]))
- if (length(dims) > 1)
- stop("Array variable ", var, " has inconsistent dims")
-
- if (length(dims[[1]]) == 0) { #is dropping dims necessary for 1d arrays?
+ a$dim <- c(nrows, dim(example)[-1])
+ length <- prod(a$dim)
+ } else {
+ #1d arrays devolve into vectors
a$dim <- NULL
a$dimnames <- NULL
length <- nrows
- } else {
- a$dim <- c(nrows, dim(example)[-1])
- length <- prod(a$dim)
}
-
} else {
length <- nrows
}
@@ -101,22 +101,27 @@ test_that("time zones are preserved", {
})
-test_that("arrays are ok", {
+test_that("1d arrays treated as vectors", {
df <- data.frame(x = 1)
df$x <- array(1, 1)
+ #1d arrays converted into vectors
df2 <- rbind.fill(df, df)
- #this asserts that dim is stripped off 1d arrays. Necessary?
expect_that(df2$x, is_equivalent_to(rbind(df, df)$x))
expect_that(dim(df2$x), equals(dim(rbind(df, df)$x)))
- #this would be more consistent
- #expect_that(df2$x, is_equivalent_to(rbind(array(1,1), array(1,1))))
#if dims are stripped, dimnames should be also
df <- data.frame(x = 1)
df$x <- array(2, 1, list(x="one"))
df2 <- rbind.fill(df, df)
expect_that(is.null(dimnames(df2$x)), is_true())
+
+ #can bind 1d array to vector
+ dfV <- data.frame(x=3)
+ dfO1 <- rbind.fill(df, dfV)
+ dfO2 <- rbind.fill(dfV, df)
+ expect_equal(dfO1, data.frame(x=c(2, 3)))
+ expect_equal(dfO2, data.frame(x=c(3, 2)))
})
test_that("multidim arrays ok", {

0 comments on commit 37e60ae

Please sign in to comment.