Insert "cut off" field in R surface plot - r

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:

Related

Generalizing a 2D plot to 3D in R

I have a problem where I have data with (x,y) coordinates that I want to plot in the x-y plane. Furthermore, I have some box constraints such that -7 < x < 7 and -5 < y < 5 need to be drawn and checked. All points that fall outside of this box constraint I would like to color red. To do this I have the following code in R:
library(rgl)
x <- 7
y <- 5
data.x <- rnorm(10,0,5)
data.y <- rnorm(10,0,5)
plot(data.x, data.y, xlim = c(min(-x,data.x),max(x,data.x)),
ylim = c(min(-y,data.y),max(y,data.y)), pch = 19)
rect(-x, -y, x, y, col = "lightgrey")
idx <- abs(data.x) > x | abs(data.y) > y
points(data.x[idx], data.y[idx], col = "red", pch = 19)
points(data.x[!idx], data.y[!idx], col = "deepskyblue", pch = 19)
Now, where I am stuck, is on how to plot this type of data picture when I have a third group of data and a third constraint. I.e.,
### How to generalize when I have a third axis and constraint, i.e., a 3D cube
z <- 4
data.z <- rnorm(10, 0, 5)
So essentially I want to plot a box constraint as a cube in the x-y-z plane, and to color the points that fall outside the box constraint red again.
Also, I should say I understand there are functions for plottig 3d scatter plots in R, however, what I am struggling with is how to draw the 3D cube that defines the constraints.
The difficulty with a 3D plot such as this is being able to interpret the "depth" of the points in the image. An animated 3D image might be helpful here:
library(plot3D)
x <- 7
y <- 5
z <- 6
set.seed(123)
data.x <- rnorm(10, 0, 5)
data.y <- rnorm(10, 0, 5)
data.z <- rnorm(10, 0, 5)
in_out <- abs(data.x) > x | abs(data.y) > y | abs(data.z) > z
for(i in seq(0, 358, 2)) {
png(paste0("box", sprintf("%03d", i), ".png"))
box3D(-x, -y, -z, x, y, z, col = NA, border = "gray50", theta = i, phi = 15,
xlim = c(-10, 10), ylim = c(-10, 10), zlim = c(-10, 10),
axes = TRUE, ticktype = "detailed")
points3D(data.x, data.y, data.z, colvar = in_out, pch = 16, cex = 3,
add = TRUE, colkey = FALSE, col = c("lightblue", "red"))
dev.off()
}
library(magick)
list.files(pattern = 'box\\d+\\.png', full.names = TRUE) %>%
image_read() %>%
image_join() %>%
image_animate(fps=50) %>%
image_write("box.gif")
box.gif

3d plot of a function with a constraint in R

I would like to draw a 3D plot of the function z=f(x,y)=x^2+y^2, y>x>0 see the picture
I know the way to do that without the constraint y>x>0 which is easy. could you please help me.
My code for the version without the constraint
fxy <- function(x,y){
return(x^2+y^2)}
x <- seq(-100 ,100, by=5)
y <- seq(-100 ,100, by=5)
z <- outer(x, y, fxy)
persp(x, y, z,
main="3D Plot of x2+y2",
zlab = "Function",
theta = 20, phi = 10,
col = "blue")
I don't know how to do this with the base persp function, but it's possible with rgl.
library(rgl)
fxy <- function(x,y){
return(x^2+y^2)}
x <- seq(-100 ,100, by=5)
y <- seq(-100 ,100, by=5)
z <- outer(x, y, fxy)
# First, draw the full surface:
full <- surface3d(x, y, z,
col = "blue")
# Convert it to a mesh object:
m1 <- as.mesh3d(full)
# Clip to x > 0
m2 <- clipMesh3d(m1, "x", bound = 0, greater = TRUE)
# Clip to y > x
m3 <- clipMesh3d(m2, function(x,y,z) y-x, bound = 0, greater = TRUE)
# Plot it
plot3d(m3)
You can now rotate it to whatever orientation you like.

How to plot a surface with discontinuity in R using "persp" function

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

Plot vertical surface below function

I'm trying to create a very simple 3D plot using the rgl package: I have a function that just maps x values into y values. For a given z (in my example: z = 1), I can plot this function in a 3D plot:
library(rgl)
mycurve <- function(x) { return (1/x)}
myx <- seq(1, 10, by = 0.1)
plot3d(x = NA, xlim = c(0, 10), ylim = c(0, 10), zlim = c(0, 5),
xlab = "x", ylab = "y", zlab = "height")
lines3d(x = myx, y = mycurve(myx), z = 1)
However, even after hours of trying to understand the documentation of ?persp3d and ?surface3d, I still have no idea how to add a surface to my plot that "connects" my line to the x-y plane – like this:
(To generate this image, I cheated by plotting many lines: for (i in seq(0, 1, by = 0.01)) { lines3d(x = myx, y = mycurve(myx), z = i) }.)
I suppose that I need to supply the correct values to surface3d somehow. From ?surface3d:
The surface is defined by the matrix of height values in z, with rows corresponding to the values in x and columns corresponding to the values in y.
Given that my space curve is "vertical", each value of x corresponds to only 1 value of y. Still, I need to specify two z values for each xy pair, which is why I do not know how to proceed.
How can I plot a space curve as shown in the second image?
In persp3d, all 3 arguments can be matrices, so you can plot arbitrary surfaces. For your needs, this works:
mycurve <- function(x) { return (1/x)}
myx <- seq(1, 10, by = 0.1)
xmat <- matrix(NA, 2, length(myx))
ymat <- matrix(NA, 2, length(myx))
zmat <- matrix(NA, 2, length(myx))
for (i in 0:1) {
xmat[i+1,] <- myx
ymat[i+1,] <- mycurve(myx)
zmat[i+1,] <- i
}
library(rgl)
persp3d(x = xmat, y = ymat, z = zmat, xlim = c(0, 10), ylim = c(0, 10), zlim = c(0, 5),
xlab = "x", ylab = "y", zlab = "height", col = "gray")
The image produced looks like this:
If you want z to depend on x or y, you'll likely want a smaller step size, but this works for the surface you're after.
To use the persp3d function one needs to create a matrix for z to correspond to all of the x and y values in the desired range.
I revised your function to take both the x and y parameters and return the desired z value. The outer function will call the function repeatedly to fill the matrix. Then plot, with the defined x and y axis and z (from the outer function)
library(rgl)
mycurve <- function(x, y) { return (1/x)}
myx <- seq(1, 10, by = 0.4)
myy <-seq(1, 10, by =0.4)
#create matrix
data<-outer(myx, myy, mycurve)
#plot points
persp3d(x=myx, y=myy, z=data,
xlab = "x", ylab = "y", zlab = "height")

How to have only every other border in a persp

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)

Resources