在 Shiny 数据表 R 中使用过滤器而不是子集

Question

我有一个闪亮的仪表板，我有一个数据表，我想传递并从输入字段中过滤。我试图重现下面的代码。您可以看到，在 UI 中，第一行有一个 numericInput，它产生一个我想传递给下面 2 个数据表的数字。在第一种情况下，我尝试在最后应用 dplyr 过滤器但没有成功。第二个数据表适用于子集，但是我觉得这感觉效率低下，并且我不能（据我所知）将表功能应用到子集表（例如，我不能将 formatCurrency 之类的东西应用到子集表）。我只是想将第一个表中的表格格式应用于第二个表，所以如果这对子集可行，我很好。似乎应用过滤器可能更容易。提前谢谢你...

library(shiny)
library(tidyverse)
library(shinydashboard)
library(DT)
library(plotly)

shinyUI(
  dashboardPage(
    dashboardHeader(title = "Sales Performance Dashboard", titleWidth = 250,
                    dropdownMenu(type = "message",
                                 messageItem(from = "Finance Update", message = "Updated 6/30/2020")
                    )
    ),
    tabItem(tabName = "main",
            fluidRow(
              box(title = "Customer Search", status = "primary", solidHeader = T, width = 4,  numericInput("num", "Enter Customer ID", value = 1001002, min = 10000, max = 150000))
            ),
            fluidRow(
              box(title = "Sales Averages", status = "primary", solidHeader = T, width = 12, DT::dataTableOutput("Master"))
            ),
            fluidRow(
              box(title = "Min/Max/Med", status = "primary", solidHeader = T, width = 12, DT::dataTableOutput("Master1"))


shinyServer(function(input,output){
  
output$Master <-DT::renderDataTable(
    DT::datatable(Master, selection = 'single', filter = 'top', rownames = F,
                  options = list(pageLength = 10, autoWidth = TRUE, columnDefs = list(list(className = 'dt-center', targets = 2:14),list(width = '115px', targets = c(1:3))))) %>% formatCurrency(c(6:8,13:15), '')) **%>% filter(`Customer ID` == input$num)**
  
output$Master1 <- renderDataTable(
Master1 <- subset(Master, Master$CustomerID == input$num, selection = 'single', rownames = F))

})


shinyApp(shinyUI, shinyServer)
  

Answer 1

您确实应该发布一个小数据框来轻松调试您的代码。我使用了来自gapminder 包的gapminder 数据。您缺少一些语法，在使用 input$num 时需要使用 !!。下面的代码适用于gapminder 数据。您应该能够在您的数据上使用它并根据需要进行适当的修改。

library(gapminder)
data(gapminder, package = "gapminder")
Master <- gapminder %>% mutate(CustomerID=year)
ui <- dashboardPage(
    dashboardHeader(title = "Sales Performance Dashboard", titleWidth = 250,
                    dropdownMenu(type = "message",
                                 messageItem(from = "Finance Update", message = "Updated 6/30/2020")
                    )
    ),
    dashboardSidebar(width = 250,
                     sidebarMenu(
                       # Setting id makes input$tabs give the tabName of currently-selected tab
                       id = "tabs", 
                       menuItem("Home", tabName = "home", icon = icon("home")),
                       menuItem("Customer Search", icon = icon("bar-chart-o"),
                                numericInput("num", "Enter Customer ID", value = 1952, min = 1952, max = 2007))
                                
                       )
    ),
    dashboardBody(
    tabItem(tabName = "main",
            # fluidRow(
            #   box(title = "Customer Search", status = "primary", solidHeader = T, width = 4,  numericInput("num", "Enter Customer ID", value = 1952, min = 1952, max = 2007))
            # ),
            fluidRow(
              box(title = "Sales Averages", status = "primary", solidHeader = T, width = 12, DT::dataTableOutput("Master"))
            ),
            fluidRow(
              box(title = "Min/Max/Med", status = "primary", solidHeader = T, width = 12, DT::dataTableOutput("Master1"))
            ))
    ))

server <- function(input,output,session){
  
  output$Master <-DT::renderDataTable(
    DT::datatable(Master, selection = 'single', filter = 'top', rownames = F,
                  options = list(pageLength = 5, autoWidth = TRUE #, 
                                 #columnDefs = list(list(className = 'dt-center', targets = 2:14),list(width = '115px', targets = c(1:3)))
                                 )) # %>% 
      # formatCurrency(c(6:8,13:15), '')
    )  ## %>% filter(`Customer ID` == input$num) 
  
  output$Master1 <- renderDataTable(
    Master1 <- Master %>%  subset(CustomerID == input$num))
  
}        
              
shinyApp(ui, server)

它给出以下输出：