R语言 plot函数

相似文件 换一批

是 否 +2 论坛币

k人 参与回答

经管之家送您一份

应届毕业生专属福利!

求职就业群

赵安豆老师微信：zhaoandou666

经管之家联合CDA

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

立即领取

感谢您参与论坛问题回答

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

+2 论坛币

以上图中，图一是我分割的图形，图二是自己绘制的初期的图（在此感谢qoiqpwqr的帮助），图三是最终的结果图，有几点想向大家请教
1、图一中的25区域如何添加标题，我用的title函数，但添加以后称为图二的结果，请问怎么调整一下？
2、关于layout分割图形以后，如何跳到下一个作图区域？比如从图一的1区域到2区域，有时绘图的时候会出现图形区域不对的状况
3、关于图二中的plot函数，如何将坐标的原点绘制在26区域的正中间？
4、如何在图二中添加类似图三的注释，如果用title函数的话如何确定坐标位置？
5、对于一系列数据，如何将符合条件的绘制出来，不符合条件的写入文件中，比如绘图时y大于10就写入文件，小于10就绘制出来，目前我只会用plot把这一列全部数出来，不会筛选
6、plot函数中如何将图二中不同扇区的点用不同的颜色显示出来？
问题有点多，自己刚学R不久，希望大家能多多帮助，在此先感谢大家了

扫码加我 拉你入群

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

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

分享0 收藏1 回帖

关键词：plot R语言 Layout Title ITL 图形 分割 layout title 如何

太强大了，等着学习

能把程序传上来吗？

恩 坐等高人

强大啊

这没想到plot还能做这些

看不懂楼主要做什么

Quite an old post but very nice plot. I hope the functions I used below acted the same way as in 2012:

1. # Data for the outer plots
   
2. dfOuter <-
   
3.   as.data.frame(
   
4.     matrix(
   
5.       c(1, 3, 1,
   
6.         1, 3, 2,
   
7.         1, 3, 3,
   
8.         1, 2, 3,
   
9.         1, 1, 3,
   
10.         2, 1, 3,
    
11.         3, 1, 3,
    
12.         3, 1, 2,
    
13.         3, 1, 1,
    
14.         3, 2, 1,
    
15.         3, 3, 1,
    
16.         2, 3, 1),
    
17.       ncol = 3, byrow = TRUE,
    
18.       dimnames = list( character(), c("B73", "F1", "Mo17") )
    
19.           )
    
20.                )
    
21. 
    
22. # Dummy data for the inner plot
    
23. set.seed(1705171415)
    
24. 
    
25. n <- 100
    
26. 
    
27. dfDmmy <-
    
28.   {
    
29.     ang <- runif(n = n, min = 0, max = 2*pi)
    
30.    
    
31.     rnd <- runif(100)*4
    
32.    
    
33.     data.frame( x = rnd*sin(ang), y = rnd*cos(ang) )
    
34.   }
    
35. 
    
36. # Function to convert point into polar coordination and
    
37. #   classify into one of the 12 areas
    
38. fPlr <- function(x, y)
    
39. {
    
40.   rnd <- sqrt(x*x + y*y)
    
41.   
    
42.   ang <- acos( y/sqrt(x*x + y*y) )/pi*180*( (x >= 0)*2 - 1 ) + (x < 0)*360
    
43.   # angle between the line connecting the point and the origin and the positive
    
44.   #   part of *Y* axis, in [0, 360)
    
45.   
    
46.   group <- floor(ang/30) + 1
    
47.   
    
48.   return(group)
    
49. }
    
50. 
    
51. # Function to produce outer plots
    
52. fOutPlot <- function(dv)
    
