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've generated a vector of hex colour codes using colorfindr.
I would like to sort them by colour from light to dark.
A quick search has revealed that this is not a simple issue, for example: https://www.alanzucconi.com/2015/09/30/colour-sorting/ or https://mathematica.stackexchange.com/questions/87588/how-to-sort-colors-properly
The colour vector I am working with is:
my_colours <- c("#F6F5F5", "#F4F3F0", "#EDF2F0", "#E1E2E3", "#C2D3DD", "#F6F1E5",
"#404965", "#E4CCD0", "#DFC575", "#D14845", "#E8B426", "#DF7B6D",
"#8DBAD3", "#C44334", "#DE7E31", "#BCBFCD", "#9E4049", "#97372F",
"#BC9AB0", "#4E3427", "#132021", "#0273AD", "#1D3F59", "#F9E892",
"#E2A4AF", "#F6E8D3", "#A5B774", "#A38074", "#6B847E", "#61ABCC",
"#6F86AC", "#B2BC3D", "#718E43", "#077A85", "#28A8C4", "#1D7B51",
"#A57D35", "#3483B0", "#F7CA0E", "#F9CE73", "#FDE35C", "#FAE214",
"#F4DDD2", "#F4C8BE", "#F5BD87", "#F3B61E", "#F2A581", "#F38387",
"#F3A72F", "#F3952F")
Which looks like this:
I have tried niavely sorting the hex colour codes in {my_colours} but this does not really improve the order.
Any pointers or guidance to address this query in the context of R would be most welcome.
To "sort" color in a pleasing way where similar colors are grouped together, we can try to do find the shortest path that connects all colors in a color space. This turns out to be the same as the famous traveling salesman problem. Here's a quick way to do this is in R using the RGB color space:
# original colors
ggplot2::qplot(x = 1:50, y = 1, fill = I(my_colours), geom = 'col', width = 1) + ggplot2::theme_void()
library(TSP)
rgb <- col2rgb(my_colours)
tsp <- as.TSP(dist(t(rgb)))
sol <- solve_TSP(tsp, control = list(repetitions = 1e3))
ordered_cols <- my_colours[sol]
ggplot2::qplot(x = 1:50, y = 1, fill = I(ordered_cols), geom = 'col', width = 1) + ggplot2::theme_void()
You can use different color spaces to get different results.
Edit:
Sorting from light to dark is much easier, just use Lab space:
lab <- convertColor(t(rgb), 'sRGB', 'Lab')
ordered_cols2 <- my_colours[order(lab[, 'L'])]
ggplot2::qplot(x = 1:50, y = 1, fill = I(ordered_cols2), geom = 'col', width = 1) + ggplot2::theme_void()
I am trying to make a map with hotels in las vegas. I have all the coordinates. I also made a map with a dot at the 'hotel points'. But these dots are all black. I need every hotel (dot) to be another color.
As you can see, all the dots (hotels) are black..
This is my code:
df_hotels <- df_joinall %>%
group_by(hotel_name)
df <- st_as_sf(df_hotels, coords = c("Longitude","Latitude"))
tmap_mode("view")+
tm_basemap("OpenStreetMap") +
tm_shape(df) +
tm_dots(popup.format = list(text.align = "center"), size = 0.5, alpha = 0.7)
Does anyone has suggestions on how to give every point (hotel) another color
To have the points colored you need to map the col aesthetic to a column of your data frame. Note that {tmap} requires column names enclosed in quotation marks.
Your example is not exactly reproducible, but I expect this to work:
df_hotels <- df_joinall %>%
group_by(hotel_name)
df <- st_as_sf(df_hotels, coords = c("Longitude","Latitude"))
tmap_mode("view")+
tm_basemap("OpenStreetMap") +
tm_shape(df) + tm_dots(col = "hotel_name", size = 0.5, alpha = 0.7)
I am using pheatmap to create a heatmap of values and would like to label the legend with the units of the z values in the matrix. In this example I would like the top of the legend to say Temperature [°C]. I have read the guidelines here for pheatmap, and it seems the only manipulation of the legend is to add a list of default numbers to be displayed in place of the scale. I cannot see any option to add a legend title per se.
Here is a generic block of code to generate a matrix and plot using pheatmap. I would really appreciate any advice on how to add a title to the legend.
test <- matrix(rexp(200, rate=.1), ncol=20)
colnames(test) = paste("Room", 1:20, sep = "")
rownames(test) = paste("Building", 1:10, sep = "")
pheatmap(test, legend = TRUE, cluster_rows = FALSE, cluster_cols = FALSE)
MikeyMike's answer is incredible; I also learned a lot by reading it.
However, I needed a dumb, ugly, 10 second solution:
test <- matrix(rexp(200, rate=.1), ncol=20)
colnames(test) = paste("Room", 1:20, sep = "")
rownames(test) = paste("Building", 1:10, sep = "")
pheatmap(test, legend_breaks = c(10, 20, 30, 40, max(test)),
main = "", legend_labels = c("10", "20", "30", "40", "title\n"),
legend = TRUE, cluster_rows = FALSE, cluster_cols = FALSE)
Which produces this heatmap:
OK so since someone has yet to answer this, I'll give you one possible option if you absolutely must use the pheatmap function. This is much easier to do using
ggplot, but here it goes:
First we are going to want to generate our plot so we can use all the plot objects to create our own plot, with an edited legend.
#Edited to add in library names
library(gtable)
library(grid)
#Starting with data and generating initial plot
test <- matrix(rexp(200, rate=.1), ncol=20)
colnames(test) = paste("Room", 1:20, sep = "")
rownames(test) = paste("Building", 1:10, sep = "")
p<-pheatmap(test, legend = TRUE, cluster_rows = FALSE, cluster_cols = FALSE)
#Get grobs we want - will use these to create own plot later
plot.grob <- p$gtable$grob[[1]]
xlab.grob <- p$gtable$grob[[2]]
ylab.grob <- p$gtable$grob[[3]]
legend.grob <- p$gtable$grob[[4]]
Now once we have our objects, we actually want to shift the legend down a little to make room for the title.
#Shift both down by 1 inch
legend.grob$children[[1]]$y <- legend.grob$children[[1]]$y - unit(0.85,"inches")
legend.grob$children[[2]]$y <- legend.grob$children[[2]]$y - unit(0.85,"inches")
legend.grob$children[[1]]$x <- legend.grob$children[[1]]$x + unit(0.4,"inches")
legend.grob$children[[2]]$x <- legend.grob$children[[2]]$x + unit(0.4,"inches")
Since we've made room for the legend, now we can create the legend textGrob and add it to the legend grobTree (just set of graphical objects in what we want our legend to be)
#New legend label grob
leg_label <- textGrob("Temperature [°C]",x=0,y=0.9,hjust=0,vjust=0,gp=gpar(fontsize=10,fontface="bold"))
#Add label to legend grob
legend.grob2 <- addGrob(legend.grob,leg_label)
If you want to check out what our legend will look like try:
grid.draw(legend.grob2)
Now we actually need to build our gtable object. To do this we will use a similar layout (with some modifications) as the plot generated by the pheatmap function. Also note that the pheatmap function generates a gtable object which can be accessed by:
p$gtable
In order to see the widths/heights of each of the "sectors" in our gtable object all we need to do is:
p$gtable$heights
p$gtable$widths
These will serve as our reference values. For a more graphical display try:
gtable_show_layout(p$gtable)
Which yields this image:
Ok, so now that we have the grobs we want, all we need to do is build our gtable based on what we saw for the gtable built by pheatmap. Some sample code I've written is:
my_new_gt <- gtable(widths= unit.c(unit(0,"bigpts") + unit(5,"bigpts"),
unit(0,"bigpts"),
unit(1,"npc") - unit(1,"grobwidth",plot.grob) + unit(10,"bigpts") - max(unit(1.1,"grobwidth",plot.grob), (unit(12,"bigpts")+1.2*unit(1.1,"grobwidth",plot.grob))) + unit(5,"bigpts") - unit(3,"inches"),
unit(1,"grobwidth",ylab.grob) + unit(10,"bigpts"),
max(unit(1,"grobwidth",legend.grob2),unit(12,"bigpts")+1.2*unit(1.1,"grobwidth",legend.grob2)) + unit(1,"inches") ,
max(unit(0,"bigpts"),unit(0,"bigpts"))
),
height = unit.c(unit(0,"npc"),
unit(5,"bigpts"),
unit(0,"bigpts"),
unit(1,"npc") - unit(1,"grobheight",xlab.grob) + unit(15,"bigpts") - unit(0.2,"inches"),
unit(1,"grobheight",xlab.grob) + unit(15,"bigpts")
))
Finally, we can add all our objects to our new gtable to get a very similar plot to the one generated by pheatmap with the added legend title.
#Adding each grob to the appropriate spot
gtable <- gtable_add_grob(my_new_gt,plot.grob,4,3)
gtable <- gtable_add_grob(gtable,xlab.grob,5,3)
gtable <- gtable_add_grob(gtable,ylab.grob,4,4)
gtable <- gtable_add_grob(gtable,legend.grob2,4,5)
grid.draw(gtable)
Finally the generated output is:
Hope this helped. You can fiddle around with the different sizing to try to make the layout more dynamic, but I think this is a good setup and gets you what you wanted - the pheatmap with a legend.
EDIT - ggplot option:
Since I recommended ggplot as an alternative here is some code to accomplish it:
library(ggplot2)
library(reshape)
test <- as.data.frame(matrix(rexp(200, rate=.1), ncol=20))
colnames(test) = paste("Room", 1:20, sep = "")
test$building = paste("Building", 1:10, sep = "")
#Get the sorting right
test$sort <- 1:10
#Melting data so we can plot it with GGplot
test.m <- melt(test,id.vars = c("building","sort"))
#Resetting factors
test.m$building <- factor(test.m$building, levels=(test.m$building)[order(test.m$sort)])
#Creating the plot itself
plot <- ggplot(test.m,aes(variable,building)) + geom_tile(aes(fill=value),color = "white") +
#Creating legend
guides(fill=guide_colorbar("Temperature [°C]")) +
#Creating color range
scale_fill_gradientn(colors=c("skyblue","yellow","tomato"),guide="colorbar") +
#Rotating labels
theme(axis.text.x = element_text(angle = 270, hjust = 0,vjust=-0.05))
plot
Which produces this plot:
As you can see the ggplot2 method is much faster. All you have to do is convert your data to a dataframe and then melt it. Once that's done, you can easily change the legend titles.
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.