replicating an rgl viewpoint in lattice - r

It would be convenient to interactively select a decent viewpoint using rgl and then adopt the same orientation in a lattice 3d-plot. For example, given the following plot using a non-informative viewpoint.
library(lattice)
wireframe(volcano, screen = list(x=0, y=0, z=0))
The same can be opened in rgl by
library(rgl)
persp3d(volcano)
view3d(0, 0)
Interactively it is easy to rotate the plot to an informative view.
The matrix giving the current rgl viewpoint in can be extracted by
p <- par3d()
p$userMatrix
How can this matrix be converted into corresponding x,y,z screen parameters to replicate the view in lattice?
UPDATE 1
I tried out 42's conversion below. The code shows the rgl plot and the corresponding lattice plot per row. If I implemented it correctly (see code below), there appears to still be an issue.
# convert rgl viewpoint into lattice
# screen orientation
rgl_to_lattice_viewpoint <- function()
{
p <- par3d()
rotm <- p$userMatrix
B = 360*atan(rotm[1,2]/rotm[2,2])/(2*pi)
P = 360*asin(-rotm[3,2])/(2*pi)
H = 360*atan(rotm[3,1]/rotm[3,3])/(2*pi)
list(x=-B, y=-P, z=-H)
}
# read and plot PNG image
plot_png <- function(f)
{
img <- readPNG(f)
rimg <- as.raster(img) # raster multilayer object
plot(NULL, xlim=c(0,1), ylim=c(0,1), xlab = "", ylab = "",
asp=1, frame=F, xaxt="n", yaxt="n")
rasterImage(rimg, 0, 0, 1, 1)
}
# create rgl snapshot with random rotation and
# corresponding lattice wireframe plot
lattice_plus_rgl_plot <- function()
{
# rgl plot random rotation
persp3d(volcano, col = "green3")
theta <- sample(-180:180, 1)
phi <- sample(-90:90, 1)
view3d(theta, phi, fov=40)
v <- rgl_to_lattice_viewpoint()
f <- tempfile(fileext = ".png")
rgl.snapshot(f)
rgl.close()
# lattice plot
f2 <- tempfile(fileext = ".png")
png(f2)
print(wireframe(volcano, screen = v))
dev.off()
# plot both
plot_png(f)
plot_png(f2)
}
# CREATE SOME PLOTS
library(rgl)
library(lattice)
library(png)
par(mfrow=c(3,2), mar=c(0,0,0,0))
replicate(3, lattice_plus_rgl_plot())

I used the answer to this question for conversion from a rotation matrix to angles: Conversion euler to matrix and matrix to euler . I admit to concern that I see another somewhat different answer here: How to calculate the angle from Roational matrix . (My linear algebra is not good enough to determine which of these is correct.)
p <- par3d()
rotm <- p$userMatrix
B = 360*atan(rotm[1,2]/rotm[2,2])/(2*pi)
P = 360*asin(-rotm[3,2])/(2*pi)
H = 360*atan(rotm[3,1]/rotm[3,3])/(2*pi)
> print(list(B,P,H))
[[1]]
[1] 41.54071
[[2]]
[1] 40.28412
[[3]]
[1] 41.24902
At that point I had already rotated the RGL-object to roughly the "viewing point" that you had suggested. I discovered by experimentation that the negative values supplied to the wireframe call delivered apparently correct results. "Viewer rotation angles" are plausibly seen as the negative for "object rotation angles".
png(); print(wireframe(volcano, screen = list(x=-B, y=-P, z=-H)) ); dev.off()
There is a rotate.wireframe function in the TeachingDemos package but it does not play well with concurrently running rgl plots. (No plot was apparent until I closed the rgl device.) It also seemed kind of buggy when running on a Mac (thick black line across the lattice plot). It uses the X11/XQuartz facilities to manage interaction via tk/tcl functions and I was unable to reproduce the plots from the angles being displayed. Looking at the code I'm not able to understand why that should be so. But your mileage may vary.

