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
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 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')
I am having extreme difficulty in making my axes logarithmic/have custom tick marks in plot3d using the rgl package. I've tried using the "log='xy'" command in my code just like you would in the basic plot function, and I have tried to create custom tick marks using rgl.bbox. My y axis is plotting fine but my x and z are not cooperating. I cannot get anything to work. Any ideas? Below is my data, code, and a picture of the result I'm getting. I should also add that I'm basically plotting multiple 2d scatterplots in 3d using an arbitrary z value to separate the individual 2d plots.
https://www.dropbox.com/s/wv24rmnyalm3vvc/scattertest.csv?dl=0
#!/usr/bin/env Rscript
library("rgl")
data <- read.csv("~/Desktop/scattertest.csv", header=TRUE, fill=TRUE, sep=',')
x <- names(data[2])
y <- names(data[3])
z <- names(data[4])
plot3d(data[[x]], data[[z]], data[[y]], type="s", size=0.75, lit=FALSE, axes=FALSE,
xlab="rpmn", ylab="round", zlab="rpmt", log="xz",
xmin=c(0.1, 10^6), ymin=c(1,4), zmin=c(0.1, 10^6))
rgl.bbox(color="grey50", emission="grey50",
xat = c(0.1, 1, 10, 100, 10^3, 10^4, 10^5, 10^6), yat = c(1, 2, 3, 4), zat = c(0.1, 1, 10, 100, 10^3, 10^4, 10^5, 10^6),
xlen=8, ylen=4, zlen=8)
There's no support for log="xy" in plot3d(), you'll need to do the transformation yourself.
Your code asks for logarithmic labels, but you aren't doing the logarithmic transformation, so it's not working. You need to rescale the data as well.
You didn't post a reproducible example, but it's easy to create one:
x <- rlnorm(20, 2, 6)
y <- runif(20, 1, 4)
z <- rlnorm(20, 2, 6)
xyz <- cbind(log(x), y, log(z))
plot3d(xyz, axes = FALSE)
ticks <- 10^((-1):6)
bbox3d(xat = log(ticks), xlab = ticks, yat = pretty(1:4),
zat = log(ticks), zlab = ticks,
color="grey50", emission="grey50")
I am very new to R and have made a filled.contour plot using interpolated data like the data found in Plotting contours on an irregular grid . Using some sample data from Plotting contours on an irregular grid , I made a filled.contour and simple scatterplot using the following codes
x <- datr$Lat
y <- datr$Lon
z <- datr$Rain
require(akima)
fld <- interp(x,y,z)
filled.contour(fld)
plot(x,y)
Is there a way to make the plot(x,y) and filled.contour(fld) on the same plot (overlaying)? I have tried the points(x,y), but this doesn't match the x and y axes. In Matlab, I believe I would do this with hold, but I am unsure how to do it on R.
Thanks!
You could use the arguments plot.title or plot.axes for that:
x <- 10*1:nrow(volcano)
y <- 10*1:ncol(volcano)
filled.contour(x, y, volcano, plot.title = {
points(x = 200, y = 200)
})
(via)
One way is to read the code for filled.contour, and do a
little hacking like so:
Make your figure:
filled.contour(fld)
Define these constants by copying them from the arguments list.
nlevels = 20
zlim = range(z, finite = TRUE)
las = 1
levels = pretty(zlim, nlevels)
xlim = range(x, finite = TRUE)
ylim = range(y, finite = TRUE)
xaxs = "i"
yaxs = "i"
asp = NA
Calculate these values by copying code from the function body
mar.orig <- (par.orig <- par(c("mar", "las", "mfrow")))$mar
w <- (3 + mar.orig[2L]) * par("csi") * 2.54
Set the layout by copying code from the function body
layout(matrix(c(2, 1), ncol = 2L), widths = c(1, lcm(w)))
Noteice that the figure is actually plotted after the color scale,
but we don't wnat to reverse the order of the layout because layout
actually sets the 'current' region as the last region because the
first call to plot.new will cause the current region to wrap around
to the first region. Hence, when you set the plot window and plot the points via:
plot.window(ylim=ylim,xlim=xlim)
points(x,y)
title(main='title',
sub='Sub-Title',
xlab='This is the x axis',
ylab='This is the y axis')
They overlay figure as desired.
I have a following data:
library(rgl)
x <- c(rep(1,6),
rep(3,6),
rep(6,6),
rep(9,6),
rep(12,6))
y <- c(1.35,1.39,1.48,1.29,1.35,1.32,
NA,1.5,1.44,1.6,1.5,1.41,
NA,NA,1.72,1.56,1.6,1.55,
NA,NA,NA,1.95,1.9,1.75,
NA,NA,NA,NA,2.05,1.95)
z <- rep(1:6,5)
open3d()
plot3d(x,y,z, type = 'n')
lines3d(x,y,z)
Which is plotting lines in 3d as I expect.
But I cannot get it to plot a surface3d.
As I already read some threads I might need to interpolate my data. RGL docs has not cover this subject well. I tried akima but it doesn't accept NA's.
I would like to link lines to create a surface in linear way. I aware of the NA, so I expect that surface will be decreasing in the area for bigger x (more NA's).
Do I need to perform interpolation? If yes, how to do that on my sample data?
If no, how to achieve the surface3d on my sample data?
Thanks
the solution comes to me from this thread:
Making a wireframe plot from an x,y,z data.frame
below code will work for the sample data provided above (just switch x->y,y->z,z->x)
zmat <- matrix(data = z, nrow = 6, ncol = 5, byrow = FALSE)
surface3d(x = 1:6, y = c(1,3,6,9,12), z = zmat, alpha = 0.4, colour = 'blue')