最近人民日报新媒体发布的「新冠肺炎全球疫情形势」图,很多人想重复,但画不出来。这其实是几行代码的事情而已。

这个图,大名叫风玫瑰图,用R画起来分分钟的事情。但你画出来的,可能很丑,要画出爆款,还是有点门槛的。

这个图确诊数是取过对数,这一点容易,而颜色的映射,也是取对数的,不然的话,前三是红的,其它全绿了。然后标国家和确诊数目,字体还要旋转相应的角度,这一点可能是最难的。当然细节上还有一点,就是中间还要空一个白洞​。​如果你知道怎么加白洞,那么加两圈淡淡的圈也容易了。​

首先我们用nCov2019包中的全球历史数据,两三行代码就能拿到。

海外新冠数据

require(nCov2019)
y = load_nCov2019(lang='zh')
d = y['global']

过滤数据

过滤一下,只拿上一天的数据,并排除中国,只留海外数据,然后这里又进一步过滤,只保留海外前40的数据。

require(dplyr)
dd <- filter(d, time == time(y) & country != '中国') %>% 
    arrange(desc(cum_confirm)) 

dd = dd[1:40, ]
dd$country = factor(dd$country, levels=dd$country)

画图

最后一步,是画图。


dd$angle = 1:40 * 360/40
i = dd$angle > 90 & dd$confirm > 100
dd$angle[i] = dd$angle[i] + 180
dd$vjust = 1
dd$vjust[i] = 0
require(ggplot2)
p = ggplot(dd, aes(name, confirm, fill=confirm)) + 
    geom_col(width=1, color='grey90') + 
    geom_col(aes(y=I(5)), width=1, fill='grey90', alpha = .2) +       
    geom_col(aes(y=I(3)), width=1, fill='grey90', alpha = .2) +    
    geom_col(aes(y=I(2)), width=1, fill = "white") +
    scale_y_log10() + 
    scale_fill_gradientn(colors=c("darkgreen", "green", "orange", "firebrick","red"), trans="log") + 
    geom_text(aes(label=paste(name, confirm, sep="\n"), 
                  y = confirm *.8, angle=angle, vjust=vjust), 
            data=function(d) d[d$confirm > 100,], 
            size=3, color = "white", fontface="bold")  + 
    geom_text(aes(label=paste0(confirm, "例 ", name), 
                  y = confirm * 2, angle=angle+90), 
            data=function(d) d[d$confirm < 100,], 
            size=3, vjust=0) + 
    coord_polar(direction=-1) + 
    theme_void() + 
    theme(legend.position="none")

ggplotify::as.ggplot(p, scale=1.45, vjust=-.18, hjust=.05)

角度嘛,我们可以预先算好,把一个圆周40等份了。用scale_y_log10把柱子给取对数了。而颜色按对数映射,在scale_fill_gradientn中加入trans="log"的参数。

中间白色的圆,再加一层,盖住就行。画图无非是视觉上的错觉。

加label嘛,这里把数据分成两份,一份是确诊数大于100的,一份是小于100的,分别标白色和黑色,标记的相应位置也不同。切分数据,用到了《ggplot2小技巧-数据没有,函数倒是有一个》中介绍的技巧。最后是极坐标变换。出图如下: