【版块活动】一月一主题讨论

是 否 +2 论坛币

k人 参与回答

经管之家送您一份

应届毕业生专属福利!

求职就业群

赵安豆老师微信：zhaoandou666

经管之家联合CDA

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

立即领取

感谢您参与论坛问题回答

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

+2 论坛币

本月主题：R绘图那些事儿



讨论框架：包括但不限于以下几个方面(欢迎补充)
(1)基于R base相关函数实现常用统计图形的绘制，包括常用图表类型及特有参数，画板布局、坐标轴、辅助图形和注释的应用。力求不借助各种额外包，得到简洁、细致的可视化输出。(2)展现ggplot2/lattice等图形功能的强大之处，或图形功能强大，或代码简洁

参与方法(以跟帖形式)：
(1)分享资料
(2)分享使用和学习心得
(3)直接参与讨论(也欢迎提问)

奖励方法
(1)将有价值的回帖设为精彩回复或直接编辑到主题帖中，供坛友学习
(2)只要是具有学习价值或者讨论价值的回帖，基于论坛币的奖励
(3)请不要进行无意义的回帖，诸如顶、学习一下等，表达支持可以通过给回帖评分的形式
(4)对参与活动特别热心且有突出贡献的坛友可推荐为本版热心会员或后备版主

温馨提示
(1)分享资料包括好的书籍、博文以及之前论坛的精彩回帖等，考虑到R的更新速度，请在分享前确认资料的有效性。
(2)鼓励免费分享，不建议收取论坛币，对于好的资料会有丰厚的论坛币补偿。
(3)R毕竟只是一个工具，在分享使用经验欢迎附上使用过程中的背景知识。
(4)建议对于回帖正文，除了部分难以翻译的英文关键词，请不要使用英文。

感谢大家对活动的倡议和努力，欢迎大家提出更多好的意见建议。

扫码加我 拉你入群

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

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

分享0 收藏3 回帖

关键词：版块活动 Lattice ggplot2 gplot 分享资料 主题

还是我先来一个哈，整理了一个基础绘图的框架，包括单离散变量、单连续变量、多变量、参数设定等内容。
已经发布至https://github.com/dcshallot/visualization， 欢迎参与完善！
完整的代码见下：

1. # File-Name:       base plot.R           
   
2. # Date:            2014-06-01                  
   
3. # Author:          Chong Ding (chong.ding83@gmail.com)
   
4. # Purpose:         讨论常见图形的命令、参数和效果，尽量用R基础功能实现，效果不输excel
   
5. # Data Used:       iris, VADeaths
   
6. # Packages Used:   MASS,RColorBrewer
   
7. # R 基础绘图 v1.0
   
8. 
   
9. ### 离散变量图，一般都用汇总后的数据
   
10. 
    
11. ## 条形图
    
12. 
    
13. # 频数统计条形图
    
14. barplot( table(iris[,5]) )
    
15. 
    
16. # 统计汇总条形图
    
17. l <- aggregate( Sepal.Length ~ Species, data= iris, mean)
    
18. x <- barplot( l[,2] ,  col=terrain.colors(3) , xlim=c(0,5), ylim=c(0,8) ,axe=F, names.arg = l[,1] )
    
19. y <- as.matrix( l[,2] )
    
20. text( x, y+1, labels=l[,2], col="black" ) #柱顶标注，y +n调节标注高度，横放图则调x+n
    
21. legend(legend=l[,1], "right", pch=15, col=terrain.colors(3) )
    
22. 
    
23. # 堆砌和分组
    
24. l <- table( mtcars$cyl , mtcars$gear);l
    
25. barplot( l, beside=T, main = "car tpyes: cyl and gear",
    
26.          names.arg=c( "gear=3","gear=4","gear=5"), legend=c("cyl=4", "cly=6", "cyl=8"))
    
27. barplot( l, beside=F, main = "car tpyes: cyl and gear",
    
28.          names.arg=c( "gear=3","gear=4","gear=5"), legend=c("cyl=4", "cly=6", "cyl=8"))
    
29. 
    
30. ##饼图
    
31. 
    
32. # Pie Chart with Percentages
    
33. slices <- c(10, 12, 4, 16, 8)
    
34. lbls <- c("US", "UK", "Australia", "Germany", "France")
    
35. pct <- round(slices/sum(slices)*100)
    
36. lbls <- paste(lbls, pct) # add percents to labels
    
