दुनिया के नक्शे - ggplot2

Question

का उपयोग कर अलग अलग रंग के लिए देशों के नक्शे हिस्सों मैं इस सवाल के लिए एक 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") 

Answer 1

आपके पास कुछ विकल्प हैं। बहुभुज प्लॉट प्राप्त करने के लिए यह बहुत सरल है, लेकिन आपके पास दो अलग-अलग 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(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)) 

कुछ नोट:

• मुझे अभी भी लगता है कि यह एक कठिन-पढ़ने वाला मानचित्र है, लेकिन एक मजेदार चुनौती
• मैंने 'वृद्धि' डेटा के साथ भ्रम से बचने में मदद के लिए 'श्रेणी' नामों को संख्यात्मक से अल्फा में बदल दिया है।
• मैंने कटौती द्वारा जेनरेट किए गए 'विकास' डेटा लेबल भी बनाए रखा, यह स्पष्ट करने में सहायता के लिए कि यह निरंतर डेटा है।
• सबसे पहले, मेरे पास पौराणिक कथाओं के बाईं ओर विकास रंग था, लेकिन मैंने इसे चारों ओर बदल दिया; चूंकि श्रेणी बायीं ओर देश बहुभुज के भरने वाले रंग को निर्धारित करती है, मैंने सोचा कि श्रेणी को पौराणिक कथाओं
• में बाईं ओर दिखाई देना चाहिए, मैंने दो अलग पैलेट विकल्पों के साथ प्रयोग किया था। एक खतरा यह है कि गुणात्मक पैमाने पर अनुक्रमिक पैमाने की सीमा के समान रंग होगा (जैसा कि इस संपादन से पहले मेरी पोस्ट के मामले में था)। एक तरफ ग्रेस्केल और रंगों के साथ एक तरफ इस