R Shiny DT：如何隐藏列或格式化表格？

Question

我正在尝试格式化我的数据表输出。我想对表格格式（例如，隐藏行名）和隐藏列（例如，隐藏齿轮和碳水化合物，我用来过滤数据表）进行一些更改。我已经阅读了this response before，但似乎无法让它工作。有人对我有什么建议吗？

我在下面准备了可重现的代码。简而言之，我使用的是 mtcars 数据集（我的实际数据集更长）。用户可以设置过滤器，表格输出会相应更新。是这部分代码（在服务器下）不起作用：

class = "display nowrap compact"
    #filter = "top" # location of column filters
    filter = list(position = "top")
    rownames = TRUE
    options = list(dom = 't',
                   scrollX = TRUE # allow user to scroll wide tables horizontally
    )

完整代码在这里：

library(tidyverse)
library(shiny)
library(dplyr)
library(ggplot2)
library(tidyr)
library(shinycssloaders)
library(shinythemes)
library(ggforce)
library(DT)
library(shinyWidgets)
library(shinyjs)

mtcars

ui <- fluidPage(
             sidebarLayout(
               sidebarPanel(
                 useShinyjs(),
                 div(
                   id = "form",
                   fluidRow(
                     #Button to select gear
                     column(6,
                            pickerInput(
                              inputId = "gear_button", label = "Gear:", choices = c("All", unique(as.character(mtcars$gear))), options = list(`actions-box` = TRUE), multiple = FALSE
                            ),
                     ),
                     #Button to select carb ranges
                     column(6,
                            pickerInput(inputId = "carb_button", label = "Carb:", choices = c("All", unique(as.character(mtcars$carb))), options = list(`actions-box` = TRUE), multiple = FALSE
                            ),
                     ),
                   )),
                 actionButton("resetAll", "Reset Filters")
               ),
               
               mainPanel(
                 DT::dataTableOutput("table")
               )
               
             ),
)


server <- function(input, output, session) {
  #Explore tab - table
  data <- mtcars
  output$table <- DT::renderDataTable(DT::datatable({
    data
    class = "display nowrap compact"
    #filter = "top" # location of column filters
    filter = list(position = "top")
    rownames = TRUE
    options = list(dom = 't',
                   scrollX = TRUE # allow user to scroll wide tables horizontally
    )
    
    if (input$gear_button != "All") {
      data <- data[data$gear == input$gear_button,]
    }
    if (input$carb_button != "All") {
      data <- data[data$carb == input$carb_button,]
    }
    data
  }))
  
  observeEvent(input$resetAll, {
    reset("form")
  })
  
}

shinyApp(ui, server)

Answer 1

我们可以使用

options= list(columnDefs = list(list(visible = FALSE, targets = target)))

控制哪些列可见，并且

target <- which(names(mtcars) %in% c("gear", "carb")) - 1

获取列的位置。 - 1 是因为 js 使用 0 索引而不是像 R 那样使用 1。

应用：

library(tidyverse)
library(shiny)
library(dplyr)
library(ggplot2)
library(tidyr)
library(shinycssloaders)
library(shinythemes)
library(ggforce)
library(DT)
library(shinyWidgets)
library(shinyjs)

mtcars

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      useShinyjs(),
      div(
        id = "form",
        fluidRow(
          # Button to select gear
          column(
            6,
            pickerInput(
              inputId = "gear_button", label = "Gear:", choices = c("All", unique(as.character(mtcars$gear))), options = list(`actions-box` = TRUE), multiple = FALSE
            ),
          ),
          # Button to select carb ranges
          column(
            6,
            pickerInput(inputId = "carb_button", label = "Carb:", choices = c("All", unique(as.character(mtcars$carb))), options = list(`actions-box` = TRUE), multiple = FALSE),
          ),
        )
      ),
      actionButton("resetAll", "Reset Filters")
    ),
    mainPanel(
      DT::dataTableOutput("table")
    )
  ),
)


server <- function(input, output, session) {
  # Explore tab - table
  data <- mtcars

  table <- reactive({
    if (input$gear_button != "All") {
      data <- data[data$gear == input$gear_button, ]
    }
    if (input$carb_button != "All") {
      data <- data[data$carb == input$carb_button, ]
    }
    data
  })

  output$table <- DT::renderDataTable({
    target <- which(names(table()) %in% c("gear", "carb")) - 1

    datatable(table(),
      class = "display nowrap compact",
      filter = list(position = "top"),
      rownames = FALSE,
      options = list(
        dom = "t",
        columnDefs = list(list(visible = FALSE, targets = target)),
        scrollX = TRUE
      )
    )
  })

  observeEvent(input$resetAll, {
    reset("form")
  })
}

shinyApp(ui, server)