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

Question

原始问题

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

当我的包的用户要求将这些数据表之一打印到控制台时，我希望它们能够像 tibbles 一样打印得漂亮，即很好地压缩，列类型位于顶部，并且有一些基本的着色数字等.

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

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

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

导出数据表的具体 pretty-print

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

1. 将虚构的类 dt_tbl 添加到数据表中，换句话说，对其进行子类化:

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

然后在我的包的 R 目录中，使用新的 S3 方法为类 “dt_tbl” 创建一个源文件:

# 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, ...)
}

测试一下:

> (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"

要在您的包中使用此功能，您可以使用以下 .onLoad 创建一个 .R 文件:

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