How to highlight a particular cell value In color in R shiny

Question

DF1, DF2, and DF3 are the three data frames I have (in options). While picking DF3 from the second dataset, I'd want to highlight the value "600.00" from the column "Salary" of the 7th Row in Green color in the background in that particular cell. What's the most efficient method to do it in R? Since I'm new to Shiny, could someone please help me?

Below is my Code:

library(shiny)

DF1 <- data.frame(
  emp_id = c(1:5),
  emp_name = c("Rick","Dan","Michelle","Ryan","Gary"),
  salary = c(623.3,515.2,611.0,735.0,844.25))
DF1


DF2 <- data.frame(
  emp_id = c(1:6),
  emp_name = c("Rick","Dan","Michelle","Ryan","Gary", "Alex"),
  salary = c(623.3,515.2,611.0,729.0,843.25, 243.5))


DF3 <- data.frame(
  emp_id = c(1:7),
  emp_name = c("Rick","Dan","Michelle","Ryan","Gary", "Alex", "Christan"),
  salary = c(623.3,515.2,611.0,729.0,843.25, 243.5, 600.0))

shinyApp(
  ui = tagList(
    navbarPage(
      fluidRow(column(6, selectInput("dataset1", "Choose first dataset:",
                                     choices = c("SelectDataSet ", "DF1", "DF2", "DF3"))),
               
               column(6, selectInput("dataset2", "Choose second dataset:",
                                     choices = c("SelectDataSet ", "DF1", "DF2", "DF3")))
      ),
      # Button
      downloadButton("downloadData5", "Download")
    ),
    mainPanel(
      fluidRow(column(6,  tableOutput("table1")), 
               column(6,  tableOutput("table2"))
      )
    )
  ),
  
server = function(input, output,session) {
  datasetInput1 <- reactive({
      switch(input$dataset1,
             "DF1" = DF1,
             "DF2" = DF2,
             "DF3" = DF3)
    })
  datasetInput2 <- reactive({
      switch(input$dataset2,
             "DF1" = DF1,
             "DF2" = DF2,
             "DF3" = DF3)
    })
    
    output$table1 <- renderTable({
      datasetInput1()
    })
    
    output$table2 <- renderTable({
      datasetInput2()
    })
    
  }
)
shinyApp(ui, server)

Answer 1

If you don't mind using DT, you can color the background of that cell in the second display.

library(DT)

shinyApp(
    ui = tagList(
        navbarPage(
            fluidRow(column(6, selectInput("dataset1", "Choose first dataset:",
                                           choices = c("SelectDataSet ", "DF1", "DF2", "DF3"))),
                     
                     column(6, selectInput("dataset2", "Choose second dataset:",
                                           choices = c("SelectDataSet ", "DF1", "DF2", "DF3")))
            ),
            # Button
            downloadButton("downloadData5", "Download")
        ),
        mainPanel(
            fluidRow(column(6,  dataTableOutput("table1")), 
                     column(6,  dataTableOutput("table2"))
            )
        )
    ),
    
    server = function(input, output,session) {
        
        DF1 <- data.frame(
            emp_id = c(1:5),
            emp_name = c("Rick","Dan","Michelle","Ryan","Gary"),
            salary = c(623.3,515.2,611.0,735.0,844.25))
        
        
        DF2 <- data.frame(
            emp_id = c(1:6),
            emp_name = c("Rick","Dan","Michelle","Ryan","Gary", "Alex"),
            salary = c(623.3,515.2,611.0,729.0,843.25, 243.5))
        
        
        DF3 <- data.frame(
            emp_id = c(1:7),
            emp_name = c("Rick","Dan","Michelle","Ryan","Gary", "Alex", "Christan"),
            salary = c(623.3,515.2,611.0,729.0,843.25, 243.5, 600.0))
        
        datasetInput1 <- reactive({
            switch(input$dataset1,
                   "DF1" = DF1,
                   "DF2" = DF2,
                   "DF3" = DF3)
        })
        datasetInput2 <- reactive({
            switch(input$dataset2,
                   "DF1" = DF1,
                   "DF2" = DF2,
                   "DF3" = DF3)
        })
        
        output$table1 <- renderDataTable({
            datasetInput1()
        })
        
        output$table2 <- renderDataTable({
            if(input$dataset2 != "SelectDataSet ") {
                # Get the dataset
                d = datasetInput2()
                # Add a column specifying the background color: light green if
                # salary = 600; nothing otherwise
                d$background.color = ifelse(d$salary == 600, "lightgreen", NA)
                # Output the DataTable; hide the new 4th column we just created
                # but use it to specify the background color of the "salary"
                # column
                d %>%
                    datatable(options = list(columnDefs = list(list(targets = 4,
                                                                    visible = F)))) %>%
                    formatStyle("salary",
                                backgroundColor = styleEqual(d$salary,
                                                             d$background.color))
            }
        })
        
    }
)

This method will apply the green color to any salary of 600. You can adjust the condition to whatever it actually needs to be (e.g., just Christian's salary, or just the last row, or something like that). There are options to remove the search box and other interactive pieces if you prefer.

Answer 2

You could use kableExtra which allows to define each cell individually with cell_spec:

library(shiny)
library(kableExtra)

DF1 <- data.frame(
  emp_id = c(1:5),
  emp_name = c("Rick","Dan","Michelle","Ryan","Gary"),
  salary = c(623.3,515.2,611.0,735.0,844.25))
DF1


DF2 <- data.frame(
  emp_id = c(1:6),
  emp_name = c("Rick","Dan","Michelle","Ryan","Gary", "Alex"),
  salary = c(623.3,515.2,611.0,729.0,843.25, 243.5))


DF3 <- data.frame(
  emp_id = c(1:7),
  emp_name = c("Rick","Dan","Michelle","Ryan","Gary", "Alex", "Christan"),
  salary = c(623.3,515.2,611.0,729.0,843.25, 243.5, 600.0))

# Define specific cell spec
DF3$salary <- cell_spec(DF3$salary, background = c(rep("white",6), "green"))

shinyApp(
  ui = tagList(
    navbarPage(
      fluidRow(column(6, selectInput("dataset1", "Choose first dataset:",
                                     choices = c("SelectDataSet ", "DF1", "DF2", "DF3"))),
               
               column(6, selectInput("dataset2", "Choose second dataset:",
                                     choices = c("SelectDataSet ", "DF1", "DF2", "DF3")))
      ),
      # Button
      downloadButton("downloadData5", "Download")
    ),
    mainPanel(
      fluidRow(column(6,  tableOutput("table1")), 
               column(6,  tableOutput("table2"))
      )
    )
  ),
  
  server = function(input, output,session) {
    datasetInput1 <- reactive({
      switch(input$dataset1,
             "DF1" = DF1,
             "DF2" = DF2,
             "DF3" = DF3)
    })
    datasetInput2 <- reactive({
      switch(input$dataset2,
             "DF1" = DF1,
             "DF2" = DF2,
             "DF3" = DF3)
    })
    output$table1 <- function() {
      req(datasetInput1() )
      datasetInput1() %>%
        knitr::kable("html",escape = F) %>% kable_styling()
    }
    
    output$table2 <- function() {
      req(datasetInput2() )
      datasetInput2() %>%
        knitr::kable("html",escape = F) %>% kable_styling()
    }
    
  }
)
shinyApp(ui, server)