Question

我在R ShinyApp中使用自定义容器。目前，它以Sepal和Petal作为标头，均包含 Length和Width列。那么是否可以从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)

Answer 1

实现@StéphaneLaurent使用反应容器的想法：

关键点是：

拆分列名
相应地创建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)

无法使用DT :: DataTable过滤自定义容器中的多个标头

1 个答案: