How to add observeEvent inside a function?

[xhd...@umd.edu]

I want to add zoom support for multiple plots in my app, so I wanted to create a function to wrap the common logic:

 

  values$location_plot_gg_ranges <- c(x = NULL, y = NULL)

  observeEvent(input$overview_dblclick, {

    brush <- input$overview_brush

    if (!is.null(brush)) {

      values$ranges$x <- c(brush$xmin, brush$xmax)

      values$ranges$y <- c(brush$ymin, brush$ymax)

    } else {

      values$ranges$x <- NULL

      values$ranges$y <- NULL

    }

  })

into this:

  add_zoom <- function(plot_id, reactive_ranges) {

    reactive_ranges <<- c(x = NULL, y = NULL)

    observeEvent(input[[paste0(plot_id, "_dblclick")]], {

      brush <- input[[paste0(plot_id, "_brush")]]

      if (!is.null(brush)) {

        reactive_ranges$x <<- c(brush$xmin, brush$xmax)

        reactive_ranges$y <<- c(brush$ymin, brush$ymax)

      } else {

        reactive_ranges$x <<- NULL

        reactive_ranges$y <<- NULL

      }

    })

  }

  add_zoom("location_plot_gg", values$location_plot_gg_ranges)

However the event didn't get registered. I read the help on observeEvent and thought maybe it was autodestroyed or not registered in correct domain. I tried to use event.env = parent.frame(2) to evaluate it in outside of function, but that will lost access to the variables inside the function. I disabled the autodestory option but it is still not registered.

Is there a better way to add zoom support in batch?

[Bárbara Borges]

You cannot contain observers inside functions in the way that you seem to want to do here. But you can contain the logic of what goes inside the observer in a a function (that doesn't return any value). I think you can also get rid of all the super assign operators (I'm assuming values is a reactiveValues() object). In your case, this would be something like:

add_zoom <- function(plot_id, reactive_ranges) {

     brush <- input[[paste0(plot_id, "_brush")]]

     if (!is.null(brush)) {

       reactive_ranges$x <- c(brush$xmin, brush$xmax)

       reactive_ranges$y <- c(brush$ymin, brush$ymax)

     } else {

       reactive_ranges$x <- NULL

       reactive_ranges$y <- NULL

     }

 }

observeEvent(input$overview_dblclick, add_zoom("overview", values$overview_ranges))

[xhd...@umd.edu]

Thanks for the answer, it worked!

I'm still confused about the concept though.

I wanted to wrap the repetitive logic into function as much as possible, so I was trying to initialize reactive_ranges in the function too. I understand observeEvent was intended for its side effect, so I was wondering maybe the side effect didn't happen in right environment when it was called inside my function. Now the function will work but I need to maintain some moving parts for every function.

One thing I found not perfect in Shiny programming is that you need to maintain some constraints manually. For example the input/output id were declared as string, then used in list, and some variables are used with an naming convention (like you have a table "dt" then row selected will be "dt_rows_selected"). And for zooming support we defined the brush id and double click id in UI, then you need to remember using them in a different format in server.

I'm wondering if it's possible to have some kind of check, or have an inspect mode when a shiny program is running, which will show the input/output list with key widgets and properties. Then we can check to make sure all declared/used id should match and no missing/unused ids.

I attached a minimal example showing 3 methods of adding zoom if that can helps.

Thanks for the help!

[Bárbara Borges]

I'll to try to answer as much of your question as I can:

1) The fact that you cannot contain an observer inside a function is because a function is callable, while an observer isn't. You don't call an observer and tell it when to execute -- that's its job. I think you might have been misunderstanding an observer as just a function without return values, but that's not true. While an observer does not return anything, it also isn't callable, so you can't contain it in a callable type, like a function. I don't think this is about environments at all -- that concept isn't even that important for reactive programming, where we usually talk of reactive contexts. Again, however, I don't think this is the problem here.

2) I don't quite understand why you'd want to initialize reactive_ranges inside the function? Isn't that one of the parameters/arguments you pass in? If there is no predetermined value for reactive_ranges, then of course you can create it inside the function and keep it contained in that way.

3) You can use lapply or a similar function to avoid repetition/boilerplate if you have a lot of similar observers.

4) A lot of Shiny "extensions" (like the dt properties and the plot click, brush etc...) were not planned in advanced, so the final spec ends up being a little arbitrary. We don't have any checks to see if all inputs and outputs declared in the UI are used in the server. Part of this is because this isn't always supposed to be so -- if you have dynamic outputs, they'll be present in the server, but not in the UI. If you find that your code is getting unreadable as a consequence, I'd recommend using modules, where it's a lot easier (compered to a large app) to see what goes with what..

[xhd...@umd.edu]

Thanks for the detailed answer!

1) My previous experience with Java lead me to think observeEvent is to register a observer function, which is executed when the event was triggered. I read the help and source code about observeEvent and observe, try to understand what really happened when observeEvent was used, what side effect happened but still was not clear about it. As you said the reactive programming is quite different so I will try to read more.

2) I tried to initialize the reactive value to reduce the boilerplate code, so values as a reactiveValues is initialized but values$plot1_ranges is actually just declared when calling the function. To add a zoom control to a plot there are quite several things to do, I tried to abstract as much as possible.

3) Thanks for the tip, I'll try lapply. I also read in a previous discussion by Joe Cheng that you can use lapply for reactive while for loop may have problem because of evaluation context.

4) You are right, considering the dynamic UI cases it will be difficult to check them. I found the code is actually easy to read, just there are some moving parts need to be synced by human, so if I changed some parts I need to remember to change all the corresponding parts accordingly.

[Bárbara Borges]

1) That is not wrong. In fact, that is exactly what happens if you do this:

# Naive approach (only works once)

ui <- fluidPage(

  radioButtons("rd1", "Radio buttons 1", 1),

  radioButtons("rd2", "Radio buttons 2", 1),

  actionButton("go", "Add choices")

)

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

  add_choices <- function(id, choices) {

    observeEvent(input$go, {

      updateRadioButtons(session, id, choices = choices)

    })

  }

  

  add_choices("rd1", sample(1:100, 3))

  add_choices("rd2", sample(1:100, 3))

}

shinyApp(ui, server)

The problem is that this is probably not what you want to do, since it only "works" the first time around. Since Shiny has its own event loop, the observers created with the app above will always have choices equal to whatever the first vector was. So this approach would only work if you only needed the observer to be called once. And even in though cases, the fact that it doesn't behave as you'd expect is reason enough to discourage its use.

here's what I'd recommend you do instead:

# Shiny idiomatic approach (don't declare observers in functions that 

# will be called later)

ui <- fluidPage(

  radioButtons("rd1", "Radio buttons 1", 1),

  radioButtons("rd2", "Radio buttons 2", 1),

  actionButton("go", "Add choices")

)

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

  add_choices <- function(id, choices) {

    updateRadioButtons(session, id, choices = choices)

  }

  

  ### Option 1: (this is necessary if the triggering events are different)

  # observeEvent(input$go, add_choices("rd1", sample(1:100, 3)))

  # observeEvent(input$go, add_choices("rd2", sample(1:100, 3)))

  

  ### Option 2: (more conside and good enough for our case)

  observeEvent(input$go, {

    add_choices("rd1", sample(1:100, 3))

    add_choices("rd2", sample(1:100, 3))

  })

}

shinyApp(ui, server)

3) This gist goes over using lapply vs for loops in Shiny: https://gist.github.com/bborgesr/e1ce7305f914f9ca762c69509dda632e. In case it is of any help :)

[Joe Cheng [RStudio]]

Sorry for not weighing in earlier. I think it's quite reasonable to do what was requested in the original message (note that this is the original code verbatim and doesn't work):

 add_zoom <- function(plot_id, reactive_ranges) {

  reactive_ranges <<- c(x = NULL, y = NULL)

  observeEvent(input[[paste0(plot_id, "_dblclick")]], {

    brush <- input[[paste0(plot_id, "_brush")]]

    if (!is.null(brush)) {

      reactive_ranges$x <<- c(brush$xmin, brush$xmax)

      reactive_ranges$y <<- c(brush$ymin, brush$ymax)

    } else {

      reactive_ranges$x <<- NULL

      reactive_ranges$y <<- NULL

    }

  })

}

add_zoom("location_plot_gg", values$location_plot_gg_ranges)

It's totally fine to call observeEvent inside of functions. However, there is a bug in the way the `values$location_plot_gg_ranges` is passed and then assigned to--the <<- operator doesn't nearly do what you're expecting it to here, nor would you want it to. It's almost like you're trying to pass `values$location_plot_gg_ranges` "by reference", as we'd say in C; you can't do that, but you can pass `values` itself by reference.

You could do this instead:

add_zoom <- function(plot_id, rvalues, slot) {

  rvalues[[slot]] <- list(x = NULL, y = NULL)

  observeEvent(input[[paste0(plot_id, "_dblclick")]], {

    brush <- input[[paste0(plot_id, "_brush")]]

    if (!is.null(brush)) {

      rvalues[[slot]]$x <- c(brush$xmin, brush$xmax)

      rvalues[[slot]]$y <- c(brush$ymin, brush$ymax)

    } else {

      rvalues[[slot]]$x <- NULL

      rvalues[[slot]]$y <- NULL

    }

  })

}

