世界地圖 - 使用ggplot2將國家的一半映射到不同的顏色

Question

我正在為這個問題尋找一個ggplot2解決方案：

世界地圖 - 將國家的一半映射到不同的顏色

我從下面的問題重現了這個例子，這是基於這里的問題（ ggplot map with 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")

Answer 1

你有幾個選擇。 繪制多邊形非常簡單，但不能有兩種不同的fill比例。 此解決方案使用點形注釋，但可以更改為按顏色（或顏色和形狀）縮放geom_point 。 我認為這是你能做的最好的事情，可以在一個單獨的程序中手動覆蓋兩張地圖。

你也可能（可能）想要調整美國邊界框，因為中心有點偏離（實際上，其中一些是真的很明顯）。

我也刪除了南極洲。 如果你願意，你可以添加它，但它浪費了房地產IMO。

library(rgdal)
library(ggplot2)
library(maptools)
library(rgeos)
library(RColorBrewer)

world.map <- readOGR(dsn="/Users/bob/Desktop/TM_WORLD_BORDERS_SIMPL-0.3/", layer="TM_WORLD_BORDERS_SIMPL-0.3")

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

whole <- world.map[grep("Antarctica", world.map$NAME, invert=TRUE),]
half <- lSPDF[grep("Antarctica", lSPDF$NAME, invert=TRUE),]

whole <- fortify(whole, region="ISO3")
half <- fortify(half, region="ISO3")

world.map$scaled_growth <- as.numeric(scale(world.map@data$growth, 
                                            center = min(world.map@data$growth), 
                                            scale = max(world.map@data$growth)))

growth <- world.map@data[,c("ISO3", "scaled_growth")]
colnames(growth) <- c("id", "scaled_growth")
growth$scaled_growth <- factor(as.numeric(cut(growth$scaled_growth, 8))) # make it discrete

half_centers <- data.frame(cbind(coordinates(gCentroid(lSPDF, byid = TRUE)),
                                 id=world.map@data$ISO3, category=world.map@data$category))
half_centers$category <- factor(half_centers$category)

gg <- ggplot()
gg <- gg + geom_map(data=whole, map=whole, aes(x=long, y=lat, map_id=id), alpha=0, color="black", size=0.15)
gg <- gg + geom_map(data=growth, map=whole, aes(fill=scaled_growth, map_id=id))
gg <- gg + geom_map(data=half, map=half, aes(x=long, y=lat, map_id=id), fill="white")
gg <- gg + geom_point(data=half_centers, aes(x=x, y=y, shape=category), size=2)
gg <- gg + scale_fill_brewer(palette="Pastel2")
gg <- gg + scale_shape_discrete()
gg <- gg + coord_equal()
gg

Answer 2

我認為你可以（有效地）得到兩個不同的填充比例，只需要一點scale_fill_brewer和scale_fill_manual。

這是我的輸出：

我使用你在問題中發布的另一個帖子的第一段代碼：

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

world.map <- readOGR(dsn="data", layer="TM_WORLD_BORDERS_SIMPL-0.3")

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

現在我的貢獻（從用戶hrbrmstr借用整個/一半的名字！）

# get two data.frames, one with whole countries and the other with the left half
# this relies on code from SO user BenBarnes
whole <- fortify(world.map, region="ISO3")
half <- fortify(lSPDF, region="ISO3")

# random growth / category data, similar to the random data originally
# suggested by Xu Wang
set.seed(123)
df <- data.frame(id = unique(world.map@data$ISO3),
                 growth = 4*runif(n),
                 category = factor(sample(letters[1:5], n, replace=T)))

# make growth a factor; 5 levels for convenience
df$growth_fac <- cut(df$growth, 5)

# append growth and category factor levels together
growth_cat_levels <- c(levels(df$category), levels(df$growth_fac))

# adjust factors with new joint levels
df$growth_fac <- 
  factor(df$growth_fac, levels=growth_cat_levels)
df$category <-
  factor(df$category, levels=growth_cat_levels)

# create a palette with some sequential colors and some qualitative colors
pal <- c(scale_fill_brewer(type='seq', palette=6)$palette(5),
         scale_fill_brewer(type='qual', palette='Pastel2')$palette(5))


# merge data
whole <- data.frame(merge(whole, df, by='id'))
half <- data.frame(merge(half, df, by='id'))

# plot
ggplot() +
  geom_polygon(data=whole, 
               aes(x=long, y=lat, group=group, fill=growth_fac), 
               color='black', size=0.15) +
  geom_polygon(data=half,
               aes(x=long, y=lat, group=group, fill=category), 
               color=NA) +
  scale_shape_discrete() +
  coord_equal() +

  scale_fill_manual('Category, Growth', 
                    values=pal, breaks=growth_cat_levels) +
  guides(fill=guide_legend(ncol=2))

一些說明：

• 我仍然認為這是一張難以閱讀的地圖，但卻是一個有趣的挑戰
• 我將'類別'名稱從數字更改為alpha，以幫助避免與'增長'數據混淆。
• 我還保留了由cut生成的“增長”數據標簽，以幫助明確這是分類連續數據。
• 起初，我在傳說的左側有增長顏色，但我換了它; 由於Category確定了左側國家多邊形的填充顏色，我認為Category應該出現在圖例的左側
• 我嘗試了幾種不同的調色板選項。 一個危險是定性尺度的顏色與連續尺度的范圍太相似（就像我在此編輯之前的帖子一樣）。 一側灰度和一側顏色有助於避免這種情況