Невозможно отфильтровать несколько заголовков в пользовательском контейнере, используя DT :: DataTable - PullRequest
Новая
       35

Невозможно отфильтровать несколько заголовков в пользовательском контейнере, используя DT :: DataTable

0 голосов
/ 17 ноября 2018

Я использую пользовательский контейнер в R ShinyApp.В настоящее время заголовки содержат Sepal и Petal, которые содержат столбцы длины и ширины .Так возможно ли получить выпадающий список из Sepal / Petal для выбора / фильтрации длины или ширины?
, т.е. отфильтровать заголовки внутри заголовков.В настоящее время я использую checkboxGroupInput для этой цели, но он не дает требуемых результатов.Я также приложил свои коды.Может кто-нибудь, пожалуйста, разобраться.Заранее спасибо:) 

**MY Codes:**
library(shiny)
library(DT)

iris<-iris[,c(5,1:4)]

ui =basicPage(
tags$head(
tags$style(type = "text/css",
           HTML("th { text-align: center; }")  )),

selectInput(inputId = "Species", 
          label = "Species:",
          choices = c("All",
                      unique(as.character(iris$Species)))),

checkboxGroupInput(inputId = "columns", label = "Select Variable:",
                 choices =c("Sepal.Length", "Sepal.Width", "Petal.Length", 
 "Petal.Width"),
                 selected = c("Sepal.Length", "Sepal.Width", "Petal.Length", 
 "Petal.Width")),

h2('Iris Table'),
DT::dataTableOutput('mytable') )

server = function(input, output) {
output$mytable = DT::renderDataTable({

 # a custom table container
sketch = htmltools::withTags(table(
  class = 'display',
  thead(
    tr(
      th(rowspan = 2, 'Species'),
      th(colspan = 2, 'Sepal'),
      th(colspan = 2, 'Petal')),
    tr(
      lapply(rep(c('Length', 'Width'), 2), th)
    )) )) 

  DT::datatable( rownames = FALSE, container = sketch,
              extensions = 'Buttons',
                 options = list(dom = 'Bfrtip',
                             buttons = 
                               list('colvis', list(
                                 extend = 'collection',
                                 buttons = list(list(extend='csv',
                                                     filename = 'hitStats'),
                                                list(extend='excel',
                                                     filename = 'hitStats'),
                                                list(extend='pdf',
                                                     filename= 'hitStats'),
                                                list(extend='copy',
                                                     filename = 'hitStats'),
                                                list(extend='print',
                                              filename = 'hitStats')),

                                 text = 'Download' ))),
               {

                data<-iris

                if(input$Species != 'All'){
                  data<-data[data$Species == input$Species,]
                }    

                data<-data[,c("Species",input$columns),drop=FALSE]   

                data   
              }) })    }

shinyApp(ui = ui, server = server)

1 Ответ

0 голосов
/ 27 ноября 2018

Реализация идеи Стефана Лорана об использовании реактивного контейнера:

Ключевые моменты:

  • разделение имен столбцов
  • создать вложенный список cols_parsed соответственно в форме list(Sepal = c("Length", "Width"), Petal = c("Length", "Width"))
  • использовать эту вложенную структуру для генерации таблицы
  • передать реактивный container = sketch() аргумент datatable
library(shiny)
library(DT)

iris <- iris[, c(5, 1:4)]

ui <- basicPage(
  tags$head(
    tags$style(
      type = "text/css",
      HTML("th { text-align: center; }")
    )
  ),

  selectInput(
    inputId = "Species",
    label = "Species:",
    choices = c("All", unique(as.character(iris$Species)))
  ),

  checkboxGroupInput(
    inputId = "columns", label = "Select Variable:",
    choices = c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width"), 
    selected = c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width")
  ),

  h2("Iris Table"),
  DT::dataTableOutput("mytable")
)

server <- function(input, output) {
  # a custom table container
  sketch <- 
    reactive({
      cols_nested <-
        if (!is.null(input$columns)) {
          cols_parsed <- strsplit(input$columns, ".", fixed = TRUE)
          split(sapply(cols_parsed, "[[", 2L), sapply(cols_parsed, "[[", 1L))
        }
      htmltools::withTags(table(
        class = "display",
        thead(
          tr(c(
            list(th(rowspan = if (!is.null(cols_nested)) 2 else 1, "Species")),
            mapply(function(.x, .y) th(colspan = length(.x), .y),
                   cols_nested, names(cols_nested), SIMPLIFY = FALSE)
          )),
          if (!is.null(cols_nested)) tr(lapply(unlist(cols_nested), th))
        )
      ))
    })

  output$mytable <- DT::renderDataTable({
    DT::datatable(
      rownames = FALSE, container = sketch(),
      extensions = "Buttons",
      options = list(
        dom = "Bfrtip",
        buttons = 
          list("colvis", list(
            extend = "collection",
            buttons = list(
              list(extend = "csv", filename = "hitStats"),
              list(extend = "excel", filename = "hitStats"),
              list(extend = "pdf", filename = "hitStats"),
              list(extend = "copy", filename = "hitStats"),
              list(extend = "print", filename = "hitStats")
            ),
            text = "Download"
          ))
      ), data = {
        data <- iris
        if (input$Species != "All") {
          data <- data[data$Species == input$Species, ]
        }
        data[, c("Species", input$columns), drop = FALSE]
      }
    )
  })
}

shinyApp(ui = ui, server = server)
...