My problem: I want to draw a map obtained via rastermap package with ggplot2.
Searching for alternatives to ggmap package I found the rastermap package which provides an easy way to obtain maps from external sources. The readme provides a very simple example:
# install.packages("devtools")
devtools::install_github("hadley/rastermap")
houston <- fetch_region(c(-95.80204, -94.92313), c(29.38048, 30.14344),
stamen("terrain"))
houston
plot(houston)
The problem comes whether I try to plot using ggplot. So far I've tried several ways but none of them seems to work. Is it possible? Any idea?
rastermap generates a matrix of colours in hexadecimal strings (#RRGGBB format). It may be simplest to convert this to a more common form for spatial data, a multiband raster brick, with separate layers for the red, green and blue.
We can write a short helper function to convert hexadecimal strings into the separate integer values (i.e. this is the reverse of the rgb() function):
un_rgb = function (x) {
x = unlist(str_split(x, ''))
r = paste0(x[2], x[3])
g = paste0(x[4], x[5])
b = paste0(x[6], x[7])
strtoi(c(r,g,b), 16)
}
Using this function we convert the rastermap matrix into a three band raster brick:
library(raster)
m = as.matrix(houston)
l=lapply(m[], un_rgb)
r=g=b=matrix(, dim(m)[1], dim(m)[2])
r[] = sapply(l, function(i) i[1])
g[] = sapply(l, function(i) i[2])
b[] = sapply(l, function(i) i[3])
rgb.brick = brick(raster(r), raster(g), raster(b))
And set the extent of the new raster to that of the original rastermap
extent(rgb.brick) = extent(matrix(unlist(attributes(houston)$bb), nrow=2))
Now that we have a more usual form of raster object, we can do various things with it. For example, we can plot it in ggplot using library(RStoolbox):
ggRGB(rgb.brick, r=1, g=2, b=3)
Or we can save it as an image to use as an annotation background in ggplot:
png('test.png', dim(rgb.brick)[2], dim(rgb.brick)[1])
plotRGB(rgb.brick, 1, 2, 3)
dev.off()
img <- png::readPNG("test.png")
gr <- grid::rasterGrob(img, interpolate=TRUE)
ggplot() + annotation_custom(gr, -Inf, Inf, -Inf, Inf)
Why would you want an alternative? You can get a stamen map from ggmap:
library(ggmap)
ggmap(get_stamenmap(c(-95.80204, 29.38048, -94.92313, 30.14344))) +
# some points to plot
geom_point(aes(x = seq(-95.5, -95.2, 0.1), y = seq(29.7, 30, 0.1)), color = "red")
Related
I would like to make these kinds of mathematical plots of vector gradient fields (2D and 3D: https://en.wikipedia.org/wiki/Gradient):
Function 1: f(x,y) = x * 2.718^(-x^2 + y^2)
Function 2: f(x,y) = (cos(x))^2 + (cos(y))^2)^2
Function 1: I found this code which lets you make a 2D plot (How to plot a hyperbolic vector field in R?):
df <- expand.grid(x=seq(-2, 2, .1), y=seq(-2, 2, .1))
df$z <- with(df, x * 2.718^(-x^2 + y^2) )
library(raster)
library(rasterVis)
r <- rasterFromXYZ(df)
projection(r) <- CRS("+proj=longlat +datum=WGS84")
vectorplot(r, par.settings=RdBuTheme)
But for some reason this plot does not look the same as the one from the Wikipedia page.
Function 2: I could not find anything in R that makes something like the plot of Function 2 - all I could find was a link that shows you how to do something somewhat related in Python (https://chart-studio.plotly.com/~empet/14971.embed). I figured out how to make a 3D plot of Function 2 in R (using plotly) - but I do not know how to add the vector-gradient arrows to this plot:
Can anyone give me a hand with this?
Thank you!
Edit:
As pointed out in the comment section, I had made a mistake in my original code and now have fixed it:
df <- expand.grid(x=seq(-2, 2, .1), y=seq(-2, 2, .1))
df$z <- with(df, x * 2.718^(-(x^2 + y^2)) )
library(raster)
library(rasterVis)
r <- rasterFromXYZ(df)
projection(r) <- CRS("+proj=longlat +datum=WGS84")
vectorplot(r, par.settings=RdBuTheme)
[![enter image description here][4]][4]
Now this looks a lot better - but is there still a way to replicate the visualization for Function 2? And is there a way to copy the same color scheme for Function 1 with the same quality resolution as the Wikipedia page?
Suppose I have this very simple 2x2 RGB datacube that I want to plot:
set.seed(2017)
dc <- array(runif(12), dim = c(2,2,3))
I can plot this just by rasterizing the datacube:
plot(as.raster(dc), interpolate = FALSE)
But I would like to plot this data cube with the lattice package (for uniformity sake since I am mainly using it for other plotting too).
Is this possible? I am looking at levelplot, but am not able to make it work.
The problem you have is that lattice needs a matrix, that is a numeric matrix, and rasters of RGB become a factor matrix:
r <-as.raster(dc)
r
gives this result:
[,1] [,2]
[1,] "#ECC478" "#780AAC"
[2,] "#89C546" "#4A6F01"
to use it as lattice you need to transform this into a numeric matrix, this looks long but it seems is the only way to ensure to keep the order:
m <- matrix(as.numeric(as.factor(as.vector(as.matrix(r)))), ncol= 2)
levelplot(m, panel = panel.levelplot.raster)
The problem you will get here is that you won't keep the same RGB colors, but it's a lattice solution.
Ok, this turned out to be quite an endeavor with levelplot.
I convert the RGB hex color values from raster to integers, and then use these values to map them to the color palette of the raster.
set.seed(2017)
dc <- array(runif(12), dim = c(2,2,3))
plot(as.raster(dc), interpolate = FALSE)
# convert color hexadecimals to integers
rgbInt <- apply(as.raster(dc), MARGIN = c(1,2),
FUN = function(str){strtoi(substring(str, 2), base = 16)})
rgbIntUnq <- unique(as.vector(rgbInt))
lattice::levelplot(x = t(rgbInt), # turn so rows become columns
at = c(0,rgbIntUnq),
col.regions = sprintf("#%06X", rgbIntUnq[order(rgbIntUnq)]), # to hex
ylim = c(nrow(rgbInt) + 0.5, 1 - 0.5), # plot from top to bottom
xlab = '', ylab = '')
The legend can also be removed with colorkey = FALSE property.
I wonder whether there are simpler ways to do the same.
I am trying to plot a 3D space time cube in R and I want to have a basemap.
I am using rgl library. I know how to plot my data using x, y and z, where z is the time variable. I have also managed to download a map that I want to use as reference from openstreetmap, using the library in R. However, I cannot find a way to plot my data on the map in a 3D environment. I found the following code in several sites and as an answer to a similar question:
map3d <- function(map, ...){
if(length(map$tiles)!=1){stop("multiple tiles not implemented") }
nx = map$tiles[[1]]$xres
ny = map$tiles[[1]]$yres
xmin = map$tiles[[1]]$bbox$p1[1]
xmax = map$tiles[[1]]$bbox$p2[1]
ymin = map$tiles[[1]]$bbox$p1[2]
ymax = map$tiles[[1]]$bbox$p2[2]
xc = seq(xmin,xmax,len=ny)
yc = seq(ymin,ymax,len=nx)
colours = matrix(map$tiles[[1]]$colorData,ny,nx)
m = matrix(0,ny,nx)
surface3d(xc,yc,m,col=colours, ...)
}
However, I cannot really understand how it works.
Here's my code so far:
library(rgl)
library(ggplot2)
library(OpenStreetMap)
map <- openmap(c(53.5,73.6),c(15.7,134.7),type= 'esri-topo')
plot3d(x,y,z, col= colour) # to plot my data
autoplot(map) # to plot the map. though this is 2D
Again, I know how to plot my data on a 2D map. Confused with the 3D.
Any hints and tips on how to do this?
One option is to use the newish 'show2d' function in 'rgl'.
library(rgl)
library(OpenStreetMap)
library(raster)
map <- openmap(c(53.5,73.6),c(15.7,134.7),type= 'esri-topo')
## fake up some xyz
xyz <- expand.grid(x = map$bbox$p1,
y = map$bbox$p2,
z = 1:4)
plot3d(xyz, col = "black") # to plot my data
EDIT: this is wrong, it's only fitted to the bounding box
getting the orientation right is confusing, needs to be check with x, y, z arguments to show2d.
show2d(raster::plotRGB(raster(map)))
This function captures the normal plot expression, writes it to PNG and then texture maps it onto a quad in the scene.
I can't quite see how to control the position of the quad for the image texture with the x, y, z args - work in progress.
I'd like to use spplot + sp.lines (lattice) instead of plot + segments. Do you know a simple way to realise this, e.g. R: Calculating the shortest distance between two point layers
library(dismo)
require(rgdal)
require(FNN)
laurus <- gbif("Laurus", "nobilis")
locs <- subset(laurus, !is.na(lat) & !is.na(lon),
select = c("country", "lat", "lon"))
locs.uk <- subset(locs, locs$country=="United Kingdom")
locs.ire <- subset(locs, locs$country=="Ireland")
uk_coord <- SpatialPoints(locs.uk[,c("lon","lat")])
ire_coord <- SpatialPoints(locs.ire[,c("lon","lat")])
crs.geo<-CRS("+proj=longlat +ellps=WGS84 +datum=WGS84")
proj4string(uk_coord) <- crs.geo
proj4string(ire_coord) <- crs.geo
uk_coord <- spTransform(uk_coord, CRS("+init=epsg:27700"))
ire_coord <- spTransform(ire_coord, CRS("+init=epsg:27700"))
g = get.knnx(coordinates(uk_coord), coordinates(ire_coord),k=1)
to visualise this
plot(uk_coord, col=2, xlim=c(-1e5,6e5))
plot(ire_coord, add=TRUE)
segments(coordinates(ire_coord)[,1],
coordinates(ire_coord)[,2],
coordinates(uk_coord[g$nn.index[,1]])[,1],
coordinates(uk_coord[g$nn.index[,1]])[,2])
can probably converted to something like
ire <- list("sp.points", ire_coord)
spplot(uk_coord, sp.layout=list(ire))
but is there a easy way to convert segments to SpatialLines i.e. list("sp.lines", Lines(...))
Try panel.segments() from the lattice-package:
library("lattice")
spplot(rbind(uk_coord, ire_coord), auto.key=FALSE,
panel=function(...) {
panel.xyplot(...)
panel.segments(coordinates(ire_coord)[,1],
coordinates(ire_coord)[,2],
coordinates(uk_coord[g$nn.index[,1]])[,1],
coordinates(uk_coord[g$nn.index[,1]])[,2])
})
Understanding panel functions is more powerful than relying on sp.layout in spplot -- and so is using lattice or grid functions directly. The solution with sp.layout could look like this:
spplot(uk_coord, auto.key=FALSE, col.regions = 'black',
sp.layout = list(ire,
list("panel.segments",
coordinates(ire_coord)[,1],
coordinates(ire_coord)[,2],
coordinates(uk_coord[g$nn.index[,1]])[,1],
coordinates(uk_coord[g$nn.index[,1]])[,2])),
xlim = c(-140000,700000))
note that it is not restricted to the sp.lines etc functions; in upcoming sp 1.1-0, quotes around function names can also be omitted.
spplot tries to plot attributes of features in color by default, which is not meaningful here, so what you basically want is an xyplot with controlled aspect ratio (asp="iso").
I'm working with some custom functions and I need to draw contours for them based on multiple values for the parameters.
Here is an example function:
I need to draw such a contour plot:
Any idea?
Thanks.
First you construct a function, fourvar that takes those four parameters as arguments. In this case you could have done it with 3 variables one of which was lambda_2 over lambda_1. Alpha1 is fixed at 2 so alpha_1/alpha_2 will vary over 0-10.
fourvar <- function(a1,a2,l1,l2){
a1* integrate( function(x) {(1-x)^(a1-1)*(1-x^(l2/l1) )^a2} , 0 , 1)$value }
The trick is to realize that the integrate function returns a list and you only want the 'value' part of that list so it can be Vectorize()-ed.
Second you construct a matrix using that function:
mat <- outer( seq(.01, 10, length=100),
seq(.01, 10, length=100),
Vectorize( function(x,y) fourvar(a1=2, x/2, l1=2, l2=y/2) ) )
Then the task of creating the plot with labels in those positions can only be done easily with lattice::contourplot. After doing a reasonable amount of searching it does appear that the solution to geom_contour labeling is still a work in progress in ggplot2. The only labeling strategy I found is in an external package. However, the 'directlabels' package's function directlabel does not seem to have sufficient control to spread the labels out correctly in this case. In other examples that I have seen, it does spread the labels around the plot area. I suppose I could look at the code, but since it depends on the 'proto'-package, it will probably be weirdly encapsulated so I haven't looked.
require(reshape2)
mmat <- melt(mat)
str(mmat) # to see the names in the melted matrix
g <- ggplot(mmat, aes(x=Var1, y=Var2, z=value) )
g <- g+stat_contour(aes(col = ..level..), breaks=seq(.1, .9, .1) )
g <- g + scale_colour_continuous(low = "#000000", high = "#000000") # make black
install.packages("directlabels", repos="http://r-forge.r-project.org", type="source")
require(directlabels)
direct.label(g)
Note that these are the index positions from the matrix rather than the ratios of parameters, but that should be pretty easy to fix.
This, on the other hand, is how easilyy one can construct it in lattice (and I think it looks "cleaner":
require(lattice)
contourplot(mat, at=seq(.1,.9,.1))
As I think the question is still relevant, there have been some developments in the contour plot labeling in the metR package. Adding to the previous example will give you nice contour labeling also with ggplot2
require(metR)
g + geom_text_contour(rotate = TRUE, nudge_x = 3, nudge_y = 5)