Skip to content
Prev 178051 / 398502 Next

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))