R作图急求高手帮忙——3d作图曲面改立体网格

是 否 +2 论坛币

k人 参与回答

经管之家送您一份

应届毕业生专属福利!

求职就业群

赵安豆老师微信：zhaoandou666

经管之家联合CDA

送您一个全额奖学金名额~ !

立即领取

感谢您参与论坛问题回答

经管之家送您两个论坛币！

+2 论坛币

急求高手相助！
我在做这张3d图的时候，程序做出来是曲面，但是曲面不好看，请问怎么才能更改为三维柱体的图像？非常
感谢！这是我的程序：
p1=gam(d3~PM25+s(time,bs="cr")+as.factor(dow)+holiday+s(rh)+s(Temperature)+s(PM25,Temperature),
data=death,family=poisson)
par(mar=c(2,2,1,1))
vis.gam(p1,phi=20,view=c("Temperature","PM25"),expand=0.5,theta=35,ticktype="detailed",type="response")
这是我的图像：

扫码加我 拉你入群

请注明：姓名-公司-职位

以便审核进群资格，未注明则拒绝

分享0 收藏2 回帖

关键词：求高手 response detailed Holiday poisson detailed family death 程序

TRY THIS

可能需要自己再改改。

xuxin3000 发表于 2012-8-24 22:11
TRY THIS

可能需要自己再改改。

非常感谢！ 我论坛币不足不能下载，麻烦您能不能发送一下邮箱，或者将代码回复到帖子这里，再次感谢！
另外您的qq是多少，我加您为好友吧！
我的邮箱：lipei@dq.cern.ac.cn   lpatmos@163.com
我的qq：63944630

