如何在 R Shiny 中使用 selectizeGroupUI 和 DT::datatable

Question

根据selectizeGroup-module官方文档中的例子，我可以这样做：

library(shiny)
library(shinyWidgets)
library(dplyr)
data("mpg", package = "ggplot2")

ui <- fluidPage(
    fluidRow(
        column(
            width = 10, offset = 1,
            tags$h3("Filter data with selectize group"),
            panel(
                selectizeGroupUI(
                    id = "my-filters",
                    params = list(
                        manufacturer = list(inputId = "manufacturer", title = "Manufacturer:"),
                        model = list(inputId = "model", title = "Model:"),
                        trans = list(inputId = "trans", title = "Trans:"),
                        class = list(inputId = "class", title = "Class:")
                    )
                ),
                status = "primary"
            ),
            DT::dataTableOutput(outputId = "table")
        )
    )
)

server <- function(input, output, session) {
    
    mpgView2 <- reactive({
        mpg
    })
    
    res_mod <- callModule(
        module = selectizeGroupServer,
        id = "my-filters",
        data = mpgView2,
        vars = c("manufacturer", "model", "trans", "class")
    )
    
    output$table <- DT::renderDataTable({
        req(res_mod())
        res_mod()
    })
}

shinyApp(ui, server)

过滤器工作完美。我的要求还告诉我这个表需要是可编辑的、隐藏一些列、格式化圆形等。我通常会做这样的事情：

mpgView1 <- reactive({
        DT::datatable(
            mpg,
            filter = "none",
            selection = "none",
            style = "bootstrap",
            extensions = c("Scroller", "FixedColumns"),
            options = list(
                dom = 't',
                scrollY = 500,
                scrollX = 400,
                scroller = TRUE,
                defRender = TRUE,
                autoWidth = TRUE,
                targets = "no-sort",
                bSort = FALSE,
                order = c(),
                fixedColumns = list(leftColumns = 2),
                columnDefs = list(
                    list(
                        visible = FALSE,
                        targets = c(0)
                    ),
                    list(
                        width = "50px",
                        targets = "_all"
                    )
                )
            ),
            editable = list(
                target = 'cell',
                disable = list(columns = c(0,1,2))
            )
        ) %>% 
            DT::formatRound(
                columns = c(3)
            )
        
    })

    output$table <- DT::renderDataTable({ 
     mpgView1()
    })

但现在我不确定如何“结合”这两种功能。如果我尝试将 mpgView1() 放入 res_mod，我会收到错误：

Warning: Error in as.data.frame.default: cannot coerce class ‘c("datatables", "htmlwidget")’ to a data.frame

感谢您的帮助。谢谢。

Answer 1

selectizeGroupServer 的输出是您过滤后的数据作为响应式数据，因此您可以在根据您的需要设置样式的 datatable 调用中使用此输出。数据表可编辑的要求带来了一些问题：selectizeGroupServer 需要知道新数据。这是可能的，但是在我的解决方案中，表格完全刷新并且现有的过滤器丢失了。我认为您可以尝试使用proxy 获得更好的行为，但是proxy 和selectizeGroupServer 的组合有点棘手。

library(shiny)
library(shinyWidgets)
library(dplyr)
#> 
#> Attache Paket: 'dplyr'
#> The following objects are masked from 'package:stats':
#> 
#>     filter, lag
#> The following objects are masked from 'package:base':
#> 
#>     intersect, setdiff, setequal, union
data("mpg", package = "ggplot2")

ui <- fluidPage(
  fluidRow(
    column(
      width = 10, offset = 1,
      tags$h3("Filter data with selectize group"),
      panel(
        selectizeGroupUI(
          id = "my-filters",
          params = list(
            manufacturer = list(inputId = "manufacturer", title = "Manufacturer:"),
            model = list(inputId = "model", title = "Model:"),
            trans = list(inputId = "trans", title = "Trans:"),
            class = list(inputId = "class", title = "Class:")
          )
        ),
        status = "primary"
      ),
      DT::dataTableOutput(outputId = "table")
    )
  )
)

server <- function(input, output, session) {
  
  mpgView2 <- reactiveVal(mpg)
  
  observeEvent(input$table_cell_edit, {
    cell <- input$table_cell_edit
    updated_data <- mpgView2()
    updated_data[cell$row, cell$col] <- cell$value
    mpgView2(updated_data)
  })
  
  res_mod <- callModule(
    module = selectizeGroupServer,
    id = "my-filters",
    data = mpgView2,
    vars = c("manufacturer", "model", "trans", "class")
  )
  
  output$table <- DT::renderDataTable({
    req(res_mod())
    DT::datatable(
      res_mod(),
      filter = "none",
      selection = "none",
      style = "bootstrap",
      extensions = c("Scroller", "FixedColumns"),
      options = list(
        dom = 't',
        scrollY = 500,
        scrollX = 400,
        scroller = TRUE,
        defRender = TRUE,
        autoWidth = TRUE,
        targets = "no-sort",
        bSort = FALSE,
        order = c(),
        fixedColumns = list(leftColumns = 2),
        columnDefs = list(
          list(
            visible = FALSE,
            targets = c(0)
          ),
          list(
            width = "50px",
            targets = "_all"
          )
        )
      ),
      editable = list(
        target = 'cell',
        disable = list(columns = c(0,1,2))
      )
    ) %>% 
      DT::formatRound(
        columns = c(3)
      )
  })
}

shinyApp(ui, server)

^{由reprex package (v0.3.0) 于 2020 年 8 月 26 日创建}