This version of your function uses conversions from the orientlib package, and makes the rotation matrix an argument:
rgl_to_lattice_viewpoint <- function(rotm = par3d("userMatrix"))
{
e <- -orientlib::eulerzyx(orientlib::rotmatrix(rotm[1:3, 1:3]))#x*180/pi
list(z = e[1], y = e[2], x = e[3])
}
Note that the z, y, x order is essential.
Using it in place of your function, I get this output:
These get the rotation right. I don't know if it's also possible to get the perspective to match.
Edited to add: rgl version 0.95.1468, so far available only on R-forge,
contains a version of this function and one for base graphics as well.

Related

How to use plot3D::persp3D() to see plot in rgl device as with rgl::persp3d()?

I would like to plot my 3D function in a rgl device window using plot3D package. It allows me to rotate on x, y, z axis and scale. This is basic example with rgl package:
x <- seq(-10, 10, length = 30)
y <- x
z <- outer(x, y, function(x, y) { r <- sqrt(x^2 + y^2); 10 * sin(r)/r })
z[is.na(z)] <- 1
rgl::persp3d(x, y, z)
Unfortunately this one is not open in rgl device:
plot3D::persp3D(x, y, z)
I am pretty sure that I have see it somewhere (maybe even in my experiments with that package). Can someone help me please?
tl;dr maybe you were looking for the plot3Drgl package?
I don't think this is possible. ?plot3D::persp3D says
‘persp3D’ is an extension to the default persp plot
(emphasis added). The "default persp plot" is built on the base R graphics, which uses a static "canvas-style" model - it cannot be dynamically rotated/zoomed.
Let's try looking for other packages with "3D" in their name ...
a1 <- available.packages()
grep("3D",rownames(a1),value=TRUE)
## [1] "arf3DS4" "BaTFLED3D" "DGVM3D" "FPCA3D"
## [5] "plot3D" "plot3Drgl" "VecStatGraphs3D"
We can try plot3Drgl, whose documentation (?plot3Drgl) says
It will plot most (but not all) features from plots generated with
‘plot3D’, except for the color keys and polygons.
On the other hand, it looks from experimentation as though it does handle color keys ...
plot3Drgl::persp3Drgl(x,y,z)

What does autoplot.microbenchmark actually plot?

