[R] Lattice: correct use of ltransform3dto3d to plot a surface under a cloud ?

ilai keren at math.montana.edu
Sun Feb 5 03:55:42 CET 2012


Hello list!
I am trying to project the fitted surface to a 3d plot of the data,
similar to figures 13.7 or 6.5 in Deepayan Sarkar's "Lattice,
Multivariate Data Visualization with R", but replace the contour/map
lines with "levelplot". Problem is I can't get the color regions to
line up after the coordinate transformation. Is there a simple
solution my geometry challenged brain missed? It's been driving me
crazy for 2 days now so any help will be greatly appreciated!
I use lattice for all my other figures and would like to stay
consistent, so solutions of the form "package rgl" don't work. Thank
you all in advance.

Here is a minimal (still long) working example of what I mean, and
what I found out so far:

## make data and predicted surf
set.seed(1718)
d <- data.frame(x=runif(60),y=runif(60),g=gl(2,30))
d$z <- with(d,rnorm(60,2*x^as.numeric(g)-y^3))
d$z <- d$z+abs(min(d$z))  # so 'h' goes to the X-Y plane
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)))
})
###
require(lattice)
# Modified code for plot 13.7 [changed: build clines from surf, -.5
for xy coords (why? don't know, works :), 3dscatter not wire]
panel.3d.contour <- 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, ...)
  }
cloud(z~x+y|g,data=d,layout=c(2,1), type='h', panel.3d.cloud = panel.3d.contour,
      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)),par.box=list(lty=0),lwd=3)

# This works. But for my data the contours are messy, so I am trying
to use 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,
      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)),par.box=list(lty=0),lwd=3)

# Unexpected...
# I can use panel.points for centroids and color them in "manually"
but that leaves white space or overlap:
cloud(z~x+y|g,data=d,layout=c(2,1), type='h', par.box=list(lty=0),
lwd=3, scales=list(z=list(arrows=F,tck=0)),
      panel.3d.cloud = 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)
            lp <- level.colors(zz, at = do.breaks(range(zz), 20),
                            col.regions = heat.colors(20))
            panel.points(m[1,],m[2,],col=lp,pch=18,cex=2.8)
            panel.3dscatter(x, y, z, rot.mat, distance, zlim.scaled =
zlim.scaled, ...)
          })

#So I try to "make my own" using the lp for panel.rect, but I get the
same behavior as points for the x0,x1,y0,y1 :
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)
    lp <- level.colors(zz, at = do.breaks(range(zz), 20),
                            col.regions = heat.colors(20))
    cntrds <- expand.grid(s,s)
    apply(cntrds,1,function(i){
      xx <- i[1]+c(-.5,.5)/(n-1) ; yy <- i[2]+c(-.5,.5)/(n-1)
       m <- ltransform3dto3d(rbind(xx,yy,zlim.scaled[1]), rot.mat, distance)
       panel.rect(m[1,1],m[2,1],m[1,2],m[2,2])
     })
    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,
      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)),par.box=list(lty=0),lwd=3)

# This is as close as I got, but how to get each diagonal of
rectangles "shifted" to cover the space? I thought ltransform3dto3d
will take care of it when I transform every line in the loop. But it
didn't.



More information about the R-help mailing list