R Shiny picking and storing favorites from checked dataTables - r

Question

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 value field
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)

Answer 1

Ok, so this is a working solution now - for anyone else interested.
It will read the value of the checkbox, and send it to the favorites table on click.
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({
if(!is.null(input[["rows1"]])) paste(sort(unique(input[["rows1"]])),sep=',')
})
rowSelect2 <- reactive({
if(!is.null(input[["rows2"]])) paste(sort(unique(input[["rows2"]])),sep=',')
})
rowSelect3 <- reactive({
if(!is.null(input[["rows3"]])) paste(sort(unique(input[["rows3"]])),sep=',')
})
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);
});
}")
store_favorites <- function(rds="favorites.Rds", inputidx, name){
if(file.exists(rds)) favorites <- readRDS(rds) else favorites <- data.frame("Table"=character(0), "Key"=character(0))
if(length(input[[inputidx]])>0) {
new_favorites <- unique(rbind(favorites, data.frame("Table"=name,"Key"=input[[inputidx]])))
saveRDS(new_favorites, rds)
new_favorites
} else {
favorites
}
}
favorites1 <- reactive({
input$send_table1
isolate({store_favorites(inputidx="rows1", name="Table1")})
})
favorites2 <- reactive({
input$send_table2
isolate({store_favorites(inputidx="rows2", name="Table2")})
})
favorites3 <- reactive({
input$send_table3
isolate({store_favorites(inputidx="rows3", name="Table3")})
})
output$favorites_table <- renderDataTable({
# Re-evaluate favorites each time one of the buttons are pressed
input$send_table1
input$send_table2
input$send_table3
isolate({
#Unneccessary to bind the same table 3 times, then unique - but this works
all_favs <- unique(rbind(favorites1(),favorites2(),favorites3()))
})
validate(
need(nrow(all_favs)>0, paste0("No favorites stored"))
)
all_favs
})
}
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)