I want to plot a discontinuous surface using the persp function.
Here is the function:
f <- function(x, y)
{
r <- sqrt(x^2 + y^2)
out <- numeric(length(r))
ok <- r >= 1
out[ok] <- exp(-(r[ok] - 1))
return(out)
}
To get a perspective plot of the function on a regular grid, I use
x <- y <- seq(-4, 4, length.out = 50)
z <- outer(x, y, f)
persp(x, y, z, , theta = 30, phi = 30, expand = 0.5, col = "lightblue")
The resulting plot does not properly show the circular nature of discontinuity points of the surface. Any suggestion about how to obtain a better perspective plot, instead of contour plot or image?
If something interactive works for you, I would go for something like this:
library(plotly)
plot_ly(z = ~ z) %>% add_surface()
Because the circular nature is best seen from above, a phi of 90 would be best to highlight this feature, but then you lose the rest of the shape and it is pretty useless. Hence, I would go for something interactive.
persp(x, y, z, , theta = 30, phi = 30, expand = 0.5, col = "lightblue")
Related
So I have this code that produces the exact surface
f = function(x, y){
z = ((x^2)+(3*y^2))*exp(-(x^2)-(y^2))
}
plot3d(f, col = colorRampPalette(c("blue", "white")),
xlab = "X", ylab = "Y", zlab = "Z",
xlim = c(-3, 3), ylim = c(-3, 3),
aspect = c(1, 1, 0.5))
Giving the following plot:
Now I have some code that does a random walk metropolis algorithm to reproduce the above image. I think it works as if I do another plot of these calculated values I get the next image with 500 points. Here is the code
open3d()
plot3d(x0, y0, f(x0, y0), type = "p")
Which gives the following plot:
I know it's hard looking at this still image but being able to rotate the sampling is working.
Now here is my question: How can I use plot3d() so that I can have a surface that connects all these points and gives a more jagged representation of the exact plot? Or how can I have each point in the z axis as a bar from the xy plane? I just want something more 3 dimensional than points and I can't find how to do this.
Thanks for your help
You can do this by triangulating the surface. You don't give us your actual data, but I can create some similar data using
f = function(x, y){
z = ((x^2)+(3*y^2))*exp(-(x^2)-(y^2))
}
x <- runif(500, -3, 3)
y <- runif(500, -3, 3)
z <- f(x, y)
Then the plotting is done using the method in ?persp3d.deldir:
library(deldir)
library(rgl)
col <- colorRampPalette(c("blue", "white"))(20)[1 + round(19*(z - min(z))/diff(range(z)))]
dxyz <- deldir::deldir(x, y, z = z, suppressMsge = TRUE)
persp3d(dxyz, col = col, front = "lines", back = "lines")
This might need some cosmetic fixes, e.g.
aspect3d(2, 2, 1)
After some rotation, this gives me the following plot:
I'm not sure to understand what you want. If my understanding is correct, here is a solution. Define a parametric representation of your surface:
fx <- function(u,v) u
fy <- function(u,v) v
fz <- function(u,v){
((u^2)+(3*v^2))*exp(-(u^2)-(v^2))
}
Let's say you have these points:
x0 <- seq(-3, 3, length.out = 20)
y0 <- seq(-3, 3, length.out = 20)
Then you can use the function parametric3d of the misc3d package, with the option fill=FALSE to get a wireframe:
library(misc3d)
parametric3d(fx, fy, fz, u=x0, v=y0,
color="blue", fill = FALSE)
Is it what you want?
To get some vertical bars, use the function segments3d of rgl:
i <- 8
bar <- rbind(c(x0[i],y0[i],0),c(x0[i],y0[i],f(x0[i],y0[i])))
segments3d(bar, color="red")
Here is a plot with only 50 points using my original code.
When I then apply what was said by Stéphane Laurent I then get this plot which feels too accurate when given the actual points I have
Perhaps you need to explain to me what is actually happening in the function parametric3d
I am looking to use the R plotly library to create a 3d surface plot of x,y,z coordinate data, similar to what is shown at the link below:
https://plot.ly/r/3d-surface-plots/
It appears that the plot_ly function requires the z coordinates to be in a matrix of dimensions x * y, as seen in datasets::volcano, used in the linked example. I'd appreciate some guidance on how to construct this matrix. Here is my sample x,y coordinate data:
## x coordinates
xSeq = seq(0, 1, .01)
## y coordinates
ySeq = seq(0, 1, .01)
## list with x, y coordinates
exmplList = list(x = xSeq, y = ySeq)
The z coordinates would be calculated via a formula from the x,y pairs (example formula used here is x + y). I've played around with something like:
exmplList = within(exmplList, z <- matrix(x + y, nrow = length(xSeq), ncol = length(ySeq)))
But that doesn't accomplish the pair combinations that I am trying to achieve.
Plotly surface needs a matrix so you could simply use this bit directly:
z = matrix(xSeq + ySeq, nrow = length(xSeq), ncol = length(ySeq))
Instead of doing a list. So, by running the following code:
## x coordinates
xSeq = seq(0, 1, 0.01)
## y coordinates
ySeq = seq(0, 1, 0.01)
## list with x, y coordinates
z = matrix(xSeq + ySeq, nrow = length(xSeq), ncol = length(ySeq))
fig = plot_ly(z = ~z) %>% add_surface()
fig
One obtains the following plot:
You might need to click and rotate a bit to see the plane. Hope it helps, cheers.
I am trying to visualize a curve for pollination distribution. I am very new to R so please don't be upset by my stupidity.
llim <- 0
ulim <- 6.29
f <- function(x,y) {(.156812/((2*pi)*(.000005^2)*(gamma(2/.156812)))*exp(-((sqrt(x^2+y^2))/.000005)^.156812))}
integrate(function(y) {
sapply(y, function(y) {
integrate(function(x) f(x,y), llim, ulim)$value
})
}, llim, ulim)
fv <- Vectorize(f)
curve(fv, from=0, to=1000)
And I get:
Error in y^2 : 'y' is missing
I'm not quite sure what you're asking to plot. But I know you want to visualise your scalar function of two arguments.
Here are some approaches. First we define your function.
llim <- 0
ulim <- 6.29
f <- function(x,y) {
(.156812/((2*pi)*(.000005^2)*(gamma(2/.156812)))*exp(-((sqrt(x^2+y^2))/.000005)^.156812))
}
From your title I thought of the following. The function defined below intf integrates your function over the square [0,ul] x [0,ul] and return the value. We then vectorise and plot the integral over the square as a function the length of the side of the square.
intf <- function(ul) {
integrate(function(y) {
sapply(y, function(y) {
integrate(function(x) f(x,y), 0, ul)$value
})
}, 0, ul)$value
}
fv <- Vectorize(intf)
curve(fv, from=0, to=1000)
If f is a distribution, I guess you can make your (somewhat) nice probability interpretation of this curve. (I.e. ~20 % probability of pollination(?) in the 200 by 200 meter square.)
However, you can also do a contour plot (of the log-transformed values) which illustrate the function we are integrating above:
logf <- function(x, y) log(f(x, y))
x <- y <- seq(llim, ulim, length.out = 100)
contour(x, y, outer(x, y, logf), lwd = 2, drawlabels = FALSE)
You can also plot some profiles of the surface:
plot(1, xlim = c(llim, ulim), ylim = c(0, 0.005), xlab = "x", ylab = "f")
y <- seq(llim, ulim, length.out = 6)
for (i in seq_along(y)) {
tmp <- function(x) f(x, y = y[i])
curve(tmp, llim, ulim, add = TRUE, col = i)
}
legend("topright", lty = 1, col = seq_along(y),
legend = as.expression(paste("y = ",y)))
They need to be modified a bit to make them publication worthy, but you get the idea. Lastly, you can do some 3d plots as others have suggested.
EDIT
As per your comments, you can also do something like this:
# Define the function times radius (this time with general a and b)
# The default of a and b is as before
g <- function(z, a = 5e-6, b = .156812) {
z * (b/(2*pi*a^2*gamma(2/b)))*exp(-(z/a)^b)
}
# A function that integrates g from 0 to Z and rotates
# As g is not dependent on the angle we just multiply by 2pi
intg <- function(Z, ...) {
2*pi*integrate(g, 0, Z, ...)$value
}
# Vectorize the Z argument of intg
gv <- Vectorize(intg, "Z")
# Plot
Z <- seq(0, 1000, length.out = 100)
plot(Z, gv(Z), type = "l", lwd = 2)
lines(Z, gv(Z, a = 5e-5), col = "blue", lwd = 2)
lines(Z, gv(Z, b = .150), col = "red", lwd = 2)
lines(Z, gv(Z, a = 1e-4, b = .2), col = "orange", lwd = 2)
You can then plot the curves for the a and b you want. If either is not specified, the default is used.
Disclaimer: my calculus is rusty and I just did off this top of my head. You should verify that I've done the rotation of the function around the axis properly.
The lattice package has several functions that can help you draw 3 dimensional plots, including wireframe() and persp(). If you prefer not to use a 3d-plot, you can create a contour plot using contour().
Note: I don't know if this is intentional, but your data produces a very large spike in one corner of the plot. This produces a plot that is for all intents flat, with a barely noticable spike in one corner. This is particularly problematic with the contour plot below.
library(lattice)
x <- seq(0, 1000, length.out = 50)
y <- seq(0, 1000, length.out = 50)
First the wire frame plot:
df <- expand.grid(x=x, y=y)
df$z <- with(df, f(x, y))
wireframe(z ~ x * y, data = df)
Next the perspective plot:
dm <- outer(x, y, FUN=f)
persp(x, y, dm)
The contour plot:
contour(x, y, dm)
I would like to create a waterfall plot in R (XYYY) from my data.
So far, I use this code:
load("myData.RData")
ls()
dim(data)
##matrix to xyz coords
library(reshape2)
newData <- melt(data, id="Group.1")
dim(newData)
head(newData)
tail(newData)
newDataO <- newData[c(2,1,3)]
head(newDataO)
##color scale for z axis
myColorRamp <- function(colors, values) {
v <- (values - min(values))/diff(range(values))
x <- colorRamp(colors)(v)
rgb(x[,1], x[,2], x[,3], maxColorValue = 255)
}
cols <- myColorRamp(c("darkblue","yellow","darkorange","red","darkred"),newDataO$value)
##3D scatter
library(rgl)
plot3d(newDataO$variable, newDataO$Group.1, newDataO$value, xlab="", ylab="", zlab="", type="p", col=cols, box=FALSE, axes=FALSE)
rgl.postscript("persptrial_060514.eps","eps")
to get this plot:
https://dl.dropboxusercontent.com/u/14906265/persptrial_060514.jpg
I have also use this option in 2d with polygon but the result does not properly show the differential effect between both plots (left vs right).
I do not know whether something like persp3d could do the job but I am not familiar enough with writing code to achieve it. Any help will be very much appreciated.
It seems to me that the simplest way of doing a waterfall plot in R is to add all the lines manually in a loop.
library(rgl)
# Function to plot
f <- function(x, y) sin(10 * x * y) * cos(4 * y^3) + x
nx <- 30
ny <- 100
x <- seq(0, 1, length = nx)
y <- seq(0, 1, length = ny)
z <- outer(x, y, FUN = f)
# Plot function and add lines manually
surface3d(x, y, z, alpha = 0.4)
axes3d()
for (i in 1:nx) lines3d(x[i], y, z[i, ], col = 'white', lwd = 2)
I want to plot a matrix of z values with x rows and y columns as a surface similar to this graph from MATLAB.
Surface plot:
Code to generate matrix:
# Parameters
shape<-1.849241
scale<-38.87986
x<-seq(from = -241.440, to = 241.440, by = 0.240)# 2013 length
y<-seq(from = -241.440, to = 241.440, by = 0.240)
matrix_fun<-matrix(data = 0, nrow = length(x), ncol = length(y))
# Generate two dimensional travel distance probability density function
for (i in 1:length(x)) {
for (j in 1:length(y)){
dxy<-sqrt(x[i]^2+y[j]^2)
prob<-1/(scale^(shape)*gamma(shape))*dxy^(shape-1)*exp(-(dxy/scale))
matrix_fun[i,j]<-prob
}}
# Rescale 2-d pdf to sum to 1
a<-sum(matrix_fun)
matrix_scale<-matrix_fun/a
I am able to generate surface plots using a couple methods (persp(), persp3d(), surface3d()) but the colors aren't displaying the z values (the probabilities held within the matrix). The z values only seem to display as heights not as differentiated colors as in the MATLAB figure.
Example of graph code and graphs:
library(rgl)
persp3d(x=x, y=y, z=matrix_scale, color=rainbow(25, start=min(matrix_scale), end=max(matrix_scale)))
surface3d(x=x, y=y, z=matrix_scale, color=rainbow(25, start=min(matrix_scale), end=max(matrix_scale)))
persp(x=x, y=y, z=matrix_scale, theta=30, phi=30, col=rainbow(25, start=min(matrix_scale), end=max(matrix_scale)), border=NA)
Image of the last graph
Any other tips to recreate the image in R would be most appreciated (i.e. legend bar, axis tick marks, etc.)
So here's a ggplot solution which seems to come a little bit closer to the MATLAB plot
# Parameters
shape<-1.849241
scale<-38.87986
x<-seq(from = -241.440, to = 241.440, by = 2.40)
y<-seq(from = -241.440, to = 241.440, by = 2.40)
df <- expand.grid(x=x,y=y)
df$dxy <- with(df,sqrt(x^2+y^2))
df$prob <- dgamma(df$dxy,shape=shape,scale=scale)
df$prob <- df$prob/sum(df$prob)
library(ggplot2)
library(colorRamps) # for matlab.like(...)
library(scales) # for labels=scientific
ggplot(df, aes(x,y))+
geom_tile(aes(fill=prob))+
scale_fill_gradientn(colours=matlab.like(10), labels=scientific)
BTW: You can generate your data frame of probabilities much more efficiently using the built-in dgamma(...) function, rather than calculating it yourself.
In line with alexis_laz's comment, here is an example using filled.contour. You might want to increase your by to 2.40 since the finer granularity increases the time it takes to generate the plot by a lot but doesn't improve quality.
filled.contour(x = x, y = y, z = matrix_scale, color = terrain.colors)
# terrain.colors is in the base grDevices package
If you want something closer to your color scheme above, you can fiddle with the rainbow function:
filled.contour(x = x, y = y, z = matrix_scale,
color = (function(n, ...) rep(rev(rainbow(n/2, ...)[1:9]), each = 3)))
Finer granularity:
filled.contour(x = x, y = y, z = matrix_scale, nlevels = 150,
color = (function(n, ...)
rev(rep(rainbow(50, start = 0, end = 0.75, ...), each = 3))[5:150]))