Related
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")
I'm using persp() to create a 3d plot (but I'm open to anything that will get the job done). Now I want to add a 2d field to make it clear where the 3d plot is above a specific Z value. Is there a way to achieve this? Ideally it would ideally be something like a semi transparent surface where you can see the mass under the surface vs over.
Using the example from the persp documentation
f <- function(x, y) { r <- sqrt(x^2+y^2); 10 * sin(r)/r }
x <- seq(-10, 10, length= 30)
y <- x
z <- outer(x, y, f)
z[is.na(z)] <- 1
persp(x, y, z, theta = 30, phi = 30, expand = 0.5, col = "lightblue",
ltheta = 120, shade = 0.75, ticktype = "detailed",
xlab = "X", ylab = "Y", zlab = "Sinc( r )"
)
How can I insert a field that slices the graph at a certain point of the z-axis?
How about this - there are a lot more possibilities using the rgl package, but it has a persp3d function for easy upgrade from the base graphics.
library(rgl)
f <- function(x, y) { r <- sqrt(x^2+y^2); 10 * sin(r)/r }
x <- seq(-10, 10, length= 30)
y <- x
z <- outer(x, y, f)
z[is.na(z)] <- 1
persp3d(x, y, z, theta = 30, phi = 30, expand = 0.5, col = "lightblue",
ltheta = 120, shade = 0.75, ticktype = "detailed",
xlab = "X", ylab = "Y", zlab = "Sinc( r )")
# Here we add a transparent purple square to mark the top
# x and y mark the corners of the purple square, z is its height
sqdf <- data.frame(x=c(-10,-10,10,10,-10),
y=c(-10, 10,10,-10,-10),
z=c(5,5,5,5,5))
# now draw the purple square,
# note:
# - the "add=T" parameter that appends it to the previous 3d-plot
# - the coord paramter tells it what two planes to use when
# tesselating the polygon into triangles
# (a necessary step and expensive to calculate)
polygon3d(sqdf$x,sqdf$y,sqdf$z,coord=c(1,2),alpha=0.5,color="purple",add=T)
Yielding:
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 do the following
set.seed(1)
x <- seq(-10, 10, length= 600)
y <- x
f <- function(x, y) { r <- sqrt(x^2+y^2); 10 * sin(r)/r }
z <- outer(x, y, f)
persp(x, y, z, theta = 30, phi = 30, expand = 0.5, col = "lightblue")
But the grid is too thin so the border dominates (You can confirm it is indeed the border and not the lighting by using border = NA. It turns to blue):
One way to address this is of course to use not so fine of a grid (for example if you change length = 600 to length= 50 it looks very pleasant, and is actually the example in ?persp). But I want the same shape and smooth exactly as this fine grid. I just don't want to draw all of the borders, maybe only 1/5th of them for example (or half which I assume I can customize).
An issue with plotting the smooth shape and then plotting a grid over top of it is that you can see through the shape to the grid on the other side. To address this, you can start by plotting the course grid on top of a white object, meaning you can't see the back side of the grid, saving the result to a file.
x <- seq(-10, 10, length=50)
y <- x
z <- outer(x, y, f)
png("top.png")
print(persp(x, y, z, theta = 30, phi = 30, expand = 0.5, border="black", col="white"))
dev.off()
Then, you can plot smoothed image followed by the grid with all white colors fully transparent.
x <- seq(-10, 10, length= 600)
y <- x
f <- function(x, y) { r <- sqrt(x^2+y^2); 10 * sin(r)/r }
z <- outer(x, y, f)
png("bottom.png")
print(persp(x, y, z, theta = 30, phi = 30, expand = 0.5, border="lightblue", col="lightblue"))
dev.off()
par(oma=c(0, 0, 0, 0), mar=c(0, 0, 0, 0))
library(png)
top.img <- readPNG("top.png")
top.img[,,4][top.img[,,1] + top.img[,,2] + top.img[,,3] > 2] <- 0
plot.new()
rasterImage(bottom.img, 0, 0, 1, 1)
rasterImage(top.img, 0, 0, 1, 1)
I have got two solutions, but I think both of them are not exactly what you are searching for. I make a line overlay, but it doesn't get overlapped by the surface.
set.seed(1)
x <- seq(-10, 10, length= 600)
y <- x
f <- function(x, y) { r <- sqrt(x^2+y^2); 10 * sin(r)/r }
z <- outer(x, y, f)
persp(x, y, z, theta = 30, phi = 30, expand = 0.5, col = "lightblue", border=NA, shade=0.75, ticktype = "detailed")
par(new=T)
set.seed(1)
x <- seq(-10, 10, length=20)
y <- x
f <- function(x, y) { r <- sqrt(x^2+y^2); 10 * sin(r)/r }
z <- outer(x, y, f)
persp(x, y, z, theta = 30, phi = 30, expand = 0.5, col = NA, border="green")
set.seed(1)
x <- seq(-10, 10, length= 600)
y <- x
f <- function(x, y) { r <- sqrt(x^2+y^2); 10 * sin(r)/r }
z <- outer(x, y, f)
res <- persp(x, y, z, theta = 30, phi = 30, expand = 0.5, col = "lightblue", border=NA, shade=0.75, ticktype = "detailed")
library(grDevices)
xlines <- seq(1, length(x), length.out=20)
for(line in xlines){
lines (trans3d(x=x[line], y = y, z = z[line, ], pmat = res), col = 3, lwd=2)
}
ylines <- seq(1, length(y), length.out=20)
for(line in ylines){
lines (trans3d(x=x, y = y[line], z = z[,line], pmat = res), col = 3, lwd=2)
}
Here are two approaches, neither of which are not ideal. You can use NAs to force transparent "lines" onto the surface (Approach 1) or use NAs to get rid of all but the "grid lines" (Approach 2)
Approach 1:
z2 <- z
lin.seq<- seq(10, 600, 10)
z2[lin.seq,] <- NA
z2[,lin.seq] <- NA
persp(x, y, z2, theta = 30, phi = 30, expand = 0.5,
border=NA, col="lightblue", box=TRUE)
You can then overlay plot above on a solid black surface:
# using original example data
persp(x, y, z, theta = 30, phi = 30, expand = 0.5, col = "black", border=NA)
par(new=TRUE)
z2 <- z
lin.seq<- seq(10, 600, 10)
z2[lin.seq,] <- NA
z2[,lin.seq] <- NA
persp(x, y, z2, theta = 30, phi = 30, expand = 0.5,
border=NA, col="lightblue", box=FALSE)
Approach 2:
# using original example data
persp(x, y, z, theta = 30, phi = 30, expand = 0.5, col = "lightblue", border=NA)
z3 <- matrix(ncol=600, nrow=600) # NA matrix
lin.seq <- seq(25, 600, 25) # spacing of "grid lines"
lin.seq <- c(lin.seq, lin.seq-1, lin.seq-2) # to make lines a bit thicker
# replace some NAs on "grid lines" with values from z.
z3[lin.seq,] <- z[lin.seq,]
z3[,lin.seq] <- z[,lin.seq]
par(new=TRUE)
persp(x, y, z3, theta = 30, phi = 30, expand = 0.5,
border=NA, col="black", box=FALSE)
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)