Shiny tabPanel datatable including filter options - shiny

Question

I have created a tabPanel and want to give the chance to filter by different variables (e.g., show All, gender (male or female), gaming frequency (never, sometimes, often). Giving a filter possibility on the right side of the table.
The tabPanel alone is working fine, however, I do not know how to add the select Input filter (a) multiple variables as well as b) used the output$data for 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)
Thanks in advance.

Answer 1

You can filter your data and wrap it in a reactive element, so you can later use it for any subsequent output plots/tables. You can read more about working with reactive expressions on Rstudio website.
Here as a demo, I get an input on the 'Gender', for further filtering the data out (I've used radio buttons but you can use your widget of choice: slider, select button, etc.)
radioButtons("gender", "filter for gender",
choices = c("One" = '1',
"Two" = '2')),
Then in the server, I use this input to filter the data based on the gender, and wrap it up in a reactive element:
filteredData <- reactive({
tempDataTable <- d %>% dplyr::filter(Gender==input$gender)
tempDataTable
})
Next you can use this reactive element containing your filtered data for generating output tables:
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))
})
You can use similar strategy to add additional filters or features, find the entire demo ui+server code here:
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)