rshinyshinydashboardreactable
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)
- Test whether one factor is nested in another
- Renaming columns in the global environment
- How can I use a character containing the DB instead of the connectin in R?
- Identifying all columns shared in common by a set of files and then vertically stack them
- curly-curly braces - why won't this function accept an unquoted variable
- Concatenate columns from Excel file based on sheet name and column's name
- Conditioning previous values within groups in R
- Finding out which columns are same in different files
- Rcpp error, learning Rcpp and C++ on mac
- How can I subset a list, based on list element details, using sapply?
- Reactively pull data from list objects in Shiny
- read_xml not recognizing the contents inside the nodes and returning charater[0]
- Saving plots in multiple columns using ggsave() cuts 2/3 of output
- Replacing NA's within a set of similar values
- Hide initially displayed code from shiny modularized app after clicking actionButton
- edit plot attributes manually and redraw
- Reformat data to include 2 minute time intervals
- ggsurvplot not displaying number at risk for time 0
- Change width of callout-block in Quarto dashboard
- Is there a R function to pair elements from two columns of a data.frame to make a new data.frame
- Question about glm family in R
- How to flatten a list of lists?
- Is there a fast/clever way to return a logical vector if elements of a vector are in at least one interval?
- how can I combine three tables - 2 separate questionnaires used on the same cohort and one table with blood results
- Modify pop-up message in leaflet map
- Conditional bslib tooltip
- How to specify column parameters programmatically?
- Complex subsetting in R for case-control study
- Set CMU Sans Serif font on pdf quarto
- How to remove string before a certain delimiter in R?