请问这张图是用R哪个包画出来的？

有没有相关学习的代码

Not sure.

持续关注

用ggplot2包中的geom_tile() + coord_polar()可以达到类似的效果，但细节的地方要你自己再探索尝试一下：

1. diamonds %>%
   
2.   count(color, cut) %>%
   
3.   ggplot(mapping = aes(x = color, y = cut)) +
   
4.   geom_tile(mapping = aes(fill = n)) +
   
5.   coord_polar()

复制代码

效果如下：

ggRose能画出一个类似的图 只可惜 是类似而已

ggplot2 包的马赛克图，坐标设置为极坐标

qiu435 发表于 2017-5-9 17:01
ggplot2 包的马赛克图，坐标设置为极坐标

ggplot(data=dat,mapping = aes(x=type,y=year,fill=death))
只可惜画不出
（1）最外头那一圈代表疾病的分类，“A,B,C...”
（2）那一圈年份不知怎么镶嵌进去
（3）中间那个空白的圆圈怎么画

ggplot(data=dat,mapping=aes(x=type,y=year,fill=death))

怎么去掉中间那个圆圈里的那一个小条呀

cheetahfly 发表于 2017-4-15 17:20
用ggplot2包中的geom_tile() + coord_polar()可以达到类似的效果，但细节的地方要你自己再探索尝试一下：
...

library(ggplot2)
data(diamonds)

ggplot(data=diamonds[1:100,],mapping = aes(x=color,y=cut,fill=depth))+geom_tile(mapping=aes(fill=depth))+coord_polar()

An implementation using graphics only:

1. # Get some dummy data
   
2. dfDmmy <-
   
3.   read.table(
   
4.     text =
   
5. "Influenza H5N1,A
   
6. Influenza H1N1,A
   
7. Influenza H7N9,A
   
8. HFMD,A
   
9. Mumps,B
   
10. Hydatid disease,B
    
11. Schistosomiasis,B
    
12. Leprosy,B
    
13. Brucellosis,B
    
14. HIV infection,B
    
15. Hepatitis E,B
    
16. Hepatitis C,B
    
17. Suphilis,B
    
18. OID,B
    
19. Cholera,C
    
20. Filariasis,C
    
21. Anthrax,C
    
22. Leptospirosis,C
    
23. ECM,C
    
24. NT,C
    
25. Rabies,C
    
26. AD,C
    
27. Typhus,C
    
28. Parayphoid,C
    
29. Haemorrhagic fever,C
    
30. Encephalitis,C
    
31. Malaria,C
    
32. Tuberculosis,C
    
33. Hepatitis A,C
    
34. Gonorrhoea,C
    
35. BD,C
    
36. Pertussis,C
    
37. Plague,C
    
38. Diphtheria,D
    
39. SARS,D
    
40. Poliomyelitis,D
    
41. AHC,D
    
42. Dengue,D
    
43. Scarlet fever,D
    
44. Rubella,D
    
45. Seasonal influenza,D
    
46. Kala-azar,D
    
47. Hepatitis B,D
    
48. Measles,D",
    
49.     sep = ",", header = FALSE, col.names = c("disease", "group"), as.is = TRUE
    
50.         )
    
51. 
    
52. set.seed(1705051654)
    
53. 
    
54. dfRate <-
    
55.   do.call(
    
56.     "cbind",
    
57.     lapply(
    
58.       2004:2013,
    
59.       function(i)
    
60.       {
    
61.     dfRes <- data.frame( runif( nrow(dfDmmy) ) )
    
62.    
    
63.     names(dfRes) <- sprintf("year%d", i)
    
64.    
    
65.     dfRes
    
66.       }
    
67.       )
    
68.      )
    
69. 
    
70. dfPlt <- cbind(dfDmmy, dfRate)
    
71. 
    
72. # View(dfPlt)
    
73. 
    
74. iNclass <- nrow(dfPlt) + 1
    