1. barplot3d <- function(heights, rows, transp="f0", theta=25, phi=25, bar.size=3, bar.space=0.5,
   
2.     col.lab=NULL, row.lab=NULL, z.lab=NULL, col.bar=c("#44ff58","#5844ff","#ff5844"), grid="white", ...) {
   
3.     # Set parameters
   
4.     cols    = length(heights)/rows
   
5.     calkdl  = (bar.size + bar.space)
   
6.     slupki  = matrix(heights, nrow=cols, ncol=rows)
   
7.     zakres  = pretty(0:ceiling(max(heights, na.rm=T)*1.1))
   
8.     odstep  = bar.space/2 + bar.size/2
   
9.     colors  = paste(col.bar, transp, sep="")
   
10.     shcols  = colors
    
11.     for (i1 in 1:length(colors)) shcols[i1] = paste("#",
    
12. 
    
13. as.hexmode(round(unclass(as.hexmode(substr(colors[i1],2,3)))*0.8,0)),
    
14. 
    
15. as.hexmode(round(unclass(as.hexmode(substr(colors[i1],4,5)))*0.8,0)),
    
16. 
    
17. as.hexmode(round(unclass(as.hexmode(substr(colors[i1],6,7)))*0.8,0)),
    
18.             substr(colors[i1],8,9), sep="")
    
19. 
    
20.     # Prepare the grid for bars
    
21.     y = x = 0
    
22.     for (i1 in (1:rows)-1) y = c(y, bar.space/2+i1*calkdl, bar.space/1.99+i1*calkdl,
    
23.         bar.space/2+bar.size+i1*calkdl, bar.space/1.99+bar.size+i1*calkdl,
    
24.         bar.space+bar.size+i1*calkdl)
    
25.     for (i1 in (1:cols)-1) x = c(x, bar.space/2+i1*calkdl, bar.space/1.99+i1*calkdl,
    
26.         bar.space/2+bar.size+i1*calkdl, bar.space/1.99+bar.size+i1*calkdl,
    
27.         bar.space+bar.size+i1*calkdl)
    
28. 
    
29.     # Prepare the z matrix of bar heights
    
30.     z = matrix(nrow=length(x), ncol=length(y))
    
31.     for (i1 in (1:cols)-1)  for (i2 in (1:rows)-1) z[c(2:5)+5*i1,c(2:5)+5*i2] = 0
    
32.     for (i1 in (1:cols)-1)  for (i2 in (1:rows)-1) z[c(3:4)+5*i1,c(3:4)+5*i2] = slupki[i1+1,i2+1]
    
33. 
    
34.     # Prepare colors matrix
    
35.     fill   = matrix(nrow=length(x)-1, ncol=length(y)-1)
    
36.     for (i1 in (1:rows)-1) {
    
37.         fill[,c(2:5)+5*i1] = colors[i1+1]
    
38.         for (i2 in (1:cols)-1)  fill[c(4:5)+5*i2,c(3:5)+5*i1] = shcols[i1+1]
    
39.         }
    
40. 
    
41.     # Prepare area for plotting
    
42.     rys = persp(x, y, matrix(nrow=length(x), ncol=length(y)), col=fill, scale=F, theta=theta,
    
43.         phi=phi, zlim = range(zakres), lphi=44, ltheta=-10, axes=F, ...)
    
44. 
    
45.     # Add walls
    
46.     polygon(rbind(trans3d(0,0,0,rys), trans3d(0,0,max(zakres),rys), trans3d(0,max(y),max(zakres),rys),
    
47.         trans3d(0,max(y),0,rys)), col="#aaaaaa66")
    
48.     polygon(rbind(trans3d(0,max(y),0,rys), trans3d(0,max(y),max(zakres),rys), trans3d(max(x),
    
49.         max(y),max(zakres),rys), trans3d(max(x),max(y),0,rys)), col="#aaaaaa50")
    
50.     polygon(rbind(trans3d(0,0,0,rys), trans3d(0,max(y),0,rys), trans3d(max(x),max(y),0,rys),
    
51.         trans3d(max(x),0,0,rys)), col="#aaaaba66")
    
52. 
    
53.     # Add grid lines & numbers
    
54.     for (i1 in zakres) {
    
55.         lines(rbind(trans3d(0,0,i1,rys), trans3d(0, max(y),i1,rys)), lwd=2, col=grid)
    
56.         lines(rbind(trans3d(0,max(y),i1,rys), trans3d(max(x), max(y),i1,rys)), lwd=2, col=grid)
    
57.         text(trans3d(-(calkdl*cols)*0.04,0,i1,rys), labels=i1, adj=1, cex=0.9)
    
58.         }
    
59.     text(trans3d(-(calkdl*cols)*0.04,0,max(zakres)*1.05,rys), labels=z.lab, adj=0.8, cex=0.9)
    
60. 
    
61.     # Add ticks & text
    
62.     for (i1 in (1:cols)-1) {
    
63.         lines(rbind(trans3d((odstep+calkdl*i1),0,0,rys), trans3d((odstep+calkdl*i1),
    
64.             -(calkdl*rows)*0.05,0,rys)))
    
65.         if (!is.null(col.lab)) text(trans3d((odstep+calkdl*i1),-(calkdl*rows)*0.1,0,rys),
    
66.             col.lab[i1+1], adj=1, cex=0.9)
    
67.         }
    
68.     for (i1 in (1:rows)-1) {
    
69.         lines(rbind(trans3d(max(x),(odstep+calkdl*i1),0,rys), trans3d(max(x)+(calkdl*cols)*0.03,
    
70.             (odstep+calkdl*i1),0,rys)))
    
71.         if (!is.null(col.lab)) text(trans3d(max(x)+(calkdl*cols)*0.05,(odstep+calkdl*i1),0,rys),
    
72.             row.lab[i1+1], adj=0, cex=0.9)
    
73.         }
    
74. 
    
75.     # Plot the bars!
    
76.     par(new=T)
    
77.     persp(x, y, z, col=fill, scale=F, theta=theta, phi=phi, zlim = range(zakres),
    
78.         lphi=44, ltheta=-10, shade=0.4, axes=F, ...)
    
79. 
    
80.     invisible(rys)
    
81. }
    
82. 
    
83. barplot3d(c(5,7,8,14,13,18), rows=2, theta = 15, phi = 12, expand=0.6,
    
84.     col.lab=c("Analyte 1","Analyte 2","Analyte 3"), row.lab=c("Assay 1","Assay 2"), z.lab="% CV")

复制代码

lpatmos 发表于 2012-8-26 09:33
非常感谢！ 我论坛币不足不能下载，麻烦您能不能发送一下邮箱，或者将代码回复到帖子这里，再次感谢！
另 ...

有机会希望可以和您交流
也在学习这类模型。