javascript - selectInput 值未在可反应的 Shiny 中更新（Trouble binding-unbiding）

Question

我在 Shiny 的 reactable 中有一个 selectInput，但输入没有更新。我想做这样的事情，但可以反应：

绑定/取消绑定 DataTable 时出现反应问题

library(shiny)
library(tidyverse)
library(reactable)


runApp(list(
  ui = basicPage(
    h2("Table Data"),
    reactableOutput("tbl_react_mtcars"),
    h2("Selected"),
    textOutput("tbl_mtcars")
  ),
  server = function(input, output) {

    output$tbl_react_mtcars <- renderReactable({


      mtcars %>%
        slice(1) %>% 
        as_tibble() %>%
        select(1:4) %>%
        mutate(list = as.character(selectInput(inputId = "list_1", label = NULL, choices = 1:5))) %>% 
        reactable(columns = list(
          list = colDef(html = T, align = "center")
        ))

    })
    output$tbl_mtcars <- renderText({

      if(is.null(input$list_1)){
        NA
      } else{
          input$list_1
        }

    })
  }
)
)

标签： javascriptrshiny

Answer 1

这是一种方法：

library(shiny)
library(reactable)

js <- "
$(document).on('shiny:value', function(e) {
  if(e.name === 'rtbl'){
    setTimeout(function(){Shiny.bindAll(document.getElementById('rtbl'))}, 0);
  }
});
"

ui <- basicPage(
  tags$head(tags$script(js)),
  h2("Table Data"),
  reactableOutput("rtbl"),
  h2("Selected"),
  textOutput("selection")
)

dat <- iris[1:5,]
dat$select <- c(
  as.character(selectInput(inputId = "list_1", label = NULL, choices = 1:5)),
  rep("", 4)
)

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

  output$rtbl <- renderReactable({
    reactable(dat, columns = list(
      select = colDef(html = TRUE, align = "center")
    ))
  })

  output$selection <- renderText({
    if(is.null(input$list_1)){
      NA
    }else{
      input$list_1
    }
  })

}

shinyApp(ui, server)