combining land-only maps and contour plots using ggplot - r

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

Related

Extend geom_voronoi past its limits with scale_*_continuous

the task I have set for myself is to make a voronoi diagram of the www.politicalcompass.org chart of the currently running democratic candidates. I have coded their positions and combined points that overlap into single observations. I have used two separate ggplot extensions that create voronoi diagrams.
The problem is that politicalcompass.org's chart goes from -10 to +10 on both axes. When I try to plot the voronoi diagrams, they only extend to their original limits and not to the full range of -10 to 10 that I intend to plot. Examples and code below:
https://github.com/McCartneyAC/average_of_polls/blob/master/stupid_voronoi_one.png?raw=true
https://github.com/McCartneyAC/average_of_polls/blob/master/stupid_voronoi_two.png?raw=true
library(tidyverse)
library(ggrepel)
candidates_list_voronoi <- tribble(
~candidate,~party,~economic,~authoritarian,
"Bennet","Democratic",8.5,6,
"Biden","Democratic",5.5,3.5,
"Booker","Democratic",4,2.5,
"Buttigieg/Castro","Democratic",6.5,4.5,
"Delaney","Democratic",4,3.5,
"Gabbard","Democratic",-1.5,-1.5,
"Harris","Democratic",5,4,
"Bullock/Klobuchar","Democratic",5,5,
"Sanders","Democratic",-1.5,-1,
"Sestak","Democratic",5.5,2,
"Warren","Democratic",0.5,1,
"Williamson","Democratic",2,-1.5,
"Yang","Democratic",7,1,
"Hawkins","Green",-5,-3,
"Vohra","Libertarian",10,1.5,
"Corker/Pence","Republican",10,8.5,
"Hogan","Republican",10,8,
"Kasich","Republican",8,9,
"Trump","Republican",8.5,8.5,
"Weld","Republican",9.5,4.5
)
library(ggvoronoi)
candidates_list_voronoi %>%
ggplot(aes(economic, authoritarian, label = candidate, fill = candidate)) +
geom_voronoi(color = "black") +
geom_label_repel(fill = "#FFFFFF") +
scale_x_continuous(limits = c(-10,10))+
scale_y_continuous(limits = c(-10,10))
library(ggforce)
candidates_list_voronoi %>%
ggplot(aes(economic, authoritarian)) +
geom_voronoi_tile(aes(fill = candidate, group = -1L)) +
geom_voronoi_segment() +
geom_label_repel(aes(label = candidate)) +
scale_x_continuous(limits = c(-10,10))+
scale_y_continuous(limits = c(-10,10))
You can specify the bounding box in the outline argument in geom_voronoi (see vignette example here).
outline.df <- data.frame(x = c(-10, 10, 10, -10),
y = c(-10, -10, 10, 10))
candidates_list_voronoi %>%
ggplot(aes(economic, authoritarian, fill = candidate)) +
geom_voronoi(outline = outline.df,
color = "black")
(Leaving out the labels part since it's not critical to the question.)

Boundary polygon of lat lon collection

I have a table containing all the latitudes and longitudes of some locations in a city called queryResult and I do the following:
1 - Get the Raster map of the city[Blackpool for instance]
cityMapRaster = get_map(location = 'Blackpool', zoom = 12, source = 'google', maptype = 'roadmap')
dataToShow <- ggmap(cityMapRaster) + geom_point(aes(x = Longitude, y = Latitude), data = queryResult, alpha = .5, color = "darkred", size = 1)
print(dataToShow)
and this will return the following points on the map
Now I want to draw the outer boundary [city border line] of all these latitude and longitudes similar to the following expected result
Update 1 : Providing input data and applying suggested ahull solution:
ggmap(cityMapRaster) + geom_point(aes(x = Longitude, y = Latitude), data = queryResult, alpha = .5, color = "darkred") + ahull.gg
I applied the ahull solution suggested by #spacedman and #cuttlefish44 and got the following result which is far different than the expected polygon:
You can download the .csv file containing all latitudes and longitudes from the following link : Blackpool Lat,Lon
Googles suggested area boundary looks like the following :
If you don't want a simple convex hull (and the polygon you've drawn is far from convex) then look at alpha-shapes in the alphahull package.
I wrote an example of how to get a polygon from an alpha-shape using that package and some points that make up a complex Norway boundary:
http://rpubs.com/geospacedman/alphasimple
You should be able to follow that to get a polygon for your data, and it might even be simpler now since that was a few years ago.
Here's a reproducible example of how to use chull to calculate a convex hull solution to this. I just generate some random points for queryResult, as you did not provide data.
If you prefer a concave hull boundary, then see the answer from #Spacedman
library(ggmap)
cityMapRaster = get_map(location = 'Blackpool', zoom = 12, source = 'google', maptype = 'roadmap')
extent = attr(cityMapRaster, "bb")
queryResult = data.frame(Longitude = rnorm(200, as.numeric(extent[2] + extent[4])/2, 0.01),
Latitude = rnorm(200, as.numeric(extent[1] + extent[3])/2, 0.02))
boundary = chull(as.matrix(queryResult))
ggmap(cityMapRaster) +
geom_point(aes(x = Longitude, y = Latitude),
data = queryResult, alpha = .5, color = "darkred", size = 2) +
geom_path(aes(x = Longitude, y = Latitude), data = queryResult[c(boundary, boundary[1]),])
I suppose queryResult is x and y datasets. As far as I see, your boundary isn't convex hull, so I used alphahull package.
## example `queryResult`
set.seed(1)
df <- data.frame(Longitude = runif(200, -3.05, -2.97), Latitude = rnorm(200, 53.82, 0.02))
library(alphahull)
ahull.obj <- ahull(df, alpha = 0.03)
plot(ahull.obj) # to check
# ahull_track() returns the output as a list of geom_path objs
ahull.gg <- ahull_track(df, alpha=0.03, nps = 1000)
## change graphic param
for(i in 1:length(ahull.gg)) ahull.gg[[i]]$aes_params$colour <- "green3"
ggmap(cityMapRaster) +
geom_point(aes(x = Longitude, y = Latitude), data = df, alpha = .5, color = "darkred") +
ahull.gg
## if you like not curve but linear
ashape.obj <- ashape(df, alpha = 0.015)
plot(ashape.obj) # to check
ashape.df <- as.data.frame(ashape.obj$edge[,c("x1", "x2", "y1", "y2")])
ggmap(cityMapRaster) +
geom_point(aes(x = Longitude, y = Latitude), data = df, alpha = .5, color = "darkred") +
geom_segment(aes(x = x1, y = y1, xend = x2, yend = y2), data = ashape.df, colour="green3", alpha=0.8)

Dynamic data point label Positioning in ggmap

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)

Plot points outside grid as arrows pointing to data with ggplot2 in R

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

Non-linear color distribution over the range of values in a geom_raster

I'm faced with the following problem: a few extreme values are dominating the colorscale of my geom_raster plot. An example is probably more clear (note that this example only works with a recent ggplot2 version, I use 0.9.2.1):
library(ggplot2)
library(reshape)
theme_set(theme_bw())
m_small_sd = melt(matrix(rnorm(10000), 100, 100))
m_big_sd = melt(matrix(rnorm(100, sd = 10), 10, 10))
new_xy = m_small_sd[sample(nrow(m_small_sd), nrow(m_big_sd)), c("X1","X2")]
m_big_sd[c("X1","X2")] = new_xy
m = data.frame(rbind(m_small_sd, m_big_sd))
names(m) = c("x", "y", "fill")
ggplot(m, aes_auto(m)) + geom_raster() + scale_fill_gradient2()
Right now I solve this by setting the values over a certain quantile equal to that quantile:
qn = quantile(m$fill, c(0.01, 0.99), na.rm = TRUE)
m = within(m, { fill = ifelse(fill < qn[1], qn[1], fill)
fill = ifelse(fill > qn[2], qn[2], fill)})
This does not really feel like an optimal solution. What I would like to do is have a non-linear mapping of colors to the range of values, i.e. more colors present in the area with more observations. In spplot I could use classIntervals from the classInt package to calculate the appropriate class boundaries:
library(sp)
library(classInt)
gridded(m) = ~x+y
col = c("#EDF8B1", "#C7E9B4", "#7FCDBB", "#41B6C4",
"#1D91C0", "#225EA8", "#0C2C84", "#5A005A")
at = classIntervals(m$fill, n = length(col) + 1)$brks
spplot(m, at = at, col.regions = col)
To my knowledge it is not possible to hardcode this mapping of colors to class intervals like I can in spplot. I could transform the fill axis, but as there are negative values in the fill variable that will not work.
So my question is: are there any solutions to this problem using ggplot2?
Seems that ggplot (0.9.2.1) and scales (0.2.2) bring all you need (for your original m):
library(scales)
qn = quantile(m$fill, c(0.01, 0.99), na.rm = TRUE)
qn01 <- rescale(c(qn, range(m$fill)))
ggplot(m, aes(x = x, y = y, fill = fill)) +
geom_raster() +
scale_fill_gradientn (
colours = colorRampPalette(c("darkblue", "white", "darkred"))(20),
values = c(0, seq(qn01[1], qn01[2], length.out = 18), 1)) +
theme(legend.key.height = unit (4.5, "lines"))

Resources