Получить событие, которое запускается в Shiny и с grep (сгенерированный ввод) - PullRequest
Новая
       17

Получить событие, которое запускается в Shiny и с grep (сгенерированный ввод)

1 голос
/ 26 июня 2019

Я сгенерировал ввод, _1, _2 и т. Д. ... но я хочу знать, какое событие сработало.

Но оба не работают, .clientdata_output_aFired_hidden и d уволены. В моем реальном приложении также запускаются другие события, скрытые или связанные с реактивными значениями.

И без input$changed это работает, но не зная, какой выстрел. 

ui <- fluidPage(
  tags$head(
    tags$script(
      "$(document).on('shiny:inputchanged', function(event) {
          if (event.name != 'changed') {
            Shiny.setInputValue('changed', event.name);
          }
        });"
    )
  ),
  numericInput("a_1", "a_1", 0),
  textInput("a_2", "a_2"),
  textInput("c", "c"),
  textInput("d", "d"),



 p("changedInputs"), textOutput("changedInputs"),br(),
 p("aFired"),textOutput("aFired")
)

server <- function(input, output, session) {
  output$changedInputs <- renderText({
    paste("Outside observer: Latest input fired:", paste(input$changed, collapse = ", "))
  })

  observeEvent({
    lapply(
      (grep(pattern = "a_+[[:digit:]]|c"
      , x = names((input)), value = TRUE)),
      function(x) (input)[[x]]
    )
  }, {
    req(input$changed)
    if (input$changed == "a_1") {
      output$aFired <- renderText("Inside observer: input$a_1 was fired")
    } else  if (input$changed == "a_2") {
      output$aFired <- renderText("Inside observer: input$a_2 was fired")
    } else {
      output$aFired <- renderText((input$changed))
    }
  }, ignoreInit = TRUE)
}

shinyApp(ui, server)

1 Ответ

1 голос
/ 26 июня 2019

Были две проблемы, которые необходимо было решить:

  1. ваше регулярное выражение |c перехвачено input$changed
  2. вам нужно использовать isolate(names(input)) внутри выражения события, в противном случаенаблюдатель будет срабатывать при каждом изменении names(input)
  3. Редактировать: использовать isolate({input$changed}) - см. комментарии (не требуется при использовании reactiveVal()) 
ui <- fluidPage(
  tags$head(
    tags$script(
      "$(document).on('shiny:inputchanged', function(event) {
          if (event.name != 'changed') {
            Shiny.setInputValue('changed', event.name);
          }
        });"
    )
  ),
  numericInput("a_1", "a_1", 0),
  textInput("a_2", "a_2"),
  textInput("c", "c"),
  textInput("d", "d"),

  p("changedInputs:"), textOutput("changedInputs"), br(),
  p("aFired:"), textOutput("aFired")
)

server <- function(input, output, session) {
  output$changedInputs <- renderText({
    paste("Outside observer: Latest input fired:", paste(input$changed, collapse = ", "))
  })

  observeEvent(eventExpr = {
    lapply(grep(pattern = "^a_+[[:digit:]]$|^c$", x = isolate({names(input)}), value = TRUE), function(x){input[[x]]})
  }, handlerExpr = {
    req(input$changed)
    if (input$changed == "a_1") {
      output$aFired <- renderText("Inside observer: input$a_1 was fired")
    } else  if (input$changed == "a_2") {
      output$aFired <- renderText("Inside observer: input$a_2 was fired")
    } else {
      output$aFired <- renderText({paste("Inside observer:", isolate({input$changed}), "was fired")})
    }
  }, ignoreInit = TRUE)
}

shinyApp(ui, server)

Другое редактирование: Теперь я помню, где потерялся isolate({input$changed}) (я был уверен, что он работал во время моих тестов ...) Изначально я подозревал, что renderText() вложено внутрьНаблюдатель может вызвать проблемы, соответственно я реализовал reactiveVal() для вывода на печать.Это решение работает без isolate({input$changed}): 

ui <- fluidPage(
  tags$head(
    tags$script(
      "$(document).on('shiny:inputchanged', function(event) {
          if (event.name != 'changed') {
            Shiny.setInputValue('changed', event.name);
          }
        });"
    )
  ),
  numericInput("a_1", "a_1", 0),
  textInput("a_2", "a_2"),
  textInput("c", "c"),
  textInput("d", "d"),

  p("changedInputs:"), textOutput("changedInputs"), br(),
  p("aFired:"), textOutput("aFired")
)

server <- function(input, output, session) {
  output$changedInputs <- renderText({
    paste("Outside observer: Latest input fired:", paste(input$changed, collapse = ", "))
  })

  myText <- reactiveVal()

  observeEvent(eventExpr = {
    lapply(grep(pattern = "^a_+[[:digit:]]$|^c$", x = isolate({names(input)}), value = TRUE), function(x){input[[x]]})
  }, handlerExpr = {
    req(input$changed)
    if (input$changed == "a_1") {
      myText("Inside observer: input$a_1 was fired")
    } else  if (input$changed == "a_2") {
      myText("Inside observer: input$a_2 was fired")
    } else {
      myText(paste("Inside observer:", input$changed, "was fired"))
    }
  }, ignoreInit = TRUE)

  output$aFired <- renderText({myText()})

}

shinyApp(ui, server)

Узнав о реальных проблемах и разместив здесь ответ, я вернулся к версии без reactiveVal() (так как она ближе к вашему вопросу) изабыл isolate.Соответственно вы получили смесь обеих версий в первую очередь.

...