53. {
    
54.   # oldPar <- par(no.readonly = TRUE)
    
55.   
    
56.   # on.exit( par(oldPar) )
    
57.   
    
58.   # par( mar = c(2, 0, 0, 0), pty = "s" )
    
59.   
    
60.   dvLmt <-
    
61.     c( round( min( c( length(dv), dv ) ) ) - 1,
    
62.        round( max( c( length(dv), dv ) ) ) + 1 )
    
63.   
    
64.   plot( NA, type = "n", xlim = dvLmt, ylim = dvLmt,
    
65.         xlab = NA_character_, ylab = NA_character_,
    
66.         asp = 1, axes = FALSE, xaxs = "i", yaxs = "i")
    
67.       
    
68.   abline( h = do.call( ":", lapply(dvLmt, I) ) )
    
69.   
    
70.   abline( v = do.call( ":", lapply(dvLmt, I) ) )
    
71.   
    
72.   # axis( side = 1, at = seq_along(dv), labels = names(dv),
    
73.   #       tick = FALSE, mgp = c(1, 0, 0), cex.axis = 0.8, padj = 1 )
    
74.   
    
75.   mtext( text = names(dv), side = 1, line = 0.5, cex = 2/3,
    
76.          at = seq_along(dv), adj = 0.5, padj = 0 )
    
77.   
    
78.   points( seq_along(dv), dv, type = "o", lwd = 2, pch = 16, cex = 2 )
    
79. }
    
80. 
    
81. # Map the sequnce of lines to plot
    
82. ivSq <- c(12, 1, 2, 11, 3, 10, 4, 9, 5, 8, 7, 6)
    
83. 
    
84. # Index for lines in dfOuter to plot
    
85. iIndx <- 1L
    
86. 
    
87. # Split the device
    
88. # iNF <-
    
89.   layout(
    
90.     mat =
    
91.       matrix(
    
92.         c( 1,  1,  2,  2,  3,  4,  4,  5,  6,  6,  7,  7,
    
93.            1,  1,  2,  2,  3,  4,  4,  5,  6,  6,  7,  7,
    
94.            8,  8, 25, 25, 25, 25, 25, 25, 25, 25,  9,  9,
    
95.            8,  8, 26, 26, 26, 26, 26, 26, 26, 26,  9,  9,
    
96.           10, 10, 26, 26, 26, 26, 26, 26, 26, 26, 11, 11,
    
97.           10, 10, 26, 26, 26, 26, 26, 26, 26, 26, 11, 11,
    
98.           12, 12, 26, 26, 26, 26, 26, 26, 26, 26, 13, 13,
    
99.           12, 12, 26, 26, 26, 26, 26, 26, 26, 26, 13, 13,
    
100.           14, 14, 26, 26, 26, 26, 26, 26, 26, 26, 15, 15,
     
101.           14, 14, 26, 26, 26, 26, 26, 26, 26, 26, 15, 15,
     
102.           16, 16, 26, 26, 26, 26, 26, 26, 26, 26, 17, 17,
     
103.           16, 16, 19, 19, 20, 21, 21, 22, 23, 23, 17, 17,
     
104.           18, 18, 19, 19, 20, 21, 21, 22, 23, 23, 24, 24
     
105.           ),
     
106.         ncol = 12, byrow = TRUE
     
107.             )
     
108.         )
     
109. 
     
110. # layout.show(iNF)
     
111. 
     
112. # Decrease margin size
     
113. oldPar <- par(no.readonly = TRUE)
     
114.   
     
115. on.exit( par(oldPar) )
     
116. 
     
117. par( mar = c(2, 0, 0, 0), pty = "s" )
     
118. 
     
119. # Area  1
     
120. plot.new()
     
121. 
     
122. # Area  2
     
123. # plot.new()
     
124. 
     
125. fOutPlot( unlist( dfOuter[ ivSq[iIndx], ] ) )
     
126. 
     
127. if( iIndx < nrow(dfOuter) ) iIndx <- iIndx + 1L
     
128. 
     
129. # Area  3
     
130. plot.new()
     
131. 
     
132. # Area  4
     
133. # plot.new()
     
134. fOutPlot( unlist( dfOuter[ ivSq[iIndx], ] ) )
     
135. 
     
136. if( iIndx < nrow(dfOuter) ) iIndx <- iIndx + 1L
     
137. 
     
138. # Area  5
     
139. plot.new()
     
140. 
     
141. # Area  6
     
142. # plot.new()
     
143. 
     
144. fOutPlot( unlist( dfOuter[ ivSq[iIndx], ] ) )
     
145. 
     
146. if( iIndx < nrow(dfOuter) ) iIndx <- iIndx + 1L
     
147. 
     
148. # Area  7
     
149. plot.new()
     
150. 
     
151. # Area  8
     
152. # plot.new()
     
153. 
     
154. fOutPlot( unlist( dfOuter[ ivSq[iIndx], ] ) )
     
155. 
     
156. if( iIndx < nrow(dfOuter) ) iIndx <- iIndx + 1L
     
