Create Tables with Conditional Formatting with Rmarkdown + Knitr

Create tables with conditional formatting with RMarkdown + knitr

I always wanted to extend pandoc.table in my pander package with this feature, but failed to get the time for that. But this question is really inspiring, probably will do that in the next few days. Until then, what about:

1. Load the package:

   library(pander)
   

2. Load your data:

   n <- data.frame(x = c(1,1,1,1,1), y = c(0,1,0,1,0))
   

3. Update your lines to be marked as strong in Pandoc:

   for (i in c(1, 3, 5))
       n[i, ] <- pandoc.strong.return(n[1, ])
   

4. Show the markdown version of your table:

   pandoc.table(n)
   pander(n)       # S3 method
   

5. Covert the markdown to e.g. HTML with brew syntax:

   Pandoc.brew(text = '<%=n%>', output = tempfile(), convert = 'html')
   

---

Update: I have updated pander to take some new arguments to highlight rows/columns/cells easily. Although I am still working on some further helper functions to make this process easier, here goes a quick demo so that you might see how it could help your workflow:

> pandoc.table(n, emphasize.rows = c(1, 3, 5))

-------
 x   y 
--- ---
*1* *0*

 1   1 

*0* *1*

 1   1 

*1* *0*
-------

> pandoc.table(n, emphasize.strong.cells = which(n == 1, arr.ind = TRUE))

-----------
  x     y  
----- -----
**1**   0  

**1** **1**

**1**   0  

**1** **1**

**1**   0  
-----------

---

Update: pander gained some helper functions to highlight cells in the tables even easier:

> t <- mtcars[1:3, 1:5]
> emphasize.cols(1)
> emphasize.rows(1)
> pandoc.table(t)

----------------------------------------------------
                mpg    cyl   disp   hp    drat 
------------------- ------ ----- ------ ----- ------
   **Mazda RX4**     *21*   *6*  *160*  *110* *3.9* 

 **Mazda RX4 Wag**   *21*    6    160    110   3.9  

  **Datsun 710**    *22.8*   4    108    93    3.85 
----------------------------------------------------

Or directly with pander method:

> emphasize.strong.cells(which(t > 20, arr.ind = TRUE))
> pander(t)

---------------------------------------------------------
                 mpg     cyl   disp     hp     drat 
------------------- -------- ----- ------- ------- ------
   **Mazda RX4**     **21**    6   **160** **110**  3.9  

 **Mazda RX4 Wag**   **21**    6   **160** **110**  3.9  

  **Datsun 710**    **22.8**   4   **108** **93**   3.85 
---------------------------------------------------------

Please note that these new features are not published on CRAN yet, but you can find in the most recent version hosted on GitHub.

KableExtra conditional tables in R

One way of coloring the columns is by using data_color from {gt} package.
You can specify the colors in various ways, including manually supplying the names of your desired colors available in grDevices::colors(). You can also specify the domain with the range of the values in the targeted column.

For example:

library(tidyverse)
library(gt)

iris[45:55,c(1,5)] %>% gt() %>%
    data_color(columns = Sepal.Length, colors = scales::col_numeric(
        palette = c("tomato","yellow", "green4"), 
        domain = range(Sepal.Length)))

which results in the following colors

R Markdown - PDF Table with conditional bold format for row maximum AND percentage format

The percentage values are converted into character with the cell_spec argument. with a bit of stringr and regex the decimal values can be converted to percentages. Note % is a reserved symbol in LaTeX so needs escaping.

---
output:
  pdf_document
---

```{r setup, include=FALSE}

knitr::opts_chunk$set(echo = FALSE)

require("pacman")
p_load(dplyr, tidyr, stringr, kableExtra, forcats, tinytex, scales, janitor)

```{r df, include=FALSE}

        segment<- c('seg1', 'seg1', 'seg2', 'seg2', 'seg3', 'seg3', 'Tot')
        subSegment<- c('subseg1.1', 'subseg1.2', 'subseg2.1', 'subseg2.2', 'subseg3.1', 'subseg3.2', "-")
        co.1<- c(0.1, 0.4, 0.3, 0.2, 0.5, 0.4, 0.4)
        co.2<- c(0.5, 0.3, 0.3, 0.2, 0.1, 0.5, 0.4)
        co.3<- c(0.2, 0.1, 0.4, 0.4, 0.1, 0.1, 0.15)
        co.4<- c(0.2, 0.2, 0.0, 0.2, 0.3, 0.0, 0.05)
        total<- c(1,1,1,1,1,1,1)
        
        df <-
          data.frame(segment, subSegment, co.1, co.2, co.3, co.4, total) %>% 
          rowwise() %>% 
          mutate(across(co.1:co.4,  ~cell_spec(.x, 'latex', bold = ifelse(.x == max(c_across(co.1:co.4)), TRUE,  FALSE)))) %>% 
          ungroup() %>% 
          pivot_longer(starts_with("co."))%>% 
          mutate(pc = percent(as.numeric(str_extract(value, "0.\\d+|0")), accuracy = 0.1),
                 value = str_replace(value, "0.\\d+|0", pc),
                 value = str_replace(value, "%", "\\\\%")) %>%
          select(-pc) %>% 
          pivot_wider() %>% 
          select(-total, everything(), total)
        
```    

```{r kable, results='asis'}

