Question

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

当前，数据是根据一组闪亮的输入在服务器上处理的，并且该数据同时传递到传单和数据表。我还想在数据表上有一个按钮（或双击数据表），并根据用户与数据表的交互来更新闪亮的输入（即，调用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
      })
    }
  )
}

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

Answer 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)

        })

    }

)

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

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

1 个答案: