r-闪亮的选项卡面板数据表，包括过滤器选项

Question

我创建了一个tabPanel，希望有机会通过不同的变量进行筛选(例如，显示全部、性别(男性或女性(、游戏频率(从不、有时、经常(。在表的右侧给出了筛选的可能性。

tabPanel本身运行良好，但是，我不知道如何添加选择输入过滤器(a(多个变量以及b(使用output$data作为output$mytable。

Gender <- c(2, 2, 2, 1, 2, 2, 1, 1, 1, 2, 2, 1, 2, 1, 1, 1, 2, 1, 2, 1) # 1 male, 2 female
Gaming_freq <- c(2, 3, 3, 3, 6, 4, 5, 5, 3, 5, 6, 5, 3, 3, 3, 2, 5, 6, 6, 3) # 2 = less than once a month, 3= once a month, 4 = once a week, 5 = more than once a week, 6 = daily 
color_white <- c(0.14939, -0.40033, 0.638, -0.40328, -0.5725, 0.77422, 0.47419, -0.14982, 0.61388, 0.29264, 1.63992, 1.69396, -0.76722, 0.2279, 1.8937, 1.05535, -0.02912, -0.98787, -0.08184, 0.02536)
color_black_red <- c(-0.22686, 1.0993, 1.31564, 1.79799, 0.58323, -0.20128, 0.28315, 0.65687, -0.28894, 1.03393, 0.19963, -0.14561, 0.889, 1.5685, 0.15463, 0.74984, 0.42837, 1.31831, 0.82064, 1.13308)
color_black_blue <- c(-0.19905, -0.12332, -0.3628, 0.04108, -0.51553, -0.74827, -0.73246, -1.15794, -1.05443, -0.79687, -0.43895, -0.48986, -0.25574, -1.55343, -0.52319, -0.31203, -0.62926, -1.0094, -0.11217, -0.76892)
Controller_none <- c(-0.83456, -2.1176, -2.09919, -2.30543, -1.8594, -1.83014, -2.67447, -2.25647, -0.33004, 1.04676, -0.0674, -1.22428, -0.61644, -2.49707, 0.1737, -1.38711, -0.86417, -0.9775, -0.86747, -0.13341)
Controller_white <- c(0.51451, 0.49362, 1.17843, -0.03151, 1.27484, 0.74152, 0.07918, 1.18577, 0.50183, -0.1483, 0.22328, 1.1426, 0.46526, 1.94735, -0.60943, 1.02407, 0.55938, 1.10468, -0.12908, -0.00329)
Controller_red <- c(0.93577, 1.92379, 0.8746, 1.02084, 1.08547, 0.74312, 1.53032, 0.74821, -0.10777, 0.48774, 0.29206, 0.09947, 0.21528, 1.41961, 1.59125, -0.21777, 0.56455, 0.83702, 1.2306, 0.51277)
All <- rep(1, 20)
d <- as.data.frame(cbind(Gender, Gaming_freq, color_white, color_black_red, color_black_blue, Controller_none, Controller_white, Controller_red, All))
library(shiny)
library(shinythemes)
library(shinydashboard)
ui <- fluidPage(theme = shinytheme("sandstone"),
dashboardPage(skin = "red",
header = dashboardHeader(title = "Dashboard of Survey Results"),
sidebar = dashboardSidebar(
sidebarMenu(
menuItem("Overview", tabName = "overview", icon = icon("dashboard")),
menuItem("Utilities", icon = icon("th"), tabName = "utilities"),
menuItem("Importances", icon = icon("th"), tabName = "importances")
)
),
body = dashboardBody(tabItems(

tabItem(tabName = "utilities",
h2("Utilities of attribute levels"),
mainPanel(
tabsetPanel(
id = 'dataset',
tabPanel("Color", DT::dataTableOutput("mytable1")),
tabPanel("Extra Controller", DT::dataTableOutput("mytable2"))
)
)),

tabItem(tabName = "importances",
h2("Importance for attributes")
))))
)
server <- function(input, output) {
output$mytable1 <- DT::renderDataTable({
DT::datatable(round(d[,3:5], digits = 3), options = list(lengthMenu = c(5, 30, 50, 90), pageLength = 10, bFilter=0))
})

output$mytable2 <- DT::renderDataTable({
DT::datatable(round(d[,6:8], digits = 3),options = list(lengthMenu = c(5, 30, 50, 90), pageLength = 10, bFilter=0))
})
}

shinyApp(ui = ui, server = server)

提前谢谢。

Answer 1

您可以过滤数据并将其包装在reactive元素中，以便以后可以将其用于任何后续的输出图/表。你可以在Rstudio网站上阅读更多关于使用反应式表达式的信息

在这里，作为一个演示，我得到了"性别"的输入，用于进一步过滤数据(我使用了单选按钮，但您可以使用您选择的小工具：滑块、选择按钮等(

radioButtons("gender", "filter for gender",
choices = c("One" = '1',
"Two" = '2')),

然后在服务器中，我使用这个输入根据性别过滤数据，并将其封装在一个反应元素中：

filteredData <- reactive({
tempDataTable <- d %>% dplyr::filter(Gender==input$gender)
tempDataTable
})

接下来，您可以使用这个包含过滤数据的反应元素来生成输出表：

output$mytable1 <- DT::renderDataTable({
d <- filteredData()
DT::datatable(round(d[,3:5], digits = 3), options = list(lengthMenu = c(5, 30, 50, 90), pageLength = 10, bFilter=0))
})

你可以使用类似的策略来添加额外的过滤器或功能，在这里找到整个演示ui+服务器代码：

library(shiny)
library(shinythemes)
library(shinydashboard)
library(tidyverse)
library(DT)
ui <- fluidPage(theme = shinytheme("sandstone"),
dashboardPage(skin = "red",
header = dashboardHeader(title = "Dashboard of Survey Results"),
sidebar = dashboardSidebar(
sidebarMenu(
menuItem("Overview", tabName = "overview", icon = icon("dashboard")),
menuItem("Utilities", icon = icon("th"), tabName = "utilities"),
menuItem("Importances", icon = icon("th"), tabName = "importances")
)
),
body = dashboardBody(tabItems(

tabItem(tabName = "utilities",
h2("Utilities of attribute levels"),
mainPanel(

radioButtons("gender", "filter for gender",
choices = c("One" = '1',
"Two" = '2')),
tabsetPanel(
id = 'dataset',
tabPanel("Color", DT::dataTableOutput("mytable1")),
tabPanel("Extra Controller", DT::dataTableOutput("mytable2"))
)
)),

tabItem(tabName = "importances",
h2("Importance for attributes")
))))
)
server <- function(input, output) {

filteredData <- reactive({
tempDataTable <- d %>% dplyr::filter(Gender==input$gender)
tempDataTable
})

output$mytable1 <- DT::renderDataTable({
d <- filteredData()
DT::datatable(round(d[,3:5], digits = 3), options = list(lengthMenu = c(5, 30, 50, 90), pageLength = 10, bFilter=0))
})

output$mytable2 <- DT::renderDataTable({
d <- filteredData()
DT::datatable(round(d[,6:8], digits = 3),options = list(lengthMenu = c(5, 30, 50, 90), pageLength = 10, bFilter=0))
})
}

shinyApp(ui = ui, server = server)