How to link table panels in R Shiny Dashboard using datatable to filter data in table 2 based on click in table 1?
Is it possible to program a dashboard with the same functionality as in this example, but instead of using reactable, using the DT (DataTable) package?
Requirement: Jump to Table 2 for showing detailed information after click in Table 1. The counting of totals in the footer as shown in the above mentioned question is not necessary.
Are there any comparative studies on which package is better suited for displaying large datasets?
This is an example without the functionality for which I am asking.
library(shiny)
library(shinydashboard)
library(DT)
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",
dataTableOutput("table1"))
)
),
tabItem(tabName = "table2",
fluidRow(
box(width = 12,
title = "Table 2",
dataTableOutput("table2"))
)
)
)
)
)
server <- function(input, output, session) {
output$table1 <- renderDataTable({
datatable(
d1,
rownames = FALSE,
editable = FALSE,
selection = "none",
filter="top"
)
})
output$table2 <- renderDataTable({
datatable(
d2,
rownames = FALSE,
editable = FALSE,
selection = "none",
filter="top"
)
})
}
shinyApp(ui, server)
Solution
Here is a DT variant of the reactable solution which uses dataTableProxy in combination with updateSearch() to modify the table on the second tab.
library(shiny)
library(shinydashboard)
library(DT)
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",
DTOutput("table1"))
)
),
tabItem(tabName = "table2",
fluidRow(
box(width = 12,
title = "Table 2",
DTOutput("table2"))
)
)
)
)
)
server <- function(input, output, session) {
output$table1 <- renderDT({
datatable(
d1,
rownames = FALSE,
editable = FALSE,
selection = "none",
filter="top"
) |>
formatStyle(1, cursor='pointer')
})
output$table2 <- renderDT({
datatable(
d2,
rownames = FALSE,
editable = FALSE,
selection = "none",
filter="top"
)
})
observeEvent(input$table1_cell_clicked$value, {
filterValues <- c(input$table1_cell_clicked$value, "", "")
proxy |>
updateSearch(keywords = list(columns = filterValues))
updateTabItems(session, "tabs", "table2")
})
outputOptions(output, "table2", suspendWhenHidden = FALSE)
proxy <- dataTableProxy('table2')
}
shinyApp(ui, server)
Concerning the question regarding the comparative studies between reactable and DT I do not such studies, however, using both solutions you should be able to test them for large data sets and compare the performance. On my machine, I tested it using a data set which was derived by using rep(., 100000) on all columns of your data d1 and d2 and got a considerably fast result using DT, whereas reactable was very slow.
- Change Y intervals from 25% to 10%
- How to create a Marimekko/Mosaic plot in ggplot2
- Include code that does not run in Rpresentation Markdown
- How can I convert row names into the first column?
- How to add a ggplot2 subtitle with different size and colour?
- ggplot - making an internal pipeline within ggplot from object passed from previous pipeline
- Display bar as whole,value of bar as sum and remove as factor() from hover text
- highchart not rending in rshiny but is working in my directory
- How to listen to checkbox event that has been insert into ui using `insertUI` in Shiny-R
- Creating tooltip for radioGroupButtons while using bslib
- Reducing bootstrap table cell padding when using `bs_theme()`
- Rshiny popup won't appear under different tabs
- When I want to build a big matrix, my code becomes extremely slow. Why?
- Replace NA values in a data frame with the mean values of a variable depending on the rank of another variable
- Reshape data frame by row
- Write ZOO (XTS) object into CSV file by separating index column into two columns
- Pruning / Retrieving Nodes from a Tree Based on Parent / Child / Sibling Relationships
- Replace NA row with non-NA value from previous row and certain column
- Changing Values on the Same Column for Different DataFrames (in R)
- Binned Barplot in R
- Need a way of clumping columns together without trailing NAs and reversing the result
- How to use different parameters based on a vector for each iteration of lapply?
- Fit same model to many datasets in Python
- Why can't I iteratively add ggplot objects to a list?
- Problem with Plotting the dates on x axis for every timepoint in ggplot - and also some weird date conversion things (sidebar)
- Drawing state boundaries in county map in recent version
- How to replace and delete different underscore in a single name row
- Error package arrowR : read_parquet/open_dataset "Couldn't deserialize thrift: TProtocolException: Exceeded size limit"
- somatoChart in r (plot or ggplot)
- Selecting Flat Parts of a Curve