According to the docs, microbenchmark:::autoplot "Uses ggplot2 to produce a more legible graph of microbenchmark timings."
Cool! Let's try the example code:
library("ggplot2")
tm <- microbenchmark(rchisq(100, 0),
rchisq(100, 1),
rchisq(100, 2),
rchisq(100, 3),
rchisq(100, 5), times=1000L)
autoplot(tm)
I don't see anything about the...squishy undulations in the documentation, but my best guess from this answer by the function creator is that this is like a smoothed series of boxplots of the time taken to run, with the upper and lower quartiles connected over the body of the shape. Maybe? These plots look too interesting not to find out what is going on here.
What is this a plot of?
The short answer is a violin plot:
It is a box plot with a rotated kernel density plot on each side.
The longer more interesting(?) answer. When you call the autoplot function, you are actually calling
## class(ts) is microbenchmark
autoplot.microbenchmark
We can then inspect the actual function call via
R> getS3method("autoplot", "microbenchmark")
function (object, ..., log = TRUE, y_max = 1.05 * max(object$time))
{
y_min <- 0
object$ntime <- convert_to_unit(object$time, "t")
plt <- ggplot(object, ggplot2::aes_string(x = "expr", y = "ntime"))
## Another ~6 lines or so after this
The key line is + stat_ydensity(). Looking at ?stat_ydensity you
come to the help page on violin plots.

3D surface plot in R

I'm trying to create a 3D plot in R-Project. I know there was a question like this before but I couldn't solve my problems with the answers there.
What I have is:
Vdot_L = c(0,1,2,3,4,5,6,7,8,9,10)
Qdot_verd = c(2000,2100,2200,2300,2400,2500,2600,2700,2800,2900,3000)
zeta_ex = 0.4
T_U = 293.15 #K
T_verd = 273.15 #K
T_cond=Vdot_L*2+T_U
epsilon_k = zeta_ex * T_verd/(T_cond - T_verd)
Pfun <- function(a,b) {a/b}
P <- outer(Qdot_verd, epsilon_k, FUN="Pfun")
What I'd like to create is a colored surface plot with Vdot_L on the x-Axis, Qdot_verd on the y-Axis and P on the z-Axis. I'm thanful for every help.
So something like this??
library(rgl)
zlim <- range(P,na.rm=T)
zlen <- zlim[2] - zlim[1] + 1
color.range <- rev(rainbow(zlen)) # height color lookup table
colors <- color.range[P-zlim[1]+1] # assign colors to heights for each point
persp3d(Vdot_L, Qdot_verd, P, col=colors)
Have you investigated the Plot3D package?
http://cran.r-project.org/web/packages/plot3D/plot3D.pdf
There's a method in here called surf3d which seems like it would do what you want. After importing the package, cast your values to matrix and write:
surf3d(Vdot_L, Qdot_verd, P)
There's also a color parameter which you can adjust.
Alternatively, use rgl, and avoid the matrix issue:
rgl.surface(Vdot_L, Qdot_verd, P)
Also check out these posts for more info:
R: 3D surface plot from 2D matrix
How to create 3D - MATLAB style - surface plots in R

contour plot of a custom function in R

I'm working with some custom functions and I need to draw contours for them based on multiple values for the parameters.
Here is an example function:
I need to draw such a contour plot:
Any idea?
Thanks.
First you construct a function, fourvar that takes those four parameters as arguments. In this case you could have done it with 3 variables one of which was lambda_2 over lambda_1. Alpha1 is fixed at 2 so alpha_1/alpha_2 will vary over 0-10.
fourvar <- function(a1,a2,l1,l2){
a1* integrate( function(x) {(1-x)^(a1-1)*(1-x^(l2/l1) )^a2} , 0 , 1)$value }
The trick is to realize that the integrate function returns a list and you only want the 'value' part of that list so it can be Vectorize()-ed.
Second you construct a matrix using that function:
mat <- outer( seq(.01, 10, length=100),
seq(.01, 10, length=100),
Vectorize( function(x,y) fourvar(a1=2, x/2, l1=2, l2=y/2) ) )
Then the task of creating the plot with labels in those positions can only be done easily with lattice::contourplot. After doing a reasonable amount of searching it does appear that the solution to geom_contour labeling is still a work in progress in ggplot2. The only labeling strategy I found is in an external package. However, the 'directlabels' package's function directlabel does not seem to have sufficient control to spread the labels out correctly in this case. In other examples that I have seen, it does spread the labels around the plot area. I suppose I could look at the code, but since it depends on the 'proto'-package, it will probably be weirdly encapsulated so I haven't looked.
require(reshape2)
mmat <- melt(mat)
str(mmat) # to see the names in the melted matrix
g <- ggplot(mmat, aes(x=Var1, y=Var2, z=value) )
g <- g+stat_contour(aes(col = ..level..), breaks=seq(.1, .9, .1) )
g <- g + scale_colour_continuous(low = "#000000", high = "#000000") # make black
install.packages("directlabels", repos="http://r-forge.r-project.org", type="source")
require(directlabels)
direct.label(g)
Note that these are the index positions from the matrix rather than the ratios of parameters, but that should be pretty easy to fix.
This, on the other hand, is how easilyy one can construct it in lattice (and I think it looks "cleaner":
require(lattice)
contourplot(mat, at=seq(.1,.9,.1))
As I think the question is still relevant, there have been some developments in the contour plot labeling in the metR package. Adding to the previous example will give you nice contour labeling also with ggplot2
require(metR)
g + geom_text_contour(rotate = TRUE, nudge_x = 3, nudge_y = 5)

Using grconvertX/grconvertY in ggplot2

I am trying to figure out how to use grconvertX/grconvertX in ggplot. My ultimate goal is to to add annotation to a ggplot2 figure (and possibly lattice) with grid.text and grid.lines by going from user coordinates to device coordinates. I know it can be done with grobs but I am wondering if there is an easier way.
The following code allows me to pass values from user coordinates to ndc coordinates and use those values to annotate the plot with grid.text.
graphics.off() # close graphics windows
library(grid)
library(gridBase)
test= data.frame(
x = c(1,2,3),
y = c(12,10,3),
n = c(75,76,73)
)
par(mar = c(13,5,2,3))
plot(test$y ~ test$x,type="b", ann=F)
for (i in 1:nrow(test))
{
X=grconvertX(i , from="user", to="ndc")
grid.text(x=X, y =0.2, label=paste("GRID.text at\nuser.x=", i, "\n", "ndc.x=", (signif( X, 5)) ) )
grid.lines(x=c(X, X), y = c(0.28, 0.33) )
}
#add some code to save as PDF ...
The code is based on the solution from one of my previous posts: Mixing X and Y coordinate systems . You can see how x coordinates from the original plot were converted to ndc. The advantage of this approach is that I can use device coordinates for Y.
I assumed I could easily do the same in ggplot2 (and possibly in lattice).
library(ggplot2)
graphics.off() # close graphics windows
qplot(x=x, y=y, data=test)+geom_line()+ opts(plot.margin = unit(c(1,3,8,1), "lines"))
for (i in 1:nrow(test))
{
X=grconvertX(i , from="user", to="ndc")
grid.text(x=X, y =0.2, label=paste("GRID.text at\nuser.x=", i, "\n", "ndc.x=", (signif( X, 5)) ) )
grid.lines(x=c(X, X), y = c(0.28, 0.33) )
}
#add some code to save as PDF...
However, it does not work correctly. The coordinates seem to be a bit off. The vertical lines and text don't correspond to the tick labels on the plot. Can anybody tell me how to fix it? Thanks a lot in advance.
The grconvertX and grconvertY functions work with base graphics while ggplot2 uses grid graphics. In general the 2 different graphics engines don't play nicely together (though you have demonstrated using gridBase to help). Your first example works because you started with a base graphic so the user coordinate system exists with the base graph and grconvertX converts from it. In the second case the user coordinate system was never set in the base graphics, so it looks like it might use the default coordinates of 0,1 which are similar but not identical to the top viewport coordinates so you get something similar but not exactly correct (I am actually surprised that you did not get an error or warning
Generally for grid graphics the equivalent for converting between coordinates is to just create a new viewport with the coordinate system of interest (or push/pop to an existing viewport with the correct coordinate system), then add your annotations in that viewport.
Here is an example that creates your plot, then moves down to the viewport containing the main plot, creates a new viewport with the same dimensions but with clipping turned off, the x scale is based on the data and the y scale is 0,1, then adds some text accordingly:
library(ggplot2)
library(grid)
test= data.frame( x = c(1,2,3), y = c(12,10,3), n = c(75,76,73) )
qplot(x=x, y=y, data=test)+geom_line()+ opts(plot.margin = unit(c(1,3,8,1), "lines"))
current.vpTree()
downViewport('panel-3-4')
pushViewport(dataViewport( test$x, clip='off',yscale=c(0,1)))
for (i in 1:nrow(test)) {
grid.text(x=i, y = -0.2, default.units='native',
label=paste("GRID.text at\nuser.x=", i, "\n" ) )
grid.lines(x=c(i, i), y = c(-0.1, 0), default.units='native' )
}
One of the tricky things here is that ggplot2 does not set the viewport scales to match the data being plotted, but does the conversions itself. In this case setting the scale based on the x data worked, but if ggplot2 does something fancier then this might not work. What we would need is some way to get the back tranformed coordinates from ggplot2 to use in the call to grid.text.

Resources