在 Shiny App 中双击 table 更新 selectInput

Question

在下面的 Shiny App 中，我想根据用户在 tab 3 的 table 中双击的行更新 selectInput 框的值。例如，如果用户双击 table 中的第 3 行，则 selectInput 的值应更改为 3。

这是我的代码 -

library(shiny)
library(shinydashboard)

siderbar <- dashboardSidebar(
  sidebarMenu(
    # Add buttons to choose the way you want to select your data
    selectizeInput(inputId = "select_by", label = "Select by:",
                   choices = c(as.character(1:5)))
  )   
)

body <- dashboardBody(
  fluidRow(
    tabBox(
      side = "right",
      selected = "Tab3",
      tabPanel("Tab1", "Tab content 1", textOutput("tabset1Selected")),
      tabPanel("Tab2", "Tab content 2", textOutput("tabset2Selected")),
      tabPanel("Tab3", "Tab content 3", textOutput("tabset3Selected"), 
               DT::dataTableOutput("table", width = "100%", height = "100%"), color="#bb0a1e", size = 1.5, type = 8)
    )
  ),
)

shinyApp(
  ui = dashboardPage(
    dashboardHeader(title = "tabBoxes"),
    siderbar,
    body
  ),
  server = function(session, input, output) {
    # The currently selected tab from the first box
    output$tabset1Selected <- output$tabset2Selected <- output$tabset3Selected <- renderText({
      input$select_by
    })
    
    outputOptions(output, "tabset1Selected", suspendWhenHidden = FALSE)
    outputOptions(output, "tabset2Selected", suspendWhenHidden = FALSE)
    outputOptions(output, "tabset3Selected", suspendWhenHidden = FALSE)
    
    table_dt <- reactive({data.table(values = c(1,2,3,4,5))})
    
    output$table <- DT::renderDataTable({
      DT::datatable(table_dt(), filter = 'top', selection = "single", fillContainer = TRUE, width = "90%",
                    callback = htmlwidgets::JS(
                      "table.on('dblclick', 'td',", 
                      "  function() {",
                      "    var data = table.row(this).data();",
                      "    Shiny.setInputValue('table_tbl_dblclick', {dt_data: data});",
                      "  }",
                      ");"
                    ))
    }
    )
    
    observeEvent(input$table_tbl_dblclick, {
      reactTXT$selected <- input$table_tbl_dblclick$dt_data[[2]] # Since table index starts with 0, adding 1 to map index with data.table
    })
    
    reactTXT <- reactiveValues()
    observeEvent(eventExpr = input$select_by, handlerExpr = {
      req(input$select_by)
      reactTXT$selected <- input$select_by
      updateSelectizeInput(session, "select_by", selected = reactTXT$selected)
    }, ignoreInit = TRUE)
    
  }
)

有人可以指出在 table 中单击后 selectInput 没有更新的原因吗？

Answer 1

我不太明白你的 observeEvents 的目的是什么。如果只是更新选择输入，这个对我有用：

observeEvent(input$table_tbl_dblclick, {
  updateSelectizeInput(session, "select_by", selected = input$table_tbl_dblclick$dt_data[[2]])
})

更新替代方案以保留 reactTXT 作为新值的来源：

observeEvent(input$table_tbl_dblclick, {
  selected <- input$table_tbl_dblclick$dt_data[[2]] # Since table index starts with 0, adding 1 to map index with data.table
  reactTXT$selected <- selected
})

reactTXT <- reactiveValues()
observeEvent(reactTXT$selected, handlerExpr = {
  updateSelectizeInput(session, "select_by", selected = reactTXT$selected)
}, ignoreInit = TRUE)

来自下方评论

在 Shiny App 中双击 table 更新 selectInput

Update selectInput on the double click of table in Shiny App

r

shiny