Change Colors of Data Table

[I_like_R]

Hello,

This is my first post ever on this forum, so I apologize if I mess something up.

Here's my problem. I have been trying to figure out how to modify a chunk of code to be able to specify exactly which color I want to have in the cells of a data table.

Here is the code:

library(shinythemes)
library(shinyWidgets)
library(shiny)
library(shinydashboard)
library(DT)
library(dplyr)
library(htmltools)
library(caret)
library(amap)


# Define UI for application
ui <- fluidPage(
             tabPanel("Principal Components",
                      tabname="princomps",
                      icon=icon("compress"),
                      fluidPage(
                        sliderTextInput(inputId = "num", 
                                        label = "Number of Principal Components", 
                                        choices=c(5,4,3,2)),
                        DTOutput("rotations"))))

# Define server logic 
server <- function(input, output) {
    
  testrun<-reactive({
    PCA<-preProcess(Chirot, method = "pca", pcaComp = input$num)
    rots<-round(PCA$rotation,6)
    return(rots)
  })
  
  output$rotations<-renderDT({
    
    data<-as.data.frame(testrun())
    
    
    brks <- quantile(df, probs = seq(.05, .95, .01), na.rm = TRUE)
    clrs <- round(seq(305, 40, length.out = length(brks) + 1), 0) %>%
    {paste0("rgb(305,", ., ",", ., ")")}
    
    datatable(data,rownames=TRUE,options = list(lengthChange = FALSE, dom='t')) %>%
      formatStyle(colnames(data), backgroundColor = styleInterval(brks, clrs))
  })
}

# Run the application 
shinyApp(ui = ui, server = server)

I want to be able to have a gradient of the color I choose for each separate column. I have tried tinkering with the numbers in the clrs and paste0 lines, but I don't understand how to get a specific color. So, for the sake of this example, I want to do two things:

1.) Have a gradient of green instead of red
2.) Transition the colors from blue (smaller values) to red (larger values) like a heat map

Can anyone help explain how I modify the chunk of code in the output section to acquire the desired result?

Any help would be appreciated! Thank you!

[woodward]

In R we use <- for assignment and = to set function arguments.
I think you want data$testrun instead of df. This works now:

library(DT)

testrun <- round(runif(100), 6) # some data

data <- data.frame(testrun = testrun) # better to name it

brks <- quantile(data$testrun, probs = seq(.05, .95, .01), na.rm = TRUE) # provide numeric vector

clrs <- round(seq(305, 40, length.out = length(brks) + 1), 0) %>%
  {paste0("rgb(305,", ., ",", ., ")")}

DT::datatable(data,rownames=TRUE,options = list(lengthChange = FALSE, dom='t')) %>%
  formatStyle(colnames(data), backgroundColor = styleInterval(brks, clrs))

[I_like_R]

Thanks for the suggestion. I updated the code above.

[woodward]

Please check the rest of my code, which works.

[I_like_R]

Great! This is an excellent example. How would I change your code to get the green gradient instead of red? Also how could I transition from blue to red?

[woodward]

You just need to change the rgb() string. Maybe check the documentation ?rgb

[I_like_R]

The documentation isn't very helpful to me. I understand if you leave the second and third arguments missing (blue and green), then you just have red.

I'm confused how the arguments in the seq function relate to the arguments in the rgb function. I figured I would be able to choose HEX colors such as the ones in this link: https://www.colorhexa.com/color-names.

Yet, if I change the last argument in the rgb function, I get an error that reads, " Error in styleInterval(brks, clrs) : length(cuts) must be equal to length(values) - 1." I don't understand what this means or how to fix it. Also, when I try to match a green HEX scheme (ie: 0, 128, 0) I get a gradient of dark green to dark blue.

This is where I'm getting stuck. I just want to be able to:

1.) Change the gradient of (white to red) to (white to green) or whatever color I would want.
2.) Be able to specify a gradient to move from blue to red like with the ColorRamp function.

Any help/guidance would be appreciated! Thank you!

[nirgrahamuk]

i modifed the example to use colorRamp

library(DT)

testrun <- round(runif(100), 6) # some data

data <- data.frame(testrun = testrun) # better to name it

brks <- quantile(data$testrun, probs = seq(.05, .95, .01), na.rm = TRUE) # provide numeric vector

clrs_df <- colorRamp(c("red","green"))(c(0,brks))  %>% 
  as_tibble(.name_repair ="minimal") %>% 
  setNames(nm=c("r","g","b")) %>% 
  mutate_all(~as.character(round(.,digits=0)))  %>% mutate(mycolor=paste0("rgb(",
                                                                                       paste(r,g,b,sep = ","),
                                                                                       ")"))
clrs <- pull(clrs_df,mycolor)

DT::datatable(data,rownames=TRUE,options = list(lengthChange = FALSE, dom='t')) %>%
  formatStyle(colnames(data), backgroundColor = styleInterval(brks, clrs))

[I_like_R]

This is excellent! Thank you!

I tried modifying this for a larger dataset (mtcars) and ran into some trouble. The code will run fine if I replace data with mtcars, but the colors will not populate the table.

What am I missing? Also, can you explain what is going on in that clrs_df chunk.

[nirgrahamuk]

clrs_df is about taking the colorRamp which is a matrix, changing it to a dataframe, and pasting the rgb elements together to make rgb params

library(tidyverse)
library(DT)
mtcars$mpg


(brks <- quantile(mtcars$mpg, probs = seq(.05, .95, .01), na.rm = TRUE)) # provide numeric vector
(max_val <-max(mtcars$mpg,na.rm=TRUE))

(clrs_rmp <- colorRamp(c("red","green"))(c(0,brks/max_val)))

 (clrs_df <- clrs_rmp %>% 
  as_tibble(.name_repair ="minimal") %>% 
  setNames(nm=c("r","g","b")) %>% 
  mutate_all(~as.character(round(.,digits=0)))  %>% mutate(mycolor=paste0("rgb(",
                                                                          paste(r,g,b,sep = ","),
                                                                          ")")))
(clrs <- pull(clrs_df,mycolor))

DT::datatable(mtcars,rownames=TRUE) %>%
  formatStyle(colnames(mtcars), backgroundColor = styleInterval(brks, clrs))

[I_like_R]

You are my hero! This is awesome once again!

I have one more question: How would I modify this to have gradients of color based on the max values within columns, so its not just a color gradient applied to the whole table based on one max value - it should be a separate gradients for each column.

[nirgrahamuk]

one way that would definitely work would be multiple formatStyle statements, one for each specific column, and you prepare brks and clrs for each of those to get their own styleInterval

[I_like_R]

Can you explain the syntax in the clrs_df line? I've never seen syntax like:
colorRamp(c("red","green"))(c(0,brks/max_val)))

I

[nirgrahamuk]

@I_like_R

colorRamp(c("red","green"))

colorRamp(c("red","green")) returns a function (check the documentation for colorRamp , ?colorRamp in console
the () after it are passing arguments into that function

[I_like_R]

Gotcha! Thanks, that was helpful!