75. 
    
76. ivYears <-
    
77.   as.integer(
    
78.     gsub( "year", "",  grep( "year[0-9]{4}", names(dfPlt), value = TRUE ) )
    
79.         )
    
80. 
    
81. iYearMap <- -2000L
    
82. 
    
83. # Set plotting options
    
84. par( pty = "s", mar = rep(0, times = 4) )
    
85. 
    
86. # Start plot
    
87. plot(
    
88.   NA, NA, type = "n", xlim = c(-20, 20), ylim = c(-20, 20),
    
89.   axes = FALSE, xlab = NA_character_, ylab = NA_character_
    
90.     )
    
91. 
    
92. # Function to convert indices to correponding angular
    
93. fIndToAng <-
    
94.   function(i)
    
95.     return(
    
96.       list(
    
97.     mid = i/iNclass*2*pi,
    
98.     bgn = i/iNclass*2*pi - pi/iNclass,
    
99.     end = i/iNclass*2*pi + pi/iNclass
    
100.       )
     
101.       )
     
102. 
     
103. # Hue of color used
     
104. iHue <- rgb2hsv( col2rgb("orange") )["h", ]
     
105. 
     
106. # Fill in data
     
107. lapply(
     
108.   grep( "year", names(dfPlt) ),
     
109.   function(i)
     
110.   {
     
111.     ivY <-
     
112.       as.integer(
     
113.     gsub( "year", "", grep( "year", names(dfPlt)[i], value = TRUE ) )
     
114.         )
     
115.    
     
116.     iRad <- ivY + iYearMap
     
117.    
     
118.     lapply(
     
119.       seq.int(iNclass - 1),
     
120.       function(j)
     
121.       {
     
122.     lAngRng <- fIndToAng(j)
     
123.    
     
124.     dvAng <- seq(from = lAngRng$bgn, to = lAngRng$end, length.out = 101)
     
125.    
     
126.     polygon(
     
127.       x = c( iRad*sin(dvAng), rev( (iRad + 1)*sin(dvAng) ) ),
     
128.       y = c( iRad*cos(dvAng), rev( (iRad + 1)*cos(dvAng) ) ),
     
129.       border = NA, col = hsv( h = iHue, s = dfPlt[j, i], v = 1 )
     
130.            )
     
131.       }
     
132.       )
     
133.   }
     
134.       )
     
135. 
     
136. # Draw lines
     
137. lapply(
     
138.   seq.int(iNclass) - 1,
     
139.   function(i)
     
140.   {
     
141.     dAng <- fIndToAng(i)$bgn
     
142.    
     
143.     lines(
     
144.       x = ( range(ivYears + iYearMap) + c(0, 1) )*sin(dAng),
     
145.       y = ( range(ivYears + iYearMap) + c(0, 1) )*cos(dAng)
     
146.      )
     
147.   }
     
148.       )
     
149. 
     
150. # Draw arcs - index 0 omitted for labeling
     
151. lapply(
     
152.   c( 0, seq_along(ivYears) ) + min(ivYears) + iYearMap,
     
153.   function(i)
     
154.   {
     
155.     dvAng <-
     
156.       seq( from = fIndToAng(0)$end, to = fIndToAng(0)$bgn + 2*pi,
     
157.        length.out = (iNclass - 1)*100 + 1 )
     
158.    
     
159.     lines( x = i*sin(dvAng), y = i*cos(dvAng) )
     
160.   }
     
161.       )
     
162. 
     
163. # Draw group
     
