熱線電話:13121318867

登錄
首頁精彩閱讀一場用R語言打造的商務圖表視覺盛宴
一場用R語言打造的商務圖表視覺盛宴
2017-04-07
收藏

一場用R語言打造的商務圖表視覺盛宴

之前已經模仿了挺多網絡上流行的高難度商務圖表案例,自覺功力有所小成,就想著趁熱打鐵,把那些剩余的還沒有被挖掘出來了的商務圖表案例全部補全。

本篇給出不等寬柱形圖案例以及MEKKO(也稱市場細分矩陣)圖案例全部四張圖的R語言代碼,作為ggplot商務圖表進階道路上的一個小小一步。

因素需要構造自定義標度,這里需要scale包的支持

library(ggplot2)

library(scales)

構造不等寬柱形圖的案例數據(本案例模仿對象是劉萬祥老師的《Excel圖表之道》,感謝老師在業界的無私奉獻精神,給我后備愛或者留下了如此豐富的圖表案例資源,這里再次向老師致敬?。?。

mydata<-data.frame(Name=paste0("項目",1:5),Scale=c(35,30,20,10,5),ARPU=c(56,37,63,57,59))

因為本篇 所構造的不等寬柱形圖、MEKKO矩陣圖等都是建立在四邊形(或者呈為矩陣)的基礎圖形之上的,即物理的二維空間中,四個點坐標可以定位出一個四邊形,利用R語言的向量化操作,就可以同時操縱n組長度為4的向量,來批量生成矩形塊,這里的核心技巧只是在數據源中準確的生成每一組向量(也即每一個矩形塊的水平軸起點、終點、垂直軸的起點、終點)。

在ggplot系統中,生成矩形的圖層函數是geom_rect()函數,內置四個參數:

xmin\xmax\ymin\ymax

不等寬柱形圖:


#構造矩形X軸的起點(最小點)

mydata$xmin<-0

for (i in 2:5){

mydata$xmin[i]<-sum(mydata$Scale[1:i-1])

}

#構造矩形X軸的終點(最大點)

for (i in 1:5){

mydata$xmax[i]<-sum(mydata$Scale[1:i])

}

#構造數據標簽的橫坐標:

for (i in 1:5){

mydata$label[i]<-sum(mydata$Scale[1:i])-mydata$Scale[i]/2

}

定義字體:

windowsFonts(myFont = windowsFont("微軟雅黑"))

運行ggplot函數:


ggplot(mydata)+

geom_rect(aes(xmin=xmin,xmax=xmax,ymin=0,ymax=ARPU,fill=Name))+

scale_fill_manual(values=c("#54576B","#BD1F12","#E8BA11","#62962A","#9B56AF"))+

geom_text(aes(x=label,y=ARPU-3,label=ARPU),size=6,col="white",family="myFont")+

geom_text(aes(x=label,y=-2.5,label=Scale),size=4,col="black",family="myFont")+

geom_text(aes(x=label,y=-5.5,label=Name),size=4,col="black",family="myFont")+

annotate("text",x=16,y=70,label="不等寬柱形圖",size=8,family="myFont")+  

annotate("text",x=14,y=64,label="這是一幅很用心的圖表",size=4,family="myFont")+ 

annotate("text",x=11,y=-9.8,label="Source:EasyCharts",size=4,family="myFont")+ 

ylim(-10,80)+

theme_nothing()

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

不等寬條形圖

該案例來自于本人小號數據小魔方,也曾在本平臺轉發過:

圖表案例——全球創新國家1000強研發投入變動趨勢

設置目錄導入數據

mydata<-read.csv("barchart.csv",stringsAsFactors = FALSE) 

names(mydata)[1:5]<-c("State","RD","Betw","Cumcost","class")

#構造矩形X軸的起點(最小點)

mydata$xmin<-0

for (i in 2:nrow(mydata)){

mydata$xmin[i]<-sum(mydata$RD[1:i-1])

}

#構造矩形X軸的終點(最大點)

for (i in 1:nrow(mydata)){

mydata$xmax[i]<-sum(mydata$RD[1:i])

}

#構造數據標簽的橫坐標:

for (i in 1:nrow(mydata)){

mydata$label[i]<-sum(mydata$RD[1:i])-mydata$RD[i]/2

}

mydata$class<-factor(mydata$class,levels=c("亞洲","歐洲","北美","其他地區")).

運行作圖函數:

ggplot(mydata)+

geom_rect(aes(xmin=xmin,xmax=xmax,ymin=0,ymax=Betw,fill=class),col="white")+

coord_flip()+

scale_x_reverse()+

scale_y_continuous(limits=c(-.45,.7),breaks=seq(-.4,.7,.1),labels=percent_format(),position = "top")+

scale_fill_manual(values=c("#802428","#AB6661","#D1A6A1","#A89B94"))+

geom_text(aes(x=label,y=Betw/2,label=Betw),size=3,col="white",family="myFont")+

geom_text(aes(x=label,y=ifelse(Betw>0,Betw+.03,Betw-.033),label=mydata$RD),size=4,col="black",family="myFont")+

geom_text(aes(x=label,y=ifelse(Betw>0,-.07,.07),label=State),size=4,col="black",family="myFont")+

labs(title="不等寬柱形圖",subtitle="這是一幅很用心的圖表",caption="Source:EasyCharts",x="",y="")+

theme(

text=element_text(family="myFont"),

plot.title=element_text(size=18),

plot.subtitle=element_text(size=14),

plot.caption=element_text(size=10,hjust=0),

plot.background=element_blank(),

panel.background=element_blank(),

panel.grid=element_blank(),

axis.text.y=element_blank(),

axis.ticks.y=element_blank(),

legend.position=c(0.9,0.2),

axis.line.x=element_line()

)

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

MEKKO(也稱市場細分矩陣)

該圖表同樣來源于劉老師的圖表寶典——《Excel圖表之道》

Mekko<-read.csv("Mekko.csv",stringsAsFactors = FALSE) 

Mekko$Class<-factor(Mekko$Class,order=T)

#構造矩形(Obama)X軸的起點(最小點)

Mekko$xmin<-0

for (i in 2:nrow(Mekko)){

Mekko$xmin[i]<-sum(Mekko$percent[1:i-1])

}

#構造矩形(Obama)X軸的終點(最大點)

for (i in 1:nrow(Mekko)){

Mekko$xmax[i]<-sum(Mekko$percent[1:i])

}

#構造數據標簽的橫坐標:

for (i in 1:nrow(Mekko)){

Mekko$label[i]<-sum(Mekko$percent[1:i])-Mekko$percent[i]/2

}


這里我不想重復映射兩次geom_rect()圖層函數,所以從新整理了數據源,一定要記得ggplot的作圖體系中使用因子變量進行分類作圖的思想,這里完全可以用一個類別標量賦給fill屬性,避免代碼冗余。


mynewdata1<-Mekko[,c(1,6,7)];mynewdata1$ymin<-0;mynewdata1$ymax<-Mekko$Obama;mynewdata1$Type<-"Obama"

mynewdata2<-Mekko[,c(1,6,7)];mynewdata2$ymin<-Mekko$Obama+Mekko$m;mynewdata2$ymax<-Mekko$Obama+Mekko$m+Mekko$McCain;mynewdata2$Type<-"McCain"

mynewdata<-rbind(mynewdata1,mynewdata2)

mynewdata$Type<-factor(mynewdata$Type,levels=c("Obama","McCain"),order=T)

運行作圖函數:

ggplot(mynewdata)+

geom_rect(aes(xmin=xmin,xmax=xmax,ymin=ymin,ymax=ymax,fill=Type),col="white")+

scale_fill_manual(values=c("#004C7F","#B70023"))+

scale_x_continuous(breaks=Mekko$label,labels=Mekko$Class)+

geom_text(data=Mekko,aes(x=label,y=.25,label=percent(Obama)),size=3.5,col="white",family="myFont")+

geom_text(data=Mekko,aes(x=label,y=.8,label=percent(McCain)),size=3.5,col="white",family="myFont")+

labs(title="MEKKO-市場細分矩陣圖",subtitle="這是一幅用心良苦的圖表",caption="Source:EasyCharts",x="",y="")+

theme(

plot.margin=unit(c(2,0,0.5,0),"lines"),

panel.spacing=unit(c(0,0,0,0),"lines"),

axis.text.x=element_text(angle=90,size=10),

panel.background=element_blank(),

axis.ticks=element_blank(),

axis.text.y=element_blank(),

legend.position=c(.78,1),

legend.direction="horizontal",

text=element_text(family="myFont"),

plot.title=element_text(size=18),

plot.subtitle=element_text(size=14),

plot.caption=element_text(size=10,hjust=0),

legend.title=element_blank()

)

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

以下同樣的數據源,只是通過坐標旋轉,換成了條形圖的風格。

ggplot(mynewdata)+

geom_rect(aes(xmin=xmin,xmax=xmax,ymin=ymin,ymax=ymax,fill=Type),col="white")+

coord_flip()+

scale_fill_manual(values=c("#004C7F","#B70023"))+

scale_x_continuous(breaks=Mekko$label,labels=Mekko$Class)+

geom_text(data=Mekko,aes(x=label,y=.25,label=percent(Obama)),size=3.5,col="white",family="myFont")+

geom_text(data=Mekko,aes(x=label,y=.8,label=percent(McCain)),size=3.5,col="white",family="myFont")+

labs(title="MEKKO-市場細分矩陣圖",subtitle="這是一幅用心良苦的圖表",caption="Source:EasyCharts",x="",y="")+

theme(

plot.margin=unit(c(0,0,0,0),"lines"),

panel.spacing=unit(c(0,0,0,0),"lines"),

axis.text.y=element_text(size=10),

panel.background=element_blank(),

axis.ticks=element_blank(),

axis.text.x=element_blank(),

legend.position=c(.78,1),

legend.direction="horizontal",

text=element_text(family="myFont"),

plot.title=element_text(size=18),

plot.subtitle=element_text(size=14),

plot.caption=element_text(size=10,hjust=0),

legend.title=element_blank()

)

因水平有限,代碼寫的比較糟糕,圖表如有可改善的細節,還請的各位多多指點。


數據分析咨詢請掃描二維碼

若不方便掃碼,搜微信號:CDAshujufenxi

數據分析師資訊
更多

OK
客服在線
立即咨詢
日韩人妻系列无码专区视频,先锋高清无码,无码免费视欧非,国精产品一区一区三区无码
客服在線
立即咨詢