df %>%
  kable(booktabs = TRUE,
        caption = "Title",
        align = "c",
        escape = FALSE) %>%
  kable_styling(latex_options = c("HOLD_position", "repeat_header", "scale_down"),
                font_size = 6) %>%
  pack_rows(index = table(fct_inorder(df$segment)),
             italic = FALSE,
             bold = FALSE,
             underline = TRUE,
             latex_gap_space = "1em",
             background = "#f2f2f2") %>%
  column_spec(1, monospace = TRUE, color = "white") %>%
  row_spec(nrow(df), bold = TRUE)

```

Problems with conditional cell formatting for table in R-Markdown (Quarto)

If you change from background to color as the argument in cell_spec() your code works as expected.

If you want a colored background, you need to remove the last line of code kableExtra::kable_styling("striped", full_width = T).

If you want full width, you need to adjust latex options in kable_styling:

beans_stock %>% 
  mutate(
    Progress = kableExtra::cell_spec(
      Progress, background = ifelse(Progress > 70,"green",
                                    ifelse(Progress < 30,"red","orange")))
  ) %>% 
  kableExtra::kable(escape = FALSE,format = "latex", booktabs = T) %>% 
  kableExtra::kable_styling(latex_options="scale_down")

R - Conditional row highlighting in HTML table created using xtable or kable

Here is a solution using Gmisc::htmlTable

set.seed(123)
df <- data.frame(id       = sample(1:100, 20, replace = TRUE),
                 inputval = sample(seq(0, 1, by=0.01), 20, replace = TRUE),
                 outcome  = sample(1:4, 20, replace = TRUE))

cols <- with(df, ifelse(outcome == 1, 'magenta', 'white'))

library(Gmisc)
htmlTable(as.matrix(df), altcol = cols, 
          rgroup = '', n.rgroup = rep(1, length(cols)))

EDIT

Since htmlTable has since been moved to the package, htmlTable, and is no longer in Gmisc >= 1.0, the new way to do this would be

library('htmlTable')
htmlTable(as.matrix(df), col.rgroup = cols)

which also gives:

and your markdown code would simply be

```{r, results='asis'}
htmlTable(as.matrix(df), altcol = cols, 
          rgroup = '', n.rgroup = rep(1, length(cols)))
```

And my .Rmd would look like:

---
output: 
  html_document:
    css: ~/knitr.css
---

```{r, results='asis', message=FALSE}
set.seed(123)
df <- data.frame(id       = sample(1:100, 20, replace = TRUE),
                 inputval = sample(seq(0, 1, by=0.01), 20, replace = TRUE),
                 outcome  = sample(1:4, 20, replace = TRUE))

cols <- with(df, ifelse(outcome == 1, 'magenta', 'white'))

library(Gmisc)
htmlTable(as.matrix(df), altcol = cols, 
          rgroup = '', n.rgroup = rep(1, length(cols)))
```

Create editable tables in rmarkdown

I think your best resource will be the gtsummary vignette on R markdown. http://www.danieldsjoberg.com/gtsummary/articles/rmarkdown.html
In the vignette, you'll find this table outlining how to export gtsummary tables to various R markdown output types.

In your case, I would recommend you convert the gtsummary tables to a flextable using the as_flex_table() function.

For example, you could update your function to include this conversion. (More information/options outlined in the vignette.)

```{r , include=FALSE}
# set up user function create tables
run_xtab <- function(v1) {
  out <- data_in%>%
    tbl_cross(
      row = !!rlang::sym(v1),
      col = survey,
      percent = 'column',
      label = list(survey~v1),
      missing_text = "no"
    ) %>%
    add_p(source_note = TRUE) %>%
    bold_labels() %>%
    as_flex_table()
  
  return(out)
}
```

Conditionally format each cell containing the max value of a row in a data frame - R Markdown PDF

Using dplyr::mutate(across... and max(c_across... is one way:

---
output:
  pdf_document:
  toc: yes
---

```{r, include=FALSE}

require("pacman")
p_load(dplyr, forcats, knitr, kableExtra, tinytex, janitor)

segment<- c('seg1', 'seg1', 'seg2', 'seg2', 'seg3', 'seg3')
subSegment<- c('subseg1', 'subseg2', 'subseg1', 'subseg2', 'subseg1', 'subseg2')
var.1<- c(100, 20, 30, 50, 40, 40)
var.2<- c(200, 30, 30, 70, 30, 140)
var.3<- c(50, 50, 40, 20, 30, 40)
var.4<- c(60, 50, 35, 53, 42, 20)

df <- 
  data.frame(segment, subSegment, var.1, var.2, var.3, var.4) %>% 
  adorn_totals('row') %>% 
  rowwise() %>% 
  mutate(across(var.1:var.4,  ~cell_spec(.x, 'latex', bold = ifelse(.x == max(c_across(var.1:var.4)), TRUE,  FALSE))))
  
```

```{r, results='asis'}

df %>%
  kable(booktabs = TRUE,
        caption = "Title",
        align = "c",
        escape = FALSE) %>%
  kable_styling(latex_options = c("HOLD_position", "repeat_header", "scale_down"),
                font_size = 6) %>%
  pack_rows(index = table(fct_inorder(df$segment)),
             italic = FALSE,
             bold = FALSE,
             underline = TRUE,
             latex_gap_space = "1em",
             background = "#f2f2f2")%>%
  column_spec(1, monospace = TRUE, color = "white") %>%
  row_spec(nrow(df), bold = TRUE)

```

Which results in this pdf output:

---

Related Topics