2016-04-23 52 views
3

我正在波士頓的鄰域多邊形中進行中心站的可視化。這裏有一個按比例縮小的工作代碼:對於leafletproxy中多個多邊形的循環?

library(shiny) 
library(leaflet) 
library(plyr) 
library(dplyr) 
library(rgdal) 

#setwd 
setwd("C:/Users/580048/Downloads") 

#read hubway station data 
hubway <- read.csv("Hubway_Stations.csv") 

#read shapefiles 
neighborhoods <-readOGR("C:/Users/580048/Downloads/bosneigh/Bos_neighborhoods_new.shp","Bos_neighborhoods_new") 
neighborhoods <- spTransform(neighborhoods, CRS("+proj=longlat +datum=WGS84")) 

#ui layout 
ui <- bootstrapPage(

    #style of tags 
    tags$style(type = "text/css", "html, body {width:100%;height:100%}"), 
    tags$style(type = "text/css", 'label[for="range"] {color: white;}'), 
    tags$style(type = "text/css", 'label[for="range2"] {color: white;}'), 
    tags$style(type = "text/css", 'label[for="team"] {color: white;}'), 
    tags$style(type = "text/css", 'label[for="away"] {color: white;}'), 
    tags$style(type = "text/css", 'label {color: white;}'), 


    #the map 
    leafletOutput("bosmap", width = "100%", height = "100%") 

) 


#server functions 
server <- function(input, output, session) { 


    #plot static map 
    output$bosmap <- renderLeaflet({ 
    leaflet(randomtaxi) %>% 
     addProviderTiles("CartoDB.DarkMatterNoLabels", 
         options= providerTileOptions(opacity = 0.99)) %>% 

     fitBounds(-71.0, 42.3, -71.1, 42.4)  
    }) 

    #plot filtered cabs 
    observe({ 
     longMark <- -71.0589 
     latMark <- 42.3601 
     poppy <- "Boston" 
     hotBorough <- subset(neighborhoods, neighborhoods$Name %in% c("Allston")) 
     totalBorough <- subset(neighborhoods, neighborhoods$Name %in% c("Back Bay")) 

    leafletProxy("bosmap", data = hubway) %>% 
     clearShapes() %>% clearMarkers %>% clearPopups() %>% 

     addPolygons(data = subset(neighborhoods, neighborhoods$Name %in% c(toString(neighborhoods$Name[1]))), 
        stroke = FALSE, 
        color = "red", 
        smoothFactor = 0.5, 
        fillOpacity = 0.3, 
        popup = toString(neighborhoods$Name[1])) %>% 

     addPopups(longMark, latMark, poppy, 
       options = popupOptions(closeButton = FALSE) 
    ) %>% 
     addCircles(~hubway$long_, 
       ~hubway$lat, 
       radius = 200, 
       weight = 20, 
       stroke = FALSE, fillOpacity = 0.5) 
    }) 

} 

shinyApp(ui, server) 

我想要做的就是創建一個通過leaftletproxy()循環內循環,併爲每一個波士頓的26個社區的各個多邊形 - 是這樣的:

leafletProxy("bosmap", data = hubway) %>% 
    clearShapes() %>% clearMarkers %>% clearPopups() %>% 

    for(i in 1:26){ 

    addPolygons(data = subset(neighborhoods, neighborhoods$Name %in% c(toString(neighborhoods$Name[i]))), 
       stroke = FALSE, 
       color = "red", 
       smoothFactor = 0.5, 
       fillOpacity = 0.3, 
       popup = toString(neighborhoods$Name[i])) %>% 

    } 

    addPopups(longMark, latMark, poppy, 
      options = popupOptions(closeButton = FALSE) 
) %>% ...(and so on) 

但由於某種原因,leafletProxy()似乎不喜歡在其中放置循環 - 是否有更簡單的方法繪製大量不同的多邊形,以便我可以將不同的彈出窗口,顏色和值附加到?

博斯附近的文件位置:https://data.cityofboston.gov/City-Services/Boston-Neighborhood-Shapefiles/af56-j7tb

hubway站:http://bostonopendata.boston.opendata.arcgis.com/datasets/ee7474e2a0aa45cbbdfe0b747a5eb032_4

+0

我懷疑它是'%>%'運算符不支持循環裏面嗎?如果是這樣,你可以打破中間的鏈條,並使用循環,然後再次使用鏈條,如果你需要。 –

回答

4

我@warmoverflow是%>% for(){}是不使用%>%for的正確方法達成一致。一般來說,我不認爲在管道中使用for是一種非常好的做法,但這裏有一個模式可以實現您的建議。

library(magrittr) 

"test" %>% 
{ 
    for(i in 1:26){ 
    . <- paste0(.,i) 
    } 
    return(.) 
} 

所以在你的榜樣,你可以做,但一個「更好」的方式後,我會建議。

leafletProxy("bosmap", data = hubway) %>% 
    clearShapes() %>% clearMarkers %>% clearPopups() %>% 

    { 
    for(i in 1:26){ 

     . <- addPolygons(.,data = subset(neighborhoods, neighborhoods$Name %in% c(toString(neighborhoods$Name[i]))), 
        stroke = FALSE, 
        color = "red", 
        smoothFactor = 0.5, 
        fillOpacity = 0.3, 
        popup = toString(neighborhoods$Name[i]) 
      ) 
    } 
    return(.) 
    } %>% 
    addPopups(longMark, latMark, poppy, 
      options = popupOptions(closeButton = FALSE) 
) %>% ...(and so on) 

我認爲這是一個更好的方法來處理。

leafletProxy("bosmap", data = hubway) %>% 
    clearShapes() %>% clearMarkers %>% clearPopups() %>% 
    addPolygons(
    data = neighborhoods[1:26,], 
    stroke = FALSE, 
    color = "red", 
    smoothFactor = 0.5, 
    fillOpacity = 0.3, 
    popup = ~Name 
)