Обновление блестящего ввода на основе настроек данных - PullRequest
Новая
       5

Обновление блестящего ввода на основе настроек данных

0 голосов
/ 11 марта 2020

У меня есть листовка с таблицей данных в блестящем приложении, и у меня есть различные поля ввода для выбора того, что отображается.

В настоящее время данные обрабатываются на сервере на основе набора блестящих входов, и это данные передаются как на листок, так и на датированный. Я также хотел бы иметь кнопку для таблицы данных (или прочитать двойные щелчки на таблице данных) и обновить блестящий ввод (т. Е. Вызвать 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, и я знаю, что датированные блестящие учебники расскажут вам, как поймать выбранные строки с помощью наблюдателя. Поймать выбранные строки - это мой план резервного копирования, но я бы предпочел кнопку в строке или двойной щелчок.

1 Ответ

1 голос
/ 12 марта 2020

Конечно, но немного странно. Я использовал mtcars, так как он более разнообразен:

input buttons in datatable 

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)

        })

    }

)

Обратите внимание, что вы можете переключаться между sh локальная и серверная обработка при использовании больших фреймов данных.

...