简体   繁体   中英

Adding a customized legend to a R raster spplot map

I would like to ask you for a few advices on a R cartography with Raster / spplot I am currently working on. I am a novice so I apologize in advance should the methods I used to be not at all optimal!

=> So: I have a raster object and almost got what I wanted, but I have troubles with the legend and the result looks kind of childish. I'd like to get something a bit more "professional". I'd like to 1) improve the overall aesthetics and 2) add legends on my plot such as this concentric bubble size legend proposed in this other post: create a concentric circle legend .

Here is what I have right now: death rate and exposure in France

What I think might improve the map:

    1. Use a concentric circles bubble legend for hospital volume and put it on the top right corner
    1. Add transparency to my points. Here I have 13 bubbles, but the real map has about 600 with many overlapping (especially in Paris area).
    1. Add a legend to my colour gradient
    1. If you have any tips / comments do not hesitate: I'm a beginner but eager to learn :)

I've enclosed a simplified full code (13 hospitals instead of 600, data completely edited, variable names changed... So no need to interprete.). I've edited it so that you can just copy / paste easily.

####################################################################
####################################################################
# 1) DATA PREPARATION


# Packages
library(raster)
library(rgeos)
library(latticeExtra)
library(sf)

# Mortality dataset
french_regions=c("IDF", "NE", "NO", "SE", "SO")
death_rates_reg=c(0.032,0.014,0.019,0.018,0.021)
region_mortality=data.frame(french_regions,death_rates_reg)

# Hospital dataset
hospital_id=1:13
expo=c(0.11,0.20,0.17,0.25,0.18,0.05,0.07,0.25,0.40,0.70,0.45,0.14,0.80)
volume=sample(1:200, 13, replace=TRUE)
lat=c(44.8236,48.8197,45.7599,45.2785,48.9183,50.61,43.6356,47.9877,48.8303,48.8302,48.8991,43.2915,48.7232)
long=c(-0.57979,7.78697,4.79666,6.3421,2.52365,3.03763,3.8914,-4.095,2.34038,2.31117,2.33083,5.56335,2.45025)
french_hospitals=data.frame(hospital_id,expo,volume,lat,long)

# French regions map object - merge of departments according to phone codes
formes <- getData(name="GADM", country="FRA", level=2)
formes$NAME_3=0 # NAME_3 = new mega-regions IDF, NE, NO, SE, SO

formes$NAME_3[formes$NAME_1=="Auvergne-Rhône-Alpes"]="SE"
formes$NAME_3[formes$NAME_1=="Bourgogne-Franche-Comté"]="NE"
formes$NAME_3[formes$NAME_1=="Bretagne"]="NO"
formes$NAME_3[formes$NAME_1=="Centre-Val de Loire"]="NO"
formes$NAME_3[formes$NAME_1=="Corse"]="SE"
formes$NAME_3[formes$NAME_1=="Grand Est"]="NE"
formes$NAME_3[formes$NAME_1=="Hauts-de-France"]="NE"
formes$NAME_3[formes$NAME_1=="Île-de-France"]="IDF"
formes$NAME_3[formes$NAME_1=="Normandie"]="NO"
formes$NAME_3[formes$NAME_1=="Nouvelle-Aquitaine"]="SO"
formes$NAME_3[formes$NAME_1=="Occitanie"]="SO"
formes$NAME_3[formes$NAME_1=="Pays de la Loire"]="NO"
formes$NAME_3[formes$NAME_1=="Provence-Alpes-Côte d'Azur"]="SE"
formes$NAME_3[formes$NAME_2=="Aude"]="SE"
formes$NAME_3[formes$NAME_2=="Gard"]="SE"
formes$NAME_3[formes$NAME_2=="Hérault"]="SE"
formes$NAME_3[formes$NAME_2=="Lozère"]="SE"
formes$NAME_3[formes$NAME_2=="Pyrénées-Orientales"]="SE"
groups = aggregate(formes, by = "NAME_3")

