rr-markdowndt

Create Color Bars by column and group in Rmarkdown presentation

I would like to apply the styleColorBar format from the DT package to a datatable in a Rmarkdown presentation by group and column. The results should look like the picture below.

enter image description here

My attempt and the code is below I am not able to get the color bars by group. My real table has lots of columns so a programmatic solution would be nice but not required. Thanks

---
title: "Table Format"
output: slidy_presentation
  
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE)
```


```{r message=FALSE, warning=FALSE, include=FALSE}
library(DT)
library(tidyverse)
```
```{r}
df = read.csv("~/df.csv") 
```

## Table
```{r, echo = FALSE}
area_cols = c("area_col1","area_col2")
city_cols = c("city_col1","city_col2")
region_cols = c('region_col2','region_col3')


 datatable(df, rownames = FALSE,
           options = list(
            columnDefs = list(list(className = 'dt-center', targets = 0:ncol(df)-1)),
            pageLength = 18
            
            )) %>% 
   formatStyle('area_col1',
   background = styleColorBar(range(df["area_col1"]), 'lightblue',angle = -90),
   backgroundSize = '100% 100%',
   backgroundRepeat = 'no-repeat',
   backgroundPosition = 'center') %>%
   
   formatStyle('area_col2',
   background = styleColorBar(range(df["area_col2"]), 'lightblue',angle = -90),
   backgroundSize = '100% 100%',
   backgroundRepeat = 'no-repeat',
   backgroundPosition = 'center') %>% 
   
   formatStyle('city_col1',
   background = styleColorBar(range(df["city_col1"]), 'orange',angle = -90),
   backgroundSize = '100% 100%',
   backgroundRepeat = 'no-repeat',
   backgroundPosition = 'center') %>%
   
   formatStyle('city_col2',
   background = styleColorBar(range(df["city_col2"]), 'orange',angle = -90),
   backgroundSize = '100% 100%',
   backgroundRepeat = 'no-repeat',
   backgroundPosition = 'center') %>%
   
   formatStyle('region_col2',
   background = styleColorBar(range(df["region_col2"]), 'lightgreen',angle = -90),
   backgroundSize = '100% 100%',
   backgroundRepeat = 'no-repeat',
   backgroundPosition = 'center') %>%
   
   formatStyle('region_col3',
   background = styleColorBar(range(df["region_col3"]), 'lightgreen',angle = -90),
   backgroundSize = '100% 100%',
   backgroundRepeat = 'no-repeat',
   backgroundPosition = 'center') %>%
   
   formatCurrency(c('area_col2'),digits = 0) %>%
   formatPercentage(c(region_cols,city_cols), 0)

```

Data

    structure(list(Group = c("A", "A", "A", "B", "B", "B", "B", "C", 
    "C", "C", "C", "C", "C", "D", "D", "D", "E", "E"), area_col1 = c(113L, 
    112L, 102L, 380L, 366L, 481L, 269L, 14L, 5L, 13L, 14L, 9L, 8L, 
    62L, 43L, 52L, 9L, 9L), area_col2 = c(4411L, 3714L, 5317L, 14085L, 
    16567L, 18276L, 12776L, 5801L, 4744L, 6836L, 5913L, 2858L, 3119L, 
    843L, 446L, 497L, 380L, 449L), city_col1 = c(0.11, 0.1, 0.06, 
    0.03, 1, 0.06, 0.11, 0.05, 0.04, 0.08, 1, 0.01, 0.16, 0.05, 0.04, 
    0.34, 0.11, 1), city_col2 = c(0, 0, 0, 0, 0.01, 0, 0, 0.01, 0, 
    0, 0.02, 0, 0.02, 0, 0, 0.01, 0, 0.8), region_col2 = c(0.16, 
    0.04, 0.05, 0.12, 0.08, 0.03, 0.1, 0, 0, 0, 0, 0.78, 0, 0.12, 
    0.02, 0.01, 0.07, 0.01), region_col3 = c(0.06, 0.23, 0.07, 0.15, 
    0.11, 0.02, 0.06, 0, 0, 0, 0.01, 0, 0.01, 0.09, 0.14, 0.02, 0.07, 
    0.06)), class = "data.frame", row.names = c(NA, -18L))
Solution

  • You could also take a look at the reactable and its extension package reactablefmtr for such tables, e.g.

    library(reactable)
library(reactablefmtr)
df1 <- group_by(df, Group)

reactable(df1, 
  theme = clean(),
  pagination = FALSE,
  columns = list(
    area_col1 = colDef(
      cell = data_bars(
        data = df1,
        fill_color = viridis::mako(5),
        background = '#F1F1F1',
        min_value = 0,
        max_value = 500,
        text_position = 'outside-end'
      )
    ),
    area_col2 = colDef(
      cell = data_bars(
        data = df1,
        fill_color = c('#FFF2D9','#FFE1A6','#FFCB66','#FFB627'),
        fill_gradient = TRUE,
        background = 'transparent',
        text_position = 'outside-end',
        number_fmt = scales::dollar_format()
      )
    ),
    city_col1 = colDef(
      cell = data_bars(
        data = df1,
        fill_color = 'black',
        fill_opacity = 0.8,
        round_edges = TRUE,
        text_position = 'outside-end',
        number_fmt = scales::label_percent()
      )
    ),
    city_col2 = colDef(
      cell = data_bars(
        data = df1,
        fill_color = 'black',
        fill_opacity = 0.8,
        round_edges = TRUE,
        text_position = 'outside-end',
        number_fmt = scales::label_percent()
      )
    ),
    region_col2 = colDef(
      cell = data_bars(
        data = df1,
        fill_color = 'white',
        background = 'darkgrey',
        border_style = 'solid',
        border_width = '1px',
        border_color = 'forestgreen',
        box_shadow = TRUE,
        text_position = 'outside-end',
        number_fmt = scales::label_percent()
      )
    ),
    region_col3 = colDef(
      cell = data_bars(
        data = df1,
        fill_color = 'white',
        background = 'darkgrey',
        border_style = 'solid',
        border_width = '1px',
        border_color = 'forestgreen',
        box_shadow = TRUE,
        text_position = 'outside-end',
        number_fmt = scales::label_percent()
      )
    )
  )
)

    You could play around with different styles and colors as well as text placement that will suit your purpose. The result from the code above looks like this

    example_reactable