I have the following plot that I want to use with plot3D.
The commands I use are the following:
library("plot3D");
N <- 100
xs <- runif(N) * 87
ys <- runif(N) * 61
zs <- runif(N)*50 + 154
# scatter + surface
scatter3D(xs, ys, zs, ticktype = "detailed", pch = 16,
bty = "f", xlim = c(1, 87), ylim = c(1,61), zlim = c(94, 215))
This basically plots what I want (other than the legend, which I believe I can remove), but not quite in the right format - I want it to be surfacy, and not just a scatter plot. With the regular plot command, it is relatively easy to add a line that connects between the dots, but I am not sure how to do it in this case.
There is a surf parameter for scatter3D(), which I believe could be used to solve that, but I am not sure what help means by "a fitted surface" and how to create the surface manually. I would expect to just have a way of automatically drawing the surface (as a smooth function).
EDIT: By "surfacy" I am referring to a 3D generalization of a smooth line that goes through points in a 2D plot.
EDIT: Here is an example of what I want to do with the same code above.
par(mfrow = c(1, 1))
# surface = volcano
M <- mesh(1:nrow(volcano), 1:ncol(volcano))
# 100 points above volcano
N <- 100
xs <- runif(N) * 87
ys <- runif(N) * 61
zs <- runif(N)*50 + 154
# scatter + surface
scatter3D(xs, ys, zs, ticktype = "detailed", pch = 16,
bty = "f", xlim = c(1, 87), ylim = c(1,61), zlim = c(94, 215),
surf = list(x = M$x, y = M$y, z = volcano,
NAcol = "grey", shade = 0.1))
This set of commands also creates a surface (the "mountain" like part). What I am not sure is how to define this surface from a set of points (i.e., how to create the "volcano" matrix). Also, I am not interested in having the scattered dots, only a fixed surface which is determined from a set of scattered points.
Related
I am analyzing difference scores with polynomial regression in R. Based on [Edwards and Parry's (1993)][1] recommendations I have been trying to combine a persp() plot with a contour() plot. I would also need to plot the first two principal axes on the contour plot. My attempts so far have only provided me with each individual plot, but I don't know how to combine them. An example for the end-result is :
Edwards & Parry (1993) example difference score visualisation
I manage to get the persp() plot just fine. I have also obtained the contour plot. I can't seem to find any way to combine the two. I have managed to make the plot in plotly using the add_surface() option in the pipeline. My problem with the output is that the surface is smooth, and the contourplot lacks the values in the plot. Basically: persp() and contour() are visualised in a way that is extremely similar to the look I'm aiming for, per the example in the source.
My current attempt (in minimalistic code) is as follows:
surface <- function(e, i){
y <- .2*e + .14*i + .08*e^2 + + .1*e*i + .2*i^2
}
e <- i <- seq(-3, 3, length= 20)
y <- outer(e, i, surface)
persp(e, i, y,
xlab = 'Explicit',
ylab = 'Implicit',
zlab = 'Depression',
theta = 45)
contour(e,i,y)
So basically my question is: how can I make a plot like Edwards and Parry (1993) make, with a similar visual style, in R. It does not have to be base-R, I'm happy with any method. I've been stuck on this problem for a week now.
My attempt in plotly (to compare it to my desired end-result) is:
if(!"plotly" %in% installed.packages){install.packages('plotly')}
library(plotly)
plot_ly(z = ~y) %>% add_surface(x = ~e, y= ~i, z= ~y,
contours = list(
z = list(
show=TRUE,
usecolormap=FALSE,
highlightcolor="#ff0000",
project=list(z=TRUE)
)
)
) %>%
layout(
scene=list(
xaxis = list(title = "Explicit"),
yaxis = list(title = "Implicit"),
zaxis = list(title = "Depression")
)
)
[1]: Edwards, J. R., & Parry, M. E. (1993). On the use of polynomial regression as an alternative to difference scores. Academy of Management Journal, 36(6), 1577–1613. https://doi.org/10.2307/256822
I have found an answer and I will share it here. It seems it cannot be done in base-R. But the RSM-package allows for the addition of contour lines to the base of the plot.
In this answer I will give a minimal example of:
the persp() plot
the contour lines in the base
addition of x=y and x=-y axis
calculation and addition of the first and second principal axis
The only thing I could not solve is that the lines now are drawn over the surface. I don't know how to solve it.
library(rsm)
x <- seq(-3,3,by=0.25)
y <- seq(-3,3,by=0.25)
d <- expand.grid(x=x,y=y)
z <- c(data=NA,1089)
b0 = .140; b1 = -.441; b2 = -.154; b3 = .161 ; b4 =-.106; b5 = .168
k=1
for (i in 1:25) {
for (j in 1:25) {
z[k]=b0+b1*x[i]+b2*y[j]+b3*x[i]*x[i]+b4*x[i]*y[j]+ b5*y[j]*y[j]
k=k+1
} }
data.lm <- lm(z~poly(x,y,degree=2),data=d)
res1 <- persp(data.lm,x~y,
zlim=c(-2,max(z)),
xlabs = c('X','Y'),
zlab = 'Z',
contour=list(z="bottom"),
theta=55,
phi=25)
# draw x=y line (lightly dotted)
xy_pos <- matrix(c(-3,-3,3,3),ncol=2,byrow = T)
lines(trans3d(xy_pos[,2], xy_pos[,1], z=-2, pmat = res1$`y ~ x`$transf),
lty = 3,
col = 'darkgrey')
# draw x=-y line (lightly dotted)
xy_neg <- matrix(c(-3,3,3,-3),ncol=2,byrow = T)
lines(trans3d(xy_neg[,2], xy_neg[,1], z=-2, pmat = res1$`y ~ x`$transf),
lty = 3,
col = 'darkgrey')
# Find stationary points:
X0 <- (b2*b4 - 2*b1*b5) / (4*b3*b5 - b4^2)
Y0 <- (b1*b4 - 2*b2*b3) / (4*b3*b5 - b4^2)
# First Principal Axis
p11 = (b5-b3+sqrt((b3-b5)^2+b4^2))/b4
p10 = Y0 - p11*X0
Ypaf1 = p10 + p11*x
# plot first principal axis (full line)
xypaf1 <- matrix(c(Ypaf1[1], -3, Ypaf1[25], 3),ncol=2, byrow=T)
lines(trans3d(xypaf1[,2], xypaf1[,1], z=-2, pmat = res1$`y ~ x`$transf),
lty = 1,
col = 'black')
# Second Principal Axis
p21 = (b5-b3-sqrt((b3-b5)^2+b4^2))/b4
p20 = Y0 - p21*X0
Ypaf2 = p20 + p21*x
# plot second principal axis (dashed line)
xypaf2 <- matrix(c(Ypaf2[1], -3, Ypaf2[25], 3),ncol=2, byrow=T)
lines(trans3d(xypaf2[,2], xypaf2[,1], z=-2, pmat = res1$`y ~ x`$transf),
lty = 2,
col = 'black')
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
Suppose I'm trying to find the area below a certain value for a student t distribution. I calculate my t test statistic to be t=1.78 with 23 degrees of freedom, for example. I know how to get the area under the curve above t=1.78 with the pt() function. How can I get a plot of the student distribution with 23 degrees of freedom and the area under the curve above 1.78 shaded in. That is, I want the curve for pt(1.78,23,lower.tail=FALSE) plotted with the appropriate area shaded. Is there a way to do this?
ggplot version:
ggplot(data.frame(x = c(-4, 4)), aes(x)) +
stat_function(fun = dt, args =list(df =23)) +
stat_function(fun = dt, args =list(df =23),
xlim = c(1.78,4),
geom = "area")
This should work:
x_coord <- seq(-5, 5, length.out = 200) # x-coordinates
plot(x_coord, dt(x_coord, 23), type = "l",
xlab = expression(italic(t)), ylab = "Density", bty = "l") # plot PDF
polygon(c(1.78, seq(1.78, 5, by = .3), 5, 5), # polygon for area under curve
c(0, dt(c(seq(1.78, 5, by = .3), 5), 23), 0),
col = "red", border = NA)
Regarding arguments to polygon():
your first and last points should be [1.78, 0] and [5, 0] (5 only in case the plot goes to 5) - these basically devine the bottom edge of the red polygon
2nd and penultimate points are [1.78, dt(1.78, 23)] and [5, dt(5, 23)] - these define the end points of the upper edge
the stuff in between is just X and Y coordinates of an arbitrary number of points along the curve [x, dt(x, 23)] - the more points, the smoother the polygon
Hope this helps
Hy there,
I use persp for a 3D-Plot and i am try to find out how persp define the ticks when the parameter ticktype="detailed" is set.
I want to draw lines into the box around a surface corresponding to the ticks. Up till now, frist I draw the surface without any labels and axes and add all lines and axes afterwords. To make it clear what I have done -> example code:
z <- matrix(rep(1:10, each=10), nrow=10, ncol=10)
x.axis <- 1:nrow(z)
y.axis <- 1:ncol(z)
max.y <- max(y.axis)
# Drawing the surface without the axes and no lines on the surface
pmat <- persp(z = z, x = x.axis, y = y.axis ,
lphi = 100, phi = 25, theta = -30,
axes=F,
border = NA, # no lines on the surface
col="deepskyblue",
expand = 0.5,
shade = 0.65)
Now I add the the lines on the surface with different color and the axes with ticks and labels:
par(new=T)
pmat <- persp(z = z, x = x.axis, y = y.axis ,
lphi = 100, phi = 25, theta = -30,
ticktype = "detailed",
expand = 0.5,
cex.lab=0.75,
col=NA,
border="grey80")
par(new=F)
To get lines on the box around the surface I use the following:
for (z_high in c(2,4,6,8)) {
lines(trans3d(x.axis, max.y, z_high, pmat) , col="black", lty=3)
}
As you can see, I use a own defined vector c(2,4,6,8) which represents the z-values for the box lines in the back. If the input surface now changes, I have to adapted this vector by my own. Is there a way to get the ticks for all axes in the persp plot? Did anyone know how persp define the ticks?
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: