don't drop ordering from ordinal factors (#3710)

Author: thomasp85

R/compat-plyr.R

@@ -273,15 +273,22 @@ rbind_dfs <- function(dfs) {
   allocated <- rep(FALSE, length(columns))
   names(allocated) <- columns
   col_levels <- list()
+  ord_levels <- list()
   for (df in dfs) {
     new_columns <- intersect(names(df), columns[!allocated])
     for (col in new_columns) {
       if (is.factor(df[[col]])) {
+        all_ordered <- all(vapply(dfs, function(df) {
+          val <- .subset2(df, col)
+          is.null(val) || is.ordered(val)
+        }, logical(1)))
         all_factors <- all(vapply(dfs, function(df) {
           val <- .subset2(df, col)
           is.null(val) || is.factor(val)
         }, logical(1)))
-        if (all_factors) {
+        if (all_ordered) {
+          ord_levels[[col]] <- unique(unlist(lapply(dfs, function(df) levels(.subset2(df, col)))))
+        } else if (all_factors) {
           col_levels[[col]] <- unique(unlist(lapply(dfs, function(df) levels(.subset2(df, col)))))
         }
         out[[col]] <- rep(NA_character_, total)
@@ -318,6 +325,9 @@ rbind_dfs <- function(dfs) {
       }
     }
   }
+  for (col in names(ord_levels)) {
+    out[[col]] <- ordered(out[[col]], levels = ord_levels[[col]])
+  }
   for (col in names(col_levels)) {
     out[[col]] <- factor(out[[col]], levels = col_levels[[col]])
   }

tests/testthat/test-rbind-dfs.R

@@ -0,0 +1,14 @@
+context("data.frame binding")
+
+test_that("rbind_dfs keep classes of columns", {
+  df <- data_frame(
+    integer = seq_len(10),
+    numeric = as.numeric(seq_len(10)),
+    character = letters[1:10],
+    factor = factor(letters[1:10]),
+    ordered = ordered(letters[1:10]),
+    date = Sys.Date()
+  )
+  df2 <- rbind_dfs(list(df[1:5, ], df[6:10, ]))
+  expect_equal(df2, df)
+})