如何在R Shiny中使用不同的輸入類型觸發observeEvent和action？

Question

我擁有的

我制作了一個 Shiny 應用程序，它顯示了一些點的情節。

您可以手動更改 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和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)

但這會使您的“縮放以適合”按鈕變得多余。