如何在 R shiny 中以颜色突出显示特定单元格值

Question

DF1、DF2 和 DF3 是我拥有的三个数据框（在选项中）。 从第二个数据集中选择 DF3 时，我想在该特定单元格的背景中以绿色突出显示第 7 行的“Salary”列中的值“600.00”。 在 R 中最有效的方法是什么？ 由于我是 Shiny 的新手，有人可以帮我吗？

以下是我的代码：

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

您可以使用kableExtra ，它允许使用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)

Answer 2

如果您不介意使用DT ，您可以在第二个显示中为该单元格的背景着色。

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

此方法会将绿色应用于任何600 的薪水。您可以将条件调整为实际需要的任何值（例如，只是 Christian 的薪水，或者只是最后一行，或类似的东西）。 如果您愿意，可以选择删除搜索框和其他交互部分。