37. lbls <- paste(lbls,"%",sep="") # ad % to labels
    
38. pie(slices,labels = lbls, col=rainbow(length(lbls)),
    
39.     main="Pie Chart of Countries")
    
40. 
    
41. # 3D Exploded Pie Chart
    
42. library(plotrix)
    
43. slices <- c(10, 12, 4, 16, 8)
    
44. lbls <- c("US", "UK", "Australia", "Germany", "France")
    
45. pie3D(slices,labels=lbls,explode=0.1,
    
46.       main="Pie Chart of Countries ")
    
47. 
    
48. 
    
49. ## 点图：适合很多列别的数据
    
50. 
    
51. # Dotplot: Grouped Sorted and Colored
    
52. # Sort by mpg, group and color by cylinder
    
53. x <- mtcars[order(mtcars$mpg),] # sort by mpg
    
54. x$cyl <- factor(x$cyl) # it must be a factor
    
55. x$color[x$cyl==4] <- "red"
    
56. x$color[x$cyl==6] <- "blue"
    
57. x$color[x$cyl==8] <- "darkgreen"
    
58. dotchart(x$mpg,labels=row.names(x),cex=.7,groups= x$cyl,
    
59.          main="Gas Milage for Car Models\ngrouped by cylinder",
    
60.          xlab="Miles Per Gallon", gcolor="black", color=x$color)
    
61. 
    
62. 
    
63. ### 连续变量图：一般都用原始数据，而非汇总数据做
    
64. 
    
65. ## 直方图：连续变量的分布
    
66. 
    
67. # 分布函数
    
68. h<-hist(x, breaks=10, col="red", xlab="Miles Per Gallon", prob=F ,
    
69.         main="Histogram with Normal Curve")
    
70. xfit<-seq(min(x),max(x),length=40)
    
71. yfit<-dnorm(xfit,mean=mean(x),sd=sd(x)) # 正态分布可以这么画，其他分布参考分布函数
    
72. yfit <- yfit*diff(h$mids[1:2])*length(x)
    
73. lines(xfit, yfit, col="blue", lwd=2)
    
74. 
    
75. # 密度函数
    
76. x <- mtcars$mpg
    
77. h<-hist(x, breaks=10, col="red", xlab="Miles Per Gallon", prob=T ,
    
78.         main="Histogram with Normal Curve")
    
79. lines(density(x))
    
80. 
    
81. # 离散变量直方图
    
82. plot( table(mtcars$carb), type="h" , lwd=5 )
    
83. head(iris)
    
84. 
    
85. 
    
86. ### 多变量
    
87. 
    
88. ## 箱线图：连续变量VS离散变量
    
89. boxplot( Petal.Length ~ Species , data = iris , outline = F  ) # 离群值不显示
    
90. boxplot( mpg ~ cyl * gear, data = mtcars , varwidth=T ) # 箱体宽度由样本量决定
    
91. 
    
92. 
    
93. ## plot族
    
94. 
    
95. # 简单漂亮的散点图：两个连续变量之间的关系
    
96. plot(cars$dist~cars$speed, # y~x
    
97.      main="Relationship between car distance & speed", #Plot Title
    
98.      xlab="Speed (miles per hour)", #X axis title
    
99.      ylab="Distance travelled (miles)", #Y axis title
    
100.      xlim=c(0,30), #Set x axis limits from 0 to 30 ylim=c(0,140), #Set y axis limits from 0 to  30140  xaxs="i", #Set x axis style as internal
     
101.      yaxs="i", #Set y axis style as internal  
     
102.      col="red", #Set the colour of plotting symbol to red
     
103.      pch=19) #Set the plotting symbol to filled dots
     
104. 
     
105. # 分类散点图
     
106. # 先将鸢尾花的类型转化为整数1 、2 、3，便于使用向量
     
107. idx = as.integer(iris[["Species"]])
     
108. plot(iris[, 3:4], pch = c(24, 21, 25)[idx], col = c("black","red", "blue")[idx], panel.first = grid())
     
109. legend("topleft", legend = levels(iris[["Species"]]), col = c("black", "red", "blue"),
     
110.        pch = c(24, 21, 25), bty = "n")
     
111. 
     
112. # 散点矩阵图
     
113. pairs( ~ Sepal.Length + Sepal.Width + Petal.Length +Petal.Width, data=iris)
     
114. 
     
115. # 用散点图表示时间序列数据
     
116. data <- VADeaths
     
