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")
Related
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
I'm hoping to keep in the image below the ticks on the vertical z axis, but remove ticks and numbers from the x and y axes. I would like to be able to label my x and y axes with a label for each condition in my matrix, but have not figured out how to do this with text3D. For some reason (because I'm on a mac?) I can't download axes3D, which is one potential solution I've seen in other responses.
Here is my code:
x = c(0,1)
y = c(0,1)
zval = c(104.1861, 108.529, 110.3675, 110.4112)
z = matrix (zval, nrow=2, ncol=2, byrow=TRUE)
hist3D(x,y,z, zlim=c(101,111), colvar = NULL, d=2, col = "lightblue", NAcol = "white", breaks = NULL, colkey = NULL, theta=-60, phi=20, nticks=10, axes=TRUE, ticktype="detailed", space=0.5, lighting=TRUE, light="diffuse", shade=.5, ltheta = 50, bty = "g")
My output

Ultimately, I'd like something more along the lines of this:
I'm very new to R.
stackoverflow.com/questions/26794236/ggplot2-3d-bar-plot
^ this seems like it might be what I need, but I couldn't replicate the code without an error. When I tried to run this piece I got an error because my x and z (in this case) axes aren't numerical:
cloud(y~x+z, d, panel.3d.cloud=panel.3dbars, col.facet='grey', xbase=0.4, ybase=0.4, scales=list(arrows=FALSE, col=1), par.settings = list(axis.line = list(col = "transparent")))
Maybe this might be helpful (with the caveat that 3D plots can sometimes make interpretation more challenging).
First, I recreated a data frame d based on something similar to what you started with:
x = c(0, 0, 1, 1)
y = c(0, 1, 0, 1)
z = c(104.1861, 108.529, 110.3675, 110.4112)
d <- data.frame(
x = factor(as.logical(x)),
y = factor(as.logical(y)),
z = z
)
Note that for x and y I converted the 0 and 1 to FALSE and TRUE with as.logical, then made them factors.
Then for the plot:
library(latticeExtra)
cloud(z ~ x + y, data = d, panel.3d.cloud=panel.3dbars, col.facet='grey',
xbase=0.4, ybase=0.4, scales=list(arrows=FALSE, col=1),
par.settings = list(axis.line = list(col = "transparent")))
You will want the formula as z ~ x + y where z is a numeric response.
Edit: If you wish to customize the axis labels, you can set the factor labels as follows (for example):
d <- data.frame(
x = factor(as.logical(x), labels = c("Hi", "Lo")),
y = factor(as.logical(y), labels = c("Label1", "Label2")),
z = z
)
Plot
So I came across this answer here, and my question is, if I have three variables and I want to use the x and y to create bins, like using cut and table in the other answer, how can I then graph the z as the average of all the variable Z data that falls into those bins?
This what I have:
library(plot3D)
x <- data$OPEXMKUP_PT_1d
y <- data$prod_opex
z <- data$ab90_ROIC_wogw3
x_c <- cut(x, 20)
y_c <- cut(y, 20)
cutup <- table(x_c, y_c)
mat <- data.frame(cutup)
hist3D(z = cutup, border="black", bty ="g",
main = "Data", xlab = "Markup",
ylab ="Omega", zlab = "Star")
But it show the z as the frequency, and when I try,
hist3D(x, y, z, phi = 0, bty = "g", type = "h", main = 'NEWer',
ticktype = "detailed", pch = 19, cex = 0.5,
xlim=c(0,3),
ylim=c(-10,20),
zlim=c(0,1))
It thinks for a long time and throws an error,
Error: protect(): protection stack overflow
Graphics error: Plot rendering error
It will do the 3d scatter fine but the data doesn't make sense since the Z variable is a ratio that falls mostly between 0 and 1, so you get a bunch of tall lines and and a bunch of short lines. I would like them averaged by bin to show a visual of how the average ratio changes as x and y change. Please let me know if there is a way to do this.
Not sure exactly what your data looks like, so I made some up. You should be able to adjust to your needs. It's a bit hacky/brute force-ish, but could work just fine if your data isn't too large to slow down the loop.
library(plot3D)
# Fake it til you make it
n = 5000
x = runif(n)
y = runif(n)
z = x + 2*y + sin(x*2*pi)
# Divide into bins
x_c = cut(x, 20)
y_c = cut(y, 20)
x_l = levels(x_c)
y_l = levels(y_c)
# Compute the mean of z within each x,y bin
z_p = matrix(0, 20, 20)
for (i in 1:length(x_l)){
for (j in 1:length(y_l)){
z_p[i,j] = mean(z[x_c %in% x_l[i] & y_c %in% y_l[j]])
}
}
# Get the middle of each bin
x_p = sapply(strsplit(gsub('\\(|]', '', x_l), ','), function(x) mean(as.numeric(x)))
y_p = sapply(strsplit(gsub('\\(|]', '', y_l), ','), function(x) mean(as.numeric(x)))
# Plot
hist3D(x_p, y_p, z_p, bty = "g", type = "h", main = 'NEWer',
ticktype = "detailed", pch = 19, cex = 0.5)
Basically, we're just manually computing the average bin height z by looping over the bins. There may be a better way to do the computation.
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)