157. 
     
158. # Area  9
     
159. # plot.new()
     
160. 
     
161. fOutPlot( unlist( dfOuter[ ivSq[iIndx], ] ) )
     
162. 
     
163. if( iIndx < nrow(dfOuter) ) iIndx <- iIndx + 1L
     
164. 
     
165. # Area 10
     
166. plot.new()
     
167. 
     
168. # Area 11
     
169. plot.new()
     
170. 
     
171. # Area 12
     
172. # plot.new()
     
173. 
     
174. fOutPlot( unlist( dfOuter[ ivSq[iIndx], ] ) )
     
175. 
     
176. if( iIndx < nrow(dfOuter) ) iIndx <- iIndx + 1L
     
177. 
     
178. # Area 13
     
179. # plot.new()
     
180. 
     
181. fOutPlot( unlist( dfOuter[ ivSq[iIndx], ] ) )
     
182. 
     
183. if( iIndx < nrow(dfOuter) ) iIndx <- iIndx + 1L
     
184. 
     
185. # Area 14
     
186. plot.new()
     
187. 
     
188. # Area 15
     
189. plot.new()
     
190. 
     
191. # Area 16
     
192. # plot.new()
     
193. 
     
194. fOutPlot( unlist( dfOuter[ ivSq[iIndx], ] ) )
     
195. 
     
196. if( iIndx < nrow(dfOuter) ) iIndx <- iIndx + 1L
     
197. 
     
198. # Area 17
     
199. # plot.new()
     
200. 
     
201. fOutPlot( unlist( dfOuter[ ivSq[iIndx], ] ) )
     
202. 
     
203. if( iIndx < nrow(dfOuter) ) iIndx <- iIndx + 1L
     
204. 
     
205. # Area 18
     
206. plot.new()
     
207. 
     
208. # Area 19
     
209. # plot.new()
     
210. 
     
211. fOutPlot( unlist( dfOuter[ ivSq[iIndx], ] ) )
     
212. 
     
213. if( iIndx < nrow(dfOuter) ) iIndx <- iIndx + 1L
     
214. 
     
215. # Area 20
     
216. plot.new()
     
217. 
     
218. # Area 21
     
219. # plot.new()
     
220. 
     
221. fOutPlot( unlist( dfOuter[ ivSq[iIndx], ] ) )
     
222. 
     
223. if( iIndx < nrow(dfOuter) ) iIndx <- iIndx + 1L
     
224. 
     
225. # Area 22
     
226. plot.new()
     
227. 
     
228. # Area 23
     
229. # plot.new()
     
230. 
     
231. fOutPlot( unlist( dfOuter[ ivSq[iIndx], ] ) )
     
232. 
     
233. if( iIndx < nrow(dfOuter) ) iIndx <- iIndx + 1L
     
234. 
     
235. # Area 24
     
236. plot.new()
     
237. 
     
238. # Area 25
     
239. # plot.new()
     
240. par(pty = "m")
     
241. 
     
242. plot(
     
243.   NA, type = "n", xlim = c(0, 1), ylim = c(0, 1),
     
244.   xlab = NA_character_, ylab = NA_character_, axes = FALSE
     
245.     )
     
246. 
     
247. text(
     
248.   x = mean( par("usr")[1:2] ), y = mean( par("usr")[3:4] ),
     
249.   labels = "2D presentation of 3-line mean pattern",
     
250.   cex = par("cex.main"), font = par("font.main"), xpd = TRUE
     
251.     )
     
252. 
     
253. # Area 26
     
254. # plot.new()
     
255. par(pty = "s")
     
256. 
     
257. plot(
     
258.   NA, type = "n", xlim = c(-4, 4), ylim = c(-4, 4), xaxs = "r", yaxs = "r",
     
259.   xlab = NA_character_, ylab = NA_character_, axes = F
     
260.     )
     
261. 
     
262. box()
     
263. 
     
264. # Reference lines
     
265. invisible(
     
266.   lapply(
     
267.     seq.int(3) - 1,
     
268.     function(i)
     
269.     {
     
270.       ang <- i/3*pi
     
271.       
     
272.       lines( x = c(-4, 4)*cos(ang), y = c(-4, 4)*sin(ang), lty = 1 )
     
273.     }
     
274.         )
     
275.          )
     
276. 
     
