Search code examples
rkablekableextra

How to color the cell that contains the maximum value in a line with kableExtra?


I would like to color only the cell that contains the highest value in the first row of my table (kableExtra).

For example, if the highest value is 98.32 the background color should be red.

My data:

library(shiny)
library(shinydashboard)
library(tidyverse)

header <- dashboardHeader(title = "kable")

sidebar <- dashboardSidebar()

body <- dashboardBody(htmlOutput(outputId = "simul"))

ui <- dashboardPage(header, sidebar, body)

server <- function(input, output, session) {
  
  output$simul <- renderText({
    
    df_1 <- data.frame(x = replicate(n = 5, expr = runif(n = 10, min = 20, max = 100)))
    
    df_1 %>%
      kableExtra::kable(x = .,row.names = F, format = "html",
                        col.names = lapply(X = 1:length(.), FUN = function(x) {
                          names <- paste("Var", x, sep = " ")
                          })) %>%
      kableExtra::kable_styling(font_size = 16, bootstrap_options = "striped") %>%
      kableExtra::kable_styling() %>%
      kableExtra::row_spec(kable_input = ., row = 0, background = "#008cba", color = "#f2f2f2") %>% 
      kableExtra::row_spec(kable_input = ., row = 1, 
                           background = ifelse(test = (max(as.numeric(.)) == which.max(as.numeric(.))), 
                                               yes = "red", no = "white"), 
                           color = "#020202")
    
  })
  
}

shinyApp(ui, server)

The problem is in this part of the code.

  kableExtra::row_spec(kable_input = ., row = 1, 
                       background = ifelse(test = (max(as.numeric(.)) == which.max(as.numeric(.))), 
                                           yes = "red", no = "white"), 
                       color = "#020202")

So again, if the highest value is 98.32 in line 1 the background color should be red (and just this cell).


Solution

  • You could use cell_spec.
    escape parameter from kable must be set to FALSE in order to interpret correctly the associated html:

    library(shiny)
    library(shinydashboard)
    library(tidyverse)
    library(kableExtra)
    set.seed(123)
    header <- dashboardHeader(title = "kable")
    
    sidebar <- dashboardSidebar()
    
    body <- dashboardBody(htmlOutput(outputId = "simul"))
    
    ui <- dashboardPage(header, sidebar, body)
    
    server <- function(input, output, session) {
      
      output$simul <- renderText({
        
        df_1 <- data.frame(x = replicate(n = 5, expr = runif(n = 10, min = 20, max = 100)))
        
        cmax <- which.max(df_1[1,])
        
        df_1[1, cmax] <- kableExtra::cell_spec(df_1[1, cmax],format =  "html", background = "red",color = "#020202")
        
        # Needed : escape = FALSE
        df_1 %>% kable( row.names = F,format = "html", escape = FALSE,
                        col.names = lapply(X = 1:length(.), FUN = function(x) {
                          names <- paste("Var", x, sep = " ")})) %>%
          kableExtra::kable_styling(font_size = 16, bootstrap_options = "striped")  %>%
          kableExtra::row_spec(kable_input = ., row = 0, background = "#008cba", color = "#f2f2f2")
          
      })
      
    }
    
    shinyApp(ui, server)
    

    enter image description here