Related
I saw yesterday this beautiful map of McDonalds restaurants in USA. I wanted to replicate it for France (I found some data that can be downloaded here).
I have no problem plotting the dots:
library(readxl)
library(ggplot2)
library(raster)
#open data
mac_do_FR <- read_excel("./mcdo_france.xlsx")
mac_do_FR_df <- as.data.frame(mac_do_FR)
#get a map of France
mapaFR <- getData("GADM", country="France", level=0)
#plot dots on the map
ggplot() +
geom_polygon(data = mapaFR, aes(x = long, y = lat, group = group),
fill = "transparent", size = 0.1, color="black") +
geom_point(data = mac_do_FR_df, aes(x = lon, y = lat),
colour = "orange", size = 1)
I tried several methods (Thiessen polygons, heat maps, buffers), but the results I get are very poor. I can't figure out how the shaded polygons were plotted on the American map. Any pointers?
Here's my result, but it did take some manual data wrangling.
Step 1: Get geospatial data.
library(sp)
# generate a map of France, along with a fortified dataframe version for ease of
# referencing lat / long ranges
mapaFR <- raster::getData("GADM", country="France", level=0)
map.FR <- fortify(mapaFR)
# generate a spatial point version of the same map, defining your own grid size
# (a smaller size yields a higher resolution heatmap in the final product, but will
# take longer to calculate)
grid.size = 0.01
points.FR <- expand.grid(
x = seq(min(map.FR$long), max(map.FR$long), by = grid.size),
y = seq(min(map.FR$lat), max(map.FR$lat), by = grid.size)
)
points.FR <- SpatialPoints(coords = points.FR, proj4string = mapaFR#proj4string)
Step 2: Generate a voronoi diagram based on store locations, & obtain the corresponding polygons as a SpatialPolygonsDataFrame object.
library(deldir)
library(dplyr)
voronoi.tiles <- deldir(mac_do_FR_df$lon, mac_do_FR_df$lat,
rw = c(min(map.FR$long), max(map.FR$long),
min(map.FR$lat), max(map.FR$lat)))
voronoi.tiles <- tile.list(voronoi.tiles)
voronoi.center <- lapply(voronoi.tiles,
function(l) data.frame(x.center = l$pt[1],
y.center = l$pt[2],
ptNum = l$ptNum)) %>%
data.table::rbindlist()
voronoi.polygons <- lapply(voronoi.tiles,
function(l) Polygon(coords = matrix(c(l$x, l$y),
ncol = 2),
hole = FALSE) %>%
list() %>%
Polygons(ID = l$ptNum)) %>%
SpatialPolygons(proj4string = mapaFR#proj4string) %>%
SpatialPolygonsDataFrame(data = voronoi.center,
match.ID = "ptNum")
rm(voronoi.tiles, voronoi.center)
Step 3. Check which voronoi polygon each point on the map overlaps with, & calculate its distance to the corresponding nearest store.
which.voronoi <- over(points.FR, voronoi.polygons)
points.FR <- cbind(as.data.frame(points.FR), which.voronoi)
rm(which.voronoi)
points.FR <- points.FR %>%
rowwise() %>%
mutate(dist = geosphere::distm(x = c(x, y), y = c(x.center, y.center))) %>%
ungroup() %>%
mutate(dist = ifelse(is.na(dist), max(dist, na.rm = TRUE), dist)) %>%
mutate(dist = dist / 1000) # convert from m to km for easier reading
Step 4. Plot, adjusting the fill gradient parameters as needed. I felt the result of a square root transformation looks quite good for emphasizing distances close to a store, while a log transformation is rather too exaggerated, but your mileage may vary.
ggplot() +
geom_raster(data = points.FR %>%
mutate(dist = pmin(dist, 100)),
aes(x = x, y = y, fill = dist)) +
# optional. shows outline of France for reference
geom_polygon(data = map.FR,
aes(x = long, y = lat, group = group),
fill = NA, colour = "white") +
# define colour range, mid point, & transformation (if desired) for fill
scale_fill_gradient2(low = "yellow", mid = "red", high = "black",
midpoint = 4, trans = "sqrt") +
labs(x = "longitude",
y = "latitude",
fill = "Distance in km") +
coord_quickmap()
I'm working to plot the consolidated Z-value deviations (for a series of factors) from the national average for Pakistan on a fortified SPDF. For the purposes of this question, my data is irrelevant. I could provide it if necessary.
I am using ggplot to create my output where the command and result look something like this:
ggplot() + geom_polygon(data = plot.pakmod_sumZ, aes(x = long, y = lat, group = group, fill = SumZ.Cat), color = "black", size = 0.25, na.rm = TRUE) + scale_fill_manual(name = "Deviations from National Average", labels = c("-7", "-6", "-5", "-4", "-3", "-2", "-1", "Positive"), values = c("darkorange4","brown", "orangered1","tomato1","darkorange3","orange","yellow", "greenyellow"), na.value = "Grey", guide = guide_legend(reverse = TRUE)) + coord_map() + labs(x = NULL, y = NULL) + scale_x_discrete(breaks = NULL) + scale_y_discrete(breaks = NULL) + theme_minimal()
Deviations from National Average
I am trying to figure out now if it's possible to add diagonal lines in the polygons which have missing values and are coloured grey. Can this be done using ggplot?
This is an example I took from here. I opted to use the horizontal error bar geom. Mind that this isn't the only way of doing this.
library(ggplot2)
library(sp)
library(rgdal)
library(rgeos)
# create a local directory for the data
localDir <- "R_GIS_data"
if (!file.exists(localDir)) {
dir.create(localDir)
}
# download and unzip the data
url <- "ftp://www.ecy.wa.gov/gis_a/inlandWaters/wria.zip"
file <- paste(localDir, basename(url), sep='/')
if (!file.exists(file)) {
download.file(url, file)
unzip(file,exdir=localDir)
}
# create a layer name for the shapefiles (text before file extension)
layerName <- "WRIA_poly"
# read data into a SpatialPolygonsDataFrame object
dataProjected <- readOGR(dsn=localDir, layer=layerName)
dataProjected#data$id <- rownames(dataProjected#data)
# create a data.frame from our spatial object
watershedPoints <- fortify(dataProjected)
# merge the "fortified" data with the data from our spatial object
watershedDF <- merge(watershedPoints, dataProjected#data, by = "id")
dataProjected#data$id <- rownames(dataProjected#data)
watershedPoints <- fortify(dataProjected)
watershedDF <- merge(watershedPoints, dataProjected#data, by = "id")
ggWatershed <- ggplot(data = watershedDF, aes(x=long, y=lat, group = group, fill = WRIA_NM)) +
geom_polygon() +
geom_path(color = "white") +
scale_fill_hue(l = 40) +
coord_equal() +
theme(legend.position = "none", title = element_blank())
# Adding coordinates to the data part of SPDF. `sd` is the variable of interest
# which is beign plotted here. Each line extends sd away from long coordinate
dataProjected#data$sd <- rnorm(nrow(xy), mean = 50000, sd = 10000)
xy <- coordinates(dataProjected)
dataProjected#data$long <- xy[, 1]
dataProjected#data$lat <- xy[, 2]
ggWatershed +
geom_errorbarh(data = dataProjected#data, aes(group = id, xmin = long - sd, xmax = long + sd))
I'm trying to plot a map small multiples grid that shows hurricanes/tropical storms that have intersected with Florida since 1900. I used some spatial queries to subset the database of all Atlantic storms for this project.
I'm now plotting a line shapefile of my limited number of hurricane tracks on top of polygons of the state of Florida, some contiguous states, a few major cities in Florida and, of course, Lake Okeechobee. Here's the simple code:
library(maptools)
library(gdata)
library(RColorBrewer)
setwd("~/hurricanes")
# read shapefiles
florida <- readShapePoly("florida.shp")
south <- readShapePoly("south.shp")
hurricanes <- readShapeLines("hurricanes-florida.shp")
cities <- readShapePoints("cities.shp")
lakes <- readShapePoly("lakes.shp")
# miami, orlando and tallahassee (in FL)
cities <- subset(cities, ST == "FL")
# don't need ALL the 'canes
hurricanes1900 <- subset(hurricanes, Season >= 1900)
mycolors <- brewer.pal(5, "YlOrRd")
pdf(file = "hurricanemaps.pdf", ,width=8,height=20)
par(mfrow=c(15,5), mar=c(1,1,1,1))
for(i in 1:nrow(hurricanes1900))
{
plot(south, col="#e6e6e6", border = "#999999")
plot(florida, col="#999999", border = "#999999", add = TRUE)
plot(lakes, col="#ffffff", border = "#999999", add = TRUE)
plot(cities, pch=10, cex=.1,col="#000000", bg="#e38d2c", lwd=1, add = TRUE)
plot(hurricanes1900[i,], col = mycolors[cut(hurricanes$MAX_Wind_W, breaks = 5)],
lwd=3, add = TRUE); title(hurricanes1900$Title[i])
}
dev.off()
Three big issues I'm encountering:
1) The loop is giving me a map of each storm. I would prefer to have the code produce a Florida/South map in the grid for each year (even on those years without storms) and all the storms for that year, preferably with labels.
2) I would like to set the colors for wind speed among ALL the storms, not just those in each particular row of the loop. That way strong storms (like Andrew in 1992) show as darker even when they are the only storm of the year. Perhaps I can solve this my recoding a categorical (H1, H2, etc) variable that can be styled accordingly.
3) Assuming I can figure out No. 1, I'm having trouble getting labels to render on each storm path. The maptools documentation isn't great.
Anyway, here's the output so far (the title is a concatenation of two fields in the shapefile):
The real issue is No. 1. Thanks in advance for your help.
Given there is no reproducible data, I collected some data for this demonstration. Please provide a minimal reproducible data for SO users from next time. That will help you receive more help.
What you want to achieve can be done with ggplot2. If you want to draw a map for each year, you can use facet_wrap(). If you want to add colors based on wind, you can do that in aes() when you draw paths. If you want to add hurricanes' names, you can use the ggrepel package, which allows you to provide annotations with an ease. Note that, if you want to draw smooth paths, you further need data process.
library(stringi)
library(tibble)
library(raster)
library(ggplot2)
library(ggthemes)
library(ggrepel)
library(RColorBrewer)
library(data.table)
# Get some data. Credit to hmbrmstr for a few lines in the following code.
mylist <- c("http://weather.unisys.com/hurricane/atlantic/2007H/BARRY/track.dat",
"http://weather.unisys.com/hurricane/atlantic/2007H/TEN/track.dat",
"http://weather.unisys.com/hurricane/atlantic/2006H/ERNESTO/track.dat",
"http://weather.unisys.com/hurricane/atlantic/2006H/ALBERTO/track.dat")
temp <- rbindlist(
lapply(mylist, function(x){
foo <- readLines(x)
foo <- read.table(textConnection(gsub("TROPICAL ", "TROPICAL_",
foo[3:length(foo)])),
header=TRUE, stringsAsFactors=FALSE)
year <- stri_extract_first(str = x, regex = "[0-9]+")
name <- stri_extract_first(str = x, regex = "[A-Z]{2,}")
cbind(foo, year, name)
}
))
### Add a fake row for 2017
temp <- temp %>%
add_row(ADV = NA, LAT = NA, LON = NA, TIME = NA, WIND = NA,
PR = NA, STAT = NA, year = 2017, name = NA)
### Prepare a map
usa <- getData('GADM', country = "usa", level = 1)
mymap <- subset(usa, NAME_1 %in% c("Florida", "Arkansas", "Louisiana",
"Alabama", "Georgia", "Tennessee",
"Mississippi",
"North Carolina", "South Carolina"))
mymap <- fortify(mymap)
# Create a data.table for labeling hurricanes later.
label <- temp[, .SD[1], by = name][complete.cases(name)]
g <- ggplot() +
geom_map(data = mymap, map = mymap,
aes(x = long, y = lat, group = group, map_id = id),
color = "black", size = 0.2, fill = "white") +
geom_path(data = temp, aes(x = LON, y = LAT, group = name, color = WIND), size = 1) +
scale_color_gradientn(colours = rev(brewer.pal(5, "Spectral")), name = "Wind (mph)") +
facet_wrap(~ year) +
coord_map() +
theme_map() +
geom_text_repel(data = label,
aes(x = LON, y = LAT, label = name),
size = 2,
force = 1,
max.iter = 2e3,
nudge_x = 1,
nudge_y = -1) +
theme(legend.position = "right")
I want to plot different states of India with respective districts in R software. I have tried using GADM, level 2 data to get the coordinates.
I have followed this thread Mapping just one State of India and writing its name inside the state boundary. However, I am unable to subset the data for any state and use it for mapping.
What I've tried:
map <- fortify(Karnataka)
map$id <- as.integer(map$id)
dat <- data.frame(id = 216:242, district = Karnataka)
map_df <- inner_join(map, dat, by = "id")
centers <- data.frame(gCentroid(Karnataka, byid = TRUE))
centers$state <- dat$district
I could map a state with its district borders by using following commands.
India <- getData("GADM", country = "India", level = 2)
Karnataka <- subset(India, NAME_1 == "Karnataka")
map <- fortify(Karnataka);
map$id <- as.integer(map$id);
dat <- data.frame(id = 216:242, district = Karnataka#data$NAME_2);
map_df <- inner_join(map, dat, by = "id");
centers <- data.frame(gCentroid(Karnataka, byid = TRUE));
centers$state <- dat$district;
ggplot() +
geom_map(data = map_df, map = map_df,
aes(map_id = id, x = long, y = lat, group = group),
color = "#ffffff", fill = "#bbbbbb", size = 0.25) +
geom_text(data = centers, aes(label = state, x = x, y = y), size = 2) +
coord_map() + labs(x = "", y = "", title = "Districts of Karnataka")
You can do this beautifully and easily with Google Maps in R. Within ggmap there are a lot of options. The examples below are very basic but it's fully customizable by setting the options however you like them.
map <- qmap('Karnataka', zoom = 7, maptype = 'hybrid')
map
library(ggmap)
qmap('Karnataka')
I am generating maps with world-scale data, and then zooming in to certain regions. On the zoomed-in view, I would like to show that there are other data points outside the bounding box, by putting arrowheads that point from the center of the box to where the data point is in the outside world.
Note: I do not need it to be a "great circle" path, just XY vectors in Mercator projection, because I imagine this will be useful for "normal" plots as well.
As an example, here is the world map showing the extent of the data:
And here is the zoomed in view, with magenta arrows manually added to show what I would like to generate.
Below is the code and data I am using to generate these two basic plots. What I need is a way to generate the arrowheads.
require(ggplot2)
te = structure(list(lat = c(33.7399, 32.8571, 50.2214, 36.96263, 33.5835,
33.54557, 47.76147, 48, 59.40289, 35.93411, 32.87962, 38.3241,
50.03844, 37.44, 50.07774, 50.26668, 36.5944), lng = c(-118.37608,
-117.25746, -5.3865, -122.00809, -117.86159, -117.79805, -124.45055,
-126, -146.35157, -122.931472, -117.25285, -123.07331, -5.26339,
25.4, -5.709894, -3.86828, -121.96201)), .Names = c("lat", "lng"
), class = "data.frame", row.names = c(NA, -17L))
all_states = map_data("world")
# world version:
wp = ggplot() +
geom_polygon(data = all_states, aes(x = long, y = lat, group = group), colour = "gray",
fill = "gray") +
coord_cartesian(ylim = c(0, 80), xlim = c(-155, 45)) +
geom_point(data = te, aes(x = lng, y = lat), color = "blue", size = 5,alpha = 0.6)
print(wp)
#states plot
sp = ggplot() +
geom_polygon(data = all_states, aes(x = long, y = lat, group = group), colour = "gray", fill = "gray") +
coord_cartesian(ylim = c(30, 52), xlim = c(-128, -114)) +
geom_point(data = te, aes(x = lng, y = lat), color = "blue", size = 5, alpha = 0.6)
print(sp)
This solution uses sp and rgeos packages to manipulate spatial data, the main crux being intersecting lines and a box polygon to get the edge points for arrows. Then if you draw arrows with geom_segment and zero width, the line is invisible and only the arrow head remains.
This function computes the line-box intersections:
boxint <- function(xlim, ylim, xp, yp){
## build box as SpatialPolygons
box = cbind(xlim[c(1,2,2,1,1)],
ylim[c(1,1,2,2,1)])
box <- sp::SpatialPolygons(list(sp::Polygons(list(sp::Polygon(box)),ID=1)))
## get centre of box
x0=mean(xlim)
y0=mean(ylim)
## construct line segments to points
sl = sp::SpatialLines(
lapply(1:length(xp),
function(i){
sp::Lines(list(sp::Line(cbind(c(x0,xp[i]),c(y0,yp[i])))),ID=i)
}
)
)
## intersect lines segments with boxes to make points
pts = rgeos::gIntersection(sl, as(box, "SpatialLines"))
as.data.frame(sp::coordinates(pts), row.names=1:length(xp))
}
And this returns the geom with arrows:
wherelse <- function(xlim, ylim, points){
## get points outside bounding box
outsides = points[!(
points$lng>=xlim[1] &
points$lng <= xlim[2] &
points$lat >= ylim[1] &
points$lat <= ylim[2]),]
npts = nrow(outsides)
## get centre point of box
x = rep(mean(xlim),npts)
y = rep(mean(ylim),npts)
## compute box-point intersections
pts = boxint(xlim, ylim, outsides$lng, outsides$lat)
pts$x0=x
pts$y0=y
## create arrow segments as invisible lines with visible arrowheads
ggplot2::geom_segment(data=pts, aes(x=x0,y=y0,xend=x,yend=y),
lwd=0, arrow=grid::arrow(length=unit(0.5,"cm"),
type="closed"),col="magenta")
}
So your example, the basic plot is:
sp = ggplot() +
geom_polygon(
data=all_states,
aes(x=long, y=lat, group = group),colour="gray",fill="gray" ) +
coord_cartesian(ylim=c(30, 52), xlim=c(-128,-114)) +
geom_point(data=te,aes(x=lng,y=lat),color="blue",size=5,alpha=0.6)
and then add the arrows with:
sp + wherelse(c(-128,-114), c(30,52), te)
Not sure if there's an option to draw arrows exactly like you want them though!
Here is my attempt. This is the closest I got. I used gcIntermediate() for calculating the shortest distance between the center point of your US map and the data points which stay outside of the bbox. Hence, the arrow positions may not be something you want. My hope is that somebody else would deliver a better solution based on this attempt.
I first arranged your df (i.e., te) with the center point in the US zoomed map. I then chose data points which are not in the bbox of the US map. Then, add two columns to indicate the center point of the US map. Rename two columns and calculate the shortest distance with gcIntermediate.
library(dplyr)
library(ggplot2)
library(geosphere)
filter(te, !between(lng, -128, -114) | !between(lat, 30, 52)) %>%
mutate(start_long = (-128 - 114) / 2,
start_lat = (30 + 52) / 2) %>%
rename(end_lat = lat, end_long = lng) %>%
do(fortify(as(gcIntermediate(.[,c("start_long", "start_lat")],
.[,c("end_long", "end_lat")],
100,
breakAtDateLine = FALSE,
addStartEnd = TRUE,
sp = TRUE), "SpatialLinesDataFrame"))) -> foo
foo contains 100 data points to draw respective line. I chose data points which stay close to the bbox boundary. I was specifically looking for two data points for each line so that I could use geom_segment() later. I admit that I played with the filter condition a bit. In the end, I did not subset data using lat in this case.
filter(foo, between(long, -128, -126.5) | between(long, -115.5, -114)) %>%
group_by(group) %>%
slice(c(1,n())) -> mydf
In the next step, I rearranged the data frame based on this link
mutate(mydf, end_long = lag(long), end_lat = lag(lat)) %>%
slice(n()) -> mydf2
Finally I drew the map with arrows. I hope this will provide some kind of base for you. I also hope that other SO users will provide better solutions.
ggplot() +
geom_polygon(data = all_states, aes(x = long, y = lat, group = group),
colour = "gray", fill = "gray" ) +
coord_cartesian(ylim = c(30, 52), xlim = c(-128,-114)) +
geom_point(data = te, aes(x = lng,y = lat), color = "blue", size = 5,alpha = 0.6) +
geom_segment(data = mydf2, aes(x = end_long, xend = long,
y = end_lat, yend = lat, group = group),
arrow = arrow(length = unit(0.2, "cm"), ends = "last"))