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 :)
Related
I am trying to make some interactive maps of the United States with basic tooltips using plotly.
However, whenever I render the map the aspect ratio of the plot is 'off', the map looks like it has been stretched and it just looks odd.
library(readxl)
library(dplyr)
library(tidyr)
library(urbnmapr)
library(plotly)
library(ggplot2)
states_territory <- urbnmapr::get_urbn_map(map = "territories_states",
sf = FALSE)
states_territory <- data.frame(states_territory)
states_territory %>%
ggplot(aes_string(x = 'long',
y = 'lat',
group = 'group',
text = 'state_name')) +
geom_polygon(color = "#ffffff", size = 0.25) +
coord_map(projection = "albers", lat0 = 39, lat1 = 45) -> test_plot
plotly_plot <- ggplotly(test_plot,
tooltip = 'text')
plotly_plot
Rendering the code above should contain everything for a REPEX but please let me know if theres something I need to add.
This is a plot that will be inserted into a Shiny app, I have the app working but I am unable to get the plot to have the clean look Im hoping for.
If anyone has any suggestions to remedy this or any other interactive plotting methods, it would be much appreciated. I have already tried ggiraph, and while the plot looks nice, ggiraph does not autoscale in an R shiny context.
Thanks a bunch
This is a fairly simple fix, given the following function. I originally stole this function from a Q&A on SO. I don't know who I pilfered it from, though.
map_aspect = function(x, y) {
x.center <- sum(range(x)) / 2
y.center <- sum(range(y)) / 2
x.dist <- ggplot2:::dist_central_angle(x.center + c(-0.5, 0.5), rep(y.center, 2))
y.dist <- ggplot2:::dist_central_angle(rep(x.center, 2), y.center + c(-0.5, 0.5))
y.dist / x.dist
}
You're going to replace coord_map with the following code to specify the aspect ratio in a way in which Plotly can inherit it.
coord_fixed(with(states_territory, map_aspect(long, lat)))
I'm creating a tree with a ggtree and gheatmap. I am trying to work out how to remove the space between the tip tiles and/or merge adjacent tiles with the same value.
Below is the code I used:
library(ape)
library(tidyverse)
library(ggtree)
tree <- rtree(50)
tree_plot <- ggtree(tree, size = 1, layout = "circular", branch.length = "none")
dummy_data <- data.frame(data = c(rep(1,10),rep(2,10),rep(3,10), rep(4,10), rep(5,10)))
row.names(dummy_data) <- tree$tip.label
gheat_Sensitivity <- gheatmap(p = tree_plot, data=dummy_data, width=0.1, colnames = FALSE) +
new_scale(aes(color = dummy_data)) +
scale_fill_gradientn(colors = c("grey", "yellow"), breaks = c(1, 5.0))
plot(gheat_Sensitivity)
This creates the tree I am after:
ggtree plot
However I would like to remove the spacing between the heatmap tiles so that there is a continuous look to it. Specifically, I would like adjacent tiles with the same value to look like one larger tile.
Any help would be very appreciated,
Cheers,
Tom
Bit late, but for anyone else who has the same issue, you can add colour=NA to the gheatmap call, i.e.
gheatmap(p = tree_plot, data=dummy_data, width=0.1, colnames = FALSE, color=NA)
See here - heatmap with the left with the row space, right after using color=NA.
I'm using library(choroplethr) for some market analysis and I have some questions about making my county_choropleth and either overlaying it on top of a ggmap() or using reference_map=TRUE in my code. What I'm trying to do is take my county choropleth and place state interstates/highways and draw circles/radii on top of it.
What I currently have is this:
library(choroplethr)
data <- Data.frame(County.FIPS = c(19153,19163,19153,19153,19153,19153,19153,19113,19007,19169), Score=c(812.6,769.5,757.9,757.2,722.6,712.4,69727,690.2,64539,642.5)
county <-aggregate(data$Score~data$County.FIPS,data=data,sum)
colnames(county) <- c("region", "value")
mp <- county_choropleth(county, state_zoom=c("iowa"), num_colors = 1) +
theme(legend.position="none")+
scale_fill_gradient2("Score",
high = "dark green",
low = "red",
na.value = "grey90",
breaks = pretty(county$value, n = 10),
label = scales::dollar_format())
...which gives me this plot.
From here, what I would like to do is overlay the main interstates in the state of Iowa on top of my map and also create some radius circles to show distance from certain cities in miles. I would like it to take elements from this map and ideally incorporate them into my choroplethr map because, in my opinion, it looks a lot cleaner than in this example:
I used this code to retrieve the second map:
library(ggmap)
test<-get_map(location = c(lon=-93.57217,lat=41.67269), maptype="roadmap",source="google",zoom=7,scale="auto")
yup <- data.frame(lon=c(-93.57217,-95.87509), lat=c(41.67269,41.23238),score=c(1,1))
ggmap(test) + stat_density2d(aes(x = lon, y = lat, fill = score,alpha=score),
size = 2, bins = 2, data = yup, geom = "polygon") +
theme(legend.position="none")
My main problem with using reference_map=TRUE in the choroplethr library is that it grays out labels, roads, etc. when I place my county_choropleth on top of it. e.g.,
So, is there an easy workaround for including roads and drawing circles on a map or do I need to abandon using choroplethr and move to ggmap, ggplot2 or something else? I also have been able to locate the Iowa DOT shapefiles for roads on their website, so that is an option to include, but I don't know how specifically to only ask it to use main interstates/highways when plotting and reading into R.
Here is my "ideal" MS Paint solution to this problem:
Thank you in advance for any and all help and please let me know if you have any clarification questions that need to be answered in order to help!
For those who stumble upon this later. I was able to achieve what I was hoping to do by changing libraries to leaflet and tigris.
I plan on making final tweaks for personal use, but here is the code used:
library(tigris)
library(leaflet)
data <- data.frame(County.FIPS = c(19153,19163,19153,19153,19153,19153,19153,19113,19007,19169), Score=c(812.6,769.5,757.9,757.2,722.6,712.4,69727,690.2,64539,642.5))
county <-aggregate(data$Score~data$County.FIPS,data=data,sum)
colnames(county) <- c("GEOID", "Score")
IA_counties <- counties(state="IA", cb=TRUE, resolution ="20m")
IA_merged <- geo_join(IA_counties,county,"GEOID", "GEOID")
pal <- colorQuantile("Greens",NULL,n=3)
popup <- paste0("Profitability: ", as.character(IA_merged$Score))
yup2 <- data.frame(lon=c(-93.57217,-95.93779),lat=c(41.67269,41.25861),score=c(1,1))
leaflet() %>%
addProviderTiles("Esri.WorldStreetMap") %>%
addLegend(pal = pal,
values = IA_merged$Score,
position = "bottomright",
title = "County Profitablity: ") %>%
addCircles(lng=yup2$lon, lat=yup2$lat,weight=1,fillOpacity=0.05,color="red",
radius = 96560) %>%
addCircles(lng=yup2$lon, lat=yup2$lat,weight=1,fillOpacity=0.025,color="blue",
radius = 193121) %>%
addPolygons(data = IA_counties,
fillColor = ~pal(IA_merged$Score),
fillOpacity = 0.15,
weight = 0.2,
popup = popup)
I have been trying to create a map of membership locations from postcodes across the UK as a project in learning R. I have achieved nearly the result I wanted, but it's proving very frustrating getting the glitches sorted. This image is my current best effort:
I still want to change:
get rid of the extraneous legend (the "0.16", "0.5" squares), which are coming from the size arg to geom_point. If I remove the size=0.16 arg the guide/legend disappears, but the geom size returns to the default too. This also happens for the "black" guide -- coming from a colour obviously -- but why?
properly clip the stat_density2d polygons, which are exhibiting undesireable behaviour when clipped (see bottom-right plot near the top)
have control over the line-width of the geom_path that includes the county boundaries: it's currently too thick (would like about 1/2 thickness shown) but all I can achieve by including 'size' values is to make the lines stupidly thick - so thick that they obscure the whole map.
The R code uses revgeocode() to find the placename closest to the centre point but I don't know how to include the annotation on the map. I would like to include it in a text-box over the North Sea (top right of UK maps), maybe with a line/arrow to the point itself. A simpler option could just be some text beneath the UK map, below the x-axis ... but I don't know how to do that. geom_rect/geom_text seem fraught in this context.
Finally, I wanted to export the map to a high-res image, but when I do that everything changes again, see:
which shows the high-res (~1700x1800px) image on the left and the Rstudio version (~660x720px) on the right. The proportions of the maps have changed and the geom_text and geom_point for the centre point are now tiny. I would be happy if the gap between the two map rows was always fairly small, too (rather than just small at high res).
Code
The basics: read list of members postcodes, join with mySociety table of postcode<>OSGB locations, convert locations to Lat/long with spTransform, calculate binhex and density layers, plot with ggmap.
The code for all this is somewhat lengthy so I have uploaded it as a Gist:
https://gist.github.com/rivimey/ee4ab39a6940c0092c35
but for reference the 'guts' of the mapping code is here:
# Get a stylised base map for the whole-of-uk maps.
map.bbox = c(left = -6.5, bottom = 49.5, right = 2, top = 58)
basemap.uk <- get_stamenmap(bb = map.bbox, zoom=calc_zoom(map.bbox), maptype="watercolor")
# Calculate the density plot - a continuous approximation.
smap.den <- stat_density2d(aes(x = lat, y = lon, fill = ..level.., alpha = ..level..),
data = membs.wgs84.df, geom = "polygon",
breaks=2/(1.5^seq(0,12,by=1)), na.rm = TRUE)
# Create a point on the map representing the centroid, and label it.
cmap.p <- geom_point(aes(x = clat, y = clon), show_guide = FALSE, data = centroid.df, alpha = 1)
cmap.t1 <- geom_text(aes(x = clat, y = clon+0.22, label = "Centre", size=0.16), data = centroid.df)
cmap.t2 <- geom_text(aes(x = clat, y = clon+0.1, label = "Centre", size=0.25), data = centroid.df)
# Create an alternative presentation, as binned hexagons, which is more true to the data.
smap.bin <- geom_hex(aes(x = lat, y = lon),
data = membs.wgs84.df, binwidth = c(0.15, 0.1), alpha = 0.7, na.rm = TRUE)
# Create a path for the county and country boundaries, to help identify map regions.
bounds <- geom_path(aes(x = long, y = lat, group = group, colour = "black"), show_guide = FALSE,
data = boundaries.subset, na.rm = TRUE)
# Create the first two actual maps: a whole-uk binned map, and a whole-uk density map.
map.bin <- ggmap(basemap.uk) + smap.bin + grad + cmap.p + cmap.t1
map.den <- ggmap(basemap.uk) + smap.den + alpha + cmap.p + cmap.t1
# Create a zoomed-in map for the south-east, to show greater detail. I would like to use this
# bbox but google maps don't respect it :(
map.lon.bbox = c(left = -1, bottom = 51, right = 1, top = 52)
# Get a google terrain map for the south-east, bbox roughly (-1.7,1.7, 50.1, 53)
basemap.lon <- get_map(location = c(0,51.8), zoom = 8, maptype="terrain", color = "bw")
# Create a new hexbin with more detail than earlier.
smap.lon.bin <- geom_hex(aes(x = lat, y = lon),
data = membs.wgs84.df, bins=26, alpha = 0.7, na.rm = TRUE)
# Noe create the last two maps: binned and density maps for London and the SE.
lonmap.bin <- ggmap(basemap.lon) + bounds + smap.lon.bin + grad + cmap.p + cmap.t2
lonmap.den <- ggmap(basemap.lon) + bounds + smap.den + alpha + cmap.p + cmap.t2
# Arrange the maps in 2x2 grid, and tell the grid code to let the first row be taller than the second.
multiplot(map.bin, lonmap.bin, map.den, lonmap.den, heights = unit( c(10,7), "null"), cols=2 )
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.