Viewing & Geometrical Transformations in R - r

I am a graphics programmer from the GKS days trying to use R graphics. I have two questions that relate to transformations in R:
I was wondering if there is an equivalent for building a viewing pipeline in R where one could map a window in world coordinates [wc] to a viewport in device coordinates [dc]. For example I could specify a transofrmation t which maps a window of (wcxmin, wcxmax, wcymin, wcymax) to (vpxmin, vpxmax, vpymin, vpymax) where wc is (1000, -50, 40, 90) and vp is (0, 800, 0, 600). The objective being that all graphics calculations are done in wc but the graphics engine renders it in dc. In this case it would scale the coordinates appropriately and also flip the x-axis as wcxmin > wcxmax.
Is there an equivalent of graphics segments which could then be transformed [sclae, shift, rotate, and possibly shear] via a transformation matrix.
I am sure I am missing something very basic in R graphics. I could successfully build such transforms in SVG without any issues. I have been looking at packages like grid, lattice, ggplot2 but have not been able to make much progress.
Thanks.
Here's some sample code for something I am trying to do:
distn<-rnorm(100)
distw<-rweibull(100, shape=2)
dret<-stack(list(norm=distn, weib=distw))
n<-0
for (idx in levels(dret$ind)) {
pct<-dret[dret$ind == idx,c('values')]
# scale and shift the data
pct<-(pct-min(pct))/(max(pct) - min(pct))
if (n == 0) {
# top left
par(fig=c(0,0.5,0.5,1))
limx<-c(0,1)
} else {
# bottom right
par(fig=c(0.5,1,0,0.5), new=TRUE)
limx<-c(1,0)
}
fp<-density(pct)
sfx<-fp$x
sfy<-(fp$y-min(fp$y))/(max(fp$y)-min(fp$y))
sortpct<-sort(pct)
ecdfpct<-(1:length(sortpct))/length(sortpct)
plot(sortpct, ecdfpct, xlim=limx, type="l", col="green")
lines(sfx, sfy, xlim=limx, type="l", col="red")
n<-n+1
}
I would like to rotate the figure in the bottom right quadrant by -90 degrees.

The 'grid' package does that all the time. The viewports are represented as [0, 1] in both X and Y directions(and sometimes Z) and the functions convertX and convertY are called to move from user-coordinates to grid-coordinates. Type help(grid) for a full list of facilities. A third dimension is also represented when using wireframe or levelplot. Transformations via homogeneous coordinates are accomplished via 4 x 4 matrices stored as an item accessed as current.transform( current.viewport()). You can get more detail regarding how those transformation matrices are handled in R by looking at the code in trans3d. I see that #nograpes has already pointed you to the high-level rotation facility in the grid::pushViewport function.

Related

R plot efficiently thousands of spheres deformed in ellipsoids in 3D with transparency

