How to link table panels in R Shiny Dashboard using reactable to filter data in table 2 based on click in table 1?
I have an R dashboard with two panels. Each panel displays a table showing a different data frame. Table 1 shows all players with their team affiliation and total score. Table 2 shows the scores of each player in more detail across multiple games. The sum of the scores of a player in Table 2 matches the score in Table 1. I would like to set up Table 1 so that clicking on a name switches the panel to Table 2 and filters it by the corresponding name. Is this possible, and if so, how?
library(shiny)
library(shinydashboard)
library(reactable)
d1 <- data.frame(
name = c("Frank", "Emma", "Kurt", "Johanna", "Anna", "Ben", "Chris", "David", "Eva", "Felix", "Gina", "Hannah", "Iris", "Jack", "Karen", "Leo", "Mia", "Nina", "Omar", "Paul"),
team = c("A", "A", "B", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B"),
score = c(12, 15, 13, 13, 14, 11, 10, 16, 9, 8, 17, 14, 12, 13, 15, 16, 11, 10, 9, 8)
)
d2 <- data.frame(
name = c(
"Frank", "Frank", "Frank",
"Emma", "Emma", "Emma",
"Kurt", "Kurt", "Kurt",
"Johanna", "Johanna", "Johanna",
"Anna", "Anna", "Anna",
"Ben", "Ben", "Ben",
"Chris", "Chris", "Chris",
"David", "David", "David",
"Eva", "Eva", "Eva",
"Felix", "Felix", "Felix",
"Gina", "Gina", "Gina",
"Hannah", "Hannah", "Hannah",
"Iris", "Iris", "Iris",
"Jack", "Jack", "Jack",
"Karen", "Karen", "Karen",
"Leo", "Leo", "Leo",
"Mia", "Mia", "Mia",
"Nina", "Nina", "Nina",
"Omar", "Omar", "Omar",
"Paul", "Paul", "Paul"
),
match = c(
1, 2, 3, # Frank
1, 2, 3, # Emma
1, 2, 3, # Kurt
1, 2, 3, # Johanna
1, 2, 3, # Anna
1, 2, 3, # Ben
1, 2, 3, # Chris
1, 2, 3, # David
1, 2, 3, # Eva
1, 2, 3, # Felix
1, 2, 3, # Gina
1, 2, 3, # Hannah
1, 2, 3, # Iris
1, 2, 3, # Jack
1, 2, 3, # Karen
1, 2, 3, # Leo
1, 2, 3, # Mia
1, 2, 3, # Nina
1, 2, 3, # Omar
1, 2, 3 # Paul
),
score = c(
4, 4, 4, # Frank (12)
5, 5, 5, # Emma (15)
4, 4, 5, # Kurt (13)
4, 4, 5, # Johanna (13)
5, 4, 5, # Anna (14)
4, 4, 3, # Ben (11)
4, 3, 3, # Chris (10)
6, 5, 5, # David (16)
3, 3, 3, # Eva (9)
3, 3, 2, # Felix (8)
6, 6, 5, # Gina (17)
5, 5, 4, # Hannah (14)
4, 4, 4, # Iris (12)
4, 4, 5, # Jack (13)
5, 5, 5, # Karen (15)
6, 5, 5, # Leo (16)
4, 4, 3, # Mia (11)
4, 3, 3, # Nina (10)
3, 3, 3, # Omar (9)
3, 3, 2 # Paul (8)
)
)
ui <- dashboardPage(
dashboardHeader(title = "Test"),
dashboardSidebar(
sidebarMenu(
menuItem("Table 1", tabName = "table1", icon = icon("table")),
menuItem("Table 2", tabName = "table2", icon = icon("table"))
)
),
dashboardBody(
tabItems(
tabItem(tabName = "table1",
fluidRow(
box(width = 12,
title = "Table 1",
reactableOutput("table1"))
)
),
tabItem(tabName = "table2",
fluidRow(
box(width = 12,
title = "Table 2",
reactableOutput("table2"))
)
)
)
)
)
server <- function(input, output, session) {
output$table1 <- renderReactable({
reactable(
d1,
filterable = TRUE,
columns = list(
score = colDef(footer = JS(
c(
"function(column, state) {",
" let total = 0",
" state.sortedData.forEach(function(row) {",
" total += row[column.id] ",
" })",
" return total",
"}"
)
)),
name = colDef(footer = "Total")
),
defaultSorted = "score",
defaultSortOrder = "desc",
defaultPageSize = 5
)
})
output$table2 <- renderReactable({
reactable(
d2,
filterable = TRUE,
columns = list(
score = colDef(footer = JS(
c(
"function(column, state) {",
" let total = 0",
" state.sortedData.forEach(function(row) {",
" total += row[column.id] ",
" })",
" return total",
"}"
)
)),
name = colDef(footer = "Total")
),
defaultSorted = "score",
defaultSortOrder = "desc",
defaultPageSize = 5
)
})
}
shinyApp(ui, server)
Solution
The below example uses:
- An
onClickhandler ontable1which checks forcolInfo.id == 'name'and if so,Reactable.setFilter('table2', 'name', rowInfo.values.name)is called which sets the filter ontable2. - Also an input value
switchTabis set which triggers anobserveEventcontainingshinydashboard::updateTabItemsfor switching the tab. outputOptions(output, "table2", suspendWhenHidden = FALSE)is important such thattable2can be manipulated also if you still are ontab1.
library(shiny)
library(shinydashboard)
library(reactable)
d1 <- data.frame(
name = c("Frank", "Emma", "Kurt", "Johanna", "Anna", "Ben", "Chris", "David", "Eva", "Felix", "Gina", "Hannah", "Iris", "Jack", "Karen", "Leo", "Mia", "Nina", "Omar", "Paul"),
team = c("A", "A", "B", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B"),
score = c(12, 15, 13, 13, 14, 11, 10, 16, 9, 8, 17, 14, 12, 13, 15, 16, 11, 10, 9, 8)
)
d2 <- data.frame(
name = c(
"Frank", "Frank", "Frank",
"Emma", "Emma", "Emma",
"Kurt", "Kurt", "Kurt",
"Johanna", "Johanna", "Johanna",
"Anna", "Anna", "Anna",
"Ben", "Ben", "Ben",
"Chris", "Chris", "Chris",
"David", "David", "David",
"Eva", "Eva", "Eva",
"Felix", "Felix", "Felix",
"Gina", "Gina", "Gina",
"Hannah", "Hannah", "Hannah",
"Iris", "Iris", "Iris",
"Jack", "Jack", "Jack",
"Karen", "Karen", "Karen",
"Leo", "Leo", "Leo",
"Mia", "Mia", "Mia",
"Nina", "Nina", "Nina",
"Omar", "Omar", "Omar",
"Paul", "Paul", "Paul"
),
match = c(
1, 2, 3, # Frank
1, 2, 3, # Emma
1, 2, 3, # Kurt
1, 2, 3, # Johanna
1, 2, 3, # Anna
1, 2, 3, # Ben
1, 2, 3, # Chris
1, 2, 3, # David
1, 2, 3, # Eva
1, 2, 3, # Felix
1, 2, 3, # Gina
1, 2, 3, # Hannah
1, 2, 3, # Iris
1, 2, 3, # Jack
1, 2, 3, # Karen
1, 2, 3, # Leo
1, 2, 3, # Mia
1, 2, 3, # Nina
1, 2, 3, # Omar
1, 2, 3 # Paul
),
score = c(
4, 4, 4, # Frank (12)
5, 5, 5, # Emma (15)
4, 4, 5, # Kurt (13)
4, 4, 5, # Johanna (13)
5, 4, 5, # Anna (14)
4, 4, 3, # Ben (11)
4, 3, 3, # Chris (10)
6, 5, 5, # David (16)
3, 3, 3, # Eva (9)
3, 3, 2, # Felix (8)
6, 6, 5, # Gina (17)
5, 5, 4, # Hannah (14)
4, 4, 4, # Iris (12)
4, 4, 5, # Jack (13)
5, 5, 5, # Karen (15)
6, 5, 5, # Leo (16)
4, 4, 3, # Mia (11)
4, 3, 3, # Nina (10)
3, 3, 3, # Omar (9)
3, 3, 2 # Paul (8)
)
)
ui <- dashboardPage(
dashboardHeader(title = "Test"),
dashboardSidebar(
sidebarMenu(
id = "tabs",
menuItem("Table 1", tabName = "table1", icon = icon("table")),
menuItem("Table 2", tabName = "table2", icon = icon("table"))
)
),
dashboardBody(
tabItems(
tabItem(tabName = "table1",
fluidRow(
box(width = 12,
title = "Table 1",
reactableOutput("table1"))
)
),
tabItem(tabName = "table2",
fluidRow(
box(width = 12,
title = "Table 2",
reactableOutput("table2"))
)
)
)
)
)
server <- function(input, output, session) {
output$table1 <- renderReactable({
reactable(
d1,
filterable = TRUE,
columns = list(
score = colDef(footer = JS(
c(
"function(column, state) {",
" let total = 0",
" state.sortedData.forEach(function(row) {",
" total += row[column.id] ",
" })",
" return total",
"}"
)
)),
name = colDef(footer = "Total")
),
defaultSorted = "score",
defaultSortOrder = "desc",
defaultPageSize = 5,
onClick = JS(
c(
"function(rowInfo, colInfo, column) {",
" if (colInfo.id == 'name') {",
" Reactable.setAllFilters('table2', []);", # clear all filters
" Reactable.setFilter('table2', 'name', rowInfo.values.name);",
" Shiny.setInputValue('switchTab', {tab: 'table2'}, {priority:'event'});",
" }",
" return",
" }"
)
),
rowStyle = list(cursor = "pointer")
)
})
output$table2 <- renderReactable({
reactable(
d2,
filterable = TRUE,
columns = list(
score = colDef(footer = JS(
c(
"function(column, state) {",
" let total = 0",
" state.sortedData.forEach(function(row) {",
" total += row[column.id] ",
" })",
" return total",
"}"
)
)),
name = colDef(footer = "Total")
),
defaultSorted = "score",
defaultSortOrder = "desc",
defaultPageSize = 5
)
})
observeEvent(input$switchTab, {
updateTabItems(session, "tabs", input$switchTab$tab)
})
outputOptions(output, "table2", suspendWhenHidden = FALSE)
}
shinyApp(ui, server)
- Retrieving expected data.frame for testthat expectation
- How to use an anonymous function with pipe operator?
- R passing RSelenium driver environment as function argument
- Keep file names merging list with lapply?
- replace strings that contains one another
- Stop parsing out zeros after decimals in ggplot2's annotate
- Plot data.tree coloring and labelling by level
- Extracting the date and time out of a date and time format
- How to reshape a dataframe into wide format with specified column pairs
- Show partial segments removed after limit scales for `geom_pointrange`
- Control ggplot2 legend look without affecting the plot
- Concatenate strings over all rows in a single column of a data frame
- Is there some way to keep variable names from.SD+.SDcols together with non .SD variable names in data.table?
- How to create mutually dependent checkbox columns in a DT table?
- A problem with an stacked, grouped and faceted graph y gg plot
- Installing R on Linux: configure: error: libcurl >= 7.28.0 library and headers are required with support for https
- Create a column conditional on multiple other character and numerical columns
- data.frame to array (2 columns)
- Changing options() in a function environment without changing options() in global environment in R?
- pivot(), group_by() and summarise() with nested data
- Why legend is not showing up in plot layout using patchwork in R?
- in dplyr::mutate, dplyr::starts_with works for .before but not .after?
- Finding optimal cut-off points for dividing a variable into equal groups considering ties in which quantiles do not work
- How to add a legend to hline?
- R Shiny Suppress slider handle for sliderInput until click
- brmultinom brglm2 vifs and dredge dont work
- R, how to get current time miliseconds, without extra information ? (Sys.time(), format("%X"))
- Installing multiple versions of R
- Command to see 'R' path that RStudio is using
- Fast pairwise longest common substring from start