I'm trying to create a reactive datatable with embedded radio buttons in Shiny.
The example below is based on https://yihui.shinyapps.io/DT-radio/ but instead of a static table I use a reactive, since I'd like to dynamically add/remove rows from the table. The app works as expected before changing the number of rows. After changing the number of rows, the table is updated but the radio button values do not update. The one exception is the newly added row which does get updated.
N.B. I noticed when using the inspect element tool that "shiny-bound-input" is dropped from the table row class after changing the rows, except for newly added rows.
Does the callback function need to be updated, or is there something wrong in how I've set up the app? Any help would be appreciated.
Session info:
R version 4.0.2 (2020-06-22)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 10 x64 (build 19044)
Matrix products: default
attached base packages:
[1] stats graphics grDevices utils datasets methods base
other attached packages:
[1] DT_0.20 testthat_3.1.0 shiny_1.7.1
App
library(shiny)
library(DT)
shinyApp(
ui = fluidPage(
title = 'Radio buttons in a table',
numericInput("n_row", "Number of rows", value = 3, min = 1, max = 10),
DT::dataTableOutput('foo'),
verbatimTextOutput('sel')
),
server = function(input, output, session) {
mr = reactive({
m <-
matrix(
as.character(1:3), nrow = input$n_row, ncol = 3, byrow = TRUE,
dimnames = list(seq(input$n_row), LETTERS[1:3])
)
for (i in seq_len(nrow(m))) {
m[i, ] = sprintf(
'<input type="radio" name="%s" value="%s"/>',
seq(input$n_row)[i], m[i, ]
)
}
m
})
output$foo = DT::renderDataTable(
mr(),
escape = FALSE, selection = 'none', server = FALSE,
options = list(dom = 't', paging = FALSE, ordering = FALSE),
callback = JS("table.rows().every(function(i, tab, row) {
var $this = $(this.node());
$this.attr('id', this.data()[0]);
$this.addClass('shiny-input-radiogroup');
});
Shiny.unbindAll(table.table().node());
Shiny.bindAll(table.table().node());")
)
output$sel = renderPrint({
str(sapply(as.character(seq(input$n_row)), function(i) input[[i]]))
})
}
)
library(shiny)
library(DT)
### initial matrix
nrows <- 4
mat <- matrix(
as.character(1:3), nrow = nrows, ncol = 3, byrow = TRUE,
dimnames = list(seq_len(nrows), LETTERS[1:3])
)
for (i in seq_len(nrows)) {
mat[i, ] <- sprintf(
'<input type="radio" name="r%s" value="%s"/>',
i, mat[i, ]
)
}
### Callback
callback <- c(
sprintf('var nrows = %s;', nrows),
'$("#add_btn").on("click", function(){',
' nrows++;',
' var newrow = [String(nrows)].concat(["1", "2", "3"].map(function(i){',
' return "<input type=\\\"radio\\\" name=\\\"r" + nrows + "\\\" value=\\\"" + i + "\\\"/>";',
' }));',
' table.row.add(newrow).draw();',
'});',
'$("#delete_btn").on("click", function(){',
' var rows = table.rows(".selected");',
' if(rows.length){',
' Shiny.setInputValue("r" + rows.data()[0][0], "deleted");',
' rows.remove().draw();',
' }',
'});'
)
### Shiny App
shinyApp(
ui = basicPage(
mainPanel(
br(),
actionButton("add_btn", "Add a row"),
actionButton("delete_btn", "Delete selected row"),
tags$hr(),
DTOutput("dtable")
)
),
server = function(input, output) {
output$dtable <- renderDT({
datatable(mat, selection = "single", escape = FALSE,
callback = JS(callback), rownames = TRUE,
options = list(
dom = "t",
paging = FALSE,
ordering = FALSE,
createdRow =
JS('function(row, data, dataIndex, cells){$(row).attr("id", "r" + data[0]).addClass("shiny-input-radiogroup");}'),
preDrawCallback =
JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
drawCallback =
JS('function() { Shiny.bindAll(this.api().table().node()); }')
)
)
}, server = FALSE)
observe({
print("row1:")
print(input$r1)
print("row2:")
print(input$r2)
print("row3:")
print(input$r3)
print("row4:")
print(input$r4)
print("row5:")
print(input$r5)
})
}
)