Question

我正在使用动态过滤器在闪亮的仪表板上创建动态表。我需要更改以在表中进行进一步的数据转换。在这里，我仅向您显示表视图。但是后来希望基于动态过滤器进行进一步的数据转换。我在下面共享一个示例代码，其中我仅演示了如何查看一个额外的变量。

mtcars <- as.data.frame(mtcars )


mtcars$gear <- as.character(mtcars$gear)
mtcars$cyl <- as.character(mtcars$cyl)
mtcars$carbs <- as.character(mtcars$carb)

gear_all <- unique(mtcars$gear)
cyl_all <- unique(mtcars$cyl)
carb_all <- unique(mtcars$carb)


ui <- dashboardPage(skin = "red",
                dashboardHeader(title = "Car_df"),
                dashboardSidebar(sidebarMenu(menuItem("Views", tabName = "tab_01", icon =icon("bar-chart")))),
                dashboardBody(tabItems(
                  tabItem(tabName = "tab_01",
                          fluidRow(column(2, selectInput("gear_id",
                                                         "Gear:",
                                                         c("Gear_All", unique((mtcars$gear))))),
                                   column(2, selectInput("cyl_id",
                                                         "Cylinder:",
                                                         c("Cyl_all",unique(mtcars$cyl)))),
                                   column(2, selectInput("carb_id",
                                                         "Carburetor:",
                                                         c("carb_all",unique(mtcars$carb)))))
                          ))))

server <- function(input, output){
output$table_01 <- renderDT(DT::datatable({
data = mtcars %>% 
  filter(gear %in% input$gear_id & cyl %in% input$cyl_all & carb %in% 
input$carb_id  ) %>% 
  select(gear, cyl, carb, vs) }))}



shinyApp(ui,server)

我无法在仪表板中显示表格

谢谢。

Answer 1

您的代码中有两个错误。（1）ui中没有针对dataTableOutput（即table_01）的声明（2）在过滤条件下应为input$cyl_id（而不是input$cyl_all）。以下是有效的解决方案。

library(shiny)
library(shinydashboard)
library(DT)
library(dplyr)
mtcars <- as.data.frame(mtcars )
mtcars$gear <- as.character(mtcars$gear)
mtcars$cyl <- as.character(mtcars$cyl)
mtcars$carbs <- as.character(mtcars$carb)

gear_all <- unique(mtcars$gear)
cyl_all <- unique(mtcars$cyl)
carb_all <- unique(mtcars$carb)

ui <- dashboardPage(skin = "red",
                    dashboardHeader(title = "Car_df"),
                    dashboardSidebar(sidebarMenu(menuItem("Views", tabName = "tab_01", icon = icon("bar-chart")))),
                    dashboardBody(tabItems(
                      tabItem(tabName = "tab_01",
                              fluidRow(column(2, selectInput("gear_id",
                                                             "Gear:",
                                                             c("Gear_All", unique((mtcars$gear))))),
                                       column(2, selectInput("cyl_id",
                                                             "Cylinder:",
                                                             c("Cyl_all", unique(mtcars$cyl)))),
                                       column(2, selectInput("carb_id",
                                                             "Carburetor:",
                                                             c("carb_all", unique(mtcars$carb))))),
                                     fluidRow(box(dataTableOutput("table_01")))
                      ))))

server <- function(input, output, session){
  output$table_01 <- renderDataTable({
    datatable(mtcars %>% filter(gear %in% input$gear_id & cyl %in% input$cyl_id & carb %in% 
                                  input$carb_id) %>% select(gear, cyl, carb, vs))
  })
}

shinyApp(ui,server)

动态向下钻取闪亮的仪表板

1 个答案: