Pass 'observeEvent' output to Action button

Question

I am displaying a dynamic map in an R Shiny session using leaflet. I am allowing a user to draw a bounding box around an area, which generates an extent object. I would like to pass the result of the user-defined bounding box to raster which will crop the appropriate area (as defined in the bounding box) and plot the output. In short, the result of observeEvent needs to be passed to the actionButton. When the actionButton is pressed, the raster cropping needs to occur.

I cannot figure out how to link observeEvent with actionButton. As you will see in the reproducible code below, I can successfully display the bounding box results on-screen. I have commented the code below where the appropriate actions need to occur.

I have included a raster so that there is an object available for cropping.

library(shiny)
library(leaflet)
library(leaflet.extras)
library(sf)
library(raster)

# Downloads some Worldclim data for cropping
r<-getData('worldclim', var='bio', res=10)
r<-r[[1]]

# Crop 'r' when action button is pressed
ui <- fluidPage(
  leafletOutput("map"),
  p("Your area of extent is:"),
  textOutput("poly"),

  # actionButton takes as input the result of observeEvent
  # Crop 'r' when action button is pressed
  actionButton(inputId = "", label = "Crop") 

)

server <- function(input, output, session) {
  output$map <- renderLeaflet({
    m <- leaflet() %>% 

      addRasterImage(group="Worldclim", r, opacity = 0.75) %>% 

      addDrawToolbar(polylineOptions = F, circleOptions = F, markerOptions = F,
                     circleMarkerOptions = F, polygonOptions = F)
  })

  observeEvent(input$map_draw_new_feature, {
    feat <- input$map_draw_new_feature
    coords <- unlist(feat$geometry$coordinates)
    coords <- matrix(coords, ncol = 2, byrow = T)
    poly <- st_sf(st_sfc(st_polygon(list(coords))), crs = st_crs(27700))
    print(st_bbox(poly))
    output$poly<-renderPrint(st_bbox(poly))
  })
}

shinyApp(ui, server)

Answer 1

There are several ways of doing that, you could either use reactiveVal(), reactiveValues() or a reactive().

This example below uses reactiveVal() which is named bboxRV and initialized with NULL. Once you get the rectangle's bbox you assign it to the reactiveVal like this bboxRV(value).

You also have to assign an inputId to the actionButton, so you can listen for the action in an observeEvent(). Here the inputId is "action" and then your observeEvent looks like: observeEvent(input$action, {...}).

And finally, you can access this value anywhere in the server, so you dont have to put the renderPrint inside the observeEvent. With req(bboxRV()) you wait until a value is assigned, as a NULL value will raise a silent error and stop the execution there.

I made some adjustments so it better suits your expectations. As you want to crop the raster with the drawn rectangle, its better to use extent instead of st_bbox. After you crop the raster, you assign the new raster to another reactiveVal (croppedRaster), which is then plotted below the actionButton.

And you might have to justify the rectangle's coordinates to the maximum extent of the input raster. You could either fix the bounds for leaflet or you transform the rectangles coordinates to be inside the raster's extent. There is a function for that, but I forgot the name and where to look for it.

Otherwise it might happen that you draw a rectangle with an extent that doesn't overlap which will give you this error:

Error in .local: extents do not overlap

library(shiny)
library(leaflet)
library(leaflet.extras)
library(sf)
library(raster)

# Downloads some Worldclim data for cropping
r<-getData('worldclim', var='bio', res=10)
r<-r[[1]]

# Crop 'r' when action button is pressed
ui <- fluidPage(
  leafletOutput("map"),
  p("Your area of extent is:"),
  textOutput("poly"),

  # actionButton takes as input the result of observeEvent
  # Crop 'r' when action button is pressed
  actionButton(inputId = "action", label = "Crop"),
  ## Plot the cropped raster
  plotOutput("cropimg")
)

server <- function(input, output, session) {
  output$map <- renderLeaflet({
    leaflet() %>% 
      addRasterImage(group="Worldclim", r, opacity = 0.75) %>% 
      addDrawToolbar(polylineOptions = F, circleOptions = F, markerOptions = F,
                     circleMarkerOptions = F, polygonOptions = F)
  })

  bboxRV <- reactiveVal(NULL)

  observeEvent(input$map_draw_new_feature, {
    feat <- input$map_draw_new_feature
    coords <- unlist(feat$geometry$coordinates)
    coords <- matrix(coords, ncol = 2, byrow = T)
    poly <- st_sf(st_sfc(st_polygon(list(coords))), crs = st_crs(27700))
    # use Extent not BBOX
    bbox <- extent(poly)
    bboxRV(bbox)
  })

  output$poly <- renderPrint({
    req(bboxRV())
    bboxRV()
  })

  ## ReactiveValue for the cropped Image
  croppedRaster <- reactiveVal(NULL)

  observeEvent(input$action, {
    req(bboxRV())
    getbbox <- bboxRV()
    print("Do whatever with bbox after the actionButton is clicked")
    cropedr <- crop(r, getbbox)
    ## Assign cropped raster to reactiveVal
    croppedRaster(cropedr)
  })

  output$cropimg <- renderPlot({
    req(croppedRaster())
    ## Plot cropped raster
    plot(croppedRaster())
  })
}

shinyApp(ui, server)