tidyverse · krlmlr · Jun 13, 2016 · Mar 18, 2016 · Mar 19, 2016 · Mar 19, 2016
diff --git a/R/tbl-df.r b/R/tbl-df.r
@@ -10,10 +10,7 @@ as.data.frame.tbl_df <- function(x, row.names = NULL, optional = FALSE, ...) {
 #' @rdname formatting
 #' @export
 print.tbl_df <- function(x, ..., n = NULL, width = NULL) {
-  cat("Source: local data frame ", dim_desc(x), "\n", sep = "")
-  cat("\n")
   print(trunc_mat(x, n = n, width = width))
-
   invisible(x)
 }
 

diff --git a/R/utils-format.r b/R/utils-format.r
@@ -22,14 +22,6 @@
 #' @name formatting
 NULL
 
-dim_desc <- function(x) {
-  d <- dim(x)
-  d2 <- big_mark(d)
-  d2[is.na(d)] <- "??"
-
-  paste0("[", paste0(d2, collapse = " x "), "]")
-}
-
 #' @export
 #' @rdname formatting
 #' @importFrom stats setNames
@@ -46,30 +38,34 @@ trunc_mat <- function(x, n = NULL, width = NULL, n_extra = NULL) {
   n_extra <- n_extra %||% tibble_opt("max_extra_cols")
 
   df <- as.data.frame(head(x, n))
-  var_types <- vapply(df, type_sum, character(1))
-  var_names <- names(df)
+  trunc_mat_impl(df, n, width, n_extra, rows)
+}
 
+trunc_mat_impl <- function(df, n, width, n_extra, rows) {
   width <- tibble_width(width)
-  if (ncol(df) == 0 || nrow(df) == 0) {
-    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"))
+  shrunk <- shrink_mat(df, width, rows, n)
+  trunc_info <- list(width = width, rows_total = rows, rows_min = nrow(df),
+                     n_extra = n_extra)
+
+  structure(c(shrunk, trunc_info), class = "trunc_mat")
 }
 
 #' @importFrom stats setNames
-shrink_mat <- function(df, width, n_extra, var_names, var_types, rows, n) {
+shrink_mat <- function(df, width, rows, n) {
+  var_types <- vapply(df, type_sum, character(1))
+
+  if (ncol(df) == 0 || nrow(df) == 0) {
+    return(new_shrunk_mat(NULL, var_types))
+  }
+
   df <- remove_rownames(df)
 
   # Minimum width of each column is 5 "(int)", so we can make a quick first
   # pass
   max_cols <- floor(width / 5)
-  extra_wide <- seq_along(var_names) > max_cols
-  if (any(extra_wide)) {
-    df <- df[!extra_wide]
-  }
+  extra_wide <- (seq_along(df) > max_cols)
+  df[] <- df[!extra_wide]
 
   # List columns need special treatment because format can't be trusted
   classes <- paste0("<", vapply(df, type_sum, character(1)), ">")
@@ -104,41 +100,86 @@ shrink_mat <- function(df, width, n_extra, var_names, var_types, rows, n) {
   shrunk <- rbind(" " = classes, shrunk)
   colnames(shrunk) <- colnames(df)[!too_wide]
 
-  needs_dots <- is.na(rows) || rows > n
+  if (is.na(rows))
+    needs_dots <- (nrow(df) >= n)
+  else
+    needs_dots <- (rows > n)
   if (needs_dots) {
     dot_width <- pmin(w[-1][!too_wide], 3)
     dots <- vapply(dot_width, function(i) paste(rep(".", i), collapse = ""),
       FUN.VALUE = character(1))
-    shrunk <- rbind(shrunk, ".." = dots)
-  }
-
-  if (any(extra_wide)) {
-    extra_wide[seq_along(too_wide)] <- too_wide
-    extra <- setNames(var_types[extra_wide], var_names[extra_wide])
+    rows_missing <- rows - n
   } else {
-    extra <- setNames(var_types[too_wide], var_names[too_wide])
+    rows_missing <- 0L
   }
 
-  if (length(extra) > n_extra) {
-    more <- paste0("and ", length(extra) - n_extra, " more")
-    extra <- c(extra[1:n_extra], setNames("...", more))
-  }
+  extra_wide[seq_along(too_wide)] <- too_wide
+  new_shrunk_mat(shrunk, var_types[extra_wide], rows_missing)
+}
 
-  list(table = shrunk, extra = extra)
+new_shrunk_mat <- function(table, extra, rows_missing = NULL) {
+  list(table = table, extra = extra, rows_missing = rows_missing)
 }
 
 #' @export
 print.trunc_mat <- function(x, ...) {
-  if (!is.null(x$table)) {
+  print_table(x)
+
+  extra <- format_extra(x)
+  if (length(extra) > 0) {
+    cat(wrap("... ", paste(extra, collapse = ", "), width = x$width), "\n",
+        sep = "")
+  }
+
+  invisible(x)
+}
+
+format_extra <- function(x) {
+  extra_rows <- format_extra_rows(x)
+  extra_cols <- format_extra_cols(x)
+
+  extra <- c(extra_rows, extra_cols)
+  if (length(extra) >= 1) {
+    extra[[1]] <- paste0("with ", extra[[1]])
+    extra[-1] <- vapply(extra[-1], function(ex) paste0("and ", ex), character(1))
+  }
+  extra
+}
+
+print_table <- function(x) {
+  if (!is.null(x$table))
     print(x$table)
+}
+
+format_extra_rows <- function(x) {
+  if (!is.null(x$table)) {
+    if (is.na(x$rows_missing)) {
+      "more rows"
+    } else if (x$rows_missing > 0) {
+      paste0(big_mark(x$rows_missing), " more rows")
+    }
+  } else if (is.na(x$rows_total)) {
+    paste0("at least ", x$rows_min, " rows total")
+  } else {
+    paste0(x$rows_total, " rows total")
   }
+}
 
+format_extra_cols <- function(x) {
   if (length(x$extra) > 0) {
-    var_types <- paste0(names(x$extra), " <", x$extra, ">", collapse = ", ")
-    cat(wrap("Variables not shown: ", var_types, width = x$width),
-        ".\n", sep = "")
+    var_types <- paste0(names(x$extra), " <", x$extra, ">")
+    if (x$n_extra > 0) {
+      if (x$n_extra < length(var_types)) {
+        var_types <- c(var_types[seq_len(x$n_extra)], "...")
+      }
+      vars <- paste0(": ", paste(var_types, collapse = ", "))
+    } else {
+      vars <- ""
+    }
+    paste0(length(x$extra), " ",
+           if (!identical(x$rows_total, 0L)) "more ",
+           "variables", vars)
   }
-  invisible()
 }
 
 #' knit_print method for trunc mat
@@ -147,9 +188,10 @@ print.trunc_mat <- function(x, ...) {
 knit_print.trunc_mat <- function(x, options) {
   kable <- knitr::kable(x$table, row.names = FALSE)
 
-  if (length(x$extra) > 0) {
-    var_types <- paste0(names(x$extra), " <", x$extra, ">", collapse = ", ")
-    extra <- wrap("\n(_Variables not shown_: ", var_types, ")", width = x$width)
+  extra <- format_extra(x)
+
+  if (length(extra) > 0) {
+    extra <- wrap("(", paste(extra, collapse = ", "), ")", width = x$width)
   } else {
     extra <- "\n"
   }

diff --git a/README.md b/README.md
@@ -15,8 +15,6 @@ You can create a tibble from an existing object with `as_data_frame()`:
 ``` r
 library(tibble)
 as_data_frame(iris)
-#> Source: local data frame [150 x 5]
-#> 
 #>    Sepal.Length Sepal.Width Petal.Length Petal.Width Species
 #>           <dbl>       <dbl>        <dbl>       <dbl>  <fctr>
 #> 1           5.1         3.5          1.4         0.2  setosa
@@ -29,7 +27,7 @@ as_data_frame(iris)
 #> 8           5.0         3.4          1.5         0.2  setosa
 #> 9           4.4         2.9          1.4         0.2  setosa
 #> 10          4.9         3.1          1.5         0.1  setosa
-#> ..          ...         ...          ...         ...     ...
+#> ... with 140 more rows
 ```
 
 This will work for reasonable inputs that are already data.frame, list, matrix, or table.
@@ -38,8 +36,6 @@ You can also create a new tibble from vectors that represent the columns with `d
 
 ``` r
 data_frame(x = 1:5, y = 1, z = x ^ 2 + y)
-#> Source: local data frame [5 x 3]
-#> 
 #>       x     y     z
 #>   <int> <dbl> <dbl>
 #> 1     1     1     2
@@ -59,8 +55,6 @@ frame_data(
   "a", 2,  3.6,
   "b", 1,  8.5
 )
-#> Source: local data frame [2 x 3]
-#> 
 #>       x     y     z
 #>   <chr> <dbl> <dbl>
 #> 1     a     2   3.6
@@ -84,23 +78,22 @@ Tibbles have a refined print method that shows only the first 10 rows, and all t
 ``` r
 library(nycflights13)
 flights
-#> Source: local data frame [336,776 x 16]
-#> 
-#>     year month   day dep_time dep_delay arr_time arr_delay carrier tailnum
-#>    <int> <int> <int>    <int>     <dbl>    <int>     <dbl>   <chr>   <chr>
-#> 1   2013     1     1      517         2      830        11      UA  N14228
-#> 2   2013     1     1      533         4      850        20      UA  N24211
-#> 3   2013     1     1      542         2      923        33      AA  N619AA
-#> 4   2013     1     1      544        -1     1004       -18      B6  N804JB
-#> 5   2013     1     1      554        -6      812       -25      DL  N668DN
-#> 6   2013     1     1      554        -4      740        12      UA  N39463
-#> 7   2013     1     1      555        -5      913        19      B6  N516JB
-#> 8   2013     1     1      557        -3      709       -14      EV  N829AS
-#> 9   2013     1     1      557        -3      838        -8      B6  N593JB
-#> 10  2013     1     1      558        -2      753         8      AA  N3ALAA
-#> ..   ...   ...   ...      ...       ...      ...       ...     ...     ...
-#> Variables not shown: flight <int>, origin <chr>, dest <chr>, air_time
-#>   <dbl>, distance <dbl>, hour <dbl>, minute <dbl>.
+#>     year month   day dep_time sched_dep_time dep_delay arr_time
+#>    <int> <int> <int>    <int>          <int>     <dbl>    <int>
+#> 1   2013     1     1      517            515         2      830
+#> 2   2013     1     1      533            529         4      850
+#> 3   2013     1     1      542            540         2      923
+#> 4   2013     1     1      544            545        -1     1004
+#> 5   2013     1     1      554            600        -6      812
+#> 6   2013     1     1      554            558        -4      740
+#> 7   2013     1     1      555            600        -5      913
+#> 8   2013     1     1      557            600        -3      709
+#> 9   2013     1     1      557            600        -3      838
+#> 10  2013     1     1      558            600        -2      753
+#> ... with 336,766 more rows
+#> ... and 12 more variables (sched_arr_time <int>, arr_delay <dbl>, carrier
+#>   <chr>, flight <int>, tailnum <chr>, origin <chr>, dest <chr>, air_time
+#>   <dbl>, distance <dbl>, hour <dbl>, minute <dbl>, time_hour <time>)
 ```
 
 Tibbles are strict about subsetting. If you try to access a variable that does not exist, you'll get an error:

diff --git a/tests/testthat/output/trunc_mat/all--30.txt b/tests/testthat/output/trunc_mat/all--30.txt
@@ -1,9 +1,7 @@
-Source: local data frame [2 x 8]
-
       a     b     c     d
   <dbl> <int> <lgl> <chr>
 1   1.0     1  TRUE     a
 2   2.5     2 FALSE     b
-Variables not shown: e
+... with 4 more variables: e
   <fctr>, f <date>, g <time>,
-  h <list>.
+  h <list>
diff --git a/tests/testthat/output/trunc_mat/all-1-30-0.txt b/tests/testthat/output/trunc_mat/all-1-30-0.txt
@@ -0,0 +1,5 @@
+      a     b     c     d
+  <dbl> <int> <lgl> <chr>
+1     1     1  TRUE     a
+... with 1 more rows, and 4
+  more variables
diff --git a/tests/testthat/output/trunc_mat/all-1-30-2.txt b/tests/testthat/output/trunc_mat/all-1-30-2.txt
@@ -1,7 +1,6 @@
-       a     b     c     d
-   <dbl> <int> <lgl> <chr>
-1      1     1  TRUE     a
-..   ...   ...   ...   ...
-Variables not shown: e
-  <fctr>, f <date>, and 2
-  more <...>.
+      a     b     c     d
+  <dbl> <int> <lgl> <chr>
+1     1     1  TRUE     a
+... with 1 more rows, and 4
+  more variables: e <fctr>, f
+  <date>, ...
diff --git a/tests/testthat/output/trunc_mat/all-knit-60.txt b/tests/testthat/output/trunc_mat/all-knit-60.txt
@@ -6,4 +6,4 @@
 |1.0   |1     |TRUE  |a     |a      |2015-12-10 |
 |2.5   |2     |FALSE |b     |b      |2015-12-11 |
 
-(_Variables not shown_: g <time>, h <list>)
+(with 2 more variables: g <time>, h <list>)
diff --git a/tests/testthat/output/trunc_mat/iris--70.txt b/tests/testthat/output/trunc_mat/iris--70.txt
@@ -1,5 +1,3 @@
-Source: local data frame [150 x 5]
-
    Sepal.Length Sepal.Width Petal.Length Petal.Width Species
           <dbl>       <dbl>        <dbl>       <dbl>  <fctr>
 1           5.1         3.5          1.4         0.2  setosa
@@ -12,4 +10,4 @@ Source: local data frame [150 x 5]
 8           5.0         3.4          1.5         0.2  setosa
 9           4.4         2.9          1.4         0.2  setosa
 10          4.9         3.1          1.5         0.1  setosa
-..          ...         ...          ...         ...     ...
+... with 140 more rows
diff --git a/tests/testthat/output/trunc_mat/iris-3-5.txt b/tests/testthat/output/trunc_mat/iris-3-5.txt
@@ -1,19 +1,22 @@
-Source: local data frame [150 x 5]
-
-   Sepal.Length
-          <dbl>
-1           5.1
-2           4.9
-3           4.7
-..          ...
-Variables
-  not
-  shown:
+  Sepal.Length
+         <dbl>
+1          5.1
+2          4.9
+3          4.7
+...
+  with
+  147
+  more
+  rows,
+  and
+  4
+  more
+  variables:
   Sepal.Width
   <dbl>,
   Petal.Length
   <dbl>,
   Petal.Width
   <dbl>,
   Species
-  <fctr>.
+  <fctr>
diff --git a/tests/testthat/output/trunc_mat/iris-5-30.txt b/tests/testthat/output/trunc_mat/iris-5-30.txt
@@ -1,14 +1,12 @@
-Source: local data frame [150 x 5]
-
-   Sepal.Length Sepal.Width
-          <dbl>       <dbl>
-1           5.1         3.5
-2           4.9         3.0
-3           4.7         3.2
-4           4.6         3.1
-5           5.0         3.6
-..          ...         ...
-Variables not shown:
+  Sepal.Length Sepal.Width
+         <dbl>       <dbl>
+1          5.1         3.5
+2          4.9         3.0
+3          4.7         3.2
+4          4.6         3.1
+5          5.0         3.6
+... with 145 more rows, and 3
+  more variables:
   Petal.Length <dbl>,
   Petal.Width <dbl>, Species
-  <fctr>.
+  <fctr>
diff --git a/tests/testthat/output/trunc_mat/iris_unk-10-70.txt b/tests/testthat/output/trunc_mat/iris_unk-10-70.txt
@@ -0,0 +1,13 @@
+   Sepal.Length Sepal.Width Petal.Length Petal.Width Species
+          <dbl>       <dbl>        <dbl>       <dbl>  <fctr>
+1           5.1         3.5          1.4         0.2  setosa
+2           4.9         3.0          1.4         0.2  setosa
+3           4.7         3.2          1.3         0.2  setosa
+4           4.6         3.1          1.5         0.2  setosa
+5           5.0         3.6          1.4         0.2  setosa
+6           5.4         3.9          1.7         0.4  setosa
+7           4.6         3.4          1.4         0.3  setosa
+8           5.0         3.4          1.5         0.2  setosa
+9           4.4         2.9          1.4         0.2  setosa
+10          4.9         3.1          1.5         0.1  setosa
+... with more rows