ilai
2012-Feb-05 02:55 UTC
[R] Lattice: correct use of ltransform3dto3d to plot a surface under a cloud ?
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.