资源描述：
《R绘图系统16.doc》由会员上传分享，免费在线阅读，更多相关内容在行业资料-天天文库。
1、16.1library(rgl)tetra<-function(){t1<-tetrahedron3d()t2vb<-t1$vbt2vb[1,]<--3t2<-tmesh3d(t2vb,t1$it)plane<-qmesh3d(rbind(rep(-3.01,4),c(-2,-2,2,2),c(-3,3,3,-3),rep(1,4)),matrix(1:4,ncol=1))open3d(windowRect=c(0,0,600,600))#clear3d()shade3d(plane,color="white",specular="black")wire3d(plane
2、)wire3d(t1,lwd=3)wire3d(t2,lwd=3)segments3d(rbind(t2$vb[1,t2$it],t1$vb[1,t1$it]),rbind(t2$vb[2,t2$it],t1$vb[2,t1$it]),rbind(t2$vb[3,t2$it],t1$vb[3,t1$it]),col="gray",lwd=3)view3d(40,-30)}t1<-cube3d()t1tube<-t1t1tube$ib<-t1tube$ib[,-(3:4)]t2vb<-t1$vbt2vb[1,]<--5t2<-qmesh3d(t2vb,t1$ib)plan
3、e<-qmesh3d(rbind(rep(-5.01,4),c(-2,-2,2,2),c(-3,3,3,-3),rep(1,4)),matrix(1:4,ncol=1))open3d(windowRect=c(0,0,600,600))#clear3d()shade3d(plane,color="white",ambient="white",specular="white",emission="white")wire3d(plane)shade3d(t1tube,color="white",specular="black")wire3d(t1,lwd=3)wire3d(
4、t2,lwd=3)segments3d(rbind(t2$vb[1,t2$ib[,4]],t1$vb[1,t1$ib[,4]]),rbind(t2$vb[2,t2$ib[,4]],t1$vb[2,t1$ib[,4]]),rbind(t2$vb[3,t2$ib[,4]],t1$vb[3,t1$ib[,4]]),col="gray",lwd=3)view3d(55,-20,fov=0)rgl.postscript("Figures/threed-3dproj.eps")system("epstopdfFigures/threed-3dproj.eps")system("co
5、nvertFigures/threed-3dproj.pdfWeb/threed-3dproj.png")16.2library(rgl)tetra<-function(){t2vb<-t1$vbt2vb[1,]<--3t2vb[2,c(1,4)]<-t2vb[2,c(1,4)]*.8t2vb[3,c(1,4)]<-t2vb[3,c(1,4)]*.8t2vb[2,2:3]<-t2vb[2,2:3]*.6t2vb[3,2:3]<-t2vb[3,2:3]*.6t2<-tmesh3d(t2vb,t1$it)t3vb<-t1$vbt3vb[1,]<--10t3vb[2,]<-0
6、t3vb[3,]<-0t3<-tmesh3d(t3vb,t1$it)open3d(windowRect=c(0,0,600,600))#clear3d()shade3d(plane,color="white",specular="black")wire3d(plane)wire3d(t1,lwd=3)wire3d(t2,lwd=3)segments3d(rbind(t3$vb[1,t3$it],t1$vb[1,t1$it]),rbind(t3$vb[2,t3$it],t1$vb[2,t1$it]),rbind(t3$vb[3,t3$it],t1$vb[3,t1$it])
7、,col="gray",lwd=3)shade3d(translate3d(scale3d(cube3d(),.1,.1,.1),-10,0,0))view3d(50,-20,zoom=.8)}t1<-cube3d()t1tube<-t1t1tube$ib<-t1tube$ib[,-(3:4)]t2vb<-t1$vbt2vb[2,t1$ib[,4]]<-t2vb[2,t1$ib[,4]]*.4t2vb[3,t1$ib[,4]]<-t2vb[3,t1$ib[,4]]*.4t2vb[2,t1$ib[,3]]<-t2vb[2,t1$ib[,3]
