Last active
September 17, 2024 01:49
-
-
Save debruine/01b4ce274733a4a99622365e8c6df701 to your computer and use it in GitHub Desktop.
Testing methods for df_print-like custom table printing in quarto
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
--- | |
title: "Table printing demo" | |
author: "Lisa DeBruine" | |
toc: true | |
toc_float: true | |
--- | |
## Code | |
These functions should override `knitr::knit_print()` for data frames, but wasn't working at all until I learned in [the knit_print vignette](https://cran.r-project.org/web/packages/knitr/vignettes/knit_print.html) that you have to use `registerS3method()`. | |
<style> | |
caption { color: purple !important; } | |
</style> | |
```{r} | |
# custom knit_print functions for data.frame | |
library(knitr) | |
# print everything as paged ---- | |
# knit_print.data.frame <- function (x, options, ...) { | |
# rmarkdown::paged_table(x, options) |> | |
# rmarkdown:::print.paged_df() | |
# } | |
# registerS3method("knit_print", "data.frame", knit_print.data.frame) | |
# print everything as kable ---- | |
# knit_print.data.frame <- function (x, options, ...) { | |
# knitr::kable(x) |> knitr::knit_print(options, ...) | |
# } | |
# registerS3method("knit_print", "data.frame", knit_print.data.frame) | |
# super-customised table printing ---- | |
`%||%` <- function(l, r) { | |
if (is.null(l)) r else l | |
} | |
knit_print.data.frame <- function (x, options, ...) { | |
# get options | |
digits <- options$digits %||% getOption("digits") | |
rownames <- options$rownames %||% FALSE | |
pageLength <- options$pageLength %||% 10 | |
escape <- options$escape %||% TRUE | |
caption <- options$fig.cap | |
# remove caption so it doesn't print twice (NOT WORKING) | |
options$fig.cap <- NULL | |
# use DT for longer tables in html | |
if (nrow(x) > pageLength & knitr::is_html_output()) { | |
numeric_cols <- sapply(x, is.numeric) |> which() |> names() | |
dt <- DT::datatable(x, | |
rownames = rownames, | |
caption = caption, | |
escape = escape, | |
width = "100%", | |
height = "auto", | |
options = list(pageLength = pageLength), | |
selection = "none") | |
if (length(numeric_cols) > 0) { | |
dt <- DT::formatRound(dt, | |
columns = numeric_cols, | |
digits = digits) | |
} | |
knitr::knit_print(dt, options) | |
} else { | |
# use kableExtra::kable for PDFs or shorter tables | |
k <- kableExtra::kable(x, | |
digits = digits, | |
row.names = rownames, | |
caption = caption, | |
escape = escape) |> | |
kableExtra::kable_styling( | |
full_width = options$full_width, | |
bootstrap_options = c("striped", "hover") | |
) | |
if (knitr::is_html_output()) { | |
k <- c("<div class=\"kable-table\">", k, "</div>") |> | |
paste(collapse = "\n") | |
} | |
knitr::asis_output(k) | |
} | |
} | |
registerS3method("knit_print", "data.frame", knit_print.data.frame) | |
``` | |
## Test | |
Make data.frame and tbl_df object with 5 and 26 rows. | |
```{r} | |
df5 <- data.frame(x = rnorm(5), y = LETTERS[1:5]) | |
df26 <- data.frame(x = rnorm(26), y = LETTERS) | |
tbl5 <- tibble::tibble(x = rnorm(5), y = LETTERS[1:5]) | |
tbl26 <- tibble::tibble(x = rnorm(26), y = LETTERS) | |
``` | |
::: {.panel-tabset} | |
### Data frame - 5 rows | |
Should be displayed with `kableExtra::kable()`. | |
```{r} | |
df5 | |
``` | |
### Data frame - 26 rows | |
Should be displayed with `DT::datatable()`. | |
```{r} | |
df26 | |
``` | |
### Tibble - 5 rows | |
Should be displayed with `kableExtra::kable()` | |
```{r} | |
tbl5 | |
``` | |
### Tibble - 26 rows | |
Should be displayed with `DT::datatable()` | |
```{r} | |
tbl26 | |
``` | |
::: | |
## Option Tests | |
Testing options in the r chunk header. | |
::: {.panel-tabset} | |
### digits | |
Set the number of digits to display in numeric columns. Defaults to `getOption("digits")`. | |
```{r, digits = 3} | |
# digits = 3 | |
tbl5 | |
``` | |
```{r, digits = 4} | |
# digits = 4 | |
tbl26 | |
``` | |
### rownames | |
rownames are FALSE by default | |
```{r, rownames = TRUE} | |
# rownames = TRUE | |
tbl5 | |
``` | |
```{r, rownames = TRUE} | |
# rownames = TRUE | |
tbl26 | |
``` | |
### fig.cap | |
Figure captions are displaying twice (the caption from DT or kable is in purple). | |
```{r, fig.cap="This is my figure caption for a tibble with 5 rows"} | |
# fig.cap="This is my figure caption for a tibble with 5 rows" | |
tbl5 | |
``` | |
```{r, fig.cap="This is my figure caption for a tibble with 26 rows"} | |
# fig.cap="This is my figure caption for a tibble with 26 rows" | |
tbl26 | |
``` | |
### pageLength | |
Set the page length for DT, if the table is <= to that, will display as kable. | |
```{r, pageLength = 3} | |
# pageLength = 3, so should be a DT | |
tbl5 | |
``` | |
```{r, pageLength = 30} | |
# pageLength = 30, so should be a kable | |
tbl26 | |
``` | |
### escape | |
`escape` is TRUE by default. Set to FALSE to use html or latex in tables. | |
```{r, escape = FALSE} | |
# escape = FALSE | |
tibble::tibble(styles = c("<i>italics</i>", "<b>bold</b>")) | |
``` | |
```{r, escape = FALSE} | |
# escape = FALSE | |
tibble::tibble(styles = rep(c("<i>italics</i>", "<b>bold</b>"), 10)) | |
``` | |
### full_width | |
For kable only, defaults to TRUE for html and FALSE for pdf. | |
```{r, full_width = TRUE} | |
# full_width = TRUE | |
tbl5 | |
``` | |
```{r, full_width = FALSE} | |
# full_width = FALSE | |
tbl5 | |
``` | |
::: | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment