r - 当我更改切片图层时，传单和 Shiny 的 R 圆圈不会与 map$addCircle 一起出现

Question

我有一些代码允许我使用传单和 Shiny 的 R 更改图块图层。当我尝试使用传单 addCircle 函数添加圆圈时，圆圈不会出现在输出的 map 上。没有错误，因为圆圈不再出现。我希望能够在调制它们时向所有平铺层添加相同的圆圈。我附上了用户界面和服务器代码。非常感谢您的帮助。

用户界面:

library(shiny);library(leaflet)
shinyUI(navbarPage("Switch Map",
   tabPanel("Map",
      div(class="outer",tags$head(includeCSS("styles.css")),
          htmlOutput("mapp",inline=TRUE)),
      absolutePanel(top = 60, left = "auto", right = 20, bottom = "auto",
          selectInput("mapPick", "Background Map",c("OpenStreetMap" = "http://{s}.tile.openstreetmap.org/{z}/{x}/{y}.png",
         "MapQuestOpen.Aerial"= "http://oatile3.mqcdn.com/tiles/1.0.0/sat/{z}/{x}/{y}.jpg"),
         selected = c("http://oatile3.mqcdn.com/tiles/1.0.0/sat/{z}/{x}/{y}.jpg"))))))

server.R:

library(shiny);library(leaflet)
shinyServer(function(input, output, session) {
  output$map1 <- reactive(TRUE)
  map1 <- createLeafletMap(session, "map")
  output$mapp <- renderUI({
    input$mapPick
    isolate({
    leafletMap("map", "100%", "100%",
       initialTileLayer = input$mapPick,
       initialTileLayerAttribution = HTML('Fix This Later'),
       options=list(center = center(),zoom = zoom()))
    })
  })
  zoom <- reactive({
    ifelse(is.null(input$map_zoom),5,input$map_zoom)
  })
  center <- reactive({
    if(is.null(input$map_bounds)) {
      c(40, -98.85)
    } else {
      map_bounds <- input$map_bounds
      c((map_bounds$north + map_bounds$south)/2.0,(map_bounds$east + map_bounds$west)/2.0)
    }
  })


################  here is the snippet of code where I add the circles but doesn't yield ################  any circles
################  clinicDataReactive is some data I import.  I didn't include this part of ################  server for brevity

session$onFlushed(once=TRUE, function() {
  paintObs <- observe({
    sizeBy <- input$size
    clinicData<-clinicDataReactive()
    colorData<-clinicData$Facility.Type
    colors <- brewer.pal(3,"Set1")[cut(colorData, 3, labels = FALSE)]

    # Clear existing circles before drawing
    map$clearShapes()
    # Draw in batches of 1000; makes the app feel a bit more responsive
    chunksize <- 1000
    for (from in seq.int(1, nrow(clinicData), chunksize)) {
      to <- min(nrow(clinicData), from + chunksize)
      zipchunk <- clinicData[from:to,]
      # Bug in Shiny causes this to error out when user closes browser
      # before we get here
      try(
        map$addCircle(
          zipchunk$latitude, zipchunk$longitude,
          (zipchunk[[sizeBy]] / max(clinicData[[sizeBy]]))*5000,
          zipchunk$Index,
          list(stroke=FALSE, fill=TRUE, fillOpacity=0.4),
          list(color = colors[from:to])
        )
      )
    }
  })

  # TIL this is necessary in order to prevent the observer from
  # attempting to write to the websocket after the session is gone.
  session$onSessionEnded(paintObs$suspend)
})


})

Answer 1

这是使用 baseGroups 的 Shiny 独立解决方案addLayersControl 的特点

library(leaflet)
dat <- data.frame(lon = c(0, 0), lat = c(0, 1))
leaflet() %>%
  addTiles(urlTemplate = "http://{s}.tile.openstreetmap.org/{z}/{x}/{y}.png", group = "OpenStreetMap") %>%
  addTiles(urlTemplate = "http://oatile3.mqcdn.com/tiles/1.0.0/sat/{z}/{x}/{y}.jpg", group = "MapQuestOpen.Aerial") %>%
  addProviderTiles(providers$Stamen, group = "Stamen") %>%
  addLayersControl(baseGroups = c("OpenStreetMap", "MapQuestOpen.Aerial", "Stamen"), options = layersControlOptions(collapsed = FALSE)) %>%
  addCircles(data = dat, lat = ~lat, lng = ~lon, radius = 1e5)

但是，您提供的 MapQuest 切片服务器 URL 去年似乎已停止工作。

Screenshot