R Shiny：使用復選框更新數據表

Question

我想動態填充表格並更新使用復選框選擇的項目列表。

這是我的嘗試。 我將一些隨機數據點報告到一個表中，然后取消選中其中一些，希望圖底部的列表發生變化。

僅當取消選中最后一項而不選中其他項時，列表才正確更新。

有什么建議么？

library(shiny)
library(DT)

ui <- fluidPage(
    fluidRow(
    column(4,
        plotOutput("plot1", click = "plot_click"),
        textInput("collection_txt",label="Foo")),
    column(4,
    DT::dataTableOutput("table"))
    )
)


server <- function(input, output,session) {

    # collect data points

    x <- reactiveValues(selected = '')
    y <- reactiveValues(selected = '')
    observeEvent(input$plot_click, {
        x$x <- c(x$x,input$plot_click$x)
        y$y <- c(y$y,input$plot_click$y)
    })

    output$plot1 <- renderPlot({
        plot(1,1, type='n')
        points(x$x,y$y)
    })

    # populate the table

    shinyInput <- function(FUN,id,num,...) {
        inputs <- character(num)
        for (i in seq_len(num)) {
            inputs[i] <- as.character(FUN(paste0(id,i),label=NULL,...))
        }
        inputs
    }

    output$table = DT::renderDataTable({
        tab <- data.frame('x'=x$x ,'y'=y$y)
        DT::datatable(cbind(tab, Selected=shinyInput(checkboxInput,"srows_",nrow(tab),value=TRUE,width=1)),
                                options = list(orderClasses = TRUE,
                                   drawCallback= JS(
                                     'function(settings) {
                                     Shiny.bindAll(this.api().table().node());}'),
                                   dom = 't', searching=FALSE),
                                selection='none',escape=F)
    })

    # show the list of selected items

    rowSelect <- reactive({
      rows=names(input)[grepl(pattern = "srows_",names(input))]
      paste(unlist(lapply(rows,function(i){
        if(input[[i]]==T){
          return(substr(i,gregexpr(pattern = "_",i)[[1]]+1,nchar(i)))
        }
      })))
    })

    observe({
      updateTextInput(session, "collection_txt", value = rowSelect() ,label = "Selected:" )
    })

}


shinyApp(ui, server)

Answer 1

當您單擊一個點時，必須在創建新表之前取消先前創建的Shiny對象的綁定。 例如使用shinyjs ：

library(shinyjs)
ui <- fluidPage(
  useShinyjs(),
  fluidRow(
    ......


  observeEvent(input$plot_click, {
    runjs("Shiny.unbindAll($('#table').find('table').DataTable().table().node());")
    x$x <- c(x$x,input$plot_click$x)
    y$y <- c(y$y,input$plot_click$y)
  })