add_zoom("location_plot_gg", values, "location_plot_gg_ranges")

but the add_zoom API is then a little strange, in that you're passing a reactive values object and slot name in. Since the ranges value will not be overwritten by anyone else (right?) we could simplify the add_zoom API by having it return a reactive expression:

add_zoom <- function(plot_id) {

  rv <- reactiveValues(range = list(x = NULL, y = NULL))

  observeEvent(input[[paste0(plot_id, "_dblclick")]], {

    brush <- input[[paste0(plot_id, "_brush")]]

    if (!is.null(brush)) {

      rv$range$x <- c(brush$xmin, brush$xmax)

      rv$range$y <- c(brush$ymin, brush$ymax)

    } else {

      rv$range$x <- NULL

      rv$range$y <- NULL

    }

  })

  reactive(rv$range)

}

location_plot_gg_range <- add_zoom("location_plot_gg", values, "location_plot_gg_ranges")

Then elsewhere in your UI you can use location_plot_gg_range() to reactively read the brushed range.

By the way, you're coming pretty close to Shiny Modules at this point... https://shiny.rstudio.com/articles/modules.html

Hope this helps.

[xhd...@umd.edu]

Hi Joe,

Thanks so much for the reply! Your solutions are really smart.

So the first version passed the components needed to reference the value in variables, then the dynamically assembled expression access the value we want directly.

Then the second version focused on the reactive value of "range" and return it only, with the observeEvent happened as side effect. In this way we don't even need a global reactive value to hold the range, since it's just some operations applied to brush values.

Though that lead me to think maybe we don't need the extra layer of rv$range, and we also don't need the reactive wrapper. I put all versions in same app to test it, the plot 5 with my modifications seemed work, but I'm not sure if there is any problem with it.

full code below, also in attachment if that is easier to copy
-----------------------------
library(ggplot2)
library(shiny)

options(shiny.trace = TRUE)

ui <- fluidPage(
  fluidRow(
    column(width = 4, class = "well",
      h4("zoom1"),
      plotOutput("plot1", height = 300,
        dblclick = "plot1_dblclick",
        brush = brushOpts(
          id = "plot1_brush",
          resetOnNew = TRUE
        )
      )
    ),
    column(width = 4, class = "well",
      h4("zoom2"),
      plotOutput("plot2", height = 300,
        dblclick = "plot2_dblclick",
        brush = brushOpts(
          id = "plot2_brush",
          resetOnNew = TRUE
        )
      )
    ),
    column(width = 4, class = "well",
      h4("zoom3"),
      plotOutput("plot3", height = 300,
        dblclick = "plot3_dblclick",
        brush = brushOpts(
          id = "plot3_brush",
          resetOnNew = TRUE
        )
      )
    )
  ),
  fluidRow(
    column(width = 4, class = "well",
      h4("zoom4"),
      plotOutput("plot4", height = 300,
        dblclick = "plot4_dblclick",
        brush = brushOpts(
          id = "plot4_brush",
          resetOnNew = TRUE
        )
      )
    ),
    column(width = 4, class = "well",
    h4("zoom5"),
    plotOutput("plot5", height = 300,
      dblclick = "plot5_dblclick",
      brush = brushOpts(
        id = "plot5_brush",
        resetOnNew = TRUE
      )
    )
  )
  )
)

