简体   繁体   English

如何在R Shiny中使用不同的输入类型触发observeEvent和action?

[英]How to trigger observeEvent and action with different input types in R Shiny?

What I have我拥有的

I made a Shiny app that shows a plot with some points.我制作了一个 Shiny 应用程序,它显示了一些点的情节。

You can manually change the y axis.您可以手动更改 y 轴。 There is a button that allows to automatically adjust the y axis so it fits the data.有一个按钮可以自动调整 y 轴,使其适合数据。 There is a drop-down box that allows you to select data.有一个下拉框可让您选择数据。

I have this code:我有这个代码:

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)

What I want to do我想做的事

I want that the fit-y-axis code triggered by the action button will also be triggered when I'm changing the data with the dropdown box.我希望当我使用下拉框更改数据时,也将触发由操作按钮触发的适合 y 轴代码。

Things I've tried:我尝试过的事情:

  1. This . But I think it doesn't like getting a selectInput together with the button.但我认为它不喜欢将selectInput与按钮一起使用。
  2. Putting the fit-y-axis code into a separate function, calling the function from both ydata <- reactive and observeEvent .将适合 y 轴的代码放入一个单独的函数中,从ydata <- reactive observeEventobserveEvent调用该函数。 Did not work.不工作。 Cries about recursion (obviously - it's calling ydata again from inside ydata!).关于递归的呐喊(显然 - 它再次从 ydata 内部调用 ydata!)。

Any help would be appreciated.任何帮助,将不胜感激。

Why not just have another observeEvent that monitors the change in the yaxis input?为什么不只是有另一个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)

But this makes your 'zoom to fit' button redundant.但这会使您的“缩放以适合”按钮变得多余。

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM