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

Question

问题：

我有一个数据框，其中行A是我组织中人员的名字。我有一个单独的数据框，它是原始表中行A的子集。我想突出显示第一个数据表中与第二个表中的名称匹配的所有行。基本上，我有两套。设置A和设置B.两者都是名称，我想突出显示Set A中与Set B匹配的所有名称的数据表。但是，我一直收到错误：length(levels) must be equal to length(values)

我如何避免收到此错误？

可重复的例子：

我有一个mtcars数据框。我正在根据mpg的滑块输入过滤mtcars数据集。我想强调符合过滤标准的mtcars数据框。实际上，这将意味着突出显示所有观察的输出表，其中mpg是＆lt; =滑块输入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)

非常感谢任何帮助。提前致谢。

Answer 1

你可以通过rowCallback这样做：

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)