CODEWITHSUNDEEP
rshiny
Gimelist
Gimelist

Reputation: 823

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.

You can manually change the y axis. There is a button that allows to automatically adjust the y axis so it fits the data. 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.

Things I've tried:

  1. This. But I think it doesn't like getting a selectInput together with the button.
  2. Putting the fit-y-axis code into a separate function, calling the function from both ydata <- reactive and observeEvent. Did not work. Cries about recursion (obviously - it's calling ydata again from inside ydata!).

Any help would be appreciated.

Upvotes: 1

Views: 624

Answers (1)

Mr.Rlover
Mr.Rlover

Reputation: 2623

Why not just have another observeEvent that monitors the change in the yaxis input? 

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.

Upvotes: 1

Related Questions