world map - map halves of countries to different colors

后端 未结 1 820
醉酒成梦
醉酒成梦 2020-12-28 16:27

I am using the example here for discussion: ggplot map with l

library(rgdal)
library(ggplot2)
library(maptools)

# Data from http://thematicmapping.org/downl         


        
1条回答
  •  时光说笑
    2020-12-28 16:45

    This is a solution without ggplot that relies on the plot function instead. It also requires the rgeos package in addition to the code in the OP:

    EDIT Now with 10% less visual pain

    EDIT 2 Now with centroids for east and west halves

    library(rgeos)
    library(RColorBrewer)
    
    # Get centroids of countries
    theCents <- coordinates(world.map)
    
    # extract the polygons objects
    pl <- slot(world.map, "polygons")
    
    # Create square polygons that cover the east (left) half of each country's bbox
    lpolys <- lapply(seq_along(pl), function(x) {
      lbox <- bbox(pl[[x]])
      lbox[1, 2] <- theCents[x, 1]
      Polygon(expand.grid(lbox[1,], lbox[2,])[c(1,3,4,2,1),])
    })
    
    # Slightly different data handling
    wmRN <- row.names(world.map)
    
    n <- nrow(world.map@data)
    world.map@data[, c("growth", "category")] <- list(growth = 4*runif(n),
                     category = factor(sample(1:5, n, replace=TRUE)))
    
    # Determine the intersection of each country with the respective "left polygon"
    lPolys <- lapply(seq_along(lpolys), function(x) {
      curLPol <- SpatialPolygons(list(Polygons(lpolys[x], wmRN[x])),
        proj4string=CRS(proj4string(world.map)))
      curPl <- SpatialPolygons(pl[x], proj4string=CRS(proj4string(world.map)))
      theInt <- gIntersection(curLPol, curPl, id = wmRN[x])
      theInt
    })
    
    # Create a SpatialPolygonDataFrame of the intersections
    lSPDF <- SpatialPolygonsDataFrame(SpatialPolygons(unlist(lapply(lPolys,
      slot, "polygons")), proj4string = CRS(proj4string(world.map))),
      world.map@data)
    
    ##########
    ## EDIT ##
    ##########
    # Create a slightly less harsh color set
    s_growth <- scale(world.map@data$growth,
      center = min(world.map@data$growth), scale = max(world.map@data$growth))
    growthRGB <- colorRamp(c("red", "blue"))(s_growth)
    growthCols <- apply(growthRGB, 1, function(x) rgb(x[1], x[2], x[3],
      maxColorValue = 255))
    catCols <- brewer.pal(nlevels(lSPDF@data$category), "Pastel2")
    
    # and plot
    plot(world.map, col = growthCols, bg = "grey90")
    
    plot(lSPDF, col = catCols[lSPDF@data$category], add = TRUE)
    

    enter image description here

    Perhaps someone can come up with a good solution using ggplot2. However, based on this answer to a question about multiple fill scales for a single graph ("You can't"), a ggplot2 solution seems unlikely without faceting (which might be a good approach, as suggested in the comments above).


    EDIT re: mapping centroids of the halves to something: The centroids for the east ("left") halves can be obtained by

    coordinates(lSPDF)
    

    Those for the west ("right") halves can be obtained by creating an rSPDF object in a similar way:

    # Create square polygons that cover west (right) half of each country's bbox
    rpolys <- lapply(seq_along(pl), function(x) {
      rbox <- bbox(pl[[x]])
      rbox[1, 1] <- theCents[x, 1]
      Polygon(expand.grid(rbox[1,], rbox[2,])[c(1,3,4,2,1),])
    })
    
    # Determine the intersection of each country with the respective "right polygon"
    rPolys <- lapply(seq_along(rpolys), function(x) {
      curRPol <- SpatialPolygons(list(Polygons(rpolys[x], wmRN[x])),
        proj4string=CRS(proj4string(world.map)))
      curPl <- SpatialPolygons(pl[x], proj4string=CRS(proj4string(world.map)))
      theInt <- gIntersection(curRPol, curPl, id = wmRN[x])
      theInt
    })
    
    # Create a SpatialPolygonDataFrame of the western (right) intersections
    rSPDF <- SpatialPolygonsDataFrame(SpatialPolygons(unlist(lapply(rPolys,
      slot, "polygons")), proj4string = CRS(proj4string(world.map))),
      world.map@data)
    

    Then information could be plotted on the map according to the centroids of lSPDF or rSPDF:

    points(coordinates(rSPDF), col = factor(rSPDF@data$REGION))
    # or
    text(coordinates(lSPDF), labels = lSPDF@data$FIPS, cex = .7)
    

    0 讨论(0)
提交回复
热议问题