[英]DT: Dynamically change column values based on selectinput from another column in R shiny app
我正在尝试创建一个表(使用 DT,请不要使用 rhandsontable),其中现有的列很少,一个 selectinput 列(其中每一行都有可供选择的选项),最后是另一列,该列将根据用户的选择进行填充从每行的 selectinput 下拉列表中。
在我的示例中,“反馈”列是用户下拉选择列。 我无法更新“分数”列,该列将基于“反馈”列下拉列表中的选择。
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)
}
我建议使用dataTableProxy
和replaceData
来实现所需的行为。 这比重新呈现更快的datatable
。
此外,重新渲染表似乎与selectInputs
的绑定混淆。
另请注意:为此,我需要切换到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(
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)
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.