如果值出现在另一组中，则闪亮的DT高亮显示单元格

Question

Issue:

I have a data frame where row A is the names of people in my organization. I have a separate data frame that is a subset of row A in the original table. I would like to highlight all rows in the first data table that match names in the second table. Essentially, I have two sets. Set A and Set B. Both are names, I would like to highlight the data table for all names in Set A that match Set B. However, I keep getting an error: length(levels) must be equal to length(values)

How would I avoid receiving this error?

Reproducible Example:

I have a data frame of mtcars. I am filtering the mtcars dataset based on a slider input for mpg. I would like to highlight the data frame of mtcars that meet the filtering criteria. In effect, this would mean highlighting the output table for all observations where the mpg are <= the slider input mpg.

library(shiny)

# Define UI for application that draws a histogram
ui <- fluidPage(

   # Application title
   titlePanel("Highlight Cell Test (Sets)"),

   sidebarLayout(
     sidebarPanel = 'side',
     sliderInput('slider', 'slider input', 1, 30, 20)),

      # Show a plot of the generated distribution
      mainPanel(
         dataTableOutput("test")
      )
   )

# Define server logic required to draw a histogram
server <- function(input, output) {


  subset <- reactive({
    mtcars %>%
      filter(mpg <= input$slider)
  })

  output$test <- DT::renderDataTable(
    mtcars %>%
      DT::datatable(
        options = list(
          dom = 'ftipr',
          searching = TRUE
        ) %>%
          formatStyle(
            'test',
            background = styleEqual(
              (subset()$mpg %in% mtcars$mpg), 'lightgreen'))
      )
  )

}

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

Any help is much appreciated. Thanks in advance.

Answer 1

You can do this via rowCallback like so:

library(shiny)
library(dplyr)
library(DT)
fnc <- JS('function(row, data, index, rowId) {','console.log(rowId)','if(rowId >= ONE && rowId < TWO) {','row.style.backgroundColor = "lightgreen";','}','}')

ui <- fluidPage(

  # Application title
  titlePanel("Highlight Cell Test (Sets)"),

  sidebarLayout(
    sidebarPanel = 'side',
    sliderInput('slider', 'slider input', 1, 30, 16)),

  # Show a plot of the generated distribution
  mainPanel(
    dataTableOutput("test")
  )
)

# Define server logic required to draw a histogram
server <- function(input, output, session) {

  subset <- reactive({
    mtcars %>% filter(mpg <= input$slider)
  })

  Coloring <- eventReactive(subset(),{
    a <- which(subset()$mpg %in% mtcars$mpg)
    print(a)
    if(length(a) <= 0){
      return()
    }
    fnc <- sub("ONE",a[1],fnc)
    fnc <- sub("TWO",max(a),fnc)
    fnc
  })


  output$test <- DT::renderDataTable(
    mtcars %>%
      DT::datatable(options = list(dom = 'ftipr',searching = TRUE,pageLength = 20, scrollY = "400px",rowCallback = Coloring()))
  )
}

shinyApp(ui = ui, server = server)