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.