将“observeEvent”输出传递给操作按钮

我正在使用 R Shiny 会话中显示动态地图leaflet。我允许用户在一个区域周围绘制一个边界框，这会生成一个范围对象。 我想将用户定义的边界框的结果传递给raster这将裁剪适当的区域（如边界框中所定义）并绘制输出。简而言之，结果是observeEvent需要传递给actionButton。当。。。的时候actionButton被按下时，raster需要进行裁剪。

我不知道如何链接observeEvent with actionButton。正如您将在下面的可重现代码中看到的，我可以成功在屏幕上显示边界框结果。我已对下面需要执行适当操作的代码进行了注释。

我已经包含了一个光栅，以便有一个可用于裁剪的对象。

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)

有几种方法可以做到这一点，您可以使用reactiveVal(), reactiveValues() or a reactive().

下面这个例子使用reactiveVal()它被命名为bboxRV并用NULL初始化。一旦你得到了矩形的bbox，你就可以将它分配给reactiveVal像这样bboxRV(value).

您还必须将 inputId 分配给actionButton，这样你就可以在一个observeEvent()。这里的inputId是“action”，然后你的observeEvent看起来像：observeEvent(input$action, {...}).

最后，您可以在服务器中的任何位置访问该值，因此您不必将renderPrint在 - 的里面observeEvent. With req(bboxRV())您需要等待，直到分配一个值，因为 NULL 值会引发静默错误并停止执行。

我做了一些调整，以便它更符合您的期望。当您想用绘制的矩形裁剪光栅时，最好使用extent代替st_bbox。裁剪栅格后，将新栅格分配给另一个栅格reactiveVal(croppedRaster)，然后绘制在操作按钮下方。

您可能必须将矩形的坐标调整到输入栅格的最大范围。您可以修复传单的边界，也可以将矩形坐标转换为栅格范围内。有一个函数可以实现这一点，但我忘记了名称和在哪里可以找到它。

否则，您可能会绘制一个范围不重叠的矩形，从而出现此错误：

.local 中的错误：范围不重叠

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)