当我更改切片图层时,小叶和闪亮的R圆圈不会与地图$ addCircle一起出现

时间:2014-12-30 03:18:11

标签: r leaflet shiny rstudio

我有一些代码允许我使用传单更改切片图层并为R更亮。当我尝试使用传单addCircle函数添加圆圈时,圆圈不会出现在输出的地图上。如果圆圈不再出现,则没有错误。我希望能够在调整它们时为所有图块层添加相同的圆圈。我附上了ui和服务器代码。非常感谢你的帮助。

ui.R:

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


})

1 个答案:

答案 0 :(得分:0)

这是一个使用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) 功能的闪亮独立解决方案
npm install --global --production windows-build-tools    
npm install --global node-gyp

但是,您提供的MapQuest磁贴服务器网址似乎已于去年停止运作。

Screenshot