2014-12-21 120 views
8

國家不同顏色的地圖半我正在尋找的這個問題上GGPLOT2解決方案:世界地圖 - 使用GGPLOT2

world map - map halves of countries to different colors

我從複製下面這個問題,這是基於該示例問題在這裏(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") 
+0

所以你想要達到與原始問題相同的結果? – Konrad

+0

我想要達到與*答案*相同的結果(問題已經使用ggplot2,答案不會)。 –

+0

你會遇到一些問題,因爲如果幾乎不可能有多個不同的多邊形填充顏色比例 – hrbrmstr

回答

10

你有幾個選項。繪製多邊形非常簡單,但不能有兩個不同的fill比例。此解決方案使用點形註釋,但可以更改爲按顏色(或顏色和形狀)縮放geom_point。我認爲這是最好的,你將能夠保存在一個單獨的程序中手動覆蓋兩張地圖。因爲中心有點偏離(其中一些實際上只是其中的一個非常明顯),您也可能(可能)想調整美國邊界框。

我也去除了南極洲。如果你願意的話,你可以重新加入,但是浪費了房地產海事組織。

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([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]) 

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([email protected]$growth, 
              center = min([email protected]$growth), 
              scale = max([email protected]$growth))) 

growth <- [email protected][,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)), 
           [email protected]$ISO3, [email protected]$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 

enter image description here

6

我認爲你可以得到(有效)兩種不同的填充尺度,與scale_fill_brewer和scale_fill_manual的小黑客。

這裏是我的輸出: enter image description here

我使用的代碼的第一位從你的問題貼在其他線程:

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([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]) 

現在我的貢獻(借用用戶名全/半!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([email protected]$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)) 

一些注意事項:

  • 我仍然認爲這是一本難以閱讀的地圖,但有趣的挑戰
  • 我將'category'的名稱從數字更改爲alpha,以避免與'增長'數據混淆。
  • 我還保留了cut的「增長」數據標籤,以幫助明確說明這是分級連續數據。
  • 起初,我在圖例左側有增長顏色,但我換了一下;由於類別決定了左側國家多邊形的填充顏色,我認爲類別應該出現在圖例左側
  • 我嘗試了幾個不同的調色板選項。一種危險是定性量表的顏色與順序量表的範圍太相似了(就像我在編輯之前發表的帖子一樣)。有一面灰度和一面顏色有助於避免這種情況
+1

很好地完成ggplot將使它非常困難。我沉溺於做'scale_fill_manual',但它看起來像「工作」:-)真的很好的工作。希望我能夠投票2倍。 – hrbrmstr