Merge branch 'release/0.1-4' into production

- Non-scalar input to `frame_data()` and `tibble()` creates list-valued columns (#7).
- `frame_data()` and `tibble()` create empty `data_frame` if no rows are given (#20).
- `as_data_frame(NULL)` is 0-row 0-column data frame (#17, @jennybc).
- `lst(NULL)` doesn't raise an error anymore (#17, @jennybc), but always uses deparsed expression as name (even for `NULL`).
- `trunc_mat()` and `print()` use `width` argument also for zero-row and zero-column data frames (#18).

DESCRIPTION

@@ -1,8 +1,8 @@
 Encoding: UTF-8
 Package: tibble
 Type: Package
-Version: 0.1-3
-Date: 2016-01-05
+Version: 0.1-4
+Date: 2016-01-07
 Title: Simple data frames
 Description: Data frames and data sources in "dplyr" style.
 Authors@R: c( person("Hadley", "Wickham", , "[email protected]", role

NEWS.md

@@ -1,3 +1,13 @@
+Version 0.1-4 (2016-01-07)
+===
+
+- Non-scalar input to `frame_data()` and `tibble()` creates list-valued columns (#7).
+- `frame_data()` and `tibble()` create empty `data_frame` if no rows are given (#20).
+- `as_data_frame(NULL)` is 0-row 0-column data frame (#17, @jennybc).
+- `lst(NULL)` doesn't raise an error anymore (#17, @jennybc), but always uses deparsed expression as name (even for `NULL`).
+- `trunc_mat()` and `print()` use `width` argument also for zero-row and zero-column data frames (#18).
+
+
 Version 0.1-3 (2016-01-05)
 ===
 

R/dataframe.R

@@ -76,7 +76,6 @@ lst_ <- function(xs) {
     deparse2 <- function(x) paste(deparse(x$expr, 500L), collapse = "")
     defaults <- vapply(xs[missing_names], deparse2, character(1),
       USE.NAMES = FALSE)
-
     col_names[missing_names] <- defaults
   }
 
@@ -85,7 +84,10 @@ lst_ <- function(xs) {
   names(output) <- character(n)
 
   for (i in seq_len(n)) {
-    output[[i]] <- lazyeval::lazy_eval(xs[[i]], output)
+    res <- lazyeval::lazy_eval(xs[[i]], output)
+    if (!is.null(res)) {
+      output[[i]] <-  res
+    }
     names(output)[i] <- col_names[[i]]
   }
 
@@ -157,6 +159,9 @@ as_data_frame.data.frame <- function(x, ...) {
 #' @export
 #' @rdname as_data_frame
 as_data_frame.list <- function(x, validate = TRUE, ...) {
+
+  x <- compact(x)
+
   if (length(x) == 0) {
     x <- list()
     class(x) <- c("tbl_df", "tbl", "data.frame")
@@ -189,7 +194,7 @@ as_data_frame.matrix <- function(x, ...) {
 #' @export
 #' @rdname as_data_frame
 as_data_frame.NULL <- function(x, ...) {
-  NULL
+  as_data_frame(list())
 }
 
 #' Convert row names to an explicit variable.

R/frame-data.R

@@ -20,6 +20,9 @@ frame_data <- function(...) {
   frame_names <- character()
   i <- 1
   while (TRUE) {
+    if (i > length(dots)) {
+      return(data_frame())
+    }
 
     el <- dots[[i]]
     if (!is.call(el))
@@ -28,20 +31,23 @@ frame_data <- function(...) {
     if (!identical(el[[1]], as.name("~")))
       break
 
-    if (length(el) != 2)
+    if (length(el) != 2) {
       stop("expected a column name with a single argument; e.g. '~ name'")
+    }
 
     candidate <- el[[2]]
-    if (!(is.symbol(candidate) || is.character(candidate)))
+    if (!(is.symbol(candidate) || is.character(candidate))) {
         stop("expected a symbol or string denoting a column name")
+    }
 
     frame_names <- c(frame_names, as.character(el[[2]]))
 
     i <- i + 1
   }
 
-  if (!length(frame_names))
+  if (!length(frame_names)) {
     stop("no column names detected in 'frame_data()' call")
+  }
 
   frame_rest <- dots[i:length(dots)]
   n_elements <- length(frame_rest)
@@ -63,7 +69,11 @@ frame_data <- function(...) {
   # Extract the columns from 'frame_rest'
   frame_columns <- lapply(seq_len(frame_ncol), function(i) {
     indices <- seq.default(from = i, to = length(frame_rest), by = frame_ncol)
-    unlist(frame_rest[indices])
+    col <- frame_rest[indices]
+    if (all(vapply(col, length, integer(1L)) == 1L)) {
+      col <- unlist(col)
+    }
+    col
   })
 
   # Create a tbl_df and return it

R/utils-format.r

@@ -48,15 +48,19 @@ trunc_mat <- function(x, n = NULL, width = NULL, n_extra = 100) {
   var_types <- vapply(df, type_sum, character(1))
   var_names <- names(df)
 
+  width <- width %||% getOption("dplyr.width", NULL) %||% getOption("width")
   if (ncol(df) == 0 || nrow(df) == 0) {
-    extra <- setNames(var_types, var_names)
-
-    return(structure(list(table = NULL, extra = extra), class = "trunc_mat"))
+    shrunk <- list(table = NULL, extra = setNames(var_types, var_names))
+  } else {
+    shrunk <- shrink_mat(df, width, n_extra, var_names, var_types, rows, n)
   }
 
+  return(structure(c(shrunk, list(width = width)), class = "trunc_mat"))
+}
+
+shrink_mat <- function(df, width, n_extra, var_names, var_types, rows, n) {
   rownames(df) <- NULL
 
-  width <- width %||% getOption("dplyr.width", NULL) %||% getOption("width")
   # Minimum width of each column is 5 "(int)", so we can make a quick first
   # pass
   max_cols <- floor(width / 5)
@@ -115,8 +119,7 @@ trunc_mat <- function(x, n = NULL, width = NULL, n_extra = 100) {
     extra <- c(extra[1:n_extra], setNames("...", more))
   }
 
-  structure(list(table = shrunk, extra = extra, width = width),
-            class = "trunc_mat")
+  list(table = shrunk, extra = extra)
 }
 
 #' @export

R/utils.r

@@ -1,3 +1,5 @@
+compact <- function(x) Filter(Negate(is.null), x)
+
 names2 <- function(x) {
   names(x) %||% rep("", length(x))
 }

tests/testthat/test-data_frame.R

@@ -19,9 +19,12 @@ test_that("can't make data_frame containing data.frame or array", {
   expect_error(data_frame(diag(5)), "must be a 1d atomic vector or list")
 })
 
-test_that("null isn't a valid column", {
-  expect_error(data_frame(a = NULL))
-  expect_error(as_data_frame(list(a = NULL)), "must be a 1d atomic vector or list")
+test_that("null columns are dropped", {
+  expect_identical(data_frame(a = NULL), data_frame())
+  just_b <- data_frame(a = NULL, b = character())
+  expect_is(just_b, "tbl_df")
+  expect_equal(dim(just_b), c(0L, 1L))
+  expect_identical(attr(just_b, "names"), "b")
 })
 
 test_that("length 1 vectors are recycled", {
@@ -81,6 +84,12 @@ test_that("Zero column list makes 0 x 0 tbl_df", {
   expect_equal(dim(zero), c(0L, 0L))
 })
 
+test_that("NULL makes 0 x 0 tbl_df", {
+  nnnull <- as_data_frame(NULL)
+  expect_is(nnnull, "tbl_df")
+  expect_equal(dim(nnnull), c(0L, 0L))
+})
+
 test_that("add_rownames keeps the tbl classes (#882)", {
   res <- add_rownames( mtcars, "Make&Model" )
   expect_equal( class(res), c("tbl_df","tbl", "data.frame"))
@@ -90,10 +99,6 @@ test_that("as.tbl", {
   expect_identical(as.tbl(data.frame()), data_frame())
 })
 
-test_that("as_data_frame(NULL) is NULL, not error", {
-  expect_null(as_data_frame(NULL))
-})
-
 # Validation --------------------------------------------------------------
 
 test_that("2d object isn't a valid column", {

tests/testthat/test-frame-data.R

@@ -11,6 +11,8 @@ test_that("frame_data() constructs 'data_frame' as expected", {
   compared <- data_frame(colA = c("a", "b"), colB = c(1, 2))
   expect_equal(result, compared)
 
+  expect_identical(frame_data(~a, ~b), data_frame())
+
   ## wide
   wide <- frame_data(
     ~colA, ~colB, ~colC, ~colD,
@@ -46,8 +48,26 @@ test_that("frame_data() constructs 'data_frame' as expected", {
 
 })
 
+test_that("frame_data() creates lists for non-atomic inputs (#7)", {
+  expect_identical(
+    frame_data(~a, ~b, NA, "A", letters, LETTERS[-1L]),
+    data_frame(a = list(NA, letters), b = list("A", LETTERS[-1L]))
+  )
+
+  expect_identical(
+    frame_data(~a, ~b, NA, NULL, 1, 2),
+    data_frame(a = c(NA, 1), b = list(NULL, 2))
+  )
+})
+
 test_that("frame_data() errs appropriately on bad calls", {
 
+  # invalid colname syntax
+  expect_error(frame_data(a~b), "single argument")
+
+  # invalid colname syntax
+  expect_error(frame_data(~a + b), "symbol or string")
+
   # frame_data() must be passed colnames
   expect_error(frame_data(
     "a", "b",

tests/testthat/test-lst.R

@@ -0,0 +1,13 @@
+context("lst")
+
+test_that("lst handles named and unnamed NULL arguments", {
+  expect_equivalent(lst(NULL), list("NULL" = NULL))
+  expect_identical(lst(a = NULL), list(a = NULL))
+  expect_identical(lst(NULL, b = NULL, 1:3),
+                   list("NULL" = NULL, b = NULL, "1:3" = 1:3))
+})
+
+test_that("lst handles internal references", {
+  expect_identical(lst(a = 1, b = a), list(a = 1, b = 1))
+  expect_identical(lst(a = NULL, b = a), list(a = NULL, b = NULL))
+})

tests/testthat/test-tbl-df.r

@@ -12,15 +12,8 @@ test_that("[ with 0 cols creates correct row names (#656)", {
   expect_is(zero_row, "tbl_df")
   expect_equal(nrow(zero_row), 150)
   expect_equal(ncol(zero_row), 0)
-  expect_output(print(zero_row), "[150 x 0]", fixed = TRUE)
-})
 
-test_that("[ with 0 cols creates correct row names (#656)", {
-  zero_row <- tbl_df(iris)[0]
-  expect_is(zero_row, "tbl_df")
-  expect_equal(nrow(zero_row), 150)
-  expect_equal(ncol(zero_row), 0)
-  expect_output(print(zero_row), "[150 x 0]", fixed = TRUE)
+  expect_identical(zero_row, tbl_df(iris)[0])
 })
 
 test_that("[.tbl_df is careful about names (#1245)",{

tests/testthat/test-trunc-mat.r

@@ -59,6 +59,21 @@ test_that("trunc_mat output matches known output", {
       "  (fctr), f (date), g (time),",
       "  h (list)."))
 
+  expect_identical(
+    capture.output(print(data_frame(a = character(), b = logical()),
+                         width = 30L)),
+    c("Source: local data frame [0 x 2]",
+      "",
+      "Variables not shown: a (chr),",
+      "  b (lgl).")
+  )
+
+  expect_identical(
+    capture.output(print(tbl_df(iris)[character()], n = 5L, width = 30L)),
+    c("Source: local data frame [150 x 0]",
+      "")
+  )
+
   expect_identical(
     capture.output(trunc_mat(df_all, n = 1L, n_extra = 2L, width = 30L)),
     c("       a     b     c     d",