277. invisible(
     
278.   lapply(
     
279.     seq.int(3) - 1,
     
280.     function(i)
     
281.     {
     
282.       ang <- i/3*pi + pi/6
     
283.       
     
284.       lines( x = c(-4, 4)*cos(ang), y = c(-4, 4)*sin(ang), lty = 8 )
     
285.     }
     
286.         )
     
287.          )
     
288. 
     
289. # Reference circles
     
290. invisible(
     
291.   lapply(
     
292.     seq.int(4),
     
293.     function(i)
     
294.     {
     
295.       ang <- seq.int(360)
     
296.       
     
297.       # points( i*cos(ang/180*pi), i*sin(ang/180*pi), pch = ".",
     
298.       #         cex = 1, col = "#BFBFBF" )
     
299.       
     
300.       lines( i*cos(ang/180*pi), i*sin(ang/180*pi), lty = "14",
     
301.               col = "#BFBFBF" )
     
302.     }
     
303.         )
     
304.          )
     
305. 
     
306. # Text for each reference line
     
307. svText <-
     
308.   do.call(
     
309.     "c",
     
310.     lapply(
     
311.       seq( nrow(dfOuter) ),
     
312.       function(i)
     
313.       {
     
314.         ivOdr <- order( unlist( dfOuter[i, ] ) )
     
315.         paste0(
     
316.           do.call(
     
317.             "paste0",
     
318.             lapply(
     
319.               seq.int( length(ivOdr) - 1 ),
     
320.               function(j)
     
321.                 paste0(
     
322.                   names(dfOuter)[ ivOdr[j] ],
     
323.                   ifelse(
     
324.                     dfOuter[ i, ivOdr[j] ] == dfOuter[ i, ivOdr[j + 1] ],
     
325.                     "=", "<"
     
326.                         )
     
327.                       )
     
328.                   )
     
329.                  ),
     
330.           names(dfOuter)[ tail(ivOdr, 1) ]
     
331.               )
     
332.       }
     
333.           )
     
334.          )
     
335. 
     
336. invisible(
     
337.   lapply(
     
338.     seq_along(svText),
     
339.     function(i)
     
340.     {
     
341.       rnd <- 4L
     
342.       
     
343.       ang <- (i - 1)*pi/6
     
344.       
     
345.       dX <- rnd*cos(ang)
     
346.       
     
347.       dY <- rnd*sin(ang)
     
348.       
     
349.       # Enough space to the border?
     
350.       bdr <-
     
351.         abs( dX + sign(dX)*( strwidth(svText) + par("cxy")[1] ) ) >
     
352.         max( abs( par("usr")[1:2] ) )
     
353.       
     
354.       text(
     
355.         x =
     
356.           ifelse(
     
357.             bdr,
     
358.             ifelse( dX > 0, par("usr")[2] - par("cxy")[1],
     
359.                     par("usr")[1] + par("cxy")[1] ),
     
360.             dX
     
361.                 ),
     
362.         y = dY + ifelse( dY > 0, par("cxy")[2]/2, -1*par("cxy")[2]/2 ),
     
363.         labels = svText[i],
     
364.         adj =
     
365.           c( ifelse( bdr, as.integer(dX > 0), 0.5 ), ifelse(dY > 0, 0, 1) )
     
366.           )
     
367.     }
     
368.        )
     
369.          )
     
370. 
     
371. # Number for each region
     
372. invisible(
     
373.   lapply(
     
374.     seq.int(12),
     
375.     function(i)
     
376.     {
     
377.       ang <- (i/6 - 1/12)*pi
     
378.       
     
379.       rnd <-
     
380.         min(
     
381.           abs(
     
382.             c( 4.5,
     
383.                (par("usr")[1:2] + c(1, -1)*par("cxy")[1])/sin(ang),
     
384.                (par("usr")[3:4] + c(1, -1)*par("cxy")[2])/cos(ang) )
     
385.              )
     
386.            )
     
387.       
     
388.       text( x = rnd*sin(ang), y = rnd*cos(ang),
     
389.             labels = as.character(i), adj = c(0.5, 0.5) )
     
390.     }
     
391.         )
     
392.          )
     
393. 
     
394. # Finally add the points
     
395. with( dfDmmy, points( x, y, pch = 20, col = rainbow(12)[ fPlr(x, y) ] ) )

复制代码

Output: