如何在 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)

我想做的事

我希望当我使用下拉框更改数据时，动作按钮触发的 fit-y 轴代码也将被触发。

我尝试过的事情：

1. This。但我认为它不喜欢将selectInput 与按钮放在一起。
2. 将 fit-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)

但这会使您的“缩放以适应”按钮变得多余。