Background
I'm trying to create a multi-table Shiny app in which you can pick your favorite rows in each of several tables, through checkboxes. These should then be stored across sessions, and rendered in an additional "Favorites" table. Unfortunately my understanding of JavaScript appears too limited to achieve this.
Objectives
- Pick favorites by checking rows
- The value to store should be read from the checkbox
valuefield - Multiple tables should work independently of each other
- Picked favorites should be stored between sessions by writing to .Rds file or similar
What I've done so far
For a single table, the basic setup works well as described here: RStudio Shiny list from checking rows in dataTables
In extending this to multiple tables, separated in different tabs, these do not seem to act independently. Example: If I select row 1 from table 1, and then row 2 from table 2 - the rendering for table 2 will show both row 1 and 2 as selected. If I now press the "Save 2" button, it will save three records: row 1 (table1) and row 1+2 (table2).
In table 3, I've managed to return the value of the checkbox (ID column no longer needs to be printed in actual table), but now I can only select one row.
EDIT: The callback is now working, collecting the values of the checkboxes and working independently of each other. Still, saving is not working as expected. This is likely a Shiny/reactivity issue?
app.R
mymtcars1 = mtcars
mymtcars2 = mtcars
mymtcars3 = mtcars
mymtcars1$id = 1:nrow(mtcars)
mymtcars2$id = 1:nrow(mtcars)
mymtcars3$id = 1:nrow(mtcars)
server <- function(input, output, session) {
rowSelect1 <- reactive({
paste(sort(unique(input[["rows1"]])),sep=',')
})
rowSelect2 <- reactive({
paste(sort(unique(input[["rows2"]])),sep=',')
})
rowSelect3 <- reactive({
paste(sort(unique(input[["rows3"]])),sep=',')
})
observe({
output$favorites_table1 <- renderText(rowSelect1())
output$favorites_table2 <- renderText(rowSelect2())
output$favorites_table3 <- renderText(rowSelect3())
})
output$mytable1 = renderDataTable({
mymtcars <- mymtcars1
addCheckboxButtons <- paste0('<input id="table1" type="checkbox" name="row', mymtcars$id, '" value="op', mymtcars$id, '">',"")
#Display table with checkbox buttons
cbind(Pick=addCheckboxButtons, mymtcars)
}, options = list(orderClasses = TRUE, lengthMenu = c(5, 25, 50), pageLength = 25),
escape = FALSE,
callback = "function(table) {
table.on('change.dt', '#table1:checkbox', function() {
setTimeout(function () {
Shiny.onInputChange('rows1', $('#table1:checked').map(function() {
return $(this).val();
}).get())
}, 10);
});
}")
output$mytable2 = renderDataTable({
mymtcars <- mymtcars2
addCheckboxButtons <- paste0('<input id="table2" type="checkbox" name="row', mymtcars$id, '" value="val', mymtcars$id, '">',"")
#Display table with checkbox buttons
cbind(Pick=addCheckboxButtons, mymtcars)
}, options = list(orderClasses = TRUE, lengthMenu = c(5, 25, 50), pageLength = 25),
escape = FALSE,
callback = "function(table) {
table.on('change.dt', '#table2:checkbox', function() {
setTimeout(function () {
Shiny.onInputChange('rows2', $('#table2:checked').map(function() {
return $(this).val();
}).get())
}, 10);
});
}")
output$mytable3 = renderDataTable({
mymtcars <- mymtcars3
addCheckboxButtons <- paste0('<input id="table3" type="checkbox" name="row', mymtcars$id, '" value="', mymtcars$id, '">',"")
#Display table with checkbox buttons
cbind(Pick=addCheckboxButtons, mymtcars[,-ncol(mymtcars)])
}, options = list(orderClasses = TRUE, lengthMenu = c(5, 25, 50), pageLength = 25),
escape = FALSE,
callback = "function(table) {
table.on('change.dt', '#table3:checkbox', function() {
setTimeout(function () {
Shiny.onInputChange('rows3', $('#table3:checked').map(function() {
return $(this).val();
}).get())
}, 10);
});
}")
favorites <- reactive({
input$send_table1
input$send_table2
input$send_table3
if(file.exists("favorites.Rds")) {
old_favorites <- readRDS("favorites.Rds")
} else {
old_favorites <- data.frame()
}
isolate({
new_favorites <- data.frame("Table"=character(0), "Key"=character(0))
if(length(input$rows1>0)) new_favorites <- rbind(new_favorites, data.frame("Table"="Table1","Key"=input$rows1))
if(length(input$rows2>0)) new_favorites <- rbind(new_favorites, data.frame("Table"="Table2","Key"=input$rows2))
if(length(input$rows3>0)) new_favorites <- rbind(new_favorites, data.frame("Table"="Table3","Key"=input$rows3))
if(nrow(new_favorites)>0){
saveRDS(new_favorites, "favorites.Rds")
new_favorites
} else {
old_favorites
}
})
})
output$favorites_table <- renderDataTable({
validate(
need(nrow(favorites())>0, paste0("No favorites stored"))
)
favorites()
})
}
ui <- shinyUI(
pageWithSidebar(
headerPanel('Examples of DataTables'),
sidebarPanel(
inputPanel(
h5("Selected (table 1)"),br(),
verbatimTextOutput("favorites_table1"),
actionButton(inputId = "send_table1", "Save 1", class="btn-mini")
),
inputPanel(
h5("Selected (table 2)"),br(),
verbatimTextOutput("favorites_table2"),
actionButton(inputId = "send_table2", "Save 2", class="btn-mini")
),
inputPanel(
h5("Selected (table 3)"),br(),
verbatimTextOutput("favorites_table3"),
actionButton(inputId = "send_table3", "Save 3", class="btn-mini")
)
),
mainPanel(
tabsetPanel(
tabPanel("Table1",
dataTableOutput("mytable1")
),
tabPanel("Table2",
dataTableOutput("mytable2")
),
tabPanel("Table3",
dataTableOutput("mytable3")
),
tabPanel("Favorites",
dataTableOutput("favorites_table")
)
)
)
)
)
shinyApp(ui = ui, server = server)