164. with(
     
165.   dfPlt,
     
166.   lapply(
     
167.     unique(group),
     
168.     function(s)
     
169.     {
     
170.       ivIndx <- which(group == s)
     
171.       
     
172.       dvAngRng <-
     
173.     c( fIndToAng( min(ivIndx) )$bgn, fIndToAng( max(ivIndx) )$end )
     
174.       
     
175.       dvAng <-
     
176.     seq(
     
177.       from = dvAngRng[1] + 2*pi/iNclass/10,
     
178.       to = dvAngRng[2] - 2*pi/iNclass/10,
     
179.       length.out = length(ivIndx)*100 - 2*10 + 1
     
180.        )
     
181.       
     
182.       lines(
     
183.     x =
     
184.       c(
     
185.         ( max(ivYears) + iYearMap + 1.1 )*sin( head(dvAng, 1) ),
     
186.         ( max(ivYears) + iYearMap + 2 )*sin(dvAng),
     
187.         ( max(ivYears) + iYearMap + 1.1 )*sin( tail(dvAng, 1) )
     
188.        ),
     
189.     y =
     
190.       c(
     
191.         ( max(ivYears) + iYearMap + 1.1 )*cos( head(dvAng, 1) ),
     
192.         ( max(ivYears) + iYearMap + 2 )*cos(dvAng),
     
193.         ( max(ivYears) + iYearMap + 1.1 )*cos( tail(dvAng, 1) )
     
194.        )
     
195.        )
     
196.       
     
197.       text(
     
198.     x = ( max(ivYears) + iYearMap + 1.5 )*sin( mean(dvAngRng) ),
     
199.     y = ( max(ivYears) + iYearMap + 1.5 )*cos( mean(dvAngRng) ),
     
200.     label = s, adj = c(0.5, 0.5)
     
201.       )
     
202.     }
     
203.     )
     
204.     )
     
205. 
     
206. # Write names of diseases??
     
207. iNameRad <- max(ivYears) + iYearMap + 2.5
     
208. 
     
209. with(
     
210.   dfPlt,
     
211.   lapply(
     
212.     seq.int( length(disease) ),
     
213.     function(i)
     
214.     {
     
215.       dTht <- fIndToAng(i)$mid
     
216.       
     
217.       text(
     
218.     x = iNameRad*sin(dTht), y = iNameRad*cos(dTht),
     
219.     labels = disease[i], # font = 2,
     
220.     adj =
     
221.       c(
     
222.         ( 1 - sign( sin(dTht) )*
     
223.         abs( sin(dTht) )^( 1/nchar( disease ) ) )/2,
     
224.         ( 1 - sign( cos(dTht) )*
     
225.         abs( cos(dTht) )^nchar( disease ) )/2 ),
     
226.     cex = 0.75
     
227.       )
     
228.     }
     
229.     )
     
230.     )
     
231. 
     
232. # Write years
     
233. invisible(
     
234.   lapply(
     
235.     ivYears,
     
236.     function(i)
     
237.       text(
     
238.     x = (i + iYearMap + 0.5)*sin( fIndToAng(0)$mid ),
     
239.     y = (i + iYearMap + 0.5)*cos( fIndToAng(0)$mid ),
     
240.     labels = i, adj = c(0.5, 0.5), cex = 0.75
     
241.       )
     
242.     )
     
243.      )
     
244. 
     
245. # Legend
     
246. invisible(
     
247. {
     
248.   lapply(
     
249.     seq(100),
     
250.     function(i)
     
251.       rect(
     
252.     xleft = -20, ybottom = 10 + (i - 1)*0.1, xright = -18, ytop = 10 + i*0.1,
     
253.     col = hsv( h = iHue, s = i/100, v = 1 ), border = NA
     
254.       )
     
255.     )
     
256.   
     
257.   rect( xleft = -20, ybottom = 10, xright = -18, ytop = 20 )
     
258.   
     
259.   sapply(
     
260.     0:4/4,
     
261.     function(d)
     
262.       text( x = -18 + par("cxy")[1]*0.5, y = 10 + d*10, cex = 0.75,
     
263.         labels = ifelse( d == 0, "0", sprintf("%4.2f", d) ), adj = c(0, 0.5) )
     
264.     )
     
265. }
     
266.      )

复制代码