Plotting Vector Fields and Gradient Fields - r

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?

Related

Having trouble with paths returned by flowPath in raster R-package

Paths returned by the flowPath function in the raster package consist of segments parallel to the x- and y-axes.
Starting with the Vector Field Plots example in the rasterVis documentation (https://oscarperpinan.github.io/rastervis/), I try to find the flow-path from a starting point on the surface, but the path output is incorrect.
library(raster)
library(rasterVis)
proj <- CRS('+proj=longlat +datum=WGS84')
df <- expand.grid(x = seq(-2, 2, .01), y = seq(-2, 2, .01))
df$z <- with(df, (3*x^2 + y)*exp(-x^2-y^2))
r <- rasterFromXYZ(df, crs=proj)
# Up to this point we follow the example in the rasterVis documentation
# Now attempt to find the path from a point on the surface
contour(r$z)
r.fd<-terrain(r,opt='flowdir')
r.c<-cellFromXY(r,cbind(-1,0))
r.p<-flowPath(r.fd,r.c)
p.xy<-xyFromCell(r.fd,r.p)
lines(p.xy,col='green')
Flow path from point (-1,0) depicting undesired behavior.
As you can see above, the flow path proceeds to the minimum at approximately (0,-.8) by moving towards +x and then -y. I have been unable to construct a data set which does not exhibit this problem. However: the example included in the flowPath documentation (in the raster package, using the volcano data) produces output one might expect and does not exhibit this problem.
What am I doing incorrectly that I cannot extend the example in the rasterVis documentation?
Addendum: My reason for questioning the output may be more a misunderstanding of what flowPath is supposed to return. I expected the kind of path a droplet might follow as it moves downhill. Like this:
Expected flowPath
This was computed using a simple steepest-descent walk. However, if (as stated by respondent Hijmans) flowPath is working as intended, then I may need to find another function which provides the path droplets would follow moving downhill.
Why is the path incorrect? It looks good to me. Illustrated by aggregating and labeling.
library(raster)
proj <- CRS('+proj=longlat +datum=WGS84')
df <- expand.grid(x = seq(-2, 2, .01), y = seq(-2, 2, .01))
df$z <- with(df, (3*x^2 + y)*exp(-x^2-y^2))
r <- rasterFromXYZ(df, crs=proj)
r <- aggregate(r, 25) * 10
r.fd <- terrain(r, opt='flowdir')
r.p <- flowPath(r.fd, cbind(-1,0))
p.xy <- xyFromCell(r.fd,r.p)
plot(r)
lines(p.xy,col='green', lwd=2)
text(r)
Add some noise to get a more wiggly path
set.seed(01234)
r <- rasterFromXYZ(df, crs=proj)
r <- aggregate(r, 10) * 10
r <- r + runif(ncell(r), 1, 2)
r.fd <- terrain(r, opt='flowdir')
r.p <- flowPath(r.fd, cbind(-1,0))
p.xy <- xyFromCell(r.fd,r.p)
plot(r)
lines(p.xy,col='green', lwd=2)

From rastermap package to ggplot2

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

How to plot additional raster with spplot?

I want to plot SpatialPolygonsDataFrame as a semi-transparent main object (with legend on the right), but I want to plot yet additional raster (hillshade) as a background - just to make nicer map. I would need something like:
spplot(polygons, sp.layout = list(list("raster", myRaster)))
but looking at ?spplot, it doesn't seem to be possible to specify the raster in sp.layout. I can't specify the raster as the main object, because the main object are the polygons dataFrame, whose value scale I want to plot in the legend on the right side.
How is it possible to plot an additional raster in spplot?
Here's one way to do it. There's probably a neater way to achieve it without plotting the polygon object twice, though...
library(sp)
library(rasterVis)
r <- raster(nrow=18, ncol=36)
r[] <- runif(ncell(r)) * 10
r[r > 8] <- NA
pol <- rasterToPolygons(r, function(x) x > 6)
spplot(pol) + levelplot(r) + spplot(pol)
Or alternatively:
library(latticeExtra)
spplot(pol) + spplot(r) + spplot(pol)
EDIT
As per the comment by #OscarPerpiñán, a better way to do this is:
spplot(pol) + as.layer(spplot(r), under = TRUE)

3D surface plot in R

I'm trying to create a 3D plot in R-Project. I know there was a question like this before but I couldn't solve my problems with the answers there.
What I have is:
Vdot_L = c(0,1,2,3,4,5,6,7,8,9,10)
Qdot_verd = c(2000,2100,2200,2300,2400,2500,2600,2700,2800,2900,3000)
zeta_ex = 0.4
T_U = 293.15 #K
T_verd = 273.15 #K
T_cond=Vdot_L*2+T_U
epsilon_k = zeta_ex * T_verd/(T_cond - T_verd)
Pfun <- function(a,b) {a/b}
P <- outer(Qdot_verd, epsilon_k, FUN="Pfun")
What I'd like to create is a colored surface plot with Vdot_L on the x-Axis, Qdot_verd on the y-Axis and P on the z-Axis. I'm thanful for every help.
So something like this??
library(rgl)
zlim <- range(P,na.rm=T)
zlen <- zlim[2] - zlim[1] + 1
color.range <- rev(rainbow(zlen)) # height color lookup table
colors <- color.range[P-zlim[1]+1] # assign colors to heights for each point
persp3d(Vdot_L, Qdot_verd, P, col=colors)
Have you investigated the Plot3D package?
http://cran.r-project.org/web/packages/plot3D/plot3D.pdf
There's a method in here called surf3d which seems like it would do what you want. After importing the package, cast your values to matrix and write:
surf3d(Vdot_L, Qdot_verd, P)
There's also a color parameter which you can adjust.
Alternatively, use rgl, and avoid the matrix issue:
rgl.surface(Vdot_L, Qdot_verd, P)
Also check out these posts for more info:
R: 3D surface plot from 2D matrix
How to create 3D - MATLAB style - surface plots in R

contour plot of a custom function in R

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)

Resources