Карта мира - отображает половинки стран разных цветов

Я использую здесь пример для обсуждения: карта ggplot с l

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

# Data from http://thematicmapping.org/downloads/world_borders.php.
# Direct link: http://thematicmapping.org/downloads/TM_WORLD_BORDERS_SIMPL-0.3.zip
# Unpack and put the files in a dir 'data'

gpclibPermit()
world.map <- readOGR(dsn="data", layer="TM_WORLD_BORDERS_SIMPL-0.3")
world.ggmap <- fortify(world.map, region = "NAME")

n <- length(unique(world.ggmap$id))
df <- data.frame(id = unique(world.ggmap$id),
                 growth = 4*runif(n),
                 category = factor(sample(1:5, n, replace=T)))

## noise
df[c(sample(1:100,40)),c("growth", "category")] <- NA


ggplot(df, aes(map_id = id)) +
     geom_map(aes(fill = growth, color = category), map =world.ggmap) +
     expand_limits(x = world.ggmap$long, y = world.ggmap$lat) +
     scale_fill_gradient(low = "red", high = "blue", guide = "colorbar")

Дает следующие результаты:

Я хотел бы отобразить одну переменную в левую "половину" страны и другую переменную в правую "половину" страны. Я поставил "половину" в кавычки, потому что он не был четко определен (или, по крайней мере, я не четко определяю его). Ответ Ian Fellows может помочь (что дает простой способ получить центроид). Я надеюсь на что-то, чтобы я мог сделать aes(left_half_color = growth, right_half_color = category) в этом примере. Меня также интересуют верхняя половина и нижняя половина, если это другое.

Если возможно, я также хотел бы сопоставить отдельные центроиды половинок с чем-то.

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 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([email protected]) [email protected][, 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))), [email protected]) ########## ## EDIT ## ########## # Create a slightly less harsh color set s_growth <- scale([email protected]$growth, center = min([email protected]$growth), scale = max([email protected]$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([email protected]$category), "Pastel2") # and plot plot(world.map, col = growthCols, bg = "grey90") plot(lSPDF, col = catCols[[email protected]$category], add = TRUE)

# Create square polygons that cover west (right) half of each country 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))), [email protected])

Ответ 1