如何使用同样漂亮的小标题打印来漂亮地打印数据表？

Question

原问题

我正在开发一个 R 数据包，它提供了一堆数据表对象。

当我的包的用户要求将这些数据表之一打印到控制台时，我希望它们打印得像小标题一样漂亮，即很好地压缩，顶部有列类型和一些基本颜色数字等。

那么你知道如何为我的包中的数据表编写一个简单的 S3 方法吗？也许这已经在其他地方实现了，但我找不到。

我知道还有一个与此类似的问题：Print pretty data.frames/tables to console，@csgillespie 已经部分回答了这个问题，但他只留下了可以为 data.frames 编写 S3 方法的建议。但是考虑到我想借用已经为 tibbles (tbl_df) 开发的功能，是不是有一个简单的机制可以从 {tibble} 包或 {pillar} 包中导入这个功能，而现在看来这个功能最初是实施了吗？

顺便说一句：我不想简单地将数据表对象转换为小标题，例如tibble::as_tibble() 因为那样我就失去了拥有数据表对象的优势。

导出数据表的特定漂亮打印

在@Waldi 的回答之后，我想到了一种替代方法，它只会在我的包加载后漂亮地打印提供我的包的数据表，而不是所有的数据表。这是我的方法，希望得到您的反馈。

1. 将组成的类dt_tbl 添加到数据表中，换句话说，将其子类化：

# Assume `dt` is one of the data tables provided by my package
class(dt) <- c('dt_tbl', class(dt))

1. 然后在我的包的R目录下，用"dt_tbl"类的新S3方法创建一个源文件：

# In file print_dt_tbl.R

#' @keywords internal
print_dt_tbl <- function(x, ...) {
  print_txt <- capture.output(print(tibble::as_tibble(x), ...))
  print_txt[1] <- sub('tibble', 'data.table', print_txt[1])
  cat(print_txt, sep = '\n')
  invisible(x)
}

#' @export
print.dt_tbl <- function(x, ...) {
  print_dt_tbl(x, ...)
}

1. 测试一下：

> (iris_dt <- data.table::as.data.table(iris))
     Sepal.Length Sepal.Width Petal.Length Petal.Width   Species
  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
 ---                                                            
146:          6.7         3.0          5.2         2.3 virginica
147:          6.3         2.5          5.0         1.9 virginica
148:          6.5         3.0          5.2         2.0 virginica
149:          6.2         3.4          5.4         2.3 virginica
150:          5.9         3.0          5.1         1.8 virginica
> class(iris_dt) <- c('dt_tbl', class(iris_dt))
> iris_dt
# A data.table: 150 x 5
   Sepal.Length Sepal.Width Petal.Length Petal.Width Species
          <dbl>       <dbl>        <dbl>       <dbl> <fct>  
 1          5.1         3.5          1.4         0.2 setosa 
 2          4.9         3            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           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           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

Answer 1

你可以修改print.data.table:

library(data.table)

print_as_tibble <- function(dt) print(tibble::as_tibble(dt))

assignInNamespace("print.data.table", print_as_tibble , ns="data.table")

dt <- as.data.table(mtcars)

dt
#> # A tibble: 32 x 11
#>      mpg   cyl  disp    hp  drat    wt  qsec    vs    am  gear  carb
#>    <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
#>  1  21       6  160    110  3.9   2.62  16.5     0     1     4     4
#>  2  21       6  160    110  3.9   2.88  17.0     0     1     4     4
#>  3  22.8     4  108     93  3.85  2.32  18.6     1     1     4     1
#>  4  21.4     6  258    110  3.08  3.22  19.4     1     0     3     1
#>  5  18.7     8  360    175  3.15  3.44  17.0     0     0     3     2
#>  6  18.1     6  225    105  2.76  3.46  20.2     1     0     3     1
#>  7  14.3     8  360    245  3.21  3.57  15.8     0     0     3     4
#>  8  24.4     4  147.    62  3.69  3.19  20       1     0     4     2
#>  9  22.8     4  141.    95  3.92  3.15  22.9     1     0     4     2
#> 10  19.2     6  168.   123  3.92  3.44  18.3     1     0     4     4
#> # ... with 22 more rows
class(dt)
#> [1] "data.table" "data.frame"

要在你的包中使用它，你可以创建一个.R 文件，下面是.onLoad：

.onLoad <- function(libname, pkgname) {
  print_as_tibble <- function(dt) print(tibble::as_tibble(dt))
  assignInNamespace("print.data.table", print_as_tibble , ns="data.table")
}

Answer 2

可能有一种更简单的方法来实现一些所需的功能。

根据help("print.data.table", "data.table")，有一些可用于data.table 对象的打印选项，特别是class 和trunc.cols 选项。可以在options() 中设置选项。例如，

iris_dt <- data.table::as.data.table(iris)

options(datatable.print.class = TRUE)
options(datatable.print.trunc.cols = TRUE)

old_width <- options(width = 40)
iris_dt
options(old_width)

     Sepal.Length Sepal.Width
            <num>       <num>
  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
 ---                         
146:          6.7         3.0
147:          6.3         2.5
148:          6.5         3.0
149:          6.2         3.4
150:          5.9         3.0
3 variables not shown: [Petal.Length <num>, Petal.Width <num>, Species <fctr>]

比较

old_width <- options(width = 40)
tibble::as_tibble(iris_dt)
options(old_width)

# A tibble: 150 × 5
   Sepal.Length Sepal.Width Petal.Length
          <dbl>       <dbl>        <dbl>
 1          5.1         3.5          1.4
 2          4.9         3            1.4
 3          4.7         3.2          1.3
 4          4.6         3.1          1.5
 5          5           3.6          1.4
 6          5.4         3.9          1.7
 7          4.6         3.4          1.4
 8          5           3.4          1.5
 9          4.4         2.9          1.4
10          4.9         3.1          1.5
# … with 140 more rows, and 2 more
#   variables: Petal.Width <dbl>,
#   Species <fct>

顺便说一句，我更喜欢 data.table 打印大型数据集的第一行和最后一行的方式。