117. plot(data[,1] ,type="b" , lwd =2, xaxt="n" , ylim=c(0, 75) ,
     
118.      main ="Death Rates in Virginia (1940)", xlab="age", ylab="Death Rate"  )
     
119. axis( 1, at=1:nrow(data) ,labels = row.names(data) )
     
120. lines( data[,2], type="b" , lwd =2, col="red" )
     
121. lines( data[,3], type="b" , lwd =2, col="orange" )
     
122. lines( data[,4], type="b" , lwd =2, col="purple" )
     
123. legend( 4,30 , legend=colnames(data) , lty=1, lwd=2, pch=21, bty="n" ,
     
124.         col=c("black","red","orange","purple") , cex =0.8, inset=0.01)
     
125. grid()
     
126. 
     
127. ## matplot 分类散点图，强化类别差异的表现
     
128. nam.var <- colnames(iris)[-5]
     
129. nam.spec <- as.character(iris[1+50*0:2, "Species"])
     
130. iris.S <- array(NA, dim = c(50,4,3),
     
131.                 dimnames = list(NULL, nam.var, nam.spec))
     
132. for(i in 1:3) iris.S[,,i] <- data.matrix(iris[1:50+50*(i-1), -5])
     
133. matplot(iris.S[, "Petal.Length",], iris.S[, "Petal.Width",], pch = "SCV",
     
134.         col = rainbow(3, start = 0.8, end = 0.1),
     
135.         sub = paste(c("S", "C", "V"), dimnames(iris.S)[[3]],
     
136.                     sep = "=", collapse= ",  "),
     
137.         main = "Fisher's Iris Data")
     
138. 
     
139. ### 复杂图形(复杂一点而已)
     
140. 
     
141. ## 对应分析：两个或多个变量之间的对应关系
     
142. library(MASS)
     
143. cal<-corresp(USPersonalExpenditure,nf=2) ;
     
144. biplot(cal,expand=1.5, xlim=c(-0.5 , 0.5), ylim=c(-0.1 , 0.15))
     
145. abline(v=0,h=0,lty=3)
     
146. 
     
147. ## 系统聚类：样本距离的衡量
     
148. dist <-dist(scale(iris[,c(1:4)]))
     
149. hc <- hclust(dist, "ward")
     
150. plclust(hc,hang=-1 ,  labels=iris[,5]  )
     
151. re<-rect.hclust(hc,k=4,border="red")
     
152. 
     
153. # 随机点的艺术作品
     
154. par(mar = c(0.2, 0.2, 0.2, 0.2), mfrow = c(2, 2))
     
155. for (n in c(63, 60, 76, 74)) {
     
156.   set.seed(711)
     
157.   plot.new()
     
158.   size = c(replicate(n, 1/rbeta(2, 1.5, 4)))
     
159.   center = t(replicate(n, runif(2)))
     
160.   center = center[rep(1:n, each = 2), ]
     
161.   color = apply(replicate(2 * n, sample(c(0:9,
     
162.                                           LETTERS[1:6]), 8, TRUE)), 2, function(x) sprintf("#%s", paste(x, collapse = "")))
     
163.   points(center, cex = size, pch = rep(20:21, n),  col = color)
     
164.   box()
     
165. }
     
166. dev.off()
     
167. 
     
168. # 热力图，用于展现相同数值在两个维度上的水平/相关系数
     
169. library(RColorBrewer)
     
170. data <- VADeaths
     
171. pal=brewer.pal(4,"YlOrRd")
     
172. breaks<-c(0, 15, 26, 44, 72)
     
173. layout(matrix(data=c(1,2),  nrow=1, ncol=2), widths=c(8,1),
     
174.        heights=c(1,1))  ## 画一个空白的图形画板，按照参数把图形区域分隔好
     
175. ## 看layout的分割可以这样：
     
176. ## xx <- layout(matrix(data=c(1,2),  nrow=1, ncol=2), widths=c(8,1), heights=c(1,1)) ; layout.show(xx)
     
177. par(mar = c(2,6,4,1 ), oma=c(0.1, 0.1 ,0.1 , 0.1), mex = 1.2 ) #Set margins for the heatmap
     
178. image(x=1:nrow(data),
     
179.       y=1:ncol(data),
     
180.       z=data,axes=FALSE,
     
181.       xlab="Month",   ylab="", main="Sales Heat Map" ,
     
182.       col=pal[1:(length(breaks)-1)],
     
183.       breaks=breaks ) # breaks 颜色块对应的数值（数值分组），要比颜色数量多1个
     
