根据数据表设置更新闪亮的输入答案

【问题标题】：Update shiny input based on datatable settings根据数据表设置更新闪亮的输入
【发布时间】：2020-06-23 15:29:34
【问题描述】：

我在一个闪亮的应用程序中有一个传单地图和数据表，并且有各种输入框来选择要映射的内容。

目前，数据在服务器上基于一组闪亮的输入进行处理，并且该数据被传递给传单和数据表。我还想在数据表上有一个按钮（或双击数据表读取）并根据用户与数据表的交互更新闪亮的输入（即调用shiny::updateSelectizeInput）。

最小代码示例：

if (interactive()) {
  library(shiny)
  library(DT)
  shinyApp(
    ui = fluidPage(
      selectInput("species_selection", "Select species",
                  choices = c("all", as.character(iris$Species)))

      , dataTableOutput("dt")
      )
    , server = function(input, output) {

      output$dt <- renderDataTable({
        if ( input$species_selection != "all" ) {
        for_table <- iris %>%
          filter(Species == input$species_selection)
        } else {
          for_table <- iris
        }
        for_table
        # but also you can click a button or double-click a row on this datatable
        # to update input$species_selection above
      })
    }
  )
}

我知道在这个最小的示例中没有理由这样做，但我确实想在我更大的应用程序的上下文中这样做。我已经看到数据表上的按钮链接到 html 的示例（例如，superzip），我知道数据表闪亮教程告诉您如何使用观察者捕获选定的行。捕捉选定的行是我的备用计划，但我更喜欢行上的按钮或双击。

【问题讨论】：

标签： r shiny dt

【解决方案1】：

当然，但它有点繁琐。我使用 mtcars，因为它有更多种类：

library(shiny)
library(DT)


shinyApp(

    #UI
    ui <- fluidPage(

        selectInput('carb_selection', 'Select carb', choices = c('all', as.character(mtcars$carb))),
        DT::dataTableOutput('dt'),

    ),

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

        #Function to create buttons
        shinyInput <- function(FUN, len, id, ...) {

            inputs <- character(len)
            for (i in seq_len(len)) {
                inputs[i] <- as.character(FUN(paste0(id, i), ...))
            }
            inputs

        }

        #Add buttons to the mtcars dataframe
        mtcars_btn <- reactiveValues(

            data = data.frame(

                mtcars,
                carb_selector = shinyInput(actionButton, nrow(mtcars), 'button_', label = "Select", onclick = 'Shiny.onInputChange(\"select_button\", this.id)'),
                stringsAsFactors = FALSE

            )

        )

        #Output datatable
        output$dt <- DT::renderDataTable(

            if (input$carb_selection == 'all'){

                DT::datatable(mtcars_btn$data, escape = FALSE, selection = 'none', options = list(searching = FALSE, ordering  = FALSE))

            } else {

                DT::datatable(mtcars_btn$data[mtcars_btn$data$carb == input$carb_selection, ], escape = FALSE, selection = 'none', options = list(searching = FALSE, ordering  = FALSE))

            }

        )

        #Observe a button being clicked
        observeEvent(input$select_button, {

            carb_selected <- mtcars_btn$data[as.numeric(strsplit(input$select_button, "_")[[1]][2]),]$carb

            print(paste0('clicked on ', carb_selected))

            updateSelectInput(session, 'carb_selection', selected = carb_selected)

        })

    }

)

请注意，当使用大型数据帧时，您可能希望在本地和服务器处理之间切换。

【讨论】：