I am trying to create a table (with DT, pls don't use rhandsontable) which has few existing columns, one selectinput column (where each row will have options to choose) and finally another column which will be populated based on what user select from selectinput dropdown for each row.
in my example here, 'Feedback' column is the user dropdown selection column. I am not able to update the 'Score' column which will be based on the selection from 'Feedback' column dropdown.
if(interactive()){
library(DT)
library(shiny)
tbl1 <- data.frame(A = c(1:10), B = LETTERS[1:10], C = c(11:20), D = LETTERS[1:10])
ui <- fluidPage(
DT::dataTableOutput(outputId = 'my_table')
)
server <- function(input, output, session) {
rv <- reactiveValues(tbl = tbl1)
observe({
for (i in 1:nrow(rv$tbl)) {
rv$tbl$Feedback[i] <- as.character(selectInput(paste0("sel", i), "",
choices = c(1,2,3,4)
))
if(!is.null(input[[paste0("sel", i)]])) {
if(input[[paste0("sel", i)]] == 1) {
rv$tbl$Score[i] <- 10
} else if(input[[paste0("sel", i)]] == 2) {
rv$tbl$Score[i] <- 20
} else if(input[[paste0("sel", i)]] == 3) {
rv$tbl$Score[i] <- 25
} else if(input[[paste0("sel", i)]] == 4) {
rv$tbl$Score[i] <- 30
}
}
}
})
output$my_table = DT::renderDataTable({
datatable(
rv$tbl, escape = FALSE, selection = 'none', rownames = F,
options = list( paging = FALSE, ordering = FALSE, scrollx = T, dom = "t",
preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
)
)
}, server = FALSE)
}
shinyApp(ui = ui, server = server)
}
I'd suggest using dataTableProxy
along with replaceData
to realize the desired behaviour. This is faster than re-rendering the datatable
.
Furthermore, re-rendering the table seems to be messing around with the bindings of the selectInputs
.
Also please note: for this to work I needed to switch to server = TRUE
library(DT)
library(shiny)
selectInputIDs <- paste0("sel", 1:10)
initTbl <- data.frame(
A = c(1:10),
B = LETTERS[1:10],
C = c(11:20),
D = LETTERS[1:10],
Feedback = sapply(selectInputIDs, function(x){as.character(selectInput(inputId = x, label = "", choices = c(1, 2, 3, 4), selected = 1))}),
Score = rep(10, 10)
)
ui <- fluidPage(
# please see: https://github.com/rstudio/shiny/issues/3979#issuecomment-1920046008
# alternative: set selectize = FALSE in selectInput
htmltools::findDependencies(selectizeInput("dummy", label = NULL, choices = NULL)),
DT::dataTableOutput(outputId = 'my_table')
)
server <- function(input, output, session) {
displayTbl <- reactive({
data.frame(
A = c(1:10),
B = LETTERS[1:10],
C = c(11:20),
D = LETTERS[1:10],
Feedback = sapply(selectInputIDs, function(x){as.character(selectInput(inputId = x, label = "", choices = c(1, 2, 3, 4), selected = input[[x]]))}),
Score = sapply(selectInputIDs, function(x){as.integer(input[[x]])*10})
)
})
output$my_table = DT::renderDataTable({
DT::datatable(
initTbl, escape = FALSE, selection = 'none', rownames = FALSE,
options = list(paging = FALSE, ordering = FALSE, scrollx = TRUE, dom = "t",
preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
)
)
}, server = TRUE)
my_table_proxy <- dataTableProxy(outputId = "my_table", session = session)
observeEvent({sapply(selectInputIDs, function(x){input[[x]]})}, {
replaceData(proxy = my_table_proxy, data = displayTbl(), rownames = FALSE) # must repeat rownames = FALSE see ?replaceData and ?dataTableAjax
}, ignoreInit = TRUE)
}
shinyApp(ui = ui, server = server)