Related
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:
Use a concentric circles bubble legend for hospital volume and put it on the top right corner
Add transparency to my points. Here I have 13 bubbles, but the real map has about 600 with many overlapping (especially in Paris area).
Add a legend to my colour gradient
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 :)
I am trying to do something similar to what is described in the blog here but using R with ggtree, ggmap, and ggplot2.
I want to be able to combine the plots of the phylogenetic tree and the map showing the sampling locations of the tips on a geographical map, and link the tips to the sampling locations by segments. That would allow to see ie. if some clusters appears to specific geographical locations (ie north, south of an area) and would allow also to display different data with tips colors/symbols. This would be at first used as exploratory graphs, but this can also be used later on for publication ...
I would like to use the gg* libraries (ggplot2, ggtree, ggmap ...) to do that, because then it is easy to modify plots to display different variables. Here is a dummy script to describe how I do that so far. I do the tree and map plot separately and combine them. I want also to be able to have a common legend for the two plots. I am stuck after combining, I do not find out how to link the points from the tree plot to the points on the map plot with segments.
Anyone with ideas / possible solutions on how to do that or an alternative approach ?
Here is the dummy dataset to illustrate for creating the plots
library(patchwork)
library(ggpubr)
library(ggtree)
library(tidyverse)
library(ggmap)
library(ggplot2)
mytree <- ggtree::rtree(100)
mymap <- ggmap::get_map(c(left = 0.903, bottom = 44.56, right = 6.72, top = 49.38),
scale = 4, maptype = "terrain",
source = "stamen",
color = "bw")
save(mymap, file = "dummy_map.Rdata")
ggmap require API key to create the map (sorry I cannot share the API key, but you can make one for free on google cloud). I saved the map object and its downloadable from here.
# Loading the map
load("dummy_map.Rdata")
# creating dummy metadata
mytree_data <- tidytree::as_tibble(mytree)
mymetadata <- mytree_data %>%
dplyr::filter(!is.na(label)) %>%
tibble::add_column(year = sample(seq(1990, 2020, by = 1), 100, replace = T),
lon = sample(seq(0.91, 6.7, by = 0.01), 100, replace = T),
lat = sample(seq(44.56, 49.38, by = 0.01), 100, replace = T)) %>%
dplyr::rename(id = label) %>%
dplyr::select(id, year, lat, lon)
# plotting the phylogenetic tree
# phylogenetic tree example
mytree_plot <-
ggtree::ggtree(mytree, layout = "rectangular", ladderize = T, lwd = .2) %<+%
mymetadata +
geom_tippoint(aes(color = year), size = 1, show.legend = T) +
scale_color_gradient(low='red', high="blue", space = "Lab",
limits = c(NA, NA), na.value = "black",
n.breaks = 8,
guide = "colorbar") +
geom_tiplab(aes(label = label), size = 1, offset = -1E-10) +
geom_treescale(fontsize = 2, linesize = 0.5, offset = 1) +
theme(legend.position = c(0.9,0.15),
legend.title = element_text(size = 8),
legend.text = element_text(size = 6),
plot.title = element_text(hjust = 1))
mytree_plot
For some reason, I have to add the theme to be able to see the legend for the points, it is not created automatically. This should not occur. If anyone see what I am doing wrong here please let me know.
Then I add the sampling locations on the map, and deactivate the legend that is common with the tree legend
mymap_plot <- ggmap(mymap, n_pix = 340, darken = c(0.6, "white"))+
geom_point(data = mymetadata,
aes(x = lon, y = lat, color = year),
size = 2, alpha = .8, na.rm = T) +
scale_color_gradient(low='red', high="blue", space = "Lab",
limits = c(NA, NA),
n.breaks = 8,
guide = "colorbar") +
guides(color = F)
mymap_plot
Then I combine the tree plot and the map plot together. I tried with "patchwork" and "ggpubr" packages.
So far it appear easier to combine plots and draw a single legend with ggpubr, so this is currently my first choice at combining plot
# combining plots with patchwork
combined_plot <- mytree_plot + mymap_plot
# combining plots with ggpubr
# which I like better because it allows to combine the legends which is usefull
# when more variables are used ie shape for uncertainty location
other_combined <- ggarrange(mytree_plot, mymap_plot,
ncol = 2,
labels = c("A", "B"),
align = "hv",
legend = "bottom",
common.legend = T)
Here is the combined plot of the phylogenetic tree (ggtree) and the map (ggmap) obtained with ggpubr.
I am stuck at this point.
I need a way to add segments between corresponding points at the tips of the tree to the corresponding sampling locations of each tip on the map
Any solutions/ideas on how I could do that?
I am trying to understand the behavior of the "fill" argument in geom_polygon for ggplot.
I have a dataframe where I have multiple values from a measure of interest, obtained in different counties for each state. I have merged my database with the coordinates from the "maps" package and then I call the plot via ggplot. I don't understand how ggplot chooses what color to show for a state considering that different numbers are provided in the fill variable (mean?median?interpolation?)
Reproducing a piece of my dataframe to explain what I mean:
state=rep("Alabama",3)
counties=c("Russell","Clay","Montgomery")
long=c(-87.46201,-87.48493,-87.52503)
lat=c(30.38968,30.37249,30.33239)
group=rep(1,3)
measure=c(22,28,17)
df=data.frame(state, counties, long,lat,group,measure)
Call for ggplot
p <- ggplot()
p <- p + geom_polygon(data=df, aes(x=long, y=lat, group=group, fill=df$measure),colour="black"
)
print(p)
Using the full dataframe, I have hundreds of rows with iterations of 17 counties and all the set of coordinates for the Alabama polygon. How is it that ggplot provides the state fill with a single color?
Again, I would assume it is somehow interpolating the fill values provided at each set of coordinate, but I am not sure about it.
Thanks everyone for the help.
Through trial and error, it looks like the first value of the fill mapping is used for the fill of the polygon. The range of the fill scale takes all values into account. This makes sense because the documentation doesn't mention any aggregation---I agree that an aggregate function would also make sense, but I would assume that the aggregation function would be set via an argument if that were the implementation.
Instead, the documentation shows an example (and recommends) starting with two data frames, one of which has coordinates for each vertex, and one which has a single row (and single fill value) per polygon, and joining them based on an ID column.
Here's a demonstration:
long=c(1, 1, 2)
lat=c(1, 2, 2)
group=rep(1,3)
df=data.frame(long,lat,group,
m1 = c(1, 1, 1),
m2 = c(1, 2, 3),
m3 = c(3, 1, 2),
m4 = c(1, 10, 11),
m5 = c(1, 5, 11),
m6 = c(11, 1, 10))
library(ggplot2)
plots = lapply(paste0("m", 1:6), function(f)
ggplot(df, aes(x = long, y = lat, group = group)) +
geom_polygon(aes_string(fill = f)) +
labs(title = sprintf("%s:, %s", f, toString(df[[f]])))
)
do.call(gridExtra::grid.arrange, plots)
Here is a sample script using random numbers instead of real elevation data.
library(gridExtra)
library(spatstat) #im function
elevation <- runif(500, 0, 10)
B <- matrix(elevation, nrow = 20, ncol = 25)
Elevation_Map <- im(B)
custom <- colorRampPalette(c("cyan","green", "yellow", "orange", "red"))
plot(Elevation_Map, col = custom(10), main = NULL)
This is the plot and legend that I get:
This is the legend that I am trying to recreate in R (this one made in Word):
I know this is possible and its probably a simple solution but I've tried using some examples I found online to no avail.
This plot (with real elevation data) is an art piece that will be hung in a gallery, with the elevation plot on 1 board and the legend on a separate board. I tried to get R to plot just the plot without the legend using
plot(Elevation_Map, col = custom(10), main = NULL, legend = NULL)
like I have in the past but for some reason it always plots the legend with the plot. As of right now I'm planning on just cropping the .pdf into 2 separate files to achieve this.
Here are two ways of doing it using other packages:
# example data, set seed to reproduce.
set.seed(1); elevation <- runif(500, 0, 10)
B <- matrix(elevation, nrow = 20, ncol = 25)
#Elevation_Map <- im(B)
custom <- colorRampPalette(c("cyan","green", "yellow", "orange", "red"))
1) Using fields package, image.plot(), it is same "base" graphics::image.default() plot but with more arguments for customisation (but couldn't remove the ticks from legend):
library(fields)
image.plot(B, nlevel = 10, col = custom(10),
breaks = 1:11,
lab.breaks = c("Low Elevation", rep("", 9), "High Elevation"),
legend.mar = 10)
2) Using ggplot package, geom_raster function:
library(ggplot2)
library(reshape) # convert matrix to long dataframe: melt
B_melt <- reshape2::melt(B)
head(B_melt)
ggplot(B_melt, aes(X1, X2, fill = value)) +
geom_raster() +
theme_void() +
scale_fill_gradientn(name = element_blank(),
breaks = c(1, 9),
labels = c("Low Elevation", "High Elevation"),
colours = custom(10))
The code in the original post is using the im class from the spatstat package. The plot command is dispatched to plot.im. Simply look at help(plot.im) to figure out how to control the colour ribbon. The relevant argument is ribargs. Here is a solution:
plot(Elevation_Map, col=custom(10), main="",
ribargs=list(at=Elevation_Map$yrange,
labels=c("Low Elevation", "High Elevation"),
las=1))
I have been playing around with ggplot2 a bunch and found Adding table within the plotting region of a ggplot in r
I was wondering is there any method for this for plotting using non cartesian coordinates, eg if map coordinates were used for the positioning of the table. I had some maps and thought it would be cool if they could have their corresponding data in a table for points to show more detail.
If anyone knows a work around for annotation_custom for non cartesian coordinates it would be greatly appreciated.
EDIT:Here is a image of what my map looks like, I was just thinking is there another way to plot the table on the left side of this.
EDIT: here is what Im attempting to do
EDIT: Here is the basic code structure for the plot
library(ggplot2)
library(ggmap)
plotdata <- read.csv("WellSummary_All_SE_NRM.csv", header = T)
plotdata <- na.omit(plotdata)
plotdata <- plotdata[1:20, c("Unit_No","neg_decimal_lat", "decimal_long", "max_drill_depth", "max_drill_date")]
map.plot<- get_map(location = c(min(plotdata$decimal_long),
min(plotdata$neg_decimal_lat),
max(plotdata$decimal_long),
max(plotdata$neg_decimal_lat)),
maptype ="hybrid",source = "google", zoom=8)
theme_set(theme_bw(base_size = 8))
colormap <- c("darkblue","blue","lightblue", "green", "yellow", "orange","darkorange", "red", "darkred")
myBreaks <- c(0,2, 10, 50, 250, 1250, 2000, 2500)
static.map <- ggmap(map.plot) %+% plotdata +
aes(x = decimal_long,
y = neg_decimal_lat,
z= max_drill_depth)+
stat_summary2d(fun = median, binwidth = c(.03, .03),alpha = 0.7) +
scale_fill_gradientn(name = "depth", colours= colormap, breaks=myBreaks,labels = format(myBreaks),
limits= c(0,2600), space = "Lab") +
labs(x = "Longitude",y = "Latitude")+
geom_text(aes(label=Unit_No),hjust=0, vjust=0,size=2,
position = position_dodge(width=0.9), angle = 45)+
coord_map()
#Creates image of the plot in file to Working Directory
filename=paste("2dmap",".png", sep="")
cat("\t",filename,"file created, saving...\n")
print(static.map)
cat("\tpassed mapping, file now being made\n")
ggsave(filename=filename,
plot = static.map,
scale = 1,
width = 6, height = 4,
dpi = 300)
I will try to upload the data today, cheers for some of the pointers already!
I have uploaded the data, dont worry about the positioning of the gradient values and text tags as I can fix them later I will also link the current ggmap code but I am using a very large loop for the data to be sorted.
https://drive.google.com/file/d/0B8qOIJ-nPp9rM1U1dkEzMUM0Znc/edit?usp=sharing
try this,
library(gridExtra)
grid.arrange(tableGrob(head(iris)), qplot(1,1), ncol=2)
annotation_custom wouldn't help, it's meant for adding things inside the plot panel, not to the side.