I have developed a genetic algorithm for estimating the probability of observing an animal, given its genotype, across a regular grid of locations, here in south-east England. Using ggplot2 I can easily generate either a probability contour plot or a land-only (polygon-filled) map, but what I want is a map where the contour plot is restricted to land:
()
The desired outcome is generated by adding a black mask to the contour plot in Powerpoint, a tedious procedure that is impractical for generating the hundreds I need. I am sure there must be a simple way to do this.
I generate the contour plot using:
v <- ggplot(data, aes(Lat, Lng, z = P))
v + geom_contour(bins = 20)
and the map using:
ggplot(data = world) +
geom_sf(color = "black", fill = "gray") +
coord_sf(xlim = c(-2.3, 1.9), ylim = c(50.9, 53.5), expand = FALSE)
my input file comprises all locations in 0.05 increments of longitude and latitude in the intervals specified. It is large but I would happily add it if this helps. I have looked online and cannot see any examples that match what I want.
I have tried adding one component to the other as an extra layer but I struggle to understand what is needed and what the syntax are. For example:
layer(geom = "contour", stat = "identity", data = data, mapping = aes(Lng,Lat,P))
Error: Attempted to create layer with no position.
but even if this works it does not mask the sea area.
Here's a worked example with some made-up data:
library(rnaturalearth)
library(ggplot2)
sea <- ne_download(scale = 10, type = 'ocean', category = "physical",
returnclass = "sf")
ggplot(data) +
geom_contour_filled(aes(Lng, Lat, z = P), bins = 20, color = "black") +
guides(fill = "none") +
geom_sf(data = sea, fill = "black") +
coord_sf(ylim = c(51, 53.5), xlim = c(-2.2, 1.8), expand = FALSE)
Data used
set.seed(1)
a <- MASS::kde2d(rnorm(100), rnorm(100, 53), n = 100,
lims = c(-2.2, 1.8, 51, 53.5))
b <- MASS::kde2d(rnorm(25, 0.5), rnorm(25, 52), n = 100,
lims = c(-2.2, 1.8, 51, 53.5))
a$z <- b$z - a$z + max(a$z)
data <- cbind(expand.grid(Lng = a$x, Lat = a$y), P = c(a$z))
Created on 2023-01-02 with reprex v2.0.2
I'm working with the ggmap package in R and I am relatively new to geospatial data visualizations. I have a data frame of eleven latitude and longitude pairs that I would like to plot on a map, each with a label. Here is the dummy data:
lat<- c(47.597157,47.656322,47.685928,47.752365,47.689297,47.628128,47.627071,47.586349,47.512684,47.571232,47.562283)
lon<-c(-122.312187,-122.318039,-122.31472,-122.345345,-122.377045,-122.370117,-122.368462,-122.331734,-122.294395,-122.33606,-122.379745)
labels<-c("Site 1A","Site 1B","Site 1C","Site 2A","Site 3A","Site 1D","Site 2C","Site 1E","Site 2B","Site 1G","Site 2G")
df<-data.frame(lat,lon,labels)
Now I use annotate to create the data point labels and plot these on a map;
map.data <- get_map(location = c(lon=-122.3485,lat=47.6200),
maptype = 'roadmap', zoom = 11)
pointLabels<-annotate("text",x=uniqueReach$lon,y=c(uniqueReach$lat),size=5,font=3,fontface="bold",family="Helvetica",label=as.vector(uniqueReach$label))
dataPlot <- ggmap(map.data) +
geom_point(data = uniqueReach,aes(x = df$lon, y = df$lat), alpha = 1,fill="red",pch=21,size = 6) + labs(x = 'Longitude', y = 'Latitude')+pointLabels
This produces a plot of the data points
As you can see, there are two data points that overlap around (-122.44,47.63), and their labels also overlap. Now I can manually add a shift to each label point to keep the labels from overlapping (see this post), but this is not a great technique when I need to produce many of these plots for different sets of latitude and longitude pairs.
Is there a way I can automatically keep data labels from overlapping? I realize whether the labels overlap is dependent on the actual figure size, so I'm open to fixing the figure size at certain dimensions if need be. Thank you in advance for any insights!
EDIT
The following is modified code using the answer given by Sandy Mupratt
# Defining function to draw text boxes
draw.rects.modified <- function(d,...){
if(is.null(d$box.color))d$box.color <- NA
if(is.null(d$fill))d$fill <- "grey95"
for(i in 1:nrow(d)){
with(d[i,],{
grid.rect(gp = gpar(col = box.color, fill = fill,alpha=0.7),
vp = viewport(x, y, w, h, "cm", c(hjust, vjust=0.25), angle=rot))
})
}
d
}
# Defining function to determine text box borders
enlarge.box.modified <- function(d,...){
if(!"h"%in%names(d))stop("need to have already calculated height and width.")
calc.borders(within(d,{
w <- 0.9*w
h <- 1.1*h
}))
}
Generating the plot:
dataplot<-ggmap(map.data) +
geom_point(data = df,aes(x = df$lon, y = df$lat),
alpha = 1, fill = "red", pch = 21, size = 6) +
labs(x = 'Longitude', y = 'Latitude') +
geom_dl(data = df,
aes(label = labels),
list(dl.trans(y = y + 0.3), "boxes", cex = .8, fontface = "bold"))
This is a MUCH more readable plot, but with one outstanding issue. You'll note that the label "Site 1E" begins to overlap the data point associated with "Site 1A". Does directlabels have a way with dealing with labels overlapping data points belonging to another label?
A final question I have regarding this is how can I plot several duplicate labels using this method. Suppose the labels for data.frame are all the same:
df$labels<-rep("test",dim(df)[1])
When I use the same code, directlabels removes the duplicate label names:
But I want each data point to have a label of "test". Any suggestions?
Edit 11 Jan 2016: using ggrepel package with ggplot2 v2.0.0 and ggmap v2.6
ggrepel works well. In the code below, geom_label_repel() shows some of the available parameters.
lat <- c(47.597157,47.656322,47.685928,47.752365,47.689297,47.628128,47.627071,
47.586349,47.512684,47.571232,47.562283)
lon <- c(-122.312187,-122.318039,-122.31472,-122.345345,-122.377045,-122.370117,
-122.368462,-122.331734,-122.294395,-122.33606,-122.379745)
labels <- c("Site 1A","Site 1B","Site 1C","Site 2A","Site 3A","Site 1D",
"Site 2C","Site 1E","Site 2B","Site 1G","Site 2G")
df <- data.frame(lat,lon,labels)
library(ggmap)
library(ggrepel)
library(grid)
map.data <- get_map(location = c(lon = -122.3485, lat = 47.6200),
maptype = 'roadmap', zoom = 11)
ggmap(map.data) +
geom_point(data = df, aes(x = lon, y = lat),
alpha = 1, fill = "red", pch = 21, size = 5) +
labs(x = 'Longitude', y = 'Latitude') +
geom_label_repel(data = df, aes(x = lon, y = lat, label = labels),
fill = "white", box.padding = unit(.4, "lines"),
label.padding = unit(.15, "lines"),
segment.color = "red", segment.size = 1)
Original answer but updated for ggplot v2.0.0 and ggmap v2.6
If there is only a small number of overlapping points, then using the "top.bumpup" or "top.bumptwice" method from the direct labels package can separate them. In the code below, I use the geom_dl() function to create and position the labels.
lat <- c(47.597157,47.656322,47.685928,47.752365,47.689297,47.628128,47.627071,
47.586349,47.512684,47.571232,47.562283)
lon <- c(-122.312187,-122.318039,-122.31472,-122.345345,-122.377045,-122.370117,
-122.368462,-122.331734,-122.294395,-122.33606,-122.379745)
labels <- c("Site 1A","Site 1B","Site 1C","Site 2A","Site 3A","Site 1D",
"Site 2C","Site 1E","Site 2B","Site 1G","Site 2G")
df <- data.frame(lat,lon,labels)
library(ggmap)
library(directlabels)
map.data <- get_map(location = c(lon = -122.3485, lat = 47.6200),
maptype = 'roadmap', zoom = 11)
ggmap(map.data) +
geom_point(data = df, aes(x = lon, y = lat),
alpha = 1, fill = "red", pch = 21, size = 6) +
labs(x = 'Longitude', y = 'Latitude') +
geom_dl(data = df, aes(label = labels), method = list(dl.trans(y = y + 0.2),
"top.bumptwice", cex = .8, fontface = "bold", family = "Helvetica"))
Edit: Adjusting for underlying labels
A couple of methods spring to mind, but neither is entirely satisfactory. But I don't think you will find a solution that will apply to all situations.
Adding a background colour to each label
This is a bit of a workaround, but directlabels has a "box" function (i.e., the labels are placed inside a box). It looks like one should be able to modify background fill and border colour in the list in geom_dl, but I can't get it to work. Instead, I take two functions (draw.rects and enlarge.box) from the directlabels website; modify them; and combine the modified functions with the "top.bumptwice" method.
draw.rects.modified <- function(d,...){
if(is.null(d$box.color))d$box.color <- NA
if(is.null(d$fill))d$fill <- "grey95"
for(i in 1:nrow(d)){
with(d[i,],{
grid.rect(gp = gpar(col = box.color, fill = fill),
vp = viewport(x, y, w, h, "cm", c(hjust, vjust=0.25), angle=rot))
})
}
d
}
enlarge.box.modified <- function(d,...){
if(!"h"%in%names(d))stop("need to have already calculated height and width.")
calc.borders(within(d,{
w <- 0.9*w
h <- 1.1*h
}))
}
boxes <-
list("top.bumptwice", "calc.boxes", "enlarge.box.modified", "draw.rects.modified")
ggmap(map.data) +
geom_point(data = df,aes(x = lon, y = lat),
alpha = 1, fill = "red", pch = 21, size = 6) +
labs(x = 'Longitude', y = 'Latitude') +
geom_dl(data = df, aes(label = labels), method = list(dl.trans(y = y + 0.3),
"boxes", cex = .8, fontface = "bold"))
Add an outline to each label
Another option is to use this method to give each label an outline, although it is not immediately clear how it would work with directlabels. Therefore, it would need a manual adjustment of the coordinates, or a search of the dataframe for coordinates that are within a given threshold then adjust. However, here, I use the pointLabel function from maptools package to position the labels. No guarantee that it will work every time, but I got a reasonable result with your data. There is a random element built into it, so you can run it a few time until you get a reasonable result. Also, note that it positions labels in a base plot. The label locations then have to extracted and loaded into the ggplot/ggmap.
lat<- c(47.597157,47.656322,47.685928,47.752365,47.689297,47.628128,47.627071,47.586349,47.512684,47.571232,47.562283)
lon<-c(-122.312187,-122.318039,-122.31472,-122.345345,-122.377045,-122.370117,-122.368462,-122.331734,-122.294395,-122.33606,-122.379745)
labels<-c("Site 1A","Site 1B","Site 1C","Site 2A","Site 3A","Site 1D","Site 2C","Site 1E","Site 2B","Site 1G","Site 2G")
df<-data.frame(lat,lon,labels)
library(ggmap)
library(maptools) # pointLabel function
# Get map
map.data <- get_map(location = c(lon=-122.3485,lat=47.6200),
maptype = 'roadmap', zoom = 11)
bb = t(attr(map.data, "bb")) # the map's bounding box
# Base plot to plot points and using pointLabels() to position labels
plot(df$lon, df$lat, pch = 20, cex = 5, col = "red", xlim = bb[c(2,4)], ylim = bb[c(1,3)])
new = pointLabel(df$lon, df$lat, df$labels, pos = 4, offset = 0.5, cex = 1)
new = as.data.frame(new)
new$labels = df$labels
## Draw the map
map = ggmap(map.data) +
geom_point(data = df, aes(x = lon, y = lat),
alpha = 1, fill = "red", pch = 21, size = 5) +
labs(x = 'Longitude', y = 'Latitude')
## Draw the label outlines
theta <- seq(pi/16, 2*pi, length.out=32)
xo <- diff(bb[c(2,4)])/400
yo <- diff(bb[c(1,3)])/400
for(i in theta) {
map <- map + geom_text(data = new,
aes_(x = new$x + .01 + cos(i) * xo, y = new$y + sin(i) * yo, label = labels),
size = 3, colour = 'black', vjust = .5, hjust = .8)
}
# Draw the labels
map +
geom_text(data = new, aes(x = x + .01, y = y, label=labels),
size = 3, colour = 'white', vjust = .5, hjust = .8)
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"))