Create Color Bars by column and group in Rmarkdown presentation

Question

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.

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))

userOHjX · Answer

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

Create Color Bars by column and group in Rmarkdown presentation

1 Answers