Как запустить Наблюдение за событиями и действиями с различными типами ввода в R Shiny?

Question

Что у меня есть

Я сделал блестящее приложение, которое показывает график с некоторыми точками.

Вы можете вручную изменить ось y. Есть кнопка, которая позволяет автоматически регулировать ось y, чтобы она соответствовала данным. Существует раскрывающийся список, в котором можно выбрать данные.

У меня есть этот код:

library(shiny)

# user interface ----------------------------------------------------------

ui <- fluidPage(

  fluidRow(plotOutput("myplot")),
  tabsetPanel(
    tabPanel(
      "Input",
      fluidRow(

        column(
          2,
          numericInput(inputId = "ymax", label = "y-axis maximum", value = 30),
          numericInput(inputId = "ymin", label = "y-axis minimum", value = 9),
          actionButton("fity", label = "zoom to fit")
        ),
        column(
          2,
          selectInput(inputId = "yaxis", label = "y-axis",
                      choices = list("1 to 5" = 1,
                                     "3 to 7" = 2)
          ),
          checkboxInput("mybx", label = "checkbox", value = TRUE)
        )
      )
    ),
    fluidRow()
  )
)


# server function ---------------------------------------------------------



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

  ydata <- reactive({
    switch(input$yaxis,
           "1" = {
             updateCheckboxInput(session, "mybx", value = TRUE)
             1:5},
           "2" = {
             updateCheckboxInput(session, "mybx", value = FALSE)
             3:7}
    )
  })

  observeEvent(input$fity, {
    newymax <- trunc(max(ydata())) + 1
    newymin <- trunc(min(ydata()))
    updateNumericInput(session, "ymax", value = newymax)
    updateNumericInput(session, "ymin", value = newymin)}
  )

  output$myplot <- renderPlot({

    par(mar = c(4, 4, 0.1, 0.1))
    plot(x = 1:5, y = ydata(), ylim = c(input$ymin, input$ymax))
  })
}

shinyApp(ui = ui, server = server)

Что я хочу сделать

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

То, что я пробовал:

1. Это . Но я думаю, что не нравится собирать selectInput вместе с кнопкой.
2. Помещать код подгонки по оси Y в отдельную функцию, вызывая функцию из ydata <- reactive и observeEvent. Не сработало. Плачет о рекурсии (очевидно - он снова вызывает ydata изнутри ydata!).

Любая помощь будет признательна.

Answer 1

Почему бы просто не иметь еще один observeEvent, который отслеживает изменение входа yaxis?

library(shiny)

# user interface ----------------------------------------------------------

ui <- fluidPage(

  fluidRow(plotOutput("myplot")),
  tabsetPanel(
    tabPanel(
      "Input",
      fluidRow(

        column(
          2,
          numericInput(inputId = "ymax", label = "y-axis maximum", value = 30),
          numericInput(inputId = "ymin", label = "y-axis minimum", value = 9),
          actionButton("fity", label = "zoom to fit")
        ),
        column(
          2,
          selectInput(inputId = "yaxis", label = "y-axis",
                      choices = list("1 to 5" = 1,
                                     "3 to 7" = 2)
          ),
          checkboxInput("mybx", label = "checkbox", value = TRUE)
        )
      )
    ),
    fluidRow()
  )
)


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

  ydata <- reactive({
    switch(input$yaxis,
           "1" = {
             updateCheckboxInput(session, "mybx", value = TRUE)
             1:5},
           "2" = {
             updateCheckboxInput(session, "mybx", value = FALSE)
             3:7}
    )
  })

  observeEvent(input$fity, {
    newymax <- trunc(max(ydata())) + 1
    newymin <- trunc(min(ydata()))
    updateNumericInput(session, "ymax", value = newymax)
    updateNumericInput(session, "ymin", value = newymin)}
  )

  observeEvent(input$yaxis, {
    newymax <- trunc(max(ydata())) + 1
    newymin <- trunc(min(ydata()))
    updateNumericInput(session, "ymax", value = newymax)
    updateNumericInput(session, "ymin", value = newymin)}
  )


  output$myplot <- renderPlot({

    par(mar = c(4, 4, 0.1, 0.1))
    plot(x = 1:5, y = ydata(), ylim = c(input$ymin, input$ymax))
  })
}

shinyApp(ui = ui, server = server)

Но это делает вашу кнопку «масштабировать по размеру» лишней.