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)
Improve this question

1 Answer 1

Reset to default
1

The below example uses:

  • An onClick handler on table1 which checks for colInfo.id == 'name' and if so, Reactable.setFilter('table2', 'name', rowInfo.values.name) is called which sets the filter on table2.
  • Also an input value switchTab is set which triggers an observeEvent containing shinydashboard::updateTabItems for switching the tab.
  • outputOptions(output, "table2", suspendWhenHidden = FALSE) is important such that table2 can be manipulated also if you still are on tab1.

enter image description here

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)
Improve this answer
3
  • Thanks!!! The solution works wonderfully. In case additional filters were applied in Table 2 after the 'onClick(...)' in Table 1, and then one returns to Table 1 and clicks on another name, causing another jump to Table 2: Is it possible to clear the other filters apart from the name? Also, I am wondering if filtering as in this example after onClick is a good solution in terms of performance when I have very large data frames with about 200,000-300,000 rows and around 10 columns each. Or should the data passed to Table 2 be filtered before display, for instance, using dplyr?
    – Gurkenhals
    Commented Jun 24 at 5:22
  • 1
    The first point should be a one-liner, please check my updated answer. Concerning the second point I think it could be beneficial if you could pass less data to the reactable, though I do not tested it with some benchmarks. You then have to render less data. There are also attempts (#22) in order to implement server-side processing, which could help, however, this is currently experimental. If you are not limited to reactable, you also could e.g. have a look at DT.
    – Jan
    Commented Jun 24 at 20:34
  • Thank you very much, it works wonderfully. I have asked a new question to compare reactable and DT.
    – Gurkenhals
    Commented Jun 25 at 5:29

Not the answer you're looking for? Browse other questions tagged or ask your own question.