Передать вывод 'наблюдайте за событиями' на кнопку действий

Question

Я отображаю динамическую карту в сеансе R Shiny, используя leaflet. Я разрешаю пользователю нарисовать ограничивающую рамку вокруг области, которая генерирует объект экстента. Я хотел бы передать результат определяемой пользователем ограничительной рамки в 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() с именем bboxRV и инициализированный сНОЛЬ.Получив прямоугольник bbox, вы назначаете его на reactiveVal следующим образом bboxRV(value).

Вы также должны назначить inputId для actionButton, чтобы вы могли прослушивать действие в observeEvent().Здесь inputId - это «действие», и тогда ваш наблюдаемое событие выглядит следующим образом: 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)