shiny-bound-input class 在带有 DT 和 data.table 的 R Shiny 中丢失
shiny-bound-input class lost in R Shiny with DT and data.table
我正在尝试构建一个闪亮的应用程序,它在 DT
包的帮助下使用 data.table
中动态创建的输入。在下面的可重现示例中,在 DT 输出中创建的 shiny-input input$Sel_Group_1
取决于在 shiny-input input$selectGroup
中选择的值(值 a 或 b)。所选项目(值 c、d、f、g)随后显示在文本输出中 output$selectedItem
。
当我最初启动应用程序时一切正常,但是一旦我更新 input$selectGroup
中的值,元素 input$Sel_Group_1
的绑定就会丢失,文本输出 output$selectedItem
会丢失不再有反应。检查元素 input$Sel_Group_1
后,我发现 class 属性“shiny-bound-input”在更新 input$selectGroup
中的值后立即丢失。
非常感谢您对此主题的帮助!
library(shiny)
library(DT)
library(data.table)
data <- data.table(Group = c("a", "a", "b", "b"), Item = c("c", "d", "f", "g"))
ui <- fluidPage(
selectInput("selectGroup", "Select Group", c("a", "b")),
DT::dataTableOutput('ItemSelection'),
textOutput("selectedItem")
)
server <- function(input, output, session) {
output$ItemSelection <- DT::renderDT(
{
data_selected <- data[Group == input$selectGroup]
data_unique <- unique(data[Group == input$selectGroup, .(Group)])
data_unique$Item_Selection[1] <-
as.character(selectInput(
"Sel_Group_1",
label = NULL,
choices = unique(data_selected[Group %in% data_unique[1], Item]),
width = "100px"
))
return(data_unique)
}
, escape = FALSE, selection = 'none', server = FALSE,
options = list(dom = 't', paging = FALSE, ordering = FALSE),
rownames = FALSE,
callback = JS("table.rows().every(function(i, tab, row) {
var $this = $(this.node());
$this.attr('id', this.data()[0]);
$this.addClass('shiny-input-container');
});
Shiny.unbindAll(table.table().node());
Shiny.bindAll(table.table().node());")
)
output$selectedItem <- renderText(paste0("Item selected is: ", input$Sel_Group_1))
}
shinyApp(ui, server)
您必须在重新呈现 table 之前取消绑定:
library(shiny)
library(DT)
library(data.table)
data <- data.table(Group = c("a", "a", "b", "b"), Item = c("c", "d", "f", "g"))
ui <- fluidPage(
tags$head(tags$script(
HTML(
"Shiny.addCustomMessageHandler('unbindDT', function(id) {
var $table = $('#'+id).find('table');
if($table.length > 0){
Shiny.unbindAll($table.DataTable().table().node());
}
})")
)),
selectInput("selectGroup", "Select Group", c("a", "b")),
DT::dataTableOutput('ItemSelection'),
textOutput("selectedItem")
)
server <- function(input, output, session) {
output$ItemSelection <- DT::renderDT(
{
data_selected <- data[Group == input$selectGroup]
data_unique <- unique(data[Group == input$selectGroup, .(Group)])
data_unique$Item_Selection[1] <-
as.character(selectInput(
"Sel_Group_1",
label = NULL,
choices = unique(data_selected[Group %in% data_unique[1], Item]),
width = "100px"
))
datatable(
data_unique, escape = FALSE, selection = 'none',
options = list(
dom = 't',
paging = FALSE,
ordering = FALSE,
preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); }')
),
rownames = FALSE
)
}, server = FALSE)
observeEvent(input$selectGroup, {
session$sendCustomMessage("unbindDT", "ItemSelection")
})
output$selectedItem <- renderText(paste0("Item selected is: ", input$Sel_Group_1))
}
shinyApp(ui, server)
我正在尝试构建一个闪亮的应用程序,它在 DT
包的帮助下使用 data.table
中动态创建的输入。在下面的可重现示例中,在 DT 输出中创建的 shiny-input input$Sel_Group_1
取决于在 shiny-input input$selectGroup
中选择的值(值 a 或 b)。所选项目(值 c、d、f、g)随后显示在文本输出中 output$selectedItem
。
当我最初启动应用程序时一切正常,但是一旦我更新 input$selectGroup
中的值,元素 input$Sel_Group_1
的绑定就会丢失,文本输出 output$selectedItem
会丢失不再有反应。检查元素 input$Sel_Group_1
后,我发现 class 属性“shiny-bound-input”在更新 input$selectGroup
中的值后立即丢失。
非常感谢您对此主题的帮助!
library(shiny)
library(DT)
library(data.table)
data <- data.table(Group = c("a", "a", "b", "b"), Item = c("c", "d", "f", "g"))
ui <- fluidPage(
selectInput("selectGroup", "Select Group", c("a", "b")),
DT::dataTableOutput('ItemSelection'),
textOutput("selectedItem")
)
server <- function(input, output, session) {
output$ItemSelection <- DT::renderDT(
{
data_selected <- data[Group == input$selectGroup]
data_unique <- unique(data[Group == input$selectGroup, .(Group)])
data_unique$Item_Selection[1] <-
as.character(selectInput(
"Sel_Group_1",
label = NULL,
choices = unique(data_selected[Group %in% data_unique[1], Item]),
width = "100px"
))
return(data_unique)
}
, escape = FALSE, selection = 'none', server = FALSE,
options = list(dom = 't', paging = FALSE, ordering = FALSE),
rownames = FALSE,
callback = JS("table.rows().every(function(i, tab, row) {
var $this = $(this.node());
$this.attr('id', this.data()[0]);
$this.addClass('shiny-input-container');
});
Shiny.unbindAll(table.table().node());
Shiny.bindAll(table.table().node());")
)
output$selectedItem <- renderText(paste0("Item selected is: ", input$Sel_Group_1))
}
shinyApp(ui, server)
您必须在重新呈现 table 之前取消绑定:
library(shiny)
library(DT)
library(data.table)
data <- data.table(Group = c("a", "a", "b", "b"), Item = c("c", "d", "f", "g"))
ui <- fluidPage(
tags$head(tags$script(
HTML(
"Shiny.addCustomMessageHandler('unbindDT', function(id) {
var $table = $('#'+id).find('table');
if($table.length > 0){
Shiny.unbindAll($table.DataTable().table().node());
}
})")
)),
selectInput("selectGroup", "Select Group", c("a", "b")),
DT::dataTableOutput('ItemSelection'),
textOutput("selectedItem")
)
server <- function(input, output, session) {
output$ItemSelection <- DT::renderDT(
{
data_selected <- data[Group == input$selectGroup]
data_unique <- unique(data[Group == input$selectGroup, .(Group)])
data_unique$Item_Selection[1] <-
as.character(selectInput(
"Sel_Group_1",
label = NULL,
choices = unique(data_selected[Group %in% data_unique[1], Item]),
width = "100px"
))
datatable(
data_unique, escape = FALSE, selection = 'none',
options = list(
dom = 't',
paging = FALSE,
ordering = FALSE,
preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); }')
),
rownames = FALSE
)
}, server = FALSE)
observeEvent(input$selectGroup, {
session$sendCustomMessage("unbindDT", "ItemSelection")
})
output$selectedItem <- renderText(paste0("Item selected is: ", input$Sel_Group_1))
}
shinyApp(ui, server)