Fix ordering in plyr compats... (#3327)

Author: thomasp85

R/compat-plyr.R

@@ -292,12 +292,26 @@ rbind_dfs <- function(dfs) {
     allocated[new_columns] <- TRUE
     if (all(allocated)) break
   }
+  is_date <- lapply(out, inherits, 'Date')
+  is_time <- lapply(out, inherits, 'POSIXct')
   pos <- c(cumsum(nrows) - nrows + 1)
   for (i in seq_along(dfs)) {
     df <- dfs[[i]]
     rng <- seq(pos[i], length.out = nrows[i])
     for (col in names(df)) {
-      if (inherits(df[[col]], 'factor')) {
+      date_col <- inherits(df[[col]], 'Date')
+      time_col <- inherits(df[[col]], 'POSIXct')
+      if (is_date[[col]] && !date_col) {
+        out[[col]][rng] <- as.Date(
+          unclass(df[[col]]),
+          origin = ggplot_global$date_origin
+        )
+      } else if (is_time[[col]] && !time_col) {
+        out[[col]][rng] <- as.POSIXct(
+          unclass(df[[col]]),
+          origin = ggplot_global$time_origin
+        )
+      } else if (date_col || time_col || inherits(df[[col]], 'factor')) {
         out[[col]][rng] <- as.character(df[[col]])
       } else {
         out[[col]][rng] <- df[[col]]
@@ -307,7 +321,11 @@ rbind_dfs <- function(dfs) {
   for (col in names(col_levels)) {
     out[[col]] <- factor(out[[col]], levels = col_levels[[col]])
   }
-  attributes(out) <- list(class = "data.frame", names = names(out), row.names = .set_row_names(total))
+  attributes(out) <- list(
+    class = "data.frame",
+    names = names(out),
+    row.names = .set_row_names(total)
+  )
   out
 }
 #' Apply function to unique subsets of a data.frame
@@ -333,6 +351,7 @@ dapply <- function(df, by, fun, ..., drop = TRUE) {
   grouping_cols <- .subset(df, by)
   ids <- id(grouping_cols, drop = drop)
   group_rows <- split(seq_len(nrow(df)), ids)
+  fallback_order <- unique(c(by, names(df)))
   rbind_dfs(lapply(seq_along(group_rows), function(i) {
     cur_data <- df_rows(df, group_rows[[i]])
     res <- fun(cur_data, ...)
@@ -341,6 +360,8 @@ dapply <- function(df, by, fun, ..., drop = TRUE) {
     vars <- lapply(setNames(by, by), function(col) .subset2(cur_data, col)[1])
     if (is.matrix(res)) res <- split_matrix(res)
     if (is.null(names(res))) names(res) <- paste0("V", seq_along(res))
-    new_data_frame(modify_list(unclass(vars), unclass(res)))
+    if (all(by %in% names(res))) return(new_data_frame(unclass(res)))
+    res <- modify_list(unclass(vars), unclass(res))
+    new_data_frame(res[intersect(c(fallback_order, names(res)), names(res))])
   }))
 }

R/zzz.r

@@ -35,6 +35,12 @@ pathGrob <- NULL
 
   ggplot_global$theme_current <- theme_gray()
 
+  # Used by rbind_dfs
+  date <- Sys.Date()
+  ggplot_global$date_origin <- date - unclass(date)
+  time <- Sys.time()
+  ggplot_global$time_origin <- time - unclass(time)
+
   # To avoid namespace clash with dplyr.
   # It seems surprising that this hack works
   if (requireNamespace("dplyr", quietly = TRUE)) {

tests/testthat/test-layer.r

@@ -60,7 +60,7 @@ test_that("if an aes is mapped to a function that returns NULL, it is removed",
   df <- data_frame(x = 1:10)
   null <- function(...) NULL
   p <- cdata(ggplot(df, aes(x, null())))
-  expect_identical(names(p[[1]]), c("PANEL", "x", "group"))
+  expect_identical(names(p[[1]]), c("x", "PANEL", "group"))
 })
 
 # Data extraction ---------------------------------------------------------