server <- function(input, output) {
  # plot 1, add zoom with regular approach ----
  values <- reactiveValues()
  values$plot1_ranges <- reactiveValues(x = NULL, y = NULL)

  output$plot1 <- renderPlot({
    ggplot(mtcars, aes(wt, mpg)) +
      geom_point() +
      coord_cartesian(xlim = values$plot1_ranges$x, ylim = values$plot1_ranges$y)
  })

  # When a double-click happens, check if there's a brush on the plot.
  # If so, zoom to the brush bounds; if not, reset the zoom.
  observeEvent(input$plot1_dblclick, {
    brush <- input$plot1_brush
    if (!is.null(brush)) {
      values$plot1_ranges$x <- c(brush$xmin, brush$xmax)
      values$plot1_ranges$y <- c(brush$ymin, brush$ymax)

    } else {
      values$plot1_ranges$x <- NULL
      values$plot1_ranges$y <- NULL
    }
  })

  # plot 2, call function in observeEvent expression parameter ----
  values$plot2_ranges <- reactiveValues(x = NULL, y = NULL)

  add_zoom <- function(plot_id, reactive_ranges) {
    brush <- input[[paste0(plot_id, "_brush")]]
    if (!is.null(brush)) {
      reactive_ranges$x <- c(brush$xmin, brush$xmax)
      reactive_ranges$y <- c(brush$ymin, brush$ymax)
    } else {
      reactive_ranges$x <- NULL
      reactive_ranges$y <- NULL
    }
  }

  output$plot2 <- renderPlot({
    ggplot(mtcars, aes(wt, mpg)) +
      geom_point() +
      coord_cartesian(xlim = values$plot2_ranges$x, ylim = values$plot2_ranges$y)
  })
  observeEvent(input$plot2_dblclick, add_zoom("plot2", values$plot2_ranges))

  # plot 3, use varialbe$slot separately ----
  add_zoom_slot <- function(plot_id, rvalues, slot) {

    rvalues[[slot]] <- list(x = NULL, y = NULL)
    observeEvent(input[[paste0(plot_id, "_dblclick")]], {
      brush <- input[[paste0(plot_id, "_brush")]]
      if (!is.null(brush)) {
        rvalues[[slot]]$x <- c(brush$xmin, brush$xmax)
        rvalues[[slot]]$y <- c(brush$ymin, brush$ymax)
      } else {
        rvalues[[slot]]$x <- NULL
        rvalues[[slot]]$y <- NULL
      }
    })
  }

  output$plot3 <- renderPlot({
    ggplot(mtcars, aes(wt, mpg)) +
      geom_point() +
      coord_cartesian(xlim = values$plot3_ranges$x, ylim = values$plot3_ranges$y)
  })
  add_zoom_slot("plot3", values, "plot3_ranges")
  # plot 4, reactive expression ----
  add_zoom_exp <- function(plot_id) {

    rv <- reactiveValues(range = list(x = NULL, y = NULL))
    observeEvent(input[[paste0(plot_id, "_dblclick")]], {
      brush <- input[[paste0(plot_id, "_brush")]]
      if (!is.null(brush)) {
        rv$range$x <- c(brush$xmin, brush$xmax)
        rv$range$y <- c(brush$ymin, brush$ymax)
      } else {
        rv$range$x <- NULL
        rv$range$y <- NULL
      }
    })
    reactive(rv$range)
  }

  plot4_range <- add_zoom_exp("plot4")

  output$plot4 <- renderPlot({
    ggplot(mtcars, aes(wt, mpg)) +
      geom_point() +
      coord_cartesian(xlim = plot4_range()$x, ylim = plot4_range()$y)
  })
  # plot 5, reactive expression with less level ----
  add_zoom_exp_2 <- function(plot_id) {
    ranges <- reactiveValues(x = NULL, y = NULL)

    observeEvent(input[[paste0(plot_id, "_dblclick")]], {
      brush <- input[[paste0(plot_id, "_brush")]]
      if (!is.null(brush)) {

        ranges$x <- c(brush$xmin, brush$xmax)
        ranges$y <- c(brush$ymin, brush$ymax)
      } else {
        ranges$x <- NULL
        ranges$y <- NULL
      }
    })
    ranges
  }
  plot5_range <- add_zoom_exp_2("plot5")
  output$plot5 <- renderPlot({
    ggplot(mtcars, aes(wt, mpg)) +
      geom_point() +
      coord_cartesian(xlim = plot5_range$x, ylim = plot5_range$y)
  })

}
shinyApp(ui = ui, server = server)

[xhd...@umd.edu]

After reading more carefully, I believe Joe's version should be the idiomatic way. My plot5 works because ranges happened to hold x and y reactive values. ranges itself is not reactive so we don't need to wrap with reactive() in return expression, the usage of ranges$x accessed the reactive value part.

So if we write a zoom that only zoom in x axis and return the x part directly, we will need to use the reactive() expression:

-----
  # plot 6, reactive value ----
  add_zoom_exp_3 <- function(plot_id) {

    ranges <- reactiveValues(x = NULL, y = NULL)
    observeEvent(input[[paste0(plot_id, "_dblclick")]], {
      brush <- input[[paste0(plot_id, "_brush")]]
      if (!is.null(brush)) {
        ranges$x <- c(brush$xmin, brush$xmax)
        ranges$y <- c(brush$ymin, brush$ymax)
      } else {
        ranges$x <- NULL
        ranges$y <- NULL
      }
    })

    reactive(ranges$x)
  }
  plot6_range_x <- add_zoom_exp_3("plot6")
  output$plot6 <- renderPlot({

    ggplot(mtcars, aes(wt, mpg)) +
      geom_point() +

      coord_cartesian(xlim = plot6_range_x())
  })

By the way I do intend to read more about modules, which should be the way to go since I will have a lot of plots and adding many similar features to them.