I need to really speeding up a small piece of code that deforms about 3000 spheres in the 3d rgl space according to a 3x3 tensors list that transforms them in ellipsoids. Moreover, I would need transparent color ("alpha" argument <1). Then I want to plot them rapidly and efficiently. I would like to have the same performance of spheres3d() but of course it is not the case...(run the code below). Here below my code with necessary functions for a fully reproducible example. Could you help me in doing this? Many thanks in advance.
Paolo
library(Morpho)
library(Rvcg)
library(rgl)
rep.row<-function(x,n){ #### rep rows of a matrix
matrix(rep(x,each=n),nrow=n)
}
traslamesh<-function(mesh,c){ #### just translate a mesh in the 3d space according a position vector
newvb<-t(mesh$vb[-4,])+rep.row(c,nrow(t(mesh$vb[-4,])))
newmesh<-list(vb=t(cbind(newvb,1)),it=mesh$it)
class(newmesh)<-"mesh3d"
newmesh
}
defosph<-function(sphere,mat,after=T){#### this deforms a sphere in an ellipspoid according to a 3x3 tensor
if(after==T){newvb<-t(sphere$vb[-4,])%*%t(mat)}else{newvb<-t(mat%*%sphere$vb[-4,])}
newmesh<-list(vb=t(cbind(newvb,1)),it=sphere$it)
class(newmesh)<-"mesh3d"
newmesh
}
creasph<-function(radius=1,centroid=c(0,0,0),subdivision=1){ #### just a wrap of vcgSphere
temp_sphere<-vcgSphere(subdivision = subdivision)
temp_sphere$vb[1,]<-temp_sphere$vb[1,]+centroid[1]
temp_sphere$vb[2,]<-temp_sphere$vb[2,]+centroid[2]
temp_sphere$vb[3,]<-temp_sphere$vb[3,]+centroid[3]
final_sphere<-scalemesh(temp_sphere, radius, center = "none")
return(final_sphere)
}
positions<-matrix(rnorm(9000,2,20),ncol=3) ###### positions where we want to plot
spheres3d(positions,alpha=0.5) #### very fast to plot and reasonably fast to naviagate in the 3d rgl window
tensor1<-matrix(rnorm(9),ncol=3) #### a random tensor; let's use the same one for deforming all the 3000 spheres. In the real application each sphere will have its own tensor.
open3d()
for(i in 1:dim(positions)[1]){ #### embarrassingly slow ......
sphi<-creasph(radius=1,subdivision=2)
shade3d(traslamesh(scalemesh(defosph(sphi,tensor1,after=F),1,center="none"),positions[i,]),col=2,alpha=0.5)
print(i)
}
I want to deform the spheres in ellipsoids according to n tensors and plot them efficiently
There are two things you are doing that make this code slow. First, you are plotting 3000 objects, and updating the display after every one. That's easy to fix: call par3d(skipRedraw=TRUE) at the beginning, and par3d(skipRedraw=FALSE) at the end, and the drawing will be much faster.
The second thing you are doing is much harder to fix. You are constructing ellipsoids as meshes, which makes each one a collection of 320 triangles. Since you have 3000 of these, you've got nearly a million triangles to plot. rgl can handle that, but what makes it really slow is that you are declaring them all to be transparent. To plot these, it needs to sort all million triangles in order from most distant to closest to plot them. Every time it switches from plotting a triangle in one ellipsoid to a triangle in a different one, it needs to go through a fairly expensive context change.
If you set alpha = 1 you'll get a much faster display because sorting isn't needed.
The other thing you could do is to merge all 3000 ellipsoids into one huge mesh. It will still need to sort the triangles, but won't need all those context changes.
The code below illustrates the suggestions. I'll assume you keep your original code to setup the functions.
# Skip redrawing and set alpha = 1
open3d()
par3d(skipRedraw=TRUE)
for(i in 1:dim(positions)[1]){ #### reasonably fast
sphi<-creasph(radius=1,subdivision=2)
shade3d(traslamesh(scalemesh(defosph(sphi,tensor1,after=F),1,center="none"),positions[i,]),col=2,alpha=1)
print(i)
}
par3d(skipRedraw=FALSE)
# Keep alpha = 0.5, but plot just one big mesh
open3d()
for(i in 1:dim(positions)[1]){ #### pretty slow, but faster than the original
sphi<-creasph(radius=1,subdivision=2)
sphi <- traslamesh(scalemesh(defosph(sphi,tensor1,after=F),1,center="none"),positions[i,])
if (i == 1) result <- sphi else result <- merge(result, sphi)
print(i)
}
shade3d(result, col=2, alpha = 0.5)
The second method is still pretty slow: it does a lot of allocations doing all those merges. You could speed up the construction parts a lot by working with mesh internals. It is also pretty slow in updates, because of the sorting needed for alpha = 0.5.
The reason the built-in spheres display is so fast is that it doesn't attempt to do such a good job. It sorts the sphere centers, not all the triangles making up each sphere. If you set fastTransparency = FALSE, it will slow down a lot, because then it will sort all the triangles. It also uses the equivalent of "sprites", initializing just one sphere and redrawing it in lots of different locations. Sprites would work for your example, but not if you needed different transformations on every ellipsoid.

R: create animated gif in rgl with rotation around Z axis

I need to produce an animated gif from a OpenGL visualization package rgl in R. The recipe is described in this link at genomearchitecture.com. First we create some 3D cube with our image. It was produced in plot3D package via scatter3D() commands. Next we invoke a rgl window with it by
require(plot3Drgl)
plotrgl()
The recipe from the link above sounds as follows (essential part):
for (i in 1:90) {
view3d(userMatrix=rotationMatrix(2*pi * i/90, 1, -1, -1))
rgl.snapshot(filename=paste("animation/frame-",
sprintf("%03d", i), ".png", sep=""))
}
that is we create 90 rgl snapshots and rotate our object using parameters in userMatrix=rotationMatrix() directive. However exactly this directive performs rotation around some specific axis, and the whole rotating animation looks kinky, especially if we have just a 3D geographical map to rotate, like on this image.
We do not want this image rotate and go upside down, we just need to rotate it around vertical Z axis. However, every attempt to modify the directive view3d(userMatrix=rotationMatrix(2*pi * i/90, 1, -1, -1)) changing vector (1,-1,-1) produces the cube with Z axis facing to us with initial position of the angle.
In the static framework the position of the cube can be intuitively controlled by two polar coordinates via directive
plotdev(theta=10,phi=15)
It would be good to program the snapshots running theta from 0 to 2 pi with some reasonable phi, but setting theta, phi instead of userMatrix works good only for static image. In rgl window it again produces something not expected, for example, theta=0, phi=0 again aim Z axis towards us. How it is possible to modify the view angle directive to make the cube rotate around its Z axis?

R Visualize many 3D boxes inside a big box

