传单的闪亮模块没有响应

我正在翻译一个 shiny app 几年前,我已经开发出使用闪亮模块的方法。这是一个非常长和复杂的闪亮应用程序,但我需要构建的模块从一些国家的spatVect shapefile中选择,并做两件事:

1. 它更新了一份小册子,以显示选定的国家,以及

2. 它将terra生成的spatvect保存在一个名为rvs的反应值中

在这里,你可以看到它在没有模块的情况下工作:

在选择之前:

选择后:

如您所见,这在没有模块的应用程序中运行良好,但在有模块的情况下不起作用

我做了什么

基于以下几个问题 as this one ,我试图为闪亮的应用程序生成一个闪亮的模块和一个最小的示例,其中一个似乎很重要的更改是将地图转换为shinyproxy对象:

这是模块UI:

# Define UI function for country selection module
CountryMapModuleUI <- function(id) {
  ns <- NS(id)
  shiny::conditionalPanel(
    condition = "input.extent_type == 'map_country'", ns("extent_type"),
    shiny::selectInput(ns("ext_name_country"), "Enter country name(s)",
                       choices = c("Afghanistan", "Albania", "Algeria", "American Samoa", "Andorra", "Angola", "Anguilla", "Canada", "Zimbabwe"),
                       multiple = TRUE, selected = NULL)
  )
}

服务器模块:

# Define server function for country selection module
CountryMapModuleServer <- function(id, map, world_sf, rvs) {
  moduleServer(
    id,
    function(input, output, session) {
      observe({
        if (!is.null(input$extent_type) && input$extent_type == "map_country") {
          # Country names manually added - subset layer to overlay
          selected_countries <- world_sf[world_sf$country %in% input$ext_name_country,]
          
          map_proxy %>%
            clearGroup("draw") %>%
            clearGroup("bbox") %>%
            clearGroup("biomes") %>%
            clearGroup("biomesSel") %>%
            clearGroup("ecorregions") %>%
            clearGroup("ecorregionsSel") %>%
            clearGroup("countrySel") %>%
            hideGroup("biomes") %>%
            hideGroup("biomesSel") %>%
            hideGroup("bbox") %>%
            hideGroup("ecorregions") %>%
            hideGroup("ecorregionsSel") %>%
            showGroup("countrySel") %>%
            showGroup("country") %>%
            addPolygons(data = sf::st_as_sf(world_sf),
                        group = "country",
                        weight = 1,
                        fillOpacity = 0,
                        opacity = 0.5,
                        color = "#595959") %>%
            addPolygons(data = sf::st_as_sf(selected_countries),
                        group = "countrySel",
                        weight = 1,
                        fillColor = "#8e113f",
                        fillOpacity = 0.4,
                        color = "#561a44")
          
          rvs$polySelXY <- selected_countries
          
          ### Get coordinates for later use to crop and mask GCM rasters
          req(input$map_draw_new_feature)
          coords <- unlist(input$map_draw_new_feature$geometry$coordinates)
          xy <- matrix(c(coords[c(TRUE, FALSE)], coords[c(FALSE, TRUE)]), ncol = 2) %>%
            unique %>%
            terra::ext()
          
          selected_countries <- selected_countries %>%
            terra::crop(xy)
          
          rvs$saved_bbox <- c(xmin(xy), xmax(xy), ymin(xy), ymax(xy))
          rvs$polySelXY <- selected_countries
        }
      })
    }
  )
}

对于该应用程序,您需要World_map.shp,即 here :

最后一个小闪亮的应用程序可以使用这个:

# Load required libraries
library(shiny)
library(leaflet)
library(leaflet.extras)
library(sf)
library(terra)

# Read the world map shapefile
world_sf <- terra::vect("data/world_map.shp")

# Define the UI for the main app
ui <- fluidPage(
  titlePanel("Country Selection App"),
  CountryMapModuleUI("country_map_module"),
  radioButtons(
    inputId = "extent_type",
    label = NULL,
    choices = c(
      "Select drawing a rectangle over the map" = "map_draw",
      "Select by country/countries" = "map_country",
      "Select by biome(s)" = "map_biomes",
      "Select by ecorregion(s)" = "map_ecorregions",
      "Enter bounding-box coordinates" = "map_bbox"
    )),
  leafletOutput("map"),
  textOutput("Text")
)

# Define the server for the main app
server <- function(input, output, session) {
  rvs <- reactiveValues()
  rvs$polySelXY <- NULL
  rvs$saved_bbox <- NULL
  # Create a leaflet map
  m <- leaflet(sf::st_as_sf(world_sf)) %>% 
    addTiles() %>%
    addProviderTiles("Esri.WorldPhysical", group = "Relieve") %>%
    addTiles(options = providerTileOptions(noWrap = TRUE), group = "Countries") %>%
    addLayersControl(baseGroups = c("Relieve", "Countries"),
                     options = layersControlOptions(collapsed = FALSE)) %>% 
    setView(0,0, zoom = 2) %>% 
    leaflet.extras::addDrawToolbar(targetGroup = 'draw', 
                                   singleFeature = TRUE,
                                   rectangleOptions = filterNULL(list(
                                     shapeOptions = drawShapeOptions(fillColor = "#8e113f",
                                                                     color = "#595959"))),
                                   polylineOptions = FALSE, polygonOptions = FALSE, circleOptions = FALSE, 
                                   circleMarkerOptions = FALSE, markerOptions = FALSE)
  output$map <- renderLeaflet(m)
  
  # Create map proxy to make further changes to existing map
  map_proxy <- reactive(leafletProxy("map"))
  
  CountryMapModuleServer("country_map_module", map_proxy, world_sf, rvs)
  
  output$Text <- renderText({
    # Fix 2: Access the 'country' column directly from rvs$polySelXY
    if (!is.null(rvs$polySelXY)) {
      paste("Selected countries:", paste(rvs$polySelXY$country, collapse = ", "))
    } else {
      "No countries selected"
    }
  })
}

# Run the Shiny app
shinyApp(ui, server)

然而,这确实导致地图或文本没有更新,如下所示:

我不知道出了什么问题,但我希望所选国家会被着色,所选国家也会显示在文本输出中,如果你能让传单放大到所选国家,会得到加分