2016-03-17 33 views
10

Ho trovato risposte simili a domande come questa, ma la maggior parte di esse utilizza i pacchetti rworldmap, ggmap, ggsubplot o geom_subplot2d. Si veda ad esempio here o here.Come tracciare il diagramma a barre sulla mappa ggplot2

Mi piacerebbe sapere come è possibile tracciare altri oggetti ggplot come un grafico a barre su una mappa, creata da uno shapefile. Quello che sto usando può essere scaricato here.

EDIT

Come @beetroot giustamente osservato, il nuovo file che può essere scaricato sotto il link postato sopra è cambiata significativamente. Pertanto, i nomi dello shapefile, ecc. Vengono regolati.

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

map.det<- readOGR(dsn="<path to your directory>/swissBOUNDARIES3D100216/swissBOUNDARIES3D/V200/SHAPEFILE_LV03", layer="VECTOR200_KANTONSGEBIET") 
map.kt <- map.det[[email protected]$KANTONSNUM=="CH01000000"|[email protected]$KANTONSNUM=="CH19000000",] 


#get centroids 
map.test.centroids <- gCentroid(map.kt, byid=T) 
map.test.centroids <- as.data.frame(map.test.centroids) 
map.test.centroids$KANTONSNR <- row.names(map.test.centroids) 

#create df for ggplot 
kt_geom <- fortify(map.kt, region="KANTONSNUM") 

#Plot map 
map.test <- ggplot(NULL)+ 
     geom_polygon(data=kt_geom, aes(long, lat, group=group), fill="white")+ 
     coord_fixed()+ 
     geom_path(data=kt_geom, color="gray48", mapping=aes(long, lat, group=group), size=0.2)+ 
     geom_point(data=map.test.centroids, aes(x=x, y=y), size=9, alpha=6/10) 

mapp 

Ciò risulta in tale mappa. Fin qui tutto bene. enter image description here

Tuttavia, sto avendo difficoltà che combinano due trame come mappa map.test e, per esempio, questo:

geo_data <- data.frame(who=rep(c(1:2), each=2), 
        value=as.numeric(sample(1:100, 4, replace=T)), 
        KANTONSNR=rep(c(1,19), 2)) 

bar.testplot <- ggplot()+ 
    geom_bar(data=geo_data, aes(factor(id),value,group=who),position='dodge',stat='identity') 

I barcharts deve trovarsi al centro dei due poligoni, cioè dove i due punti sono. Potrei produrre i grafici a barre e tracciarli sulla mappa separatamente, se questo rende le cose più facili.

+0

quindi perché non 'ggsubplot' non funziona per voi, come nell'esempio si parla? –

+1

@DavidH Sembra che il pacchetto sia stato rimosso dal repository CRAN. – Thomas

+0

È ancora su [github] (https://github.com/garrettgman/ggsubplot). Non sono sicuro se sia funzionale dopo tutte le recenti modifiche in 'ggplot2'. – Axeman

risposta

8

Ho modificato un po 'il codice per rendere l'esempio più illustrativo. Sto tracciando non solo 2 Kantons, ma 47.

library(rgdal) 
library(ggplot2) 
library(rgeos) 
library(maptools) 
library(grid) 
library(gridExtra) 

map.det<- readOGR(dsn="c:/swissBOUNDARIES3D/V200/SHAPEFILE_LV03", layer="VECTOR200_KANTONSGEBIET") 
map.kt <- map.det[map.det$ICC=="CH" & (map.det$OBJECTID %in% c(1:73)),] 

# Merge polygons by ID 
map.test <- unionSpatialPolygons(map.kt, [email protected]$OBJECTID) 

#get centroids 
map.test.centroids <- gCentroid(map.test, byid=T) 
map.test.centroids <- as.data.frame(map.test.centroids) 
map.test.centroids$OBJECTID <- row.names(map.test.centroids) 

#create df for ggplot 
kt_geom <- fortify(map.kt, region="OBJECTID") 

#Plot map 
map.test <- ggplot(kt_geom)+ 
    geom_polygon(aes(long, lat, group=group), fill="white")+ 
    coord_fixed()+ 
    geom_path(color="gray48", mapping=aes(long, lat, group=group), size=0.2)+ 
    geom_point(data=map.test.centroids, aes(x=x, y=y), size=2, alpha=6/10) 

map.test 

initial plot

Diamo generare dati per barplots.

set.seed(1) 
geo_data <- data.frame(who=rep(c(1:length(map.kt$OBJECTID)), each=2), 
         value=as.numeric(sample(1:100, length(map.kt$OBJECTID)*2, replace=T)), 
         id=rep(c(1:length(map.kt$OBJECTID)), 2)) 

Ora facendo 47 barattoli che dovrebbero essere tracciati ai punti centrali più tardi.

bar.testplot_list <- 
    lapply(1:length(map.kt$OBJECTID), function(i) { 
    gt_plot <- ggplotGrob(
     ggplot(geo_data[geo_data$id == i,])+ 
     geom_bar(aes(factor(id),value,group=who), fill = rainbow(length(map.kt$OBJECTID))[i], 
       position='dodge',stat='identity', color = "black") + 
     labs(x = NULL, y = NULL) + 
     theme(legend.position = "none", rect = element_blank(), 
       line = element_blank(), text = element_blank()) 
    ) 
    panel_coords <- gt_plot$layout[gt_plot$layout$name == "panel",] 
    gt_plot[panel_coords$t:panel_coords$b, panel_coords$l:panel_coords$r] 
    }) 

Qui si convertono ggplot s in gtable s e poi ritagliare loro di avere solo pannelli di ogni barplot. È possibile modificare questo codice per mantenere le scale, aggiungere legenda, titolo, ecc.

Possiamo aggiungere questi barattoli alla mappa iniziale con l'aiuto di annotation_custom.

bar_annotation_list <- lapply(1:length(map.kt$OBJECTID), function(i) 
    annotation_custom(bar.testplot_list[[i]], 
        xmin = map.test.centroids$x[map.test.centroids$OBJECTID == as.character(map.kt$OBJECTID[i])] - 5e3, 
        xmax = map.test.centroids$x[map.test.centroids$OBJECTID == as.character(map.kt$OBJECTID[i])] + 5e3, 
        ymin = map.test.centroids$y[map.test.centroids$OBJECTID == as.character(map.kt$OBJECTID[i])] - 5e3, 
        ymax = map.test.centroids$y[map.test.centroids$OBJECTID == as.character(map.kt$OBJECTID[i])] + 5e3)) 

result_plot <- Reduce(`+`, bar_annotation_list, map.test) 

enter image description here

+0

Questo è fantastico! Grazie. Una domanda: c'è un modo per controllare la dimensione dei barattoli? Nel mio caso, non sono quasi visibili sulla mappa ... –

+1

questo +/- 5e3 alla fine di ogni riga all'interno di 'annotation custom' definisce la dimensione, prova a farlo non 5 ma 20 o 50 mila - dipende da le gamme di assi 'x' e' y' – inscaven

+0

Funziona alla grande! Grazie!! –