# Colour palettes
couleurs_death=colorRampPalette(c('gray100','gray50'))
couleurs_expo=colorRampPalette(c('green','gold','red','darkred'))

# Hospitals bubble sizes and colours

my_colours=couleurs_expo(401)
french_hospitals$bubble_color="Initialisation"
french_hospitals$indice=round(french_hospitals$expo*400,digits=0)+1
french_hospitals$bubble_size=french_hospitals$volume*(1.5/50)

for(i in 1:length(french_hospitals$bubble_color)){
  french_hospitals$bubble_color[i]=my_colours[french_hospitals$indice[i]]
  
}


####################################################################
####################################################################
# 2) MAP

# Assignation of death rates to regions
idx <- match(groups$NAME_3, region_mortality$french_regions)
concordance <- region_mortality[idx, "death_rates_reg"]
groups$outcome_char <- concordance

# First map: region colours = death rates
graphA=spplot(groups, "outcome_char", col.regions=couleurs_death(500),
              par.settings = list(fontsize = list(text = 12)),
              main=list(label=" ",cex=1),colorkey = list(space = "bottom", height = 0.85))

# Second map: hospital bubbles = exposure
GraphB=graphA + layer(panel.points(french_hospitals[,c(5,4)],col=french_hospitals$bubble_color,pch=20, cex=french_hospitals$bubble_size))


# Addition of the legend

Bubble_location=matrix(data=c(-4.0,-2.0,0.0,-4.0,-2.0,0.0,42.3,42.3,42.3,41.55,41.55,41.55),nrow=6,ncol=2)
GraphC1=GraphB + layer(panel.points(Bubble_location, col=c(my_colours[5],my_colours[125],my_colours[245],"black","black","black"), pch=19,cex=c(2.5,2.5,2.5,5.0,2.0,1.0)))
Bubble_location2=matrix(data=c(-3.4,-1.27,0.55, -3.65, -3.3 , -3.4,-1.52,0.48,42.31,42.31,42.31,42.55,41.9, 41.56,41.56,41.56),nrow=8,ncol=2)
GraphC2=GraphC1+layer(panel.text(Bubble_location2, label=c("0%","30%","60%", "Exposure:", "Hospital volume:", "125","50","25"), col="black", cex=1.0))

# Final map
GraphC2

Thank you in advance for your help, (I know this is a lot, do not feel forced to dive in the code)

It isn't pretty, but I think this can get you started baring a more complete answer from someone else. I'd suggest using ggplot instead of spplot. The only thing you need to do is convert your sp object to sf to integrate with ggplot. The bubble plot needs a lot of guess and check, so I'll leave that up to you...

Map layout design is still better in GIS software, in my opinion.

library(sf)
library(ggplot2)

# Convert sp to sf
groups_sf <- st_as_sf(groups)
# Make reference dataframe for concentric bubble legend
bubble_legend <- data.frame(x = c(8.5, 8.5, 8.5), y = c(50, 50, 50), size = c(3, 6, 9))

ggplot() +
  geom_sf(data = groups_sf) +
  geom_point(data = french_hospitals, aes(x = long, y = lat, color = indice, size = bubble_size), alpha = 0.7) +
  geom_point(data = bubble_legend, aes(x = x, y = y + size/50), size = bubble_legend$size, shape = 21, color = "black", fill = NA) +
  geom_text(data = bubble_legend, aes(x = x + 0.5, y = y + size/50, label = size), size = 3) +
  scale_color_gradient(low = "green", high = "red") +
  guides(size="none")

在此处输入图像描述

Let me know what you think. I can help troubleshoot more if there are any issues.

Thank you for your answer Skaqqs, very appreciated. This is in my opinion a good step forward,. I tried it quickly on the real data and it already looks way better. especially with the transparency. I can't really show more since that's sensitive data on a trendy topic and we want to keep it confidential as much as possible until article submission.

I'll move on from this good starting base and update you.

Thank you:)

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM