用R語言製作商務圖表，讓你的圖表美出新高度~

01-25

本文案例圖表是之前本公眾號推送過的一個方塊面積比較圖，之前看到過劉萬祥老師在其公眾號及博客中也提供了很好的製作思路。

Excel史上最全的氣泡與方塊系列的圖表

當時就想如果是使用R來寫該圖表，不止是否可行呢，只是當時一時半會兒沒有思路，直到最近，隨著對ggplot 系統的理解進一步加深，這才找到了比較合適的思路。

今天跟大家分享使用R語言的ggplot函數來模仿該圖表：

以下是原圖：

為了將本文製作的成品圖與該案例原圖進行比較，我使用了相同的數據源：

library(ggplot2)library(ggmap) #載入ggmap是為了使用其theme_nothing（）函數清空其原有主題元素

製作數據源：

mydata<-data.frame(X=c(3,7,11,15,19),A=c(2471,1893,1248,1078,556),B=c(1385,951,869,784,366),C=c(56,7,19,13,40))

以下過程構造三個序列的矩形範圍數據（X軸起點終點、Y軸起點終點）

mydata$Axmin<-mydata$X-sqrt(mydata$A)/30mydata$Axmax<-mydata$X+sqrt(mydata$A)/30mydata$Aymin<-0mydata$Aymax<-sqrt(mydata$A)/15

mydata$Bxmin<-mydata$X+sqrt(mydata$A)/30-sqrt(mydata$B)/15mydata$Bxmax<-mydata$X+sqrt(mydata$A)/30mydata$Bymin<-0mydata$Bymax<-sqrt(mydata$B)/15

mydata$Cxmin<-mydata$X+sqrt(mydata$A)/30-sqrt(mydata$C)/10mydata$Cxmax<-mydata$X+sqrt(mydata$A)/30mydata$Cymin<-0mydata$Cymax<-sqrt(mydata$C)/10

仔細體會我在設置以上起始點時所用到的思路

其中第一個序列在最底層，可以使其中心對齊
第二、三個序列則需要對齊第一個序列的右側
原數據開方後仍然很大需要酌情進行壓縮標度（這裡除以15）

數值標籤和文本標籤

mydata$text<-c("University of Pennsylvania","University of Notre Dame","Princeton University","Stanford University","California Institute of Technology")mydata$full<-c("31663","16548","27189","34348","5225")

設置字體為arial字體

windowsFonts(myFont = windowsFont("arial"))

運行以下圖表函數：

ggplot(mydata)+geom_rect(aes(xmin=Axmin,xmax=Axmax,ymin=Aymin,ymax=Aymax),fill="#59AF8A")+geom_rect(aes(xmin=Bxmin,xmax=Bxmax,ymin=Bymin,ymax=Bymax),fill="#0074A3")+geom_rect(aes(xmin=Cxmin,xmax=Cxmax,ymin=Cymin,ymax=Cymax),fill="#C72733")+geom_linerange(aes(x=X+2,ymin=0,ymax=4.8),col="grey",linetype=2)+ylim(-.5,6)+labs(x="",y="")+geom_text(aes(x=X,y=4.5,label=text),size=4,fontface="bold",family="myFont")+geom_label(aes(x=X,y=3.7,label=full),fill="#EFE5CA",colour="black",fontface="bold",size=3.5,label.r=unit(0.15,"lines"),family="myFont")+geom_text(aes(x=Axmin,y=Aymax,label=A),hjust=-.2,vjust=1,size=3.5,col="white",family="myFont")+geom_text(aes(x=Bxmin,y=Bymax,label=B),hjust=-.2,vjust=1,size=3.5,col="white",family="myFont")+geom_text(aes(x=Cxmin,y=Cymax,label=C),hjust=-.2,vjust=1,size=3,col="white",family="myFont")+annotate("text",x=2.5,y=5.7,label="Class Struggle",col="black", size=6,family="myFont")+ annotate("text",x=8.85,y=5.2,label="A spot on a university or college"s waitlist rarely translates into admission. A look at the numbers for several institutions", size=4,family="myFont")+ annotate("text",x=3.9,y=-.32,label="Source:The universities and 2011-2012 Common Data Set",col="black",size=3,family="myFont")+ annotate("text",x=19.8,y=-.32,label="The wall Street Jaunual",col="black",size=3,family="myFont")+ theme_nothing()+theme(panel.background=element_rect(fill="#F5F2E1"))

建議保存尺寸（1035*330）

建議使用Cairo包進行保存操作：

使用方法如下：

font.add("myfont", "arial.ttf")CairoPNG(file="C:/Users/Administrator/Desktop/image.png",width_=1035,height=330)showtext.begin()……showtext.end()dev.off()

---------------------

作者：EasyCharts

博客專欄：EasyCharts 博客專欄
公眾號：EasyCharts

大家也可以加小編微信：tswenqu(備註：知乎)，進R語言中文社區交流群，可以跟各位老師互相交流

官方公眾號：R語言中文社區 (ID：R_shequ) 歡迎關注，持續連載。