Creating a RAG datatable in R

Question

Based on the solution here, Add colours to datatable I am trying to produce a RAG table and want to assign four colours.

library(tidyverse)
library(DT)

rag_df <- data.frame(Vulnerabilities = c("AB", "BC", "DE",
                                         "FG", "HU", "JK",
                                         "PF", "IC", "EC"),
                     `Rates` = c(21.1, 32.2, 2.12, 4.6, 5.43, 6.56, 7.9, 8.11, 9.13),
                     `Turns` = c(111, 222, 333, 444, 555, 666, 777, 88, 99))

high_rates <- rag_df$`Rates`
transmis_chanls <- rag_df$`Turns`

# Generate colors
color_intervals <- seq(0, 1, length.out = nrow(rag_df))
clrs_rmp <- colorRamp(c("#FD015B", "#FF7300", "#FFF200", "#A5D700"))(color_intervals)

# Extract RGB values
clrs_df <- tibble(r = clrs_rmp[, 1] / 255, g = clrs_rmp[, 2] / 255, b = clrs_rmp[, 3] / 255) %>%
  mutate(mycolor=paste0("rgb(", paste(r,g,b,sep = ","),")"))

(clrs <- pull(clrs_df,mycolor))

# Apply colors to the datatable
create_db <- datatable(rag_df, rownames = TRUE) %>%
  formatStyle(names(rag_df), backgroundColor = styleInterval(high_rates, clrs))

create_db

The error:

Error in styleInterval(high_rates, clrs) : 
  length(cuts) must be equal to length(values) - 1

The Screenshot illustrate what am trying to achieve.

Answer 1

Three issues:

1: Your vector of cuts (high_rates) must be sorted in increasing order

high_rates <- sort(rag_df$`Rates`)

2: The length of "cuts" must be one less than the length of "values" in the styleInterval function. One way to do this is to add 1 to the length of the color_intervals sequence:

color_intervals <- seq(0, 1, length.out = nrow(rag_df) + 1)

3: The "backgroundColor" argument of the "formatStyle" function doesn't like rbg values in [0,1]. So remove the division by 255.

clrs_df <- tibble(r = clrs_rmp[, 1], 
                  g = clrs_rmp[, 2], 
                  b = clrs_rmp[, 3]) %>%
  mutate(mycolor=paste0("rgb(", paste(r,g,b,sep = ","),")"))

With these changes, you should get the following picture:

---

high_rates <- sort(rag_df$`Rates`)
transmis_chanls <- rag_df$`Turns`

# Generate colors
color_intervals <- seq(0, 1, length.out = nrow(rag_df) + 1)
clrs_rmp <- colorRamp(c("#FD015B", "#FF7300", "#FFF200", "#A5D700"))(color_intervals)

# Extract RGB values
clrs_df <- tibble(r = clrs_rmp[, 1], 
                  g = clrs_rmp[, 2], 
                  b = clrs_rmp[, 3]) %>%
  mutate(mycolor=paste0("rgb(", paste(r,g,b,sep = ","),")"))

(clrs <- pull(clrs_df, mycolor))

# Apply colors to the datatable
datatable(rag_df, rownames = TRUE) %>%
  formatStyle(names(rag_df), backgroundColor = styleInterval(high_rates, clrs))