I would need to somehow make an interactive visualization of a 3D box contain many 3D boxes inside it.
My first crude ideas were as following. In 2D I could use
x<-matrix(runif(25),nrow=5,ncol=5);
image(x)
to color every single cell in the matrix to make it look like the big rectangle would contain small rectangles in it.
How could this be translated into 3D? Let's say in 3D the big box is of size 10x10x10. In practice I would like to choose the color of every single one of the 1000 elements in the box.I know that rgl can be used to make interactive 3D plots, but I'm having issues understanding how to color every single element in the 3D array.
If you have some suggestions for some better solutions I would gladly like to hear them.
If I understood correctly, I believe that this should work:
library(rgl)
grd <- expand.grid(x=seq(0,10,2), y=seq(0,10,2), z=seq(0,10,2))
grd$dist <- sqrt(grd$x^2 + grd$y^2 + grd$z^2) # distance to coordinate 0,0,0
grd$col <- rainbow(ceiling(max(grd$dist+1)))[ceiling(grd$dist+1)]
grd$alpha <- rep(c(0.2, 1), each=nrow(grd)/2)
open3d()
for(i in seq(nrow(grd))){
shade3d( translate3d( cube3d(col = grd$col[i]), grd$x[i], grd$y[i], grd$z[i]) , alpha=grd$alpha[i])
}
rgl.snapshot("cube.png")
This example is for a 6x6x6 cube, and colors are based on euclidean distance of their centers to the origen. Hopefully this will show you a way to adapt your colors as you like.

3D: Check point inside elliptical cone

I seem to have searched the whole internet trying to find an implementation of checking if a 3d point is within an elliptical cone defined by (origin, length, horizontal angle, vertical angle). Unfortunately without success as I only really found one math solution which I did not understand.
Now I am aware on how to use implement it using a normal cone:
inRange = magnitude(point - origin) <= length;
heading = normalized(point - origin);
return dot(forward, heading) >= cos(angle) && inRange;
However there the height detection is far too tall. I would really like to implement a more realistic vision cone for the AI for a game but this requires having the cone shaped more like a human field of view being more wide than tall.
Thanks a lot for any help:)
Given a 3D elliptic cone, with base at B=(x_B,y_B,z_B), height h along the cone axis k=(k_x,k_y,j_z), major base radius a, minor base radius b and direction along the major axis i=(i_x,i_y,i_z) you need to find if a point P=(x,y,z) lies inside the cone. It is your choice on how to parametrize the major axis direction and I think your are trying to use spherical coordinates with two angles.
Here are the steps to take:
Establish a coordinate system with origin on the base B and with the local x axis along your major axis i. The local z axis should be towards the tip along k. Finally the local y axis should be
j=cross(k,i)=(i_z*k_y-i_y*k_z, i_x*k_z-i_z*k_x, i_y*k_x-i_x*k_y)
j=normalize(j)
Your 3×3 rotation matrix is defined by the columns E=[i,j,k]
Transform your point P=(x,y,z) into the local coordinates with
P2 = transpose(E)*(P-B) = (x2,y2,z2)
Now establish how far along the axis of the cone is with s=(h-z2)/h where s=0 at the tip and s=1 at the base.
If s>1 or s<0 then the point is outside
Otherwise if s>0 you need to check that (x2/(s*a))^2+(y2/(s*b))^2<=1 for the point to be inside.
If s=0 then check that x2=0 and y2=0 for the point being exactly at the tip.
If you cannot do basic vector algebra, like cross products, 3D transformations and normalization that I suggest you have some reading to do before you can understand what is going on here.
Note:
// | i_x i_y i_z |
// transpose(E) = | j_x j_y j_z |
// | k_x k_y k_z |

Rendering 3D surfaces

I've got data representing 3D surfaces (i.e. earthquake fault planes) in xyz point format. I'd like to create a 3D representation of these surfaces. I've had some success using rgl and akima, however it can't really handle geometry that may fold back on itself or have multiple z values at the same x,y point. Alternatively, using geometry (the convhulln function from qhull) I can create convex hulls that show up nicely in rgl but these are closed surfaces where in reality, the objects are open (don't completely enclose the point set). Is there a way to create these surfaces and render them, preferably in rgl?
EDIT
To clarify, the points are in a point cloud that defines the surface. They have varying density of coverage across the surface. However, the main issue is that the surface is one-sided, not closed, and I don't know how to generate a mesh/surface that isn't closed for more complex geometry.
As an example...
require(rgl)
require(akima)
faultdata<-cbind(c(1,1,1,2,2,2),c(1,1,1,2,2,2),c(10,20,-10,10,20,-10))
x <- faultdata[,1]
y <- faultdata[,2]
z <- faultdata[,3]
s <- interp(x,z,y,duplicate="strip")
surface3d(s$x,s$y,s$z,col=a,add=T)
This creates generally what I want. However, for planes that are more complex this doesn't necessarily work. e.g. where the data are:
faultdata<-cbind(c(2,2,2,2,2,2),c(1,1,1,2,2,2),c(10,20,-10,10,20,-10))
I can't use this approach because the points are all vertically co-planar. I also can't use convhulln because of the same issue and in general I don't want a closed hull, I want a surface. I looked at alphashape3d and it looks promising, but I'm not sure how to go about using it for this problem.
How do you determine how the points are connected together as a surface? By distance? That can be one way, and the alphashape3d package might be of use. Otherwise, if you know exactly how they are to be connected, then you can visualize it directly with rgl structures.

Resources