Shiny DT Highlight Cells if Value Appears in Another Set - r

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)