Question

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

我不知道如何将observeEvent与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)

Answer 1

有几种方法可以使用reactiveVal()，reactiveValues()或reactive()。

下面的示例使用名为reactiveVal()且初始化为NULL的bboxRV。一旦获得矩形的bbox，就将其分配给reactiveVal，如bboxRV(value)。

您还必须为actionButton分配inputId，以便可以在observeEvent()中收听操作。这里的inputId是“ action”，然后您的watchEvent类似于：observeEvent(input$action, {...})。

最后，您可以在服务器中的任何位置访问此值，因此不必将renderPrint放在observeEvent内。使用req(bboxRV())时，您要等到赋值为止，因为NULL值将引发静默错误并在那里停止执行。

我进行了一些调整，以使其更符合您的期望。当您想使用绘制的矩形裁剪栅格时，最好使用extent而不是st_bbox。裁剪栅格后，将新栅格分配给另一个reactiveVal（croppedRaster），然后将其绘制在actionButton下方。

您可能必须在输入栅格的最大范围内调整矩形的坐标。您可以固定传单的边界，也可以将矩形坐标转换为栅格范围内。有一个功能，但是我忘记了名称和在哪里寻找。

否则，您可能会绘制一个矩形，该矩形的范围不重叠，这将给您以下错误：

.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)

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

1 个答案: