add maps

RCura · Nov 24, 2015 · 36c504e · 36c504e
1 parent 82934bd
commit 36c504e
Show file tree

Hide file tree

Showing 3 changed files with 35 additions and 52 deletions.
diff --git a/server.R b/server.R
@@ -947,63 +947,40 @@ shinyServer(function(input, output, session) {
         return((div(HTML(lapply(blob, paste)),class="shiny-html-output")))
     })
 
-output$populationmaps <- renderUI({
-
-
-    library(cartography)
-    library(sp)
-
-
-    plot_output_list <- lapply(unique(BRICS$system), function(sysname) {
-        plotname <- paste("map", sysname, sep="")
-        fluidRow(plotOutput(plotname))
-    })
-
-    do.call(tagList, plot_output_list)
-})    
-    observe({
+output$populationmaps <- renderPlot({
+
     maxyear <- BRICS %>%
         group_by(system) %>%
         summarise(yearmax = max(year))
 
     lastPops <- BRICS %>%
         semi_join(maxyear, by= c("system",  "year" = "yearmax")) %>%
         filter(pop > 10E3, !is.na(pop))
-
-    for (sysname in unique(BRICS$system)) {
-        # Need local so that each item gets its own number. Without it, the value
-        # of i in the renderPlot() will be the same across all instances, because
-        # of when the expression is evaluated.
-        local({
-            currSys <- sysname
-            plotname <- paste("map", currSys, sep="")
-
-            output[[plotname]] <- renderPlot({
-                currentPops <- as.data.frame(lastPops %>% filter(system == currSys), stringsAsFactors = FALSE)
-
-                coordinates(currentPops) <- ~Long+Lat
-                proj4string(currentPops) <- CRS("+init=epsg:4326")
-                baseMap <- getTiles(spdf = currentPops, type = "osm")
-                fluidRow()
-                tilesLayer(baseMap)
-
-                propSymbolsLayer(spdf = currentPops, # SpatialPolygonsDataFrame of the countries
-                                 df = currentPops@data,  # data frame of the regions
-                                 var = "pop",  # population
-                                 symbols = "circle", # type of symbol
-                                 border = "white", # color of the symbols borders
-                                 lwd = 1.5, # width of the symbols borders
-                                 legend.pos = "topleft", 
-                                 legend.title.txt = "Total population")
-                # Layout plot
-                layoutLayer(title = sprintf("Cities in %s", currentSys),
-                            author = "Base map: Map tiles by OSM, under CC BY 3.0. Data by OpenStreetMap, under CC BY SA.",
-                            scale = NULL, frame = TRUE,
-                            col = "#688994") # color of the frame
-            })
-        })
-    }
-})
+
+    maxPop <- max(lastPops$pop)
+    currentPops <- as.data.frame(lastPops %>% filter(system == input$countryMap), stringsAsFactors = FALSE)
+
+    coordinates(currentPops) <- ~Long+Lat
+    proj4string(currentPops) <- CRS("+init=epsg:4326")
+    baseMap <- getTiles(spdf = currentPops, type = "osm")
+    fluidRow()
+    tilesLayer(baseMap)
+
+    propSymbolsLayer(spdf = currentPops, # SpatialPolygonsDataFrame of the countries
+                     df = currentPops@data,  # data frame of the regions
+                     var = "pop",  # population
+                     fixmax = maxPop, # for comparability
+                     symbols = "circle", # type of symbol
+                     border = "white", # color of the symbols borders
+                     lwd = 0.1, # width of the symbols borders
+                     legend.pos = "topleft", 
+                     legend.title.txt = "Total population")
+    # Layout plot
+    layoutLayer(title = sprintf("Cities in %s", input$countryMap),
+                author = "Base map: Map tiles by OSM, under CC BY 3.0. Data by OpenStreetMap, under CC BY SA.",
+                scale = NULL, frame = TRUE,
+                col = "#688994") # color of the frame
+    })
 
     updateInputs <- function(session, columns, realColumns){        
         updateSelectInput(session=session, inputId="timeColumnSelected",

diff --git a/tests.R b/tests.R
@@ -525,6 +525,7 @@ layout.show(n = 7)
 
 systemOrder <- c("Europe", "Brazil", "South Africa", "USA", "Former USSR", "China", "India")
 
+maxPop <- max(lastPops$pop)
 for (currentSys in systemOrder){
     currentPops <- as.data.frame(lastPops %>% filter(system == currentSys), stringsAsFactors = FALSE)
     ## On converti en SPDF
@@ -537,9 +538,10 @@ for (currentSys in systemOrder){
     propSymbolsLayer(spdf = currentPops, # SpatialPolygonsDataFrame of the countries
                      df = currentPops@data,  # data frame of the regions
                      var = "pop",  # population
+                     fixmax = maxPop, # for comparability
                      symbols = "circle", # type of symbol
                      border = "white", # color of the symbols borders
-                     lwd = 1.5, # width of the symbols borders
+                     lwd = 0.5, # width of the symbols borders
                      legend.pos = "topleft", 
                      legend.title.txt = "Total population")
     # Layout plot
@@ -550,6 +552,8 @@ for (currentSys in systemOrder){
 
 }
 
+
+####### New Pops / Cities tables ######
 currSys <- "China"
 
 currentWideDF <- BRICS %>% filter(system == currSys) %>% select(ID, year, pop) %>% tidyr::spread(year, pop)

diff --git a/ui.R b/ui.R
@@ -121,7 +121,9 @@ shinyUI(
                                      fluidRow(tableOutput('numCitiesAppeared')),
                                      fluidRow(tableOutput('popCitiesAppeared'))),
                             tabPanel("Maps",
-                                     uiOutput("populationmaps"))
+                                     selectInput("countryMap",label = "Select system",
+                                                 choices = c("South Africa", "Brazil", "Former USSR", "India", "China", "USA", "Europe")),
+                                     plotOutput("populationmaps"))
                         )
                         )