I created an HTML-based R-Quarto document running on the knitr engine. In the example below, I set up the document, include dplyr, and try to format cells of mtcars that are above the column’s average with a green fill, but xtable (the underylying table renderer) does not recognize my commands.
I have tried formatting with \cellcolor, \colorbox, and \cellfill. None of these seem to be formatting properly.
I have also tried adding sanitize.text.function = function(x){x} as it was recommended in another post, but that seems to do nothing.
I also can’t seem to find any documentation that says what the formatting options are. The three “options” I tried above were all from other posts.
What am I missing here?
Here is a reproducible example, and then the output.
---
title: "Test"
format: html
server: shiny
---
#| context: setup
#| output: false
#| echo: false
# Include packages
install_if_not_found <- function(package_name){
if (!package_name %in% rownames(installed.packages()))
install.packages(package_name, repos = "http://cran.us.r-project.org")
library(package_name, character.only = TRUE)
}
packages <- c("dplyr")
sapply(packages, FUN=install_if_not_found)
#| context: server
#| echo: true
output$example_table <- renderTable(expr={
above_average_format_rule <- "\cellcolor{green}{"
suffix <- "}"
mtcars %>%
mutate(across(
mpg:qsec,
~ case_when(
.x > mean(.x) ~ paste0(above_average_format_rule, .x, suffix),
.default = paste0(.x)
)
)) %>%
slice_head(n=5) %>%
select(mpg:drat)
}, striped = TRUE,
align = "c",
caption = "MT-Cars, Supposedly Formatted",
size = "\small",
caption.placement = "top",
sanitize.text.function = function(x){x}
)
Output
#| panel: fill
tableOutput("example_table")
Here’s a way to do it, although I feel it re-invents the wheel: create the HTML table yourself. There really should just be an xtable option for this, though.
Basically, you define what each condition’s HTML formatting should be and put it into a character vector, mutate the cells of the table using case_when, and then chain together all of the table’s HTML into a huge string.
Note that you have to now use the renderUI function instead of the renderTable function, although you can still use the tableOutput function.
Here’s my code and the output. I tried to get decently close to XTable output.
---
title: "Test"
format: html
server: shiny
---
#| context: setup
#| output: false
#| echo: false
# Include packages
install_if_not_found <- function(package_name){
if (!package_name %in% rownames(installed.packages()))
install.packages(package_name, repos = "http://cran.us.r-project.org")
library(package_name, character.only = TRUE)
}
packages <- c("dplyr")
sapply(packages, FUN=install_if_not_found)
#| context: server
#| echo: true
output$example_table <- renderUI({
above_average_format_rule <- "background-color: MediumSeaGreen; text-align: center; vertical-align: top;"
default_cell_style <- "text-align: center; vertical-align: top;"
table_data <- mtcars %>%
mutate(across(
mpg:carb,
~ case_when(
.x > mean(.x) ~ paste0('<td style="', above_average_format_rule, '">', .x, '</td>'),
.default = paste0('<td style="', default_cell_style, '">', .x, '</td>')
)
)) %>%
slice_head(n=5) #%>%
# select(mpg:drat)
# Create HTML table
table_html <- '<table class="table table-striped" style="width: 100%;">'
table_html <- paste0(table_html, '<caption>MT-Cars, Formatted</caption>')
table_html <- paste0(table_html, '<thead><tr>',
paste0('<th style="text-align: center; vertical-align: bottom;">',
colnames(table_data), '</th>', collapse = ""),
'</tr></thead><tbody>')
for (i in 1:nrow(table_data)) {
row_html <- paste0('<tr>', paste0(table_data[i, ], collapse = ""), '</tr>')
table_html <- paste0(table_html, row_html)
}
table_html <- paste0(table_html, '</tbody></table>')
HTML(table_html)
})
Output
#| panel: fill
tableOutput("example_table")