184. axis(1, col="white",las=1 , at=1:nrow(data), labels=rownames(data)  )
     
185. axis(2, col="white",las=1 , at=1:ncol(data), labels=colnames(data)  )
     
186. abline(h=c(1:ncol(data))+0.5, v=c(1:nrow(data))+0.5,  col="white",lwd=2,xpd=FALSE)
     
187. # 画标尺
     
188. breaks2 <- breaks[-length(breaks)]  # breaks 少一个
     
189. par(mar = c(2,1,4,2))
     
190. image(x = 1, y= 0:length(breaks2),
     
191.       z=t(matrix(breaks2))*1.001,
     
192.       col=pal[1:length(breaks)-1],
     
193.       axes=FALSE,breaks=breaks,
     
194.       xlab="", ylab="",xaxt="n")
     
195. axis(4,at=0:(length(breaks2)-1), labels=breaks2, col="white", las=1)
     
196. abline(h=c(1:length(breaks2)),col="white",lwd=2, xpd=F )
     
197. dev.off()
     
198. 
     
199. ### 参数参考
     
200. 
     
201. # 玩线条形状
     
202. x <- c(1:5); y <- x # create some data
     
203. par(pch=22, col="red") # plotting symbol and color
     
204. par(mfrow=c(2,4)) # all plots on one page
     
205. opts = c("p","l","o","b","c","s","S","h")
     
206. for(i in 1:length(opts)){
     
207.   heading = paste("type=",opts[i])
     
208.   plot(x, y, type="n", main=heading)
     
209.   lines(x, y, type=opts[i])
     
210. }
     
211. dev.off()
     
212. 
     
213. # 玩颜色
     
214. library( RColorBrewer)
     
215. display.brewer.all(n=10, exact.n=FALSE) # 调色板
     
216. col= brewer.pal( n  ,"Set1") # 引用颜色
     
217. 
     
218. # 玩坐标轴
     
219. x <- c(1:10); y <- x; z <- 10/x
     
220. # 为一个坐标在右边创建额外页边空间
     
221. par(mar=c(5, 4, 4, 8) + 0.1)
     
222. # 绘制 x 相对 y
     
223. plot(x, y,type="b", pch=21, col="red",
     
224.      yaxt="n", lty=3, xlab="", ylab="")
     
225. # 添加 x 相对 1/x
     
226. lines(x, z, type="b", pch=22, col="blue", lty=2)
     
227. # 在左边画一条轴线
     
228. axis(2, at=x,labels=x, col.axis="red", las=0)
     
229. # 用小字体标记在右边画一条轴线
     
230. axis(4, at=z,labels=round(z,digits=2),
     
231.      col.axis="blue", las=2, cex.axis=0.7, tck=-.01)
     
232. # 为右边轴线添加标题
     
233. mtext("y=1/x", side=4, line=3, cex.lab=1,las=2, col="blue")
     
234. # 添加主标题，底和左轴标签
     
235. title("An Example of Creative Axes", xlab="X values",
     
236.       ylab="Y=X")
     
237. dev.off()
     
238. 
     
239. # 玩辅助线和图例
     
240. plot(1:10, type = "n", xlim = c(0, 20), ylim = c(0, 20)) # 不作图，只画出框架，且指定坐标轴范围
     
241. lines(1:10, abs(rnorm(10)))  # 10个正态随机数绝对值的波动线
     
242. # 不同的直线
     
243. abline(a = 0, b = 1, col = "gray")
     
244. abline(v = 2, lty = 2)
     
245. abline(h = 2, lty = 2)
     
246. #添加文本
     
247. text(8, 3, "abline(a = 0, b = 1)")
     
248. # 添加箭头
     
249. arrows(8, 3.5, 6, 5.7, angle = 40)
     
250. # 参数用了向量：不同灰度的线段
     
251. segments(rep(3, 4), 6:9, rep(5, 4), 6:9, col = gray(seq(0.2, 0.8, length = 4)))
     
252. text(4, 9.8, "segments")
     
253. dev.off()
     
254. 
     
255. ####################################
     
256. 
     
257. # 待增补

复制代码

再附上之前总结的R base绘图功能mind map，调整了一下结构，供参考

有图片 就更好了
：D

jmpamao 发表于 2014-6-3 17:37
有图片 就更好了
：D

图+代码太纠结，等我学会了markdown的

学习了