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.sar...@gmail.com> wrote: > On Fri, Feb 10, 2012 at 12:43 AM, ilai <ke...@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@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. ______________________________________________ R-help@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.