Блестящие ячейки подсветки DT, если значение появляется в другом наборе - PullRequest
Новая
       13

Блестящие ячейки подсветки DT, если значение появляется в другом наборе

0 голосов
/ 29 мая 2018

Проблема:

У меня есть фрейм данных, где строка A - это имена людей в моей организации.У меня есть отдельный фрейм данных, который является подмножеством строки A в исходной таблице.Я хотел бы выделить все строки в первой таблице данных, которые соответствуют именам во второй таблице.По сути, у меня есть два комплекта.Набор A и Набор B. Оба являются именами, я хотел бы выделить таблицу данных для всех имен в наборе A, которые соответствуют набору B. Однако я продолжаю получать сообщение об ошибке: length(levels) must be equal to length(values)

Как мне избежатьполучать эту ошибку?

Воспроизводимый пример:

У меня есть фрейм данных mtcars.Я фильтрую набор данных mtcars на основе ввода ползунка для MPG.Я хотел бы выделить фрейм данных mtcars, который соответствует критериям фильтрации.По сути, это будет означать выделение выходной таблицы для всех наблюдений, где значение mpg <= входное значение ползунка mpg.</p> 

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)

Любая помощь очень ценится.Заранее спасибо.

1 Ответ

0 голосов
/ 30 мая 2018

Вы можете сделать это через 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)
...