R help - Apr 2009 - Two 3D cones in one graph

Dear R-users:

The following code produces two cones in two panels. What I would like  
to have is to have them in one, and to meet in the origin. Does anyone  
have any good ideas how to do this?

Thanks for your help

Jaakko

library(lattice)

A<-matrix(ncol=2, nrow=64)

for(i in 0:63)
{
   A[i+1,1]<-sin(i/10)
   A[i+1,2]<-cos(i/10)
}

Sigma<-matrix(c(0.5,0.1,0.1,0.25),byrow=TRUE,nrow=2)
G<-eigen(Sigma)

E1<-t(G$vector%*%t(A))
E2<-t(diag(sqrt(G$values))%*%t(E1))
mu<-c(0.1,0.2)
E3<-sweep(E2,2,-mu)

a<-sqrt(max(rowSums(sweep(E3,2,mu)**2)))
b<-sqrt(min(rowSums(sweep(E3,2,mu)**2)))

astar<-as.numeric(a+abs(mu[1]))
bstar<-as.numeric(b+abs(mu[2]))

xstar<-seq(-astar,astar,len=50)
ystar<-seq(-bstar,bstar,len=50)

g<-expand.grid(x=xstar,y=ystar)

p1<-2*g$x*mu[1]/a**2+2*g$y*mu[2]/b**2
p2<-(g$x**2/a**2+g$y**2/b**2)
p3<-mu[1]**2/a**2+mu[2]**2/b**2-1

q<-(p1+sqrt(p1**2-4*p2*p3))/(2*p2)
z<-sqrt(1-(q*g$x)**2-(q*g$y)**2)
zstar<-(z/q)
ind0<-!(q<1)
g$z<-zstar
sc<-matrix(c(rep(c(-1,-1,-1),sum(ind0))),nrow=sum(ind0),byrow=TRUE)
gstar<-rbind(g[ind0,],sc*g[ind0,])

group<-c(rep(1,nrow(gstar)/2),rep(2,nrow(gstar)/2))
gstar$group<-group

wireframe(z~x*y|group,gstar,colorkey=TRUE,drape=TRUE,  
scales=list(arrows=FALSE))

Jaakko Nevalainen wrote:
> 
> 
> The following code produces two cones in two panels. What I would like  
> to have is to have them in one, and to meet in the origin. Does anyone  
> have any good ideas how to do this?
> 
> 
Adapt the cone3d() function from the shapes3d demo in the rgl package?

 Ben Bolker

-- 
View this message in context:
http://www.nabble.com/Two-3D-cones-in-one-graph-tp23195102p23196270.html
Sent from the R help mailing list archive at Nabble.com.

On Thu, Apr 23, 2009 at 4:22 AM, Jaakko Nevalainen
<Jaakko.Nevalainen at uta.fi> wrote:
> Dear R-users:
>
> The following code produces two cones in two panels. What I would like to
> have is to have them in one, and to meet in the origin. Does anyone have
any
> good ideas how to do this?
wireframe gets easily confused when not all (x, y) combinations in the
grid are present in your data. It's safer to set the z-values to NA if
you want to omit them. This should be a good start:

    gstar <- g
    gstar$z[!ind0] <- NA
    gstar$z2 <- -gstar$z
    wireframe(z + z2 ~ x * y, gstar, colorkey=TRUE,drape=TRUE,
scales=list(arrows=FALSE))

If you really want to combine surfaces defined on different (x,y)
grids, probably the only safe way is to combine them into a single
grid.

-Deepayan
>
> Thanks for your help
>
> Jaakko
>
> library(lattice)
>
> A<-matrix(ncol=2, nrow=64)
>
> for(i in 0:63)
> {
> ?A[i+1,1]<-sin(i/10)
> ?A[i+1,2]<-cos(i/10)
> }
>
> Sigma<-matrix(c(0.5,0.1,0.1,0.25),byrow=TRUE,nrow=2)
> G<-eigen(Sigma)
>
> E1<-t(G$vector%*%t(A))
> E2<-t(diag(sqrt(G$values))%*%t(E1))
> mu<-c(0.1,0.2)
> E3<-sweep(E2,2,-mu)
>
> a<-sqrt(max(rowSums(sweep(E3,2,mu)**2)))
> b<-sqrt(min(rowSums(sweep(E3,2,mu)**2)))
>
> astar<-as.numeric(a+abs(mu[1]))
> bstar<-as.numeric(b+abs(mu[2]))
>
> xstar<-seq(-astar,astar,len=50)
> ystar<-seq(-bstar,bstar,len=50)
>
> g<-expand.grid(x=xstar,y=ystar)
>
> p1<-2*g$x*mu[1]/a**2+2*g$y*mu[2]/b**2
> p2<-(g$x**2/a**2+g$y**2/b**2)
> p3<-mu[1]**2/a**2+mu[2]**2/b**2-1
>
> q<-(p1+sqrt(p1**2-4*p2*p3))/(2*p2)
> z<-sqrt(1-(q*g$x)**2-(q*g$y)**2)
> zstar<-(z/q)
> ind0<-!(q<1)
> g$z<-zstar
> sc<-matrix(c(rep(c(-1,-1,-1),sum(ind0))),nrow=sum(ind0),byrow=TRUE)
> gstar<-rbind(g[ind0,],sc*g[ind0,])
>
> group<-c(rep(1,nrow(gstar)/2),rep(2,nrow(gstar)/2))
> gstar$group<-group
>
> wireframe(z~x*y|group,gstar,colorkey=TRUE,drape=TRUE,
> scales=list(arrows=FALSE))
>
> ______________________________________________
> 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.
>