# [R] Lattice 3d coordinate transformation

ilai keren at math.montana.edu
Sun Feb 12 02:07:05 CET 2012

```Thank you Deepayan, your answer put me on the path to SOLVED !!!
Actually passing projected corners to panel.rect was the first thing I
tried, but couldn't get it to work. However, panel.3dpolygon in
latticeExtra did the trick.
I'm posting it here for completion.

require(lattice) ; require(latticeExtra)
set.seed(1113)
d <- data.frame(x=runif(30),y=runif(30),g=gl(2,15))
d\$z <- with(d,rnorm(30,3*asin(x^2)-5*y^as.integer(g),.1))
d\$z <- d\$z+min(d\$z)^2
surf <- by(d,d\$g,function(D){
fit <- lm(z~poly(x,2)*poly(y,2),data=D)
outer(seq(0,1,l=10),seq(0,1,l=10),function(x,y,...)
predict(fit,data.frame(x=x,y=y)))
})
panel.3d.surf <- function(x, y, z, rot.mat, distance, zlim.scaled, ...){
zz <- surf[[packet.number()]] ; n <- nrow(zz)
lp <- level.colors(zz, at = do.breaks(range(zz), 20), col.regions
= heat.colors(20))
s <- seq(-.5,.5,l=n) ; cntrds <- expand.grid(s,s) ; index <- 0
apply(cntrds,1,function(i){
index <<- index+1
xx <- i[1]+c(-.5,-.5,.5,.5)/(n-1) ; yy <- i[2]+c(-.5,.5,.5,-.5)/(n-1)
panel.3dpolygon(xx,yy, zlim.scaled[1], rot.mat, distance,
border=lp[index], col=lp[index],...)
})
panel.3dscatter(x, y, z, rot.mat, distance, zlim.scaled = zlim.scaled, ...)
}
cloud(z~x+y|g,data=d,layout=c(2,1), type='h', panel.3d.cloud = panel.3d.surf,
zoom = 1,screen=list(z= 21,y=0,x=-60),aspect = c(1,1), panel.aspect = 1,
scales=list(z=list(arrows=F,tck=0),x=list(distance=.75)),
par.box=list(lwd=NA),lwd=3)

## Beautiful !

On Sat, Feb 11, 2012 at 6:00 AM, Deepayan Sarkar
<deepayan.sarkar at gmail.com> wrote:
> On Fri, Feb 10, 2012 at 12:43 AM, ilai <keren at math.montana.edu> wrote:
>> Hello List!
>> I asked this before (with no solution), but maybe this time... I'm
>> trying to project a surface to the XY under a 3d cloud using lattice.
>> I can project contour lines following the code for fig 13.7 in
>> Deepayan Sarkar's "Lattice, Multivariate Data Visualization with R",
>> but it fails when I try to "color them in" using panel.levelplot.
>> ?utilities.3d says there may be some bugs, and I think
>> ltransform3dto3d() is not precise (where did I hear that?), but is
>> this really the source of my problem? Is there a (simple?) workaround,
>> maybe using 3d.wire but projecting it to XY? How? Please, any insight
>> may be useful.
>
> I don't think this will be that simple. panel.levelplot() essentially
> draws a bunch of colored rectangles. For a "3D" projection, each of
> these will become (four-sided) polygons. You need to compute the
> coordinates of those polygons, figure out their fill colors (possibly
> using ?level.colors) and then draw them.
>
> -Deepayan
>
>
>> Elai.
>>
>> A working example:
>>
>>  ## data "d" and predicted "surf":
>> set.seed(1113)
>> d <- data.frame(x=runif(30),y=runif(30),g=gl(2,15))
>> d\$z <- with(d,rnorm(30,3*asin(x^2)-5*y^as.integer(g),.1))
>> d\$z <- d\$z+min(d\$z)^2
>> surf <- by(d,d\$g,function(D){
>>  fit <- lm(z~poly(x,2)*poly(y,2),data=D)
>>  outer(seq(0,1,l=10),seq(0,1,l=10),function(x,y,...)
>> predict(fit,data.frame(x=x,y=y)))
>> })
>> ##
>> # This works to get contours:
>> require(lattice)
>> cloud(z~x+y|g,data=d,layout=c(2,1), type='h', lwd=3, par.box=list(lty=0),
>>      scales=list(z=list(arrows=F,tck=0)),
>>      panel.3d.cloud = function(x, y, z,rot.mat, distance,
>> zlim.scaled, nlevels=20,...){
>>        clines <- contourLines(surf[[packet.number()]],nlevels = nlevels)
>>        for (ll in clines) {
>>          m <- ltransform3dto3d(rbind(ll\$x-.5, ll\$y-.5,
>> zlim.scaled[1]), rot.mat,
>>                                distance)
>>        }
>>        panel.3dscatter(x, y, z, rot.mat, distance, zlim.scaled =
>> zlim.scaled, ...)
>>      }
>>      )
>> # But using levelplot:
>> panel.3d.levels <- function(x, y, z,rot.mat, distance, zlim.scaled,...)
>> {
>>    zz <- surf[[packet.number()]]
>>    n <- nrow(zz)
>>    s <- seq(-.5,.5,l=n)
>>    m <- ltransform3dto3d(rbind(rep(s,n),rep(s,each=n),zlim.scaled[1]),
>>                          rot.mat, distance)
>>    panel.levelplot(m[1,],m[2,],zz,1:n^2,col.regions=heat.colors(20))
>>    panel.3dscatter(x, y, z, rot.mat, distance, zlim.scaled = zlim.scaled, ...)
>>  }
>> cloud(z~x+y|g,data=d,layout=c(2,1), type='h', panel.3d.cloud = panel.3d.levels,
>>      scales=list(z=list(arrows=F,tck=0)),par.box=list(lty=0),lwd=3)
>> # I also tried to "fill" between contours but can't figure out what to
>> do with the edges and how to incorporate the x,y limits to 1st and nth
>> levels.
>> panel.3d.contour <- function(x, y, z,rot.mat, distance,xlim,ylim,
>> zlim.scaled,nlevels=20,...)
>> {
>>    zz <- surf[[packet.number()]]
>>    clines <- contourLines(zz,nlevels = nlevels)
>>    colreg <- heat.colors(max(unlist(lapply(clines,function(ll) ll\$level))))
>>    for (i in 2:length(clines)) {
>>      ll <- clines[[i]]
>>      ll0 <- clines[[i-1]]
>>      m <- ltransform3dto3d(rbind(ll\$x-.5, ll\$y-.5, zlim.scaled[1]),
>> rot.mat, distance)
>>      m0 <- ltransform3dto3d(rbind(ll0\$x-.5, ll0\$y-.5,
>> zlim.scaled[1]), rot.mat, distance)
>>      xvec <- c(m0[1,],m[1,ncol(m):1])
>>      yvec <- c(m0[2,],m[2,ncol(m):1])
>>      panel.polygon(xvec,yvec,col=colreg[ll\$level],border='transparent')
>>    }
>>    panel.3dscatter(x, y, z, rot.mat, distance, zlim.scaled = zlim.scaled, ...)
>>  }
>> cloud(z~x+y|g,data=d,layout=c(2,1), type='h', panel.3d.cloud = panel.3d.contour,
>>      scales=list(z=list(arrows=F,tck=0)),par.box=list(lty=0),lwd=3)
>>
>> #############################################################################
>>
>> ______________________________________________
>> R-help at r-project.org mailing list
>> https://stat.ethz.ch/mailman/listinfo/r-help