diff --git a/R/compat-plyr.R b/R/compat-plyr.R index 898aacdf05..6ec0ae6b06 100644 --- a/R/compat-plyr.R +++ b/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))]) })) } diff --git a/R/zzz.r b/R/zzz.r index 3e5843be7b..e3fb28ab60 100644 --- a/R/zzz.r +++ b/R/zzz.r @@ -23,6 +23,12 @@ 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)) { diff --git a/tests/testthat/test-layer.r b/tests/testthat/test-layer.r index b497e9f921..31f6240cda 100644 --- a/tests/testthat/test-layer.r +++ b/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 ---------------------------------------------------------