[英]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.