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.
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)
#############################################################################
Oops. Obviously I mean "> A working example:> require(lattice) > ..."On Thu, Feb 9, 2012 at 12:13 PM, 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. > 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) > > #############################################################################
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.