Roads and Radius Circles in choroplethr, ggmap, or ggplot2 - r

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)

Related

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:
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 :)

How to give every co-ordinate another color using tmap

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)

Static polygons in plotly? Is it possible?

I have been trying to create a plot where I have some points that I want to be interactive with hover-info etc but I want to include two polygon areas without any of the interactive stuff.
For MWE:
library(plotly)
data("iris")
xsq <- function(x) sqrt(x)
x <- c( c(seq(0,10,0.001),0,0), c(0.5,10,10,0.5))
y <- c( c(xsq(x[1:length(seq(0,10,0.001))]),xsq(max(x)),0), c(0,2,0,0))
## produce the plotly plot
plot_ly(x = x, y = y, alpha = 0.1, opacity=0.1) %>%
add_polygons(hoverinfo = "none", color = I("red"),showlegend=F) %>%
add_polygons(x = c(0.5,10,10,0.5), y=c(0,2,0,0), hoverinfo = "none",
color = I("blue"), showlegend=F) %>%
add_markers(x=iris$Sepal.Length,y=iris$Sepal.Width-2, opacity=1, alpha=1,
color=iris$Species, hoverinfo="text", text=iris$Species)
This is sort of giving me what I want but I have a couple of problems:
The hover informative for the points in the polygon regions are not appearing
If I select a group, then the two polygons also disappear from view. I would like to keep the polygon present at all times even when only a single groups of points is to be selected
I was also trying to use ggplot but wasn't having any luck there.
Basically what I think I want is a way to add two static polygons to a plotly plot. Does anyone have any other suggestions/ideas?
Thanks.
So after some extensive searching and experimentation, I worked out how to solve problem 1. One needs to include hoveron="points" for the polygon layers. e.g.,
plot_ly(x = x, y = y, alpha = 0.1, opacity=0.1) %>%
add_polygons(hoverinfo = "none", color = I("red"),showlegend=F, hoveron="points") %>%
add_polygons(x = c(0.5,10,10,0.5), y=c(0,2,0,0), hoverinfo = "none",
color = I("blue"), showlegend=F, hoveron="points") %>%
add_markers(x=iris$Sepal.Length,y=iris$Sepal.Width-2, opacity=1, alpha=1,
color=iris$Species, hoverinfo="text", text=iris$Species)

Restrict the viewable part of a Leaflet tile to a polygon area

I am learning how to use R and Leaflet. I am almost done making a map using California counties, but I don't like that I can see other states in the map. I would like to white out the map around my polygon (the counties). I saw a similar problem resolved elsewhere but I don't know enough to apply what was said there to my code. Could someone check this code out and suggest what I need to add?
If you scroll to the bottom of this link you'll see what I am trying to do. http://rpubs.com/stefanya/127436
The code I am using is:
#loading shapefile
counties <- readOGR("./shapefiles", layer="cb_2014_us_county_20m")
#filtering for only california
counties <- subset(counties, counties#data$STATEFP=="06")
#making a leaflet map of california counties
leaflet() %>% addTiles() %>% addPolygons(data=counties)
#merging the data into this shapefile
counties#data = data.frame(counties#data, sumByCounty[match(counties#data[,"NAME"], sumByCounty[,"NAME"]),])
#set color palette
colorRamp <- colorRamp(c("#2c7fb8","#7fcdbb","#edf8b1"), interpolate = "spline")
palette <- colorNumeric(colorRamp, counties#data$progress)
leaflet() %>% addProviderTiles("Stamen.TonerLite") %>%
addPolygons(
weight= 2,
stroke = TRUE,
fillOpacity = .65,
data=counties,
color = ~palette(progress),
popup = ~paste("<strong>County:</strong>",NAME,
"<br>",
"<strong>Total Responses:</strong>",sumByCounty,
"<br>",
"<strong>Complete:</strong>",progress,"<strong>%</strong>")
) %>% addLegend(title = "Response <br> Goal Met", pal = palette, values = counties#data$progress, bins=5, opacity = 1, position="topright", labFormat = labelFormat(suffix = '%'))
Create a polygon with with two rings, the first with geometry of the entire earth (or your view's bounds), the second with the geometry of California:
[
// World
[[90,-180], [90,180], [-90,180], [-90,-180]],
// California
[[42.006186,-123.233256],[42.011663,-122.378853],[41.995232,-121.037003],[41.995232,-120.001861],[40.264519,-119.996384],[38.999346,-120.001861],[38.101128,-118.71478],[37.21934,-117.498899],[36.501861,-116.540435],[35.970598,-115.85034],[35.00118,-114.634459],[34.87521,-114.634459],[34.710902,-114.470151],[34.448009,-114.333228],[34.305608,-114.136058],[34.174162,-114.256551],[34.108438,-114.415382],[33.933176,-114.535874],[33.697668,-114.497536],[33.54979,-114.524921],[33.40739,-114.727567],[33.034958,-114.661844],[33.029481,-114.524921],[32.843265,-114.470151],[32.755634,-114.524921],[32.717295,-114.72209],[32.624187,-116.04751],[32.536556,-117.126467],[32.668003,-117.24696],[32.876127,-117.252437],[33.122589,-117.329114],[33.297851,-117.471515],[33.538836,-117.7837],[33.763391,-118.183517],[33.703145,-118.260194],[33.741483,-118.413548],[33.840068,-118.391641],[34.042715,-118.566903],[33.998899,-118.802411],[34.146777,-119.218659],[34.26727,-119.278905],[34.415147,-119.558229],[34.40967,-119.875891],[34.475393,-120.138784],[34.448009,-120.472878],[34.579455,-120.64814],[34.858779,-120.609801],[34.902595,-120.670048],[35.099764,-120.631709],[35.247642,-120.894602],[35.450289,-120.905556],[35.461243,-121.004141],[35.636505,-121.168449],[35.674843,-121.283465],[35.784382,-121.332757],[36.195153,-121.716143],[36.315645,-121.896882],[36.638785,-121.935221],[36.6114,-121.858544],[36.803093,-121.787344],[36.978355,-121.929744],[36.956447,-122.105006],[37.115279,-122.335038],[37.241248,-122.417192],[37.361741,-122.400761],[37.520572,-122.515777],[37.783465,-122.515777],[37.783465,-122.329561],[38.15042,-122.406238],[38.112082,-122.488392],[37.931343,-122.504823],[37.893004,-122.701993],[38.029928,-122.937501],[38.265436,-122.97584],[38.451652,-123.129194],[38.566668,-123.331841],[38.698114,-123.44138],[38.95553,-123.737134],[39.032208,-123.687842],[39.366301,-123.824765],[39.552517,-123.764519],[39.831841,-123.85215],[40.105688,-124.109566],[40.259042,-124.361506],[40.439781,-124.410798],[40.877937,-124.158859],[41.025814,-124.109566],[41.14083,-124.158859],[41.442061,-124.065751],[41.715908,-124.147905],[41.781632,-124.257444],[42.000709,-124.213628],[42.006186,-123.233256]]
]
Example on Plunker: http://embed.plnkr.co/ZWzuxz/preview

Can you plot a table onto a ggmap similar to annotation_custom method for non- Cartesian coordinates

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.

Resources