Skip to content
Browse files

Made pass tests

  • Loading branch information...
1 parent 8606a72 commit 7e24a29622534f1462cdeacc30036a1f837b2ac3 @crowding crowding committed Oct 17, 2012
Showing with 16 additions and 10 deletions.
  1. +1 −1 NEWS
  2. +14 −7 R/alply.r
  3. +1 −2 inst/tests/test-empty.r
View
2 NEWS
@@ -46,7 +46,7 @@ PERFORMANCE IMPROVEMENTS
BUG FIXES
-* `*aply` functions now bind list mode results into a list-array. (Peter Meilstrup).
+* `*aply` functions now bind list mode results into a list-array (Peter Meilstrup)
* `*aply` now accepts 0-dimension arrays as inputs. (#88)
View
21 R/alply.r
@@ -4,8 +4,9 @@
#' list.
#'
#' The list will have "dims" and "dimnames" corresponding to the
-#' margins given. For instance \code{llply(x, c(3,2))} where \code{x}
-#' has dims \code{c(4,3,2)} will give a result with dims \code{c(2,3)}.
+#' margins given. For instance \code{alply(x, c(3,2), ...)} where
+#' \code{x} has dims \code{c(4,3,2)} will give a result with dims
+#' \code{c(2,3)}.
#'
#' \code{alply} is somewhat similar to \code{\link{apply}} for cases
#' where the results are not atomic.
@@ -19,17 +20,23 @@
#' alply(ozone, 3, function(x) table(round(x)))
alply <- function(.data, .margins, .fun = NULL, ..., .expand = TRUE,
.progress = "none", .inform = FALSE, .parallel = FALSE,
- .paropts = NULL, .dims=FALSE) {
+ .paropts = NULL) {
pieces <- splitter_a(.data, .margins, .expand)
res <- llply(.data = pieces, .fun = .fun, ...,
.progress = .progress, .inform = .inform,
.parallel = .parallel, .paropts = .paropts)
labels <- attr(pieces, "split_labels")
- res_labels <- lapply(labels, function(x) as.character(unique(x)))
- res_dim <- sapply(res_labels, length)
- dim(res) <- res_dim
- dimnames(res) <- res_labels
+ #splitting a dataframe along dimension 1 is a special case which
+ #gets a different output from splitter_a, so guard against that
+ if (length(labels) == length(.margins)) {
+ res_labels <- lapply(labels, function(x) as.character(unique(x)))
+ res_dim <- sapply(res_labels, length)
+ if (length(res_dim) > 0) {
+ dim(res) <- res_dim
+ dimnames(res) <- res_labels
+ }
+ }
res
}
View
3 inst/tests/test-empty.r
@@ -8,8 +8,7 @@ test_that("empty arrays returns object of same shape", {
expect_that(aaply(x, 3, identity), equals(logical()))
expect_that(adply(x, 1, identity), equals(data.frame()))
- expect_that(alply(x, 1, identity), equals(list()))
-
+ expect_that(alply(x, 1, identity), is_equivalent_to(list()))
})
test_that("empty lists return an empty object", {

0 comments on commit 7e24a29

Please sign in to comment.
Something went wrong with that request. Please try again.