[R] Lattice 3d coordinate transformation

[Deepayan Sarkar]

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


> Thanks in advance,
> 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,...){
>        add.line <- trellis.par.get("add.line")
>        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.lines(m[1,], m[2,], col = add.line$col, lty = add.line$lty,
>                      lwd = add.line$lwd)
>        }
>        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,...)
> {
>    add.line <- trellis.par.get("add.line")
>    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.lines(m[1,], m[2,], col = add.line$col, lty = add.line$lty,
>                  lwd = add.line$lwd)
>    }
>    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
> PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
> and provide commented, minimal, self-contained, reproducible code.