Получить только InputID, которые изменились - PullRequest
0 голосов
/ 22 октября 2018

Можно ли выбрать / получить только входные имена виджетов, которые изменились?Скажите, что у меня есть блестящее приложение, и я отменил выбор поля checkboxGroupInput.Можно ли как-нибудь получить inputId этого виджета?

1 Ответ

0 голосов
/ 22 октября 2018

Вот решение с использованием базового блеска:

library(shiny)

ui <- fluidPage(
  titlePanel("Old Faithful Geyser Data"),
  sidebarLayout(
    sidebarPanel(
      sliderInput("bins1",
                  "Number of bins 1:",
                  min = 1,
                  max = 50,
                  value = 30),
      sliderInput("bins2",
                  "Number of bins 2:",
                  min = 1,
                  max = 50,
                  value = 30),
      textOutput("printChangedInputs")
    ),
    mainPanel(
      plotOutput("distPlot1"),
      plotOutput("distPlot2")
    )
  )
)

server <- function(input, output) {

  output$distPlot1 <- renderPlot({
    x    <- faithful[, 2] 
    bins <- seq(min(x), max(x), length.out = input$bins1 + 1)
    hist(x, breaks = bins, col = 'darkgray', border = 'white')
  })

  output$distPlot2 <- renderPlot({
    x    <- faithful[, 2] 
    bins <- seq(min(x), max(x), length.out = input$bins2 + 1)
    hist(x, breaks = bins, col = 'darkgray', border = 'white')
  })

  previousInputStatus <- NULL

  changedInputs <- reactive({
    currentInputStatus <- unlist(reactiveValuesToList(input))
    if(is.null(previousInputStatus)){
      previousInputStatus <<- currentInputStatus
      changedInputs <- NULL
    } else {
      changedInputs <- names(previousInputStatus)[previousInputStatus != currentInputStatus]
      print(paste("Changed inputs:", changedInputs))
      previousInputStatus <<- currentInputStatus
    }
    return(changedInputs)
  })

  output$printChangedInputs <- renderText({paste("Changed inputs:", changedInputs())})

}

shinyApp(ui = ui, server = server)

Редактировать: Другой способ - прослушать событие JavaScript shiny:inputchanged:

library(shiny)

ui <- fluidPage(
  tags$head(
    tags$script(
      "$(document).on('shiny:inputchanged', function(event) {
      if (event.name != 'changed') {
        Shiny.setInputValue('changed', event.name);
      }
    });"
    )
  ),
  titlePanel("Old Faithful Geyser Data"),
  sidebarLayout(
    sidebarPanel(
      sliderInput("bins1",
                  "Number of bins 1:",
                  min = 1,
                  max = 50,
                  value = 30),
      sliderInput("bins2",
                  "Number of bins 2:",
                  min = 1,
                  max = 50,
                  value = 30),
      textOutput("changedInputs")
    ),
    mainPanel(
      plotOutput("distPlot1"),
      plotOutput("distPlot2")
    )
  )
)

server <- function(input, output) {

  output$distPlot1 <- renderPlot({
    x    <- faithful[, 2] 
    bins <- seq(min(x), max(x), length.out = input$bins1 + 1)
    hist(x, breaks = bins, col = 'darkgray', border = 'white')
  })

  output$distPlot2 <- renderPlot({
    x    <- faithful[, 2] 
    bins <- seq(min(x), max(x), length.out = input$bins2 + 1)
    hist(x, breaks = bins, col = 'darkgray', border = 'white')
  })

  output$changedInputs <- renderText({paste("Changed inputs:", input$changed)})

}

shinyApp(ui = ui, server = server)

Для получения дополнительной информации см. this .

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