New tests and improvements.

R/df_utils.R

@@ -74,6 +74,17 @@ df_row_slice <- function(data, i, reconstruct = TRUE){
   }
   out
 }
+
+# Bare-bones col select
+fast_col_select <- function(data, cols){
+  list_as_df(unclass(data)[cols])
+
+}
+# Bare-bones col bind
+fast_bind_cols <- function(...){
+  list_as_df(c(...))
+}
+
 df_add_cols <- function(data, cols){
   reconstruct(data, dplyr::dplyr_col_modify(f_ungroup(data), cols))
 }
@@ -283,11 +294,12 @@ unique_name_repair <- function(x, .sep = "..."){
   }
   x <- as.character(x)
   dup <- collapse::fduplicated(x, all = TRUE)
-
-  if (any(dup)){
-    which_dup <- cheapr::val_find(dup, TRUE)
+  which_dup <- cheapr::val_find(dup, TRUE)
+  if (length(which_dup)){
     x[which_dup] <- paste0(x[which_dup], .sep, which_dup)
-    which_empty <- empty_str_locs(x)
+  }
+  which_empty <- empty_str_locs(x)
+  if (length(which_empty)){
     x[which_empty] <- paste0(x[which_empty], .sep, which_empty)
   }
   x

R/f_bind.R

@@ -31,13 +31,13 @@ f_bind_rows <- function(..., .fill = TRUE){
   nrows <- dims[[1L]]
   ncols <- dims[[2L]]
 
-  if (sum(ncols) == 0){
-    return(new_tbl(.nrows = sum(nrows)))
-  }
+
   if (n_dots == 0){
     new_tbl()
   } else if (n_dots == 1){
     dots[[1L]]
+  } else if (sum(ncols) == 0){
+    return(reconstruct(dots[[1L]], cheapr::new_df(.nrows = sum(nrows))))
   } else {
     template <- dots[[1L]]
     prototype_names <- names(template)
@@ -79,9 +79,9 @@ f_bind_rows <- function(..., .fill = TRUE){
           cols_to_add <- fast_setdiff(prototype_names, names(df))
           if (length(cols_to_add)){
             df_to_bind <- list_as_df(lapply(col_prototypes[cols_to_add], na_init, nrows[[i]]))
-            df <- f_bind_cols(df, df_to_bind, .recycle = FALSE)
+            df <- fast_bind_cols(df, df_to_bind)
           }
-          dots[[i]] <- df_select(df, prototype_names)
+          dots[[i]] <- fast_col_select(df, prototype_names)
         }
       }
 
@@ -118,7 +118,7 @@ f_bind_rows <- function(..., .fill = TRUE){
       } else {
         other_out <- do.call(
           fast_rowbind,
-          c(lapply(dots, df_select, other_vars),
+          c(lapply(dots, fast_col_select, other_vars),
             list(use.names = FALSE))
         )
       }

R/f_select.R

@@ -73,7 +73,10 @@ f_select.data.table <- function(data, ..., .cols = NULL){
   keys <- attr(data, "sorted")
   out <- collapse::qDT(out)
   if (all(keys %in% names(out))){
-    if (all(cpp_frame_addresses_equal(df_select(out, keys), df_select(data, keys)))){
+    if (all(cpp_frame_addresses_equal(
+      fast_col_select(out, keys),
+      fast_col_select(data, keys)
+    ))){
       attr(out, "sorted") <- keys
     }
   }

tests/testthat/test-f_bind.R

@@ -0,0 +1,116 @@
+test_that("row-bind", {
+
+
+  expect_identical(f_bind_rows(), new_tbl())
+
+  expect_identical(f_bind_rows(NULL), new_tbl())
+
+  expect_identical(
+    f_bind_rows(f_select(iris, .cols = 0)),
+    cheapr::new_df(.nrows = 150)
+  )
+
+  expect_identical(
+    f_bind_rows(f_select(as_tbl(iris), .cols = 0), f_select(iris, .cols = 0)),
+    new_tbl(.nrows = 300)
+  )
+
+  expect_identical(
+    f_bind_rows(f_select(iris, .cols = 0), f_select(iris, .cols = 0)),
+    cheapr::new_df(.nrows = 300)
+  )
+
+
+  expect_identical(
+    f_bind_rows(iris, iris),
+    rbind(iris, iris)
+  )
+
+  expect_identical(
+    f_bind_rows(iris, iris, iris),
+    f_bind_rows(list(iris, iris, iris))
+  )
+
+  expect_identical(
+    f_bind_rows(iris, f_select(iris, .cols = c(4, 3, 5, 1, 2))),
+    rbind(iris, iris)
+  )
+
+  temp <- iris
+  temp$l1 <- as.list(1:150)
+  temp$l2 <- as.list(150:1)
+
+  expect_identical(
+    f_bind_rows(temp, temp),
+    dplyr::bind_rows(temp, temp)
+  )
+
+  expect_identical(
+    f_bind_rows(f_select(temp, .cols = 1:2), temp),
+    dplyr::bind_rows(f_select(temp, .cols = 1:2), temp)
+  )
+
+})
+
+test_that("col-bind", {
+
+  expect_identical(
+    f_bind_cols(f_select(iris, 1:3), f_select(iris, 4:5)),
+    iris
+  )
+
+  # Check that naming is correct, non df objs can be joined and recycled
+  expect_identical(
+    f_bind_cols(iris, ok = 1L, 1:3),
+    dplyr::mutate(iris, ok = 1L, `...7` = rep_len(1:3, 150))
+  )
+
+  # Check that class is kept
+  expect_identical(
+    f_bind_cols(as_tbl(iris), okay = 0L),
+    as_tbl(dplyr::mutate(iris, okay = 0L))
+  )
+
+  # Order of bind
+  expect_identical(
+    f_bind_cols(f_select(iris, 5:4), f_select(iris, c(2, 3, 1))),
+    f_select(iris, .cols = c(5, 4, 2, 3, 1))
+  )
+
+  expect_identical(
+    f_bind_cols(), new_tbl()
+  )
+
+  expect_identical(
+    f_bind_cols(NULL), new_tbl()
+  )
+
+  expect_identical(
+    f_bind_cols(ok1 = 1, NULL, NULL, ok2 = 2, NULL), new_tbl(ok1 = 1, ok2 = 2)
+  )
+
+  expect_identical(
+    f_bind_cols(iris, iris),
+    add_names(fast_bind_cols(iris, iris), unique_name_repair(rep(names(iris), 2)))
+  )
+
+  ## List of data frames
+
+  expect_identical(
+    f_bind_cols(iris, iris, iris),
+    f_bind_cols(list(iris, iris, iris))
+  )
+
+
+  # 0-col data frames
+
+  expect_identical(
+    f_bind_cols(f_select(iris, .cols = 0)), cheapr::new_df(.nrows = 150)
+  )
+
+  expect_identical(
+    f_bind_cols(f_select(iris, .cols = 0), iris, f_select(iris, .cols = 0)),
+    iris
+  )
+
+})