R语言 包含过滤器选项的Shiny tabPanel数据表

ttcibm8c  于 2023-04-09  发布在  其他
关注(0)|答案(1)|浏览(138)

我已经创建了一个tabPanel,并希望给予机会通过不同的变量进行过滤(例如,显示所有,性别(男性或女性),游戏频率(从不,有时,经常)。在表的右侧提供过滤器的可能性。
tabPanel本身工作正常,但是,我不知道如何添加选择输入过滤器(a)多个变量以及b)使用输出$data作为输出$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)

先谢谢你了。

q8l4jmvw

q8l4jmvw1#

您可以过滤数据并将其 Package 在reactive元素中,以便稍后将其用于任何后续输出图/表。您可以阅读有关在Rstudio website上使用React式表达式的更多信息。
作为一个演示,我在“性别”上输入了一个输入,用于进一步过滤数据(我使用了单选按钮,但您可以使用您选择的小部件:滑块、选择按钮等)

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

然后在服务器中,我使用这个输入来根据性别过滤数据,并将其 Package 在一个React式元素中:

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

接下来,您可以使用这个包含筛选数据的reactive元素来生成输出表:

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)

相关问题