其他
R可视化25|111个R模板图（下篇）
"pythonic生物人"的第161篇分享
本文R可视化「111个实例代码」部分分享，挺可惜的，因为版权的原因，作者只放出了部分数据。
「文中绘图依赖数据及代码」：关注公众号：“ pythonic生物人”，「后台回复111」获取。同类文章：
python可视化52|最有价值50图表（python实现代码分享） R可视化|最有价值30+图表（ggplot2实现代码分享） R可视化21|30个统计图绘制原理+使用场景+code
目录
1、时间序列图某段时间添加面积图（Areas Under a Time Series）
2、两个时间序列图之间添加面积图（Areas Between Two Time Series）
3、柱状时间序列图（Column Chart for Developments）
4、柱状时间序列图标记增长部分（Column Chart with Percentages for Growth Developments）
5、按天时间序列图（Daily Values with Labels）
6、标记时间序列图中的缺省值（Time Series with Missing Values）
7、时间序列柱状图中季度值为列（Quarterly Values as Columns）
8、时间序列线状图中季度值为列（Quarterly Values as Lines with Value Labels）
9、时间序列时间范围图（Temporal Ranges）
10、时间序列分面季度图（Seasonal Ranges (Panel)）
11、时间序列堆积季度图（Seasonal Ranges Stacked）
12、带月标签的时间序列图（Monthly Values with Monthly Labels (Layout)）
13、时间序列堆积面积图（Time Series with Stacked Areas）
14、时间序列分面图（Time Series with Trend (Panel)）
15、简单条形图（Bar Chart Simple）
16、气球图（Balloon Plot）
17、凹凸图（Bump Chart）
18、简化的甘特图（Simplified Gantt Chart）
19、热图（Heat Map）
20、Table with Symbols of the “Symbol Signs” Type Face
21、树状图（Tree Map）
22、树状图填充色随面积大小变化（Tree Map changing with size）
23、散点图-3（Scatter Plot Variant 3: Areas Highlighted）
24、散点图-5（Scatter Plot Variant 5: Connected Points）
25、散点图-2（Scatter Plot Variant 2: Outliers Highlighted）
26、用户定义符号的散点图（Scatter Plot With User-Defined Symbols）
27、点少的散点图（Scatter Plot with Few Points） 28、Scatter Plot Gapminder
29、饼图标签内置、分面（Pie Charts, Labels Inside (Panel)）
30、半个饼图（Seat Distribution (Panel)）
31、简单饼图
32、斯贝图（Spie chart）
33、分面雷达图（Radial Polygons (Panel)）
34、Radial Polygons Overlay
35、相关系数图
36、和弦图(chord Diagram)
37、网络图（networks_directed_network）
38、网络图
39、洛伦兹曲线（Lorenz curve）
40、 比较堆积柱状图-1（Comparison with Bar Chart）
41、比较堆积柱状图-2（Comparison with Bar Chart）
42、比较分面柱状图（Comparison with Bar Chart）
43、人口分布柱状图地图
44、聚合金字塔（Aggregated Pyramids）
........
1、时间序列图某段时间添加面积图（Areas Under a Time Series）
library(gdata)
par(cex.axis=1.1,mai=c(0.75,1.5,0.25,0.5),omi=c(0.5,0.5,1.1,0.5), mgp=c(6,1,0),family="Lato Light",las=1)
# Import data and prepare chart
colour<-rgb(68,90,111,150,maxColorValue=255)
myData<-read.table('myData/chile.txt',sep='\t',header = TRUE, encoding="latin1")
attach(myData)
# Define chart and other elements
plot(x,y,axes=F,type="n",xlab="",xlim=c(1800,2020),ylim=c(0,14000),xpd=T,ylab="million 1990 International Geary-Khamis dollars")
axis(1,at=pretty(x),col=colour)
axis(2,at=py<-pretty(y),col=colour,cex.lab=1.2,labels=format(py,big.mark=","))
y<-ts(y,start=1800,frequency=1)
points(window(y, end=1869))
lines(window(y, start=1870))
myShapeColour1<-rgb(0,128,128,50,maxColorValue=255)
myShapeColour2<-rgb(0,128,128,80,maxColorValue=255)
mySelection<-subset(myData,x >= 1879 & x <= 1884)
attach(mySelection)
polygon(c(min(mySelection$x),mySelection$x,max(mySelection$x)),c(-500,mySelection$y,-500),col=myShapeColour2,border=NA)
text(1860,2200,adj=0,col=colour,"Pacific War")
mySelection<-subset(myData,x >= 1940 & x <= 1973)
attach(mySelection)
polygon(c(min(mySelection$x),mySelection$x,max(mySelection$x)),c(-500,mySelection$y,-500),col=myShapeColour1,border=NA)
text(1930,5000,adj=0,col=colour,"Allende Regime")
mySelection<-subset(myData,x >= 1973 & x <= 1990)
attach(mySelection)
polygon(c(min(mySelection$x),mySelection$x,max(mySelection$x)),c(-500,mySelection$y,-500),col=myShapeColour2,border=NA)
text(1960,6800,adj=0,col=colour,"Military Regime")
# Titling
mtext("Gross national product of Chile",3,line=2,adj=0,cex=2.4,family="Lato Black", outer=T)
mtext("Annual figures",3,line=-0.5,adj=0,cex=1.8,font=3, outer=T)
mtext("Source: Rolf Lüders, The Comparative Economic Performance of Chile 1810-1995, www.ggdc.net/maddison",1,line=3,adj=1.0,cex=0.95,font=3)
2、两个时间序列图之间添加面积图（Areas Between Two Time Series）
par(mai=c(1,1,0.5,0.5),omi=c(0,0.5,1,0),family="Lato Light",las=1)
# Import data and prepare chart
library(gdata)
#rs<-read.xls("myData/B1_01.xls",1,header=F,encoding="latin1")
rs<-read.table('myData/B1_01.txt',sep='\t',header = F, encoding="latin1")
myColour1_150<-rgb(68,90,111,150,maxColorValue=255)
myColour1_50<-rgb(68,90,111,50,maxColorValue=255)
myColour2_150<-rgb(255,97,0,150,maxColorValue=255)
myColour2_50<-rgb(255,97,0,50,maxColorValue=255)
attach(rs)
# Define graphic and other elements
plot(V1,V11,axes=F,type="n",xlab="",ylab="Number (per 100 000 population)",cex.lab=1.5,xlim=c(1820,2020),ylim=c(10,40),xpd=T)
axis(1,at=c(1820,1870,1920,1970,2010))
axis(2,at=c(10,15,20,25,30,35,40),col=par("bg"),col.ticks="grey81",lwd.ticks=0.5,tck=-0.025)
lines(V1,V11,type="l",col=myColour1_150,lwd=3,xpd=T)
lines(V1,V12,type="l",col=myColour2_150,lwd=3)
text(1910,35,"Live births",adj=0,cex=1.5,col=myColour1_150)
text(1850,22,"Deaths",adj=0,cex=1.5,col=myColour2_150)
myBegin<-c(1817,1915,1919,1972); ende<-c(1914,1918,1971,2000)
myColour<-c(myColour1_50,myColour2_50,myColour1_50,myColour2_50)
for (i in 1:length(myBegin))
{
mySubset<-subset(rs,V1 >= myBegin[i] & V1 <= ende[i])
attach(mySubset)
xx<-c(mySubset$V1,rev(mySubset$V1)); yy<-c(mySubset$V11,rev(mySubset$V12))
polygon(xx,yy,col=myColour[i],border=F)
}
# Titling
mtext("Live births and deaths in Germany 1820-2001",3,line=1.5,adj=0,family="Lato Black",cex=2.2,outer=T)
mtext("Annual values",3,line=-0.75,adj=0,font=3,cex=1.8,outer=T)
mtext("Source: gesis.org/histat",1,line=3,adj=1,cex=1.2,font=3)
3、柱状时间序列图（Column Chart for Developments）
par(las=1,cex=0.9,omi=c(0.75,0.25,1.25,0.25),mai=c(0.5,0.25,0.5,0.75),family="Lato Light",las=1)
# Read data and prepare chart
myData<-c(25296,28365,32187,36835,39788,44282,51122,60420,58437,62484)/1000
myLabels<-c(2002:2011)
myColours<-c(rep("olivedrab",length(myData)-1),"darkred")
# Create chart and other elements
barplot(myData,border=NA,col=myColours,names.arg=substr(myLabels,3,4),axes=F,cex.names=0.8)
abline(h=c(10,20,30,40,50,60,70,80),col=par("bg"),lwd=1.5)
axis(4,at=c(0,20,40,60))
text(11.5,myData[10]+0.025*myData[10],format(round(myData[10]),nsmall=1),adj=0.5,xpd=T,col="darkgrey")
# Titling
mtext("Sales Development Microsoft",3,line=4,adj=0,family="Lato Black",outer=T,cex=2)
mtext("2002–2011, figures in Bill. US-Dollars",3,line=1,adj=0,cex=1.35,font=3,outer=T)
mtext("Source: money.cnn.com",1,line=2,adj=1.0,cex=1.1,font=3,outer=T)
4、柱状时间序列图标记增长部分（Column Chart with Percentages for Growth Developments）
par(las=1,cex=0.9,omi=c(0.75,0.5,1.25,0.5),mai=c(0.5,1,0,1),family="Lato Light",las=1)
# Define data
myData<-c(25296,28365,32187,36835,39788,44282,51122,60420,58437,62484)/1000
myLabels<-c(2002:2011)
myGrowth<-0
for (i in 2:length(myData)) myGrowth<-c(myGrowth,myData[i]-myData[i-1])
myValueLeft<-myData-myGrowth
x<-rbind(t(myData),t(myData))
y<-rbind(t(myValueLeft),rep(0,length(myData)))
f1<-"darkgreen"; f2<-"grey60"
myColours<-c(f1,f2)
for (i in 1:length(myData)-1) myColours<-c(myColours,f1,f2)
for (i in 1:length(myData))
{
if (y[1,i]>x[1,i])
{
tmp<-x[1,i]; x[1,i]<-y[1,i]; y[1,i]<-tmp
myColours[(2*i)-1]<-"darkred"
}
}
# Create chart and other elements
barplot(x,beside=T,border=NA,col=myColours,space=c(0,2),axes=F)
barplot(y,beside=T,border=NA,col=rep("grey60",2*length(myData)),add=T,names.arg=myLabels,space=c(0,2),axes=F)
axis(2,col=par("bg"),col.ticks="grey81",lwd.ticks=0.5,tck=-0.025)
hoehe<-0.1*max(myData)
j<-1
k<-j
for (i in 1:length(myData))
{
if (j > 1) k<-k+4
text(k+1.3,hoehe,format(round(x[2,i]),nsmall=0),cex=1.25,adj=0,xpd=T,col="white")
j<-j+3
if (i<length(myData)) text(k+3.1,y[1,i+1]+((x[1,i+1]-y[1,i+1])/2),
format(round(myGrowth[i+1],1),cex=0.75,nsmall=1),adj=0)
}
# Titling
mtext("Sales Development Microsoft",3,line=4,adj=0,family="Lato Black",outer=T,cex=2)
mtext("Figures in Bill. US-Dollars",3,line=1,adj=0,cex=1.35,font=3,outer=T)
mtext("Source: money.cnn.com",1,line=2,adj=1.0,cex=1.1,font=3,outer=T)
5、按天时间序列图（Daily Values with Labels）
par(cex.axis=1.1,omi=c(1,0.5,0.95,0.5),mai=c(0.1,1.25,0.1,0.2),mgp=c(5,1,0),family="Lato Light",las=1)
# Import data
christmas<-read.csv(file="myData/allyears.calendar.byday.dat.a",head=F,sep=" ",dec=".")
attach(christmas)
# Create chart
plot(axes=F,type="n",xlab="",ylab="number of deaths",V1,V2)
# other elements
axis(1,tck=-0.01,col="grey",cex.axis=0.9,at=V1[c(1,length(V1))],labels=c("1 July","30 June"))
axis(2,at=py<-pretty(V2),labels=format(py,big.mark=","),cex.axis=0.9,col=par("bg"),col.ticks="grey81",lwd.ticks=0.5,tck=-0.025)
points(V1,V2,type="l")
points(lowess(V2,f=1/5),type="l",lwd=25,col=rgb(255,97,0,70,maxColorValue=255))
text(123,V2[179],"Christmas",cex=1.1)
arrows(157,V2[179],172,V2[179],length=0.10,angle=10,code=0,lwd=2,col=rgb(100,100,100,100,maxColorValue=255))
arrows(192,V2[185],220,V2[185],length=0.10,angle=10,code=0,lwd=2,col=rgb(100,100,100,100,maxColorValue=255))
text(240,V2[185],"New Year",cex=1.1)
# Titling
mtext("Death risk on Christmas and New Year 1979-2004 (USA)",3,line=1.5,adj=0,cex=2,family="Lato Black",outer=T)
mtext("Number of deaths before reaching the emergeny room, sums of years per day",3,line=-0.2,adj=0,cex=1.35,font=3,col="black",outer=T)
mtext("Source: David Phillips, Gwendolyn E. Barker, Kimberly E. Brewer, Christmas and New Year as risk factors for death, Social Science & Medicine 71 (2010) 1463-1471",1,line=3,adj=1,cex=0.75,font=3,outer=T)
6、标记时间序列图中的缺省值（Time Series with Missing Values）
par(omi=c(0.65,0.75,0.95,0.75),mai=c(0.9,0.85,0.25,0.02),bg="antiquewhite2",family="Lato Light",las=1)
# Import data and prepare chart
library(gdata)
#myData<-read.xls("myData/Work_hours_data.xls", encoding="latin1")
myData<-read.table('myData/Work_hours_data.txt',sep='\t',header = TRUE, encoding="latin1")
myColour<-rgb(139,35,35,maxColorValue=255)
y<-ts(myData$v1,start=1850,frequency=1)
# Define chart
plot(y,typ="n",axes=F,xlim=c(1850,2010),ylim=c(35,85),xlab="",ylab="Hours")
# Other elements
axis(1,cex.axis=1.25)
axis(2,cex.axis=1.25,col=par("bg"),col.ticks="grey81",lwd.ticks=0.5,tck=-0.025)
myHeights<-c(40,50,60,70,80)
n<-length(myHeights)
for (i in 1:n) segments(1850,myHeights[i],2000,myHeights[i],col="white")
text(1905,68,"Great Britain",col=myColour,cex=1.5)
ptyp=19
source("scripts/inc_missing_values.r")
myColour<-rgb(39,139,16,maxColorValue=255)
y<-ts(myData$v2,start=1850,frequency=1)
source("scripts/inc_missing_values.r")
text(1960,38,"France",col=myColour,cex=1.5)
myColour<-rgb(0,0,139,maxColorValue=255)
y<-ts(myData$v3,start=1850,frequency=1)
source("scripts/inc_missing_values.r")
text(1872,52,"Germany",col=myColour,cex=1.5)
myColour<-rgb(205,149,12,maxColorValue=255)
y<-ts(myData$v4,start=1850,frequency=1)
source("scripts/inc_missing_values.r")
text(1990,44,"Belgium",col=myColour,cex=1.5)
# Titling
mtext("Development of weekly working time 1850-2010",3,line=0.2,adj=0,cex=2.6,family="Lato Black",outer=T)
mtext("Annual values ",3,line=-2,adj=0,cex=2,font=3,outer=T)
mtext("Source: Special analysis",1,line=0,adj=1,cex=1.25,font=3,outer=T)
7、时间序列柱状图中季度值为列（Quarterly Values as Columns）
library(gplots)
library(gdata)
par(omi=c(0.65,0.75,0.95,0.75),mai=c(0.9,0,0.25,0.02),fg="cornsilk",bg="cornsilk",family="Lato Light",las=1)
# Read data and prepare chart
gdp<-read.table('myData/GDP_germany_quarter-2.txt',sep='\t',header = TRUE, encoding="latin1")
x<-rev(gdp$priceadjusted)
t<-unique(gdp$year)
# Create chart and other elements
par(mfcol=c(1,length(t)))
for (i in length(t):1)
{
xt<-subset(gdp$priceadjusted,gdp$year == t[i])
myColours<-rep("blue4",length(xt))
for (j in 1:length(xt)) if(xt[j]<0) myColours[j]<-"coral4"
barplot2(rev(xt),border=NA,bty="n",col=rev(myColours),ylim=c(-4,2),axes=F,prcol="bisque1")
if (i==length(t)) axis(2,col="cornsilk",cex.axis=1.25,at=c(-4:2),labels=c("-4%","-3%","-2%","-1%","0%","1%","2%"))
mtext(t[i],1,line=2,col=rgb(64,64,64,maxColorValue=255),cex=1.25)
}
# Titling
mtext("Gross Domestic Product in Germany 2000 - 2011",3,line=2.5,adj=0,cex=2,family="Lato Black",col="Black",outer=T)
mtext("Price-adjusted rates of change from the previous quarter, chain index, quarterly values",3,line=-0.5,adj=0,cex=1.5,font=3,col="Black",outer=T)
mtext("Source: destatis.de",1,line=1,adj=1,cex=1.25,font=3,col="Black",outer=T)
8、时间序列线状图中季度值为列（Quarterly Values as Lines with Value Labels）
par(omi=c(0.65,0.75,0.95,0.75),mai=c(0.9,0,0.25,0.02),fg=rgb(64,64,64,maxColorValue=255),bg="azure2",family="Lato Light",las=1)
# Read data and prepare chart
gdp<-read.table('myData/GDP_germany_quarter-1',sep='\t',header = TRUE, encoding="latin1")
gdp<-subset(gdp,gdp$year > 2007)
x<-ts(rev(gdp$jeworiginal),start=2008,frequency=4)
# Create chart and other elements
plot(x,type="n",axes=F,xlim=c(2008,2012),ylim=c(560,670),xlab="",ylab="")
abline(v=c(2008:2012),col="white",lty=1,lwd=1)
lines(x,lwd=8,type="b",col=rgb(0,0,139,80,maxColorValue=255))
points(x,pch=19,cex=3,col=rgb(139,0,0,maxColorValue=255))
faktor<-rep(0.985,length(x))
for (i in 1:length(x))
{
if (i>1 & i<length(x)) { if (x[i]>x[i-1] & x[i]>x[i+1]) { faktor[i]<-1.015 } }
text((2008+i*0.25)-0.25,faktor[i]*x[i],x[i],col=rgb(64,64,64,maxColorValue=255),cex=1.1)
}
axis(1,at=c(2008:2012),tck=0)
axis(2,col=NA,col.ticks=rgb(24,24,24,maxColorValue=255),lwd.ticks=0.5,cex.axis=1.0,tck=-0.025)
# Titling
mtext("Gross Domestic Product in Germany 2000 - 2011",3,line=2.3,adj=0,cex=2,family="Lato Black",outer=T)
mtext("Original values in current prices, Bill. EUR, quarterly values",3,line=0,adj=0,cex=1.75,font=3,outer=T)
mtext("Source: destatis.de",1,line=1,adj=1,cex=1.25,font=3,outer=T)
9、时间序列时间范围图（Temporal Ranges）
par(omi=c(0.75,0.5,1,0.5),mai=c(0.5,1.25,0.5,0.1),mgp=c(4.5,1,0),family="Lato Light",las=1)
# Import data and prepare chart
library(gdata)
myData<-read.table('myData/histat_studies.txt',sep='\t',header = TRUE, encoding="latin1")
attach(myData)
n<-nrow(myData)
myColour<-rgb(240,24,24,30,maxColorValue=255)
# Define chart and other elements
plot(1:1,type="n",axes=F,xlab="Study start and end",ylab="number",xlim=c(min(from),max(to)),ylim=c(log10(min(number_timeseries)),log10(max(number_timeseries))))
axis(1,col=par("bg"),col.ticks="grey81",lwd.ticks=0.5,tck=-0.025)
axis(2,at=c(log10(10),log10(100),log10(1000),log10(10000),log10(50000)),labels=c("10","100","1.000","10.000","50.000"),col=par("bg"),col.ticks="grey81",lwd.ticks=0.5,tck=-0.025)
for (i in 1:n) segments(from[i],log10(number_timeseries)[i],to[i],log10(number_timeseries)[i],col=myColour,lwd=8)
# Titling
mtext("histat time series",3,line=2,adj=0,family="Lato Black",outer=T,cex=2)
mtext("Start, end, and number of time series per study, annual firgures",3,line=0,adj=0,cex=1.35,font=3,outer=T)
mtext("Source: gesis.org/histat",1,line=2,adj=1.0,cex=1.1,font=3,outer=T)
10、时间序列分面季度图（Seasonal Ranges (Panel)）
par(omi=c(0.25,0.25,0.5,0.25),mai=c(0.45,0.35,0.5,0),mfcol=c(1,2),family="Lato Light",las=1)
library(gplots)
library(gdata)
# Import data and prepare chart
myData<-read.table('myData/Climate.txt',sep='\t',header = TRUE, encoding="latin1")
attach(myData)
myLines<-c(-5,0,5,10,15,20,25,30)
# Create chart and other elements
myT1<-barplot2(t(cbind(NY_min,NY_max-NY_min)),col=c(NA,"coral3"),border=NA,names.arg=Month,ylim=c(-5,35),panel.first=abline(h=myLines,col="grey",lwd=1,lty="dotted"),axes=F)
for (i in 1:length(myLines)) {text(-0.8,myLines[i]+1.1,myLines[i],xpd=T)}
text(-0.25,33,"Degrees Celsius",xpd=T,cex=0.8)
mtext(side=3,"New York",cex=1.5,col=rgb(64,64,64,maxColorValue=255))
myT2<-barplot2(t(cbind(MAJ_min,MAJ_max-MAJ_min)),col=c(NA,"cornflowerblue"),border=NA,names.arg=Month,ylim=c(-5,35),panel.first=abline(h=myLines,col="grey",lwd=1,lty="dotted"),axes=F)
# Titling
mtext(side=3,"Majorca",cex=1.5,col=rgb(64,64,64,maxColorValue=255))
mtext(side=3,"Monthly average temperatures",cex=1.5,family="Lato Black",outer=T)
mtext(side=1,"Source: Wikipedia",cex=0.75,adj=1,font=3,outer=T)
11、时间序列堆积季度图（Seasonal Ranges Stacked）
par(omi=c(0.25,0,0.75,0.25),mai=c(0.5,2,0.5,2),family="Lato Light",las=1)
# Import data and prepare chart
library(gdata)
myData<-read.table('myData/Climate.txt',sep='\t',header = TRUE, encoding="latin1")
myLines<-c(-5,0,5,10,15,20,25,30)
attach(myData)
# Create chart and other elements
myT1<-barplot(t(cbind(NY_min,NY_max-NY_min)),col=c("white","coral3"),border=NA,ylim=c(-5,35),axes=F,axisnames=F)
myT2<-barplot(t(cbind(MAJ_min,MAJ_max-MAJ_min)),col=c("white","cornflowerblue"),border=NA,add=T,axes=F,names.arg=Month)
axis(2,at=myLines,col=par("bg"),col.ticks="grey81",lwd.ticks=0.5,tck=-0.025)
abline(h=myLines,col="white",lwd=2)
abline(v=seq(2.5,28.8,by=2.4),col="grey")
text(-0.95,34,"Degrees Celsius",xpd=T,cex=0.8)
legend(34,25,c("New York","Majorca"),col=c("coral3","cornflowerblue"),pch=15,bty="n",xjust=1,cex=1.5,pt.cex=1.5,xpd=T)
# Titling
mtext(side=3,"Monthly average temperatures",cex=2.25,adj=0.1,family="Lato Black",outer=T)
mtext(side=1,line=-1,"Source: Wikipedia",cex=1.25,adj=1,font=3,outer=T)
12、带月标签的时间序列图（Monthly Values with Monthly Labels (Layout)）
layout(matrix(c(1,2),ncol=1),heights=c(80,20))
par(cex=0.75,bg=rgb(240,240,240,maxColorValue=255),omi=c(0.75,0.25,0.5,0.25),mai=c(0.25,0.75,0.25,0),mgp=c(2,1,0),family="Lato Light",las=1)
# Read data and prepare chart
library(gdata)
myData<-read.table('myData/BBK01.WU3140.txt',sep='\t',header = TRUE, encoding="latin1")
attach(myData)
myColour1<-rgb(255,0,0,150,maxColorValue=255)
myColour2<-rgb(0,0,0,150,maxColorValue=255)
monthbegin<-seq(as.Date("1988-01-01"),as.Date("2014-01-01"),by="1 months")
yearbegin<-seq(as.Date("1988-01-01"),as.Date("2014-01-01"),by="1 years")
# Create chart and other elements
plot(type="n",axes=F,xlab="",ylab="Index",as.Date(paste(Monat,"01",sep="-")),Wert)
abline(v=yearbegin,col="lightgrey")
points(as.Date(paste(Monat,"01",sep="-")),Wert,col=myColour1,lwd=5,type="l")
axis(1,col=rgb(60,60,60,maxColorValue=255),at=monthbegin,labels=format(monthbegin,"%b\n%Y"),cex.axis=0.95,lwd.ticks=0.1,tck=-0.005)
axis(2,col=rgb(240,240,240,maxColorValue=255),col.ticks=rgb(60,60,60,maxColorValue=255),lwd.ticks=0.5,cex.axis=0.95,tck=-0.01,pos=as.Date("1988-01-01"))
myRate<-rep(0,nrow(myData))
for (i in 2:nrow(myData)) myRate[i]<-(Wert[i]-Wert[i-1])/Wert[i-1]
plot(type="h",axes=F,xlab="",ylab="Growth rate\nprev. month",as.Date(paste(Monat,"01",sep="-")),myRate,col=myColour2,lwd=3)
axis(1,col=rgb(60,60,60,maxColorValue=255),at=monthbegin,labels=format(monthbegin,"%b\n%Y"),cex.axis=0.95,lwd.ticks=0.1,tck=-0.02)
axis(2,col=rgb(240,240,240,maxColorValue=255),col.ticks=rgb(60,60,60,maxColorValue=255),lwd.ticks=0.5,cex.axis=0.95,tck=-0.025,pos=as.Date("1988-01-01"))
# Titling
mtext("DAX Index 1988-2013",3,line=1,adj=0,cex=1.5,family="Lato Black",outer=T)
mtext("Base: Ultimo 1987=1000, End of month",3,line=-1,adj=0,cex=1.25,font=3,outer=T)
mtext("Source: www.bundesbank.de, BBK01.WU3140",1,line=2,adj=1.0,cex=1.05,font=3,outer=T)
13、时间序列堆积面积图（Time Series with Stacked Areas）
library(plotrix)
library(gdata)
par(mai=c(0.5,1.75,0,0.5),omi=c(0.5,0.5,0.8,0.5),family="Lato Light",las=1)
# Import data and prepare chart
myData<-read.table('myData/Power_generation_Bavaria.txt',sep='\t',header = TRUE, encoding="latin1")
myC1<-"brown"
myC2<-"black"
myC3<-"grey"
myC4<-"forestgreen"
myC5<-"blue"
myC6<-"lightgoldenrod"
myYears<-myData$Year
myData$Year<-NULL
Complete<-myData$Complete
myData$Complete<-NULL
fg_org<-par("fg")
par(fg=par("bg"))
# Create chart and other elements
stackpoly(myData,main="",xaxlab=rep("", nrow(myData)),border="white",stack=TRUE,col=c(myC1,myC2,myC3,myC4,myC5,myC6), axis2=F, ylim=c(0,95000))
lines(Complete, lwd=4, col="lightgoldenrod4")
par(fg=fg_org)
mtext(seq(1990,2010,by=5), side=1, at=seq(1,21,by=5), line=0.5)
segments(0.25,0,22.25,0,xpd=T)
ypos<-c(7000,12000,16000,24000,30500,55000)
myDes<-names(myData)
text(rep(0.5,6), ypos, myDes, xpd=T, adj=1)
# Titling
mtext("Gross electricity generation in Bavaria 1990-2011",3,line=1.5,adj=0,family="Lato Black",cex=1.75,outer=T)
mtext("All values in mil. kWh, annual figures",3,line=-0.2,adj=0,font=3,cex=1.25,outer=T)
mtext("Source: www.statistik.bayern.de",1,line=1,adj=1,cex=0.9,font=3,outer=T)
14、时间序列分面图（Time Series with Trend (Panel)）
par(mfcol=c(3,1),cex.axis=1.4,mgp=c(5,1,0),family="Lato Light",las=1)
par(omi=c(0.5,0.5,1.1,0.5),mai=c(0,2,0,0.5))
# Prepare chart and import data
myColour1_150<-rgb(68,90,111,150,maxColorValue=255)
myColour1_50<-rgb(68,90,111,50,maxColorValue=255)
myColour2_150<-rgb(255,97,0,150,maxColorValue=255)
myColour2_50<-rgb(255,97,0,50,maxColorValue=255)
library(gdata)
myData<-read.table('myData/z8053.txt',sep='\t',header = TRUE, encoding="latin1")
attach(myData)
# Define graphic and other elements
par(mai=c(0,1.0,0.25,0))
plot(year,marriage,axes=F,type="n",xlab="",ylab="number (per 100 thousand)",cex.lab=1.5,xlim=c(1820,1920),ylim=c(700,1000),xpd=T)
axis(2,at=py<-c(700,800,900,1000),labels=format(py,big.mark=","),col=par("bg"),col.ticks="grey81",lwd.ticks=0.5,tck=-0.025)
lines(year,marriage,type="l",col=myColour1_150,lwd=3,xpd=T)
lines(year,marriagetrend,type="l",col=myColour1_50,lwd=10)
text(1910,880,"marriages with trend",cex=1.5,col=myColour1_150)
par(mai=c(0,1.0,0,0))
plot(year,agricultural,axes=F,type="n",xlab="",ylab="index",cex.lab=1.5,xlim=c(1820,1920),ylim=c(40,130))
axis(4,at=c(40,70,100,130),col=par("bg"),col.ticks="grey81",lwd.ticks=0.5,tck=-0.025)
lines(year,agricultural,type="l",col=myColour2_150,lwd=3)
lines(year,agriculturaltrend,type="l",col=myColour2_50,lwd=10)
text(1910,125,"agricultural prices with trend",cex=1.5,col=myColour2_150,xpd=T,)
text(1913,60,"1913=100",cex=1.5,col=rgb(100,100,100,maxColorValue=255))
arrows(1913,68,1913,90,length=0.10,angle=10,code=0,lwd=2,col=rgb(100,100,100,maxColorValue=255))
points(1913,100,pch=19,col="white",cex=3.5)
points(1913,100,pch=1,col=rgb(25,25,25,200,maxColorValue=255),cex=3.5)
points(1913,100,pch=19,col=rgb(25,25,25,200,maxColorValue=255),cex=2.5)
par(mai=c(0.5,1.0,0,0))
plot(year,marriagez,axes=F,type="n",xlab="",ylab="deviations",cex.lab=1.5,xlim=c(1820,1920),ylim=c(-70,70))
axis(1,at=pretty(year))
axis(2,at=c(-60,-30,0,30,60),col=par("bg"),col.ticks="grey81",lwd.ticks=0.5,tck=-0.025)
rect(1820,-70,1867,70,border=F,col="grey90")
lines(year,marriagez,type="l",col=myColour1_150,lwd=3)
lines(year,agriculturalz,type="l",col=myColour2_150,lwd=3)
text(1910,-40,"marriages",col=myColour1_150,cex=1.5)
text(1910,40,"agricultural prices ",col=myColour2_150,cex=1.5)
# Titling
mtext("Growth Trends and Economic Cycles",3,adj=0.5,line=3,cex=2.1,outer=T,family="Lato Black")
mtext("Annual Figures",3,adj=0.06,line=0,cex=1.75,outer=T,font=3)
15、简单条形图（Bar Chart Simple）
par(omi=c(0.65,0.25,0.75,0.75),mai=c(0.3,2,0.35,0),mgp=c(3,3,0),
family="Lato Light", las=1)
# Import data and prepare chart
library(gdata)
ipsos<-read.table('myData/ipsos.txt',sep='\t',header = TRUE, encoding="latin1")
sort.ipsos<-ipsos[order(ipsos$Percent) ,]
attach(sort.ipsos)
# Create chart
x<-barplot(Percent,names.arg=F,horiz=T,border=NA,xlim=c(0,100),col="grey", cex.names=0.85,axes=F)
# Label chart
for (i in 1:length(Country))
{
if (Country[i] %in% c("Germany","Brasil"))
{myFont<-"Lato Black"} else {myFont<-"Lato Light"}
text(-8,x[i],Country[i],xpd=T,adj=1,cex=0.85,family=myFont)
text(-3.5,x[i],Percent[i],xpd=T,adj=1,cex=0.85,family=myFont)
}
# Other elements
rect(0,-0.5,20,28,col=rgb(191,239,255,80,maxColorValue=255),border=NA)
rect(20,-0.5,40,28,col=rgb(191,239,255,120,maxColorValue=255),border=NA)
rect(40,-0.5,60,28,col=rgb(191,239,255,80,maxColorValue=255),border=NA)
rect(60,-0.5,80,28,col=rgb(191,239,255,120,maxColorValue=255),border=NA)
rect(80,-0.5,100,28,col=rgb(191,239,255,80,maxColorValue=255),border=NA)
myValue2<-c(0,0,0,0,27,0,0,0,0,0,0,0,0,84,0,0)
myColour2<-rgb(255,0,210,maxColorValue=255)
x2<-barplot(myValue2,names.arg=F,horiz=T,border=NA,xlim=c(0,100),col=myColour2,cex.names=0.85,axes=F,add=T)
arrows(45,-0.5,45,20.5,lwd=1.5,length=0,xpd=T,col="skyblue3")
arrows(45,-0.5,45,-0.75,lwd=3,length=0,xpd=T)
arrows(45,20.5,45,20.75,lwd=3,length=0,xpd=T)
text(41,20.5,"Average",adj=1,xpd=T,cex=0.65,font=3)
text(44,20.5,"45",adj=1,xpd=T,cex=0.65,family="Lato",font=4)
text(100,20.5,"All values in percent",adj=1,xpd=T,cex=0.65,font=3)
mtext(c(0,20,40,60,80,100),at=c(0,20,40,60,80,100),1,line=0,cex=0.80)
# Titling
mtext("'I Definitely Believe in God or a Supreme Being'",3,line=1.3,adj=0,cex=1.2,family="Lato Black",outer=T)
mtext("was said in 2010 in:",3,line=-0.4,adj=0,cex=0.9,outer=T)
mtext("Source: www.ipsos-na.com, Design: Stefan Fichtel, ixtract",1,line=1,adj=1.0,cex=0.65,outer=T,font=3)
16、气球图（Balloon Plot）
par(omi=c(0.75,0.25,0.5,0.25),mai=c(0.25,0.55,0.25,0),family="Lato Light",cex=1.15)
library(gplots)
# Import data and prepare chart
data(Titanic)
myData<-as.data.frame(Titanic) # convert to 1 entry per row format
attach(myData)
myColours<-Titanic
myColours[,,,"Yes"]<-"LightSkyBlue"
myColours[,,,"No"]<-"plum1"
myColours<-as.character(as.data.frame(myColours)$Freq)
# Create chart
balloonplot(x=list(Age,Sex),main="",
y=list(Class=Class,
Survived=gdata::reorder.factor(Survived,new.order=c(2,1))),
z=Freq,dotsize=18,
zlab="Number of Passengers",
sort=T,
dotcol=myColours,
show.zeros=T,
show.margins=T)
# Titling
mtext("Titanic - Passenger and Crew Statistics",3,line=0,adj=0,cex=2,family="Lato Black",outer=T)
mtext("Balloon Plot for Age, Sex by Class, Survived",3,line=-2,adj=0,cex=1.25,font=3,outer=T)
mtext("Source: R library gplots",1,line=1,adj=1.0,cex=1.25,font=3,outer=T)
mtext("Area is proportional to Number of Passengers",1,line=1,adj=0,cex=1.25,font=3,outer=T)
17、凹凸图（Bump Chart）
par(omi=c(0.5,0.5,0.9,0.5),mai=c(0,0.75,0.25,0.75),xpd=T,family="Lato Light",las=1)
library(plotrix)
library(gdata)
# Import data and prepare chart
z1<-read.table('myData/bumpdata.txt',sep='\t',header = TRUE, encoding="latin1")
rownames(z1)<-z1$name
z1$name<-NULL
myColours<-rep("grey",nrow(z1)); myLineWidth<-rep(1,nrow(z1))
myColours[5]<-"skyblue"; myLineWidth[5]<-8
par(cex=1.1)
# Create chart
bumpchart(z1,rank=F,pch=18,top.labels=c("2002","2011"),col=myColours,lwd=myLineWidth,mar=c(2,12,1,12),cex=1.1)
# Titling
mtext("Revenue development of Fortune 500 enterprises",3,line=1.5,adj=0,family="Lato Black",outer=T,cex=2.1)
mtext("Source: money.cnn.com/magazines/fortune/fortune500/",1,line=0,adj=1,cex=0.95,font=3,outer=T)
# Other elements
axis(2,col=par("bg"),col.ticks="grey81",lwd.ticks=0.5,tck=-0.025, at=c(min(z1$r2002), max(z1$r2002)),c(round(min(z1$r2002)/1000,digits=1), round(max(z1$r2002)/1000, digits=1)))
axis(4,col=par("bg"),col.ticks="grey81",lwd.ticks=0.5,tck=-0.025, at=c(min(z1$r2011), max(z1$r2011)),c(round(min(z1$r2011)/1000,digits=1), round(max(z1$r2011)/1000, digits=1)))
mtext("in billion Euro",3,font=3,adj=0,cex=1.5,line=-0.5,outer=T)
par(family="Lato Black")
axis(2,col=par("bg"),col.ticks="grey81",col.axis="skyblue",lwd.ticks=0.5,tck=-0.025,at=z1[5,1],round(z1[5,1]/1000, digits=1))
axis(4,col=par("bg"),col.ticks="grey81",col.axis="skyblue",lwd.ticks=0.5,tck=-0.025,at=z1[5,2],round(z1[5,2]/1000, digits=1))
18、简化的甘特图（Simplified Gantt Chart）
library(gdata)
c0<-"black"; c1<-"green"; c2<-"red"; c3<-"blue"; c4<-"orange"; c5<-"brown"
myColour_done<-"grey"
myColour<-c(c0,c1,c1,c1,c0,c0,c2,c2,c2,c2,c0,c0,c3,c3,c3,c0,c0,c4,c4,c4,c0,c0,c5)
par(lend=1,omi=c(0.25,1,1,0.25),mai=c(1,1.85,0.25,2.75),family="Lato Light",las=1)
mySchedule<-read.table('myData/projectplanning.txt',sep='\t',header = TRUE, encoding="latin1")
n<-nrow(mySchedule)
myScheduleData<-subset(mySchedule,nchar(as.character(mySchedule$from))>0)
myBegin<-min(as.Date(as.matrix(myScheduleData[,c('from','to')])))
myEnd<-max(as.Date(as.matrix(myScheduleData[,c('from','to')])))
attach(mySchedule)
plot(from,1:n,type="n",axes=F,xlim=c(myBegin,myEnd),ylim=c(n,1))
for (i in 1:n)
{
if (nchar(as.character(Group[i]))>0)
{
text(myBegin-2,i,Group[i],adj=1,xpd=T,cex=1.25)
}
else if (nchar(as.character(what[i]))>0)
{
x1<-as.Date(mySchedule[i,'from'])
x2<-as.Date(mySchedule[i,'to'])
x3<-x1+((x2-x1)*mySchedule[i,'done']/100)
x<-c(x1,x2)
x_done<-c(x1,x3)
y<-c(i,i)
segments(myBegin, i, myEnd, i, col="grey")
lines(x,y,lwd=20,col=myColour[i])
points(myEnd+90,i,cex=(mySchedule[i,'Persons']*mySchedule[i,'Durance'])**0.5,pch=19,col=rgb(110,110,110,50,maxColorValue=255),xpd=T)
if (x3-x1>1) lines(x_done,y,lwd=20,col=myColour_done)
if (mySchedule[i,'PAG'] > 0)
{
x4<-as.Date(mySchedule[i,'AG_from'])
x5<-as.Date(mySchedule[i,'AG_to'])
x_ag<-c(x4,x5)
rect(x4,i-0.75,x5,i+0.75,lwd=2)
}
text(myBegin-2,i,what[i],adj=1,xpd=T,cex=0.75)
text(myEnd+25,i,paste(done[i],"%",sep=" "),adj=1,xpd=T,cex=0.75)
text(myEnd+35,i,paste(format(x1,format="%d/%m/%y"),"-",format(x2,format="%d/%m/%y"),sep=" "),adj=0,xpd=T,cex=0.75)
}
else # Milestone
{
x3<-as.Date(mySchedule[i,'when'])
myHalf<-(myEnd-myBegin)/2
if (x3-x1<myHalf)
{
points(as.Date(mySchedule[i,'when']),i,pch=18,cex=1.25,col="red")
text(as.Date(mySchedule[i,'when'])+5,i,Milestone[i],adj=0,xpd=T,cex=0.75)
} else
{
points(as.Date(mySchedule[i,'when']),i,pch=18,cex=1.25,col="red")
text(as.Date(mySchedule[i,'when'])-5,i,Milestone[i],adj=1,xpd=T,cex=0.75)
}
}
}
axis(3,at=c(myBegin,myEnd),labels=c(format(myBegin,format="%d/%m/%Y"),format(myEnd,format="%d/%m/%Y")))
myToday<-as.Date("15.08.2012", "%d.%m.%Y")
abline(v=myToday)
mtext("today",1,line=0,at=myToday)
# Titling
mtext("Project plan",3,line=2,adj=0,cex=2.25,family="Lato Black",outer=T)
mtext(paste("planning status: ",format(myToday,format="%d/%m/%y"),sep=""),1,line=4,at=myEnd+20,cex=1.25,font=3)
rect(myBegin-36, n+5, myBegin, n+4, xpd=T,lwd=2)
text(myBegin-35, n+4.5, "Box: Client",xpd=T, adj=0)
19、热图（Heat Map）
library(RColorBrewer)
library(pheatmap)
par(mai=c(0.25,0.25,0.25,1.75),omi=c(0.25,0.25,0.75,0.85),family="Lato Light",las=1)
# Import data and prepare chart
myGrades<-read.table('myData/grades.txt',sep='\t',header = TRUE, encoding="latin1")
x<-as.matrix(myGrades[,2:13])
rownames(x)<-myGrades$names
x<-x[order(rowSums(x)), ]
x<-x[,order(colSums(x))]
# Create chart
plot.new()
pheatmap(x,col=brewer.pal(6,"Spectral"),cluster_rows=F,cluster_cols=F,cellwidth=25,cellheight=14,border_color="white",fontfamily="Lato Light")
# Titling
mtext("Heat map of school grades within a fictional class",3,line=1,adj=0.2,cex=1.75,family="Lato Black",outer=T)
mtext("Fictional data, names generated with de.fakenamegenerator.com",1,line=-1,adj=1,cex=0.85,font=3,outer=T)
20、Table with Symbols of the “Symbol Signs” Type Face
par(omi=c(0.5,0.25,0.5,0.25),mai=c(0,0,0,0),family="Lato Light",cex=1.2)
# Import data
library(gdata)
myData<-read.table('myData/leaking_pipeline.txt',sep='\t',header = TRUE, encoding="latin1")
attach(myData)
# Create graphics
b1<-barplot(Men+75,horiz=T,xlim=c(-175,175),border=NA,col="gainsboro",axes=F)
barplot(-Women-75,horiz=T,border=NA,add=T,col="gainsboro",axes=F)
barplot(rep(75,5),horiz=T,border=par("bg"),add=T,col=par("bg"),axes=F)
barplot(rep(-75,5),horiz=T,border=par("bg"),add=T,col=par("bg"),axes=F)
abline(v=seq(-175,195,by=10),col=par("bg"))
text(0,b1,Level)
# Titling
mtext("The 'Leaky Pipeline' 2005",3,line=0.25,adj=0,cex=1.75,family="Lato Black",outer=T)
mtext("Source: Wissenschaftsrat, Drucksache Drs. 8036-07.",1,line=0.25,adj=1.0,cex=0.65,outer=T,font=3)
# Symbols
par(family="Symbol Signs")
for (i in 1:5)
{
MyMen_Number<-Men[i]
text(seq(10,10*round(MyMen_Number/10),by=10)+73.5,rep(b1[i],5),rep("M",MyMen_Number),
cex=2.75,col="cornflowerblue")
MyWomen_Number<-Women[i]
text(-seq(10,10*round(MyWomen_Number/10),by=10)-68,rep(b1[i],5),rep("F",MyWomen_Number),
cex=2.75,col="deeppink")
}
par(family="Lato Bold")
text(55,b1,paste(Men, "%", sep=" "))
text(-55,b1,paste(Women, "%", sep=" "))
21、树状图（Tree Map）
# par(omi=c(0.65,0.25,1.25,0.75),mai=c(0.3,2,0.35,0),family="Lato Light",las=1)
par(omi=c(0.55,0.25,1.15,0.75),family="Lato Light",las=1)
library(treemap)
library(gdata)
# Import data
federalbudget<-read.table('myData/federalbudget.txt',sep='\t',header = TRUE, encoding="latin1")
# Create chart
plot.new()
treemap(federalbudget,title="",index="Title",type="index",vSize="Expenditures",palette="YlOrRd",aspRatio=1.9,inflate.labels=T)
# Titling
mtext("Federal Budget 2011",3,line=3.8,adj=0,cex=2.2,family="Lato Black",outer=T)
mtext("Shares of Expenditure",3,line=2.3,adj=0,cex=1.5,outer=T,font=3)
mtext("Source: bund.offenerhaushalt.de",1,line=1,adj=1.0,cex=0.95,outer=T,font=3)
22、树状图填充色随面积大小变化（Tree Map changing with size）
par(omi=c(0.65,0.25,1.25,0.75),mai=c(0.3,2,0.35,0),family="Lato Light",las=1)
library(treemap)
library(RColorBrewer)
# Daten einlesen und Grafik vorbereiten
load("myData/hnp.RData")
myData<-subset(daten,daten$gni>0)
attach(myData)
kgni<-cut(gni,c(0,40000,80000))
levels(kgni)<-c("low","middle","high")
myData$kgni<-kgni
myData$nkgni<-as.numeric(kgni)
# Grafik definieren und weitere Elemente
plot(1:1,type="n",axes=F)
treemap(myData,title="",index=c("kontinent","iso3"), vSize="pop",vColor="nkgni",type="value",palette="Blues",aspRatio=2.5,fontsize.labels=c(0.1,20),position.legend="none")
legend(0.35,0.6,levels(kgni)[1:3],cex=1.65,ncol=3,border=F,bty="n",fill= brewer.pal(9,"Blues")[7:9],text.col="black",xpd=NA)
# Betitelung
mtext("Within Continent: Country Level",3,line=2,adj=0,cex=2.4,outer=T,family="Lato Black")
mtext("Size: population - Colour: GNI per capita. Atlas method (current US $), 2010",3,line=0,adj=0,cex=1.75,outer=T,font=3)
mtext("Source: data.wordlbank.org",1,line=1,adj=1.0,cex=1.25,outer=T,font=3)
23、散点图-3（Scatter Plot Variant 3: Areas Highlighted）
par(mai=c(0.85,1,0.25,0.25),omi=c(1,0.5,1,0.5),family="Lato Light",las=1)
# Import data and prepare chart
library(gdata)
myPersons<-read.table('myData/persons.txt',sep='\t',header = TRUE, encoding="latin1")
attach(myPersons)
myData<-subset(myPersons,w>0 & s=="m" & name!="Max Schmeling")
attach(myData)
# Define chart and other elements
plot(type="n",xlab="Height (cm)",ylab="Weight (kg)",h,w,xlim=c(160,220),ylim=c(50,125),axes=F)
axis(1,col=par("bg"),col.ticks="grey81",lwd.ticks=0.5,tck=-0.025)
axis(2,col=par("bg"),col.ticks="grey81",lwd.ticks=0.5,tck=-0.025)
myC1<-rgb(255,0,210,maxColorValue=255)
myC2<-rgb(0,208,226,100,maxColorValue=255)
myP1<-subset(myData[c("h","w")],w>20*(h/100*h/100) & w<25*(h/100*h/100))
myP2<-subset(myData[c("h","w")],w<20*(h/100*h/100))
myP3<-subset(myData[c("h","w")],w>25*(h/100*h/100))
myDes2<-as.matrix(subset(name,w<20*(h/100*h/100)))
myDes3<-as.matrix(subset(name,w>25*(h/100*h/100)))
symbols(myP1,bg='#dc2624',fg="white",circles=rep(1,nrow(myP1)),inches=0.25,add=T)
symbols(myP2,bg='#649E7D',fg="white",circles=rep(1,nrow(myP2)),inches=0.25,add=T)
symbols(myP3,bg='#649E7D',fg="white",circles=rep(1,nrow(myP3)),inches=0.25,add=T)
text(myP2,myDes2,cex=0.75,pos=1,offset=1.1,family="Lato Black")
text(myP3,myDes3,cex=0.75,pos=3,offset=1.1,family="Lato Black")
curve(20*(x/100*x/100),xlim=c(160,220),add=T)
curve(25*(x/100*x/100),xlim=c(160,220),add=T)
abline(v=mean(h,na.rm=T),lty=3)
abline(h=mean(w,na.rm=T),lty=3)
text(182.5,52,"Average height: 182 cm",adj=0,font=3)
# Titling
mtext("Relationship between height and weight",3,adj=0,line=2,cex=2.1,outer=T,family="Lato Black")
mtext("Selected celebrities",3,adj=0,line=0,cex=1.4,outer=T,font=3)
mtext("Source: celebrityheights.com, howmuchdotheyweigh.com",1,line=1,adj=1,cex=0.95,outer=T,font=3)
24、散点图-5（Scatter Plot Variant 5: Connected Points）
par(mai=c(1.1,1.25,0.15,0),omi=c(1,0.5,1,0.5), mgp=c(4.5,1,0),family="Lato Light",las=1)
# Import data and prepare chart
library(gdata)
myData<-read.table('myData/gapminder/Greece.txt',sep='\t',header = TRUE, encoding="latin1")
myData<-myData[myData$Year>=1985, ]
attach(myData)
n<-nrow(myData)
grGDP<-vector()
grLEXP<-vector()
for (i in 2:n)
{
grGDP[i]<-(GDP[i]-GDP[i-1])/GDP[i-1]
grLEXP[i]<-(LEXP[i]-LEXP[i-1])/LEXP[i-1]
}
myData$grGDP<-grGDP*100
myData$grLEXP<-grLEXP*100
myData<-myData[2:n, ]
n<-nrow(myData)
t <- 1:n
ts <- seq(1, n, by = 1/10)
xs <- splinefun(t, myData$grGDP)(ts)
ys <- splinefun(t, myData$grLEXP)(ts)
# Define chart and other elements
plot(myData$grGDP, myData$grLEXP, type="n", xlab="Growth rate GDP (%)", ylab="Growth rate life expectancy (%)", cex.lab=1.5, axes=F)
axis(1,col=par("bg"),col.ticks="grey81",lwd.ticks=0.5,tck=-0.025,cex.axis=1.25)
axis(2,col=par("bg"),col.ticks="grey81",lwd.ticks=0.5,tck=-0.025,cex.axis=1.25)
lines(xs, ys,lwd=7,col="grey")
for (i in 1:n)
{
symbols(myData$grGDP[i],myData$grLEXP[i],bg="brown",fg="white",circles=1,inches=0.25,add=T)
text(myData$grGDP[i],myData$grLEXP[i], myData$Year[i],col="white")
}
# Titling
mtext("GDP and life expectancy in Greece",3,adj=0,line=1.5,cex=2.5,family="Lato Black",outer=T)
mtext("Correlation of growth rates, 1986-2010",3,adj=0,line=-0.25,cex=1.5,font=3,outer=T)
mtext("Source: gapminder.org",1,line=2,adj=1,cex=1.25,font=3,outer=T)
25、散点图-2（Scatter Plot Variant 2: Outliers Highlighted）
par(mar=c(4,4,0.5,2),omi=c(0.5,0.5,1,0),family="Lato Light",las=1)
# Import data and prepare chart
library(gdata)
myStructuralData<-read.csv(file="myData/struktbtwkr2005.csv",head=F,sep=";",dec=".")
myData<-subset(myStructuralData,V2 > 0 & V34 > 10)
attach(myData)
myXDes<-"Unemployed population(%)"
myYDes<-"Net migration (per 1,000 Inhabitants)"
# Define chart and other elements
plot(type="n",xlab=myXDes,ylab=myYDes,V34,V21,xlim=c(10,26),ylim=c(-20,35),axes=F,cex.lab=1.2)
axis(1,lwd.ticks=0.5,cex.axis=1.15,tck=-0.015)
axis(2,lwd.ticks=0.5,cex.axis=1.15,tck=-0.015)
myC1<-rgb(0,208,226,200,maxColorValue=255)
myC2<-rgb(255,0,210,150,maxColorValue=255)
fit<-lm(V21 ~ V34)
myData$fit<-fitted(fit)
points(V34,myData$fit,col=myC2,type="l",lwd=8)
myData$resid<-residuals(fit)
myData.sort<-myData[order(-abs(myData$resid)) ,]
myData.sort_begin<-myData.sort[1:5,]
myP1<-myData.sort[5+1:length(myData$fit),c("V34","V21")]
myP2<-myData.sort_begin[c("V34","V21")]
myR1<-sqrt(myData.sort$V6)/10
myR2<-sqrt(myData.sort_begin$V6)/10
symbols(myP1,circles=myR1,inches=0.3,bg=myC1,fg="white",add=T)
symbols(myP2,circles=myR2,inches=0.3,bg=myC2,fg="white",add=T)
text(myP2,iconv(as.matrix(myData.sort_begin["V3"]),"LATIN1","UTF-8"),cex=0.65,pos=3,offset=1.1)
abline(v=mean(V34,na.rm=T),col="black",lty=3)
abline(h=mean(V21,na.rm=T),col="black",lty=3)
text(20,20, "The five largest deviations are highlighted. \n\npoint size: constituency area", adj=0)
# Titling
mtext("Unemployed population, migration in Germany 2005",3,adj=0,line=2,cex=2.5,outer=T,family="Lato Black")
mtext("County level, unemployment rate above 10 percent",3,adj=0,line=0,cex=1.5,outer=T,font=3)
mtext("Source: www.bundeswahlleiter.de",1,line=4,adj=1,cex=1.15,font=3)
26、用户定义符号的散点图（Scatter Plot With User-Defined Symbols）
par(omi=c(0.5,0.5,0,0),mai=c(0.5,1.25,0,0.25),family="Lato Light",las=1)
library(maptools)
# Import data and prepare chart
library(gdata)
myData<-read.xls("myData/Intra-StateWarData_v4.1.xlsx", encoding="latin1")
mySelection<-subset(myData, myData$StartYear1>=1995 & myData$SideADeaths > 0 & myData$SideADeaths < 2000 & myData$SideBDeaths > 0 & myData$SideBDeaths < 4000)
attach(mySelection)
myColour<-"darkred"
myN<-nrow(mySelection)
h<-rep(0, myN)
v<-rep(0, myN)
myOffset<-cbind(h, v)
# mySelection[, c("WarName", "StartYear1", "SideADeaths", "SideBDeaths")]
myOffset[1, "h"]<--400
myOffset[5, "h"]<-232
myOffset[4, "h"]<--275
myOffset[2, "h"]<-270; myOffset[2, "v"]<-100;
myOffset[13, "h"]<--275
myOffset[12, "h"]<--300
myX<-as.numeric(SideADeaths)
myY<-as.numeric(SideBDeaths)
# Define chart and other elements
plot(myX, myY, typ="n", xlab="", ylab="", axes=F, xlim=c(0, 2000), ylim=c(0, 4000))
axis(1,col=par("bg"),col.ticks="grey81",lwd.ticks=0.5,tck=-0.025)
axis(2,col=par("bg"),col.ticks="grey81",lwd.ticks=0.5,tck=-0.025)
text(myX+130+myOffset[, "h"], myY-180+myOffset[, "v"], paste(WarName, StartYear1, sep=" "), cex=0.8, xpd=T, col="grey")
mtext(side=1, "Side A Deaths (Authorities)", adj=0.5, line=3)
mtext(side=2, "Side B Deaths (Rebels)", las=0, adj=0.5, line=4)
# Titling
mtext("Deaths by Intra-state Wars",3,adj=1,line=-3,cex=2.1,family="Lato Black")
mtext("1997-2007",3,adj=1,line=-5,cex=1.4,font=3)
mtext("Source: correlatesofwar.org",1,line=1,adj=0,cex=0.95,outer=T,font=3)
# Other elements of chart
par(family="Datendesign")
text(myX, myY, "b", col=myColour, cex=5, xpd=T)
27、点少的散点图（Scatter Plot with Few Points）
par(mai=c(2,1,1,1),omi=c(0,0,0,0),xpd=T,family="Lato Light",las=1)
# Define data and prepare chart
names<-c("BMW:\n44,6 Bn.","Daimler:\n45,5 Bn.","","Facebook:\n75-100 Bn.")
myValue<-c(44.6,45.5,100,75)
myRevenue<-c(60.5,97.8,2.5,2.5)
myProfit<-c(4.8,4.7,1,1)
myC1<-rgb(80,80,80,maxColorValue=255)
myC2<-rgb(255,97,0,maxColorValue=255)
myC3<-"grey"
myC4<-rgb(58,87,151,maxColorValue=255)
# Define chart and other elements
plot(myRevenue,myProfit,axes=F,type="n",xlab="Revenue (years)",ylab="Profit (years)",xlim=c(-20,100),ylim=c(-1,6),cex.lab=1.5)
for (i in 1:3)
{
arrows(myRevenue[i],-1,myRevenue[i],myProfit[i],length=0.10,lty="dotted",angle=10,code=0,lwd=1,col="grey70")
arrows(-20,myProfit[i],myRevenue[i],myProfit[i],length=0.10,lty="dotted",angle=10,code=0,lwd=1,col="grey70")
}
points(myRevenue,myProfit,pch=19,cex=myValue/2.6,col=c(myC1,myC2,myC3,myC4))
text(myRevenue,myProfit,names,col="white",cex=1.3)
axis(1,at=c(2.5,60.5,97.8),labels=c("2.5*","60.5","97.8"),cex.axis=1.25)
axis(2,at=c(1,4.8),labels=c("1.0","4.8\n4.7"),cex.axis=1.25)
text(-25.5,5.08,"**")
text(-26.5,1.08,"*")
# Titling
mtext(line=1,"Facebook, BMW and Daimler by comparison",cex=3.5,adj=0,family="Lato Black")
mtext(line=-1,"Profit, revenue, stock market value (circle size, status: 01.30.2012)",cex=1.75,adj=0,font=3)
mtext(line=-3,"All values in Bn. Euro",cex=1.75,adj=0,font=3)
mtext(side=1,line=6.5,"Source www.spiegel.de",cex=1.75,adj=1,font=3)
mtext(side=1,line=4.5,"* Estimated",cex=1.75,adj=0)
mtext(side=1,line=6.5,"** Result before tax",cex=1.75,adj=0)
28、Scatter Plot Gapminder
par(omi=c(0.25,0.25,1.25,0.25),mai=c(1.5,0.85,0,0.5),family="Lato Light",las=1)
# Import data and prepare chart
library(gdata)
myGdp<-read.xls("myData/gapminder/indicatorgapmindergdp_per_capita_ppp.xls", encoding="latin1")
mySelection<-c("X","X2010")
myGdp2010<-myGdp[mySelection]
myExp<-read.xls("myData/gapminder/indicatorlife_expectancy_at_birth.xls", encoding="latin1")
mySelection<-c("Life.expectancy.at.birth","X2010")
myExp2010<-myExp[mySelection]
myGdpExp2010<-merge(myGdp2010,myExp2010,by.x="X",by.y="Life.expectancy.at.birth",all =T)
myPop<-read.xls("myData/gapminder/indicatorgapminderpopulation.xls",dec=".", encoding="latin1")
mySelection<-c("Total.population","X2010")
myPop2010<-myPop[mySelection]
myGdpExpPop2010<-merge(myGdpExp2010,myPop2010,by.x="X",by.y="Total.population",all =T)
myRegions<-read.xls("myData/gapminder/regions.xlsx", encoding="latin1")
myData<-merge(myGdpExpPop2010,myRegions,by.x="X",by.y="Entity",all =T)
myData<-na.omit(myData)
attach(myData)
X2010<-as.numeric(gsub(",","",X2010))/10000000
xmax<-round(max((X2010)),1)
x75<-round(quantile((X2010),probs=0.75),1)
x25<-round(quantile((X2010),probs=0.25),1)
xmax_leg<-round(max((X2010)^0.5)/3,1)
x75_leg<-round(quantile((X2010)^0.5,probs=0.75)/3,1)
x25_leg<-round(quantile((X2010)^0.5,probs=0.25)/3,1)
mySize<-(X2010)^0.5
myData$mySize<-mySize
myOld<-c("Sub-Saharan Africa","South Asia","Middle East & North Africa",
"America","Europe & Central Asia","East Asia & Pacific")
myNew<-c(rgb(0,115,157,150,maxColorValue=255),
rgb(158,202,229,150,maxColorValue=255),
rgb(84,196,153,150,maxColorValue=255),
rgb(255,255,0,150,maxColorValue=255),
rgb(246,161,82,150,maxColorValue=255),
rgb(255,0,0,150,maxColorValue=255))
myColours<-as.character(Group)
for (i in 1:length(myOld)) {myColours[myColours == myOld[i]]<-myNew[i]}
# Define chart and other elements
plot(log10(X2010.x),X2010.y,type="n",axes=F,xlab="",ylab="")
points(log10(X2010.x),X2010.y,cex=mySize,pch=19,col=myColours,lwd=0)
axis(1,at=log10(c(200,400,1000,2000,4000,10000,20000,50000)),label=format(c(200,400,1000,2000,4000,10000,20000,50000),big.mark="."))
axis(2)
title(xlab="GDP per Person in US Dollars (purchasing power adjusted) (log scale)",ylab="Life expectancy at birth (years)",font=3)
myFit<-lm(X2010.y ~ log10(X2010.x))
myData$resid<-residuals(myFit)
myData$myFit<-fitted(myFit)
myData.sort<-myData[order(-abs(myData$resid)) ,]
myData.sort_begin<-myData.sort[1:5,]
attach(myData.sort_begin)
text(log10(X2010.x),X2010.y,X,cex=0.95,pos=1,offset=0.8)
# Titling
mtext("Gapminder World Map 2010",3,line=3,adj=0,cex=3,family="Lato Black",outer=T)
mtext("More money often leads to longer lives (i.e. better health). ",3,line=0,adj=0,cex=1.75,font=3,outer=T)
mtext("Source: http://www.gapminder.org/",1,line=5.5,adj=1.0,cex=1.55,font=3)
text(log10(30000),72.5,"Population Size",family="Lato Black",cex=1.35,adj=0)
text(log10(65000),70,paste(10*x25," Mio.",sep=""),adj=0)
text(log10(65000),68,paste(10*x75," Mio.",sep=""),adj=0)
text(log10(65000),66,paste(10*xmax," Mio.",sep=""),adj=0)
# Map Legend
library(mapplots)
legend.bubble(log10(45000),67,z=c(x25_leg,x75_leg,xmax_leg*0.7),maxradius=xmax_leg*0.7,bg=NA,txt.cex=0.01,txt.col=NA,pch=21,pt.bg="#00000020",bty="n",round=1)
# Integration of the chart
par(new=T, mai=c(1,9,3.5,0.75))
library(maptools) # contains wrld_simpl
library(rgdal) # for spTransform
data(wrld_simpl)
myW<-wrld_simpl[wrld_simpl@data[,"NAME"] != "Antarctica",]
m<-spTransform(myW,CRS=CRS("+proj=merc"))
myCountries<-m@data$ISO2
n<-length(myCountries)
myMapColours<-numeric(n)
myR1<-"Sub-Saharan Africa"
myR2<-"South Asia"
myR3<-"Middle East & North Africa"
myR4<-"America"
myR5<-"Europe & Central Asia"
myR6<-"East Asia & Pacific"
myF1<-rgb(0,115,157,150,maxColorValue=255)
myF2<-rgb(158,202,229,150,maxColorValue=255)
myF3<-rgb(84,196,153,150,maxColorValue=255)
myF4<-rgb(255,255,0,150,maxColorValue=255)
myF5<-rgb(246,161,82,150,maxColorValue=255)
myF6<-rgb(255,0,0,150,maxColorValue=255)
myRegion<-c(myR1,myR2,myR3,myR4,myR5,myR6)
myColour<-c(myF1,myF2,myF3,myF4,myF5,myF6)
myRegions<-read.xls("myData/gapminder/regions.xlsx", encoding="latin1")
for (i in 1:length(myRegion))
{
myRegionSelection<-subset(myRegions$ID,myRegions$Group==myRegion[i])
myCountrySelection<-NULL
for (j in 1:length(myRegionSelection)) myCountrySelection<-c(myCountrySelection, trim(as.character(myRegionSelection[j])))
for (j in 1:length(myCountrySelection))
{
myMapColours[grep(paste("^",myCountrySelection[j],"$",sep=""),myCountries)]<-myColour[i]
}
}
plot(m,col=myMapColours,border=F, bg=NA)
mtext("World Regions",3,line=-2,adj=0.5,cex=1.25,family="Lato Black")
29、饼图标签内置、分面（Pie Charts, Labels Inside (Panel)）
library(plotrix)
par(omi=c(0.5,0.5,1,0.5),mai=c(0,0,0,0),xpd=T,mfcol=c(1,4),family="Lato Light",las=1)
# Import data
source("scripts/inc_data_dfg.r")
# Define charts and other elements
for (i in 1:4)
{
plot(1:5,type="n",axes=F,xlab="",ylab="")
values<-c(x[2,i]-y[2,i],y[2,i])
myCircle<-floating.pie(3,3,values,border="white",radius=2.1*sqrt(x[1,i]/max(x[1,])),col=c(myColours1[i],myColours2[i]))
pie.labels(3,3,myCircle,values,bg=NA,border=NA,radius=x[1,i]/max(x[1,]),cex=2,col="white")
if (i==1) pie.labels(3,3,myCircle,c("rejected","granted"),bg=NA,border=NA,radius=1.95,font=3)
text(3,4.7,cex=2,adj=0.5,paste(format(round(100*y[2,i]/x[1,i],1),nsmall=1),"%",sep=" "))
text(3,1.2,labelling[i],cex=2,adj=0.5)
}
# Titling
mtext("DFG grants 2010",3,line=4,adj=0,family="Lato Black",outer=T,cex=2)
mtext("Individual grants by science sector, values in million Euro. Percent values: approval ratio",3,line=1,adj=0,cex=1.35,font=2,outer=T)
mtext("Source: DFG Information Cards 2011, www.dfg.de",1,line=2,adj=1.0,cex=1.1,font=3,outer=T)
30、半个饼图（Seat Distribution (Panel)）
par(omi=c(0.5,0.5,1,0.5),mai=c(0,0,0,0),xpd=T,mfcol=c(1,2),family="Lato Light")
library(plotrix)
# Define chart
plot(1:5,type="n",axes=F,xlab="",ylab="",xlim=c(1,5),ylim=c(1,10))
mySeats<-c(51,54,61,222,226)
myDes<-c(mySeats,""); mySlices<-50*mySeats /sum(mySeats)
myValues<-c(mySlices,50); myDisc<-100
MyColour<-c("white", "white", "black", "white", "white")
# Create chart
mySemiCircle<-floating.pie(3,1,myValues,border="white",radius=1.9,xpd=F,col=c("green","pink","yellow","red","black",par("bg")))
pie.labels(3,1,mySemiCircle,myDes,bg=NA,border=NA,radius=1.5,cex=2,col=MyColour)
floating.pie(3,1,myDisc,border="white",col=par("bg"),radius=0.7,xpd=F)
mtext("16th German Bundestag",3,line=0,adj=0.5,font=3,cex=1.3)
par(xpd=T)
legend(1,0.5,c("Union (CDU/CSU)","Socialist Party (SPD)","Free Democratic Party (FDP)","Left Party (Die Linke)"," Alliance '90/The Greens (Bündnis 90/Die Grünen)"),border=F,pch=15,col=c("black","red","yellow","pink","green"),bty="n",cex=0.7,xpd=NA,ncol=3)
par(xpd=F)
# Define chart
plot(1:5,type="n",axes=F,xlab="",ylab="",xlim=c(1,5),ylim=c(1,10))
mySeats<-c(68,76,93,146,237)
myDes<-c(mySeats,""); mySlices <-50*mySeats/sum(mySeats)
myValues<-c(mySlices,50); myDisc<-100
# Create chart
semicirlce<-floating.pie(3,1,myValues,border="white",radius=1.9,xpd=F,col=c("green","pink","yellow","red","black",par("bg")))
pie.labels(3,1,mySemiCircle,myDes,bg=NA,border=NA,radius=1.5,cex=2,col=MyColour)
floating.pie(3,1,myDisc,border="white",col=par("bg"),radius=0.7,xpd=F)
mtext("17th German Bundestag",3,line=0,adj=0.5,font=3,cex=1.3)
# Titling
mtext("Seat distribution in the German Bundestag",3,line=3,adj=0,family="Lato Black",outer=T,cex=1.8)
mtext("Source: www.bundestag.de",1,line=1,adj=1.0,cex=0.7,font=3,outer=T)
31、简单饼图
par(omi=c(2,0.5,1,0.25),mai=c(0,1.25,0.5,0.5),family="Lato Light",las=1)
library(RColorBrewer)
# Create chart
pie.myData<-c(5.8,27.0,0.2,21.1,12.8,33.1)
energytypes<-c("Nuclear energy:","Coal**:","Others***:","Gas:","Renewable\nenergies****:","Oil:")
names(pie.myData)<-paste(energytypes,pie.myData,"%",sep=" ")
pie(pie.myData,col=brewer.pal(length(pie.myData),"Reds"),border=0,cex=1.75,radius=0.9,init.angle=90)
# Titling
mtext("Global energy mix (including sea and air transport)",3,line=2,adj=0,family="Lato Black",outer=T,cex=2.5)
mtext("Shares of energy sources in the primary energy supply* in percent, 2008",3,line=-0.75,adj=0,cex=1.65,font=3,outer=T)
mtext("* Primary energy sources = primary energy production + imports - exports +/- stock changes",1,line=2,adj=0,cex=1.05,outer=T)
mtext("** Including peat",1,line=3.2,adj=0,cex=1.05,outer=T)
mtext("*** Bio matter, biodegradable waste (excluding industrial waste), water power, geothermal energy, solar, wind, and marine power.",1,line=4.4,adj=0,cex=1.05,outer=T)
mtext("**** Industrial waste and flammable waste that can serve as energy sources and are non-biodegradable",1,line=5.6,adj=0,cex=1.05,outer=T)
mtext("Source: German Federal Agency for Civic Education: keyword 'Enegiemix' [energy mix], www.bpb.de [website in German]",1,line=8,adj=1,cex=1.25,font=3,outer=T)
32、斯贝图（Spie chart）
这个翻译很中式啊~
par(omi=c(0.5,0.5,0.75,0.5),mai=c(0.1,0.1,0.1,0.1),family="Lato Light",las=1)
library(RColorBrewer)
# Import data and prepare chart
x<-read.xls("myData/Healthcare_costs.xlsx",1,encoding="latin1")
attach(x)
n<-nrow(x)
myFactor<-max(sqrt(Acosts60))/0.8
# Define chart and other elements
plot.new()
myC0<-rep(NA,n)
myColours<-brewer.pal(n,"Set3")
for (i in 1:n)
{
par(new=T)
r<-col2rgb(myColours[i])[1]
g<-col2rgb(myColours[i])[2]
b<-col2rgb(myColours[i])[3]
myC0[i]<-rgb(r,g,b,190,maxColorValue=255)
myValue<-format(Total60/1000000,digits=1)
myTotal<-paste(Disease,": ",myValue," Mio. $",sep="")
if (Acosts60[i] == max(Acosts60)) {myDes<-myTotal} else {myDes<-NA}
# Create slices
pie(Patients60,border=NA,radius=sqrt(Acosts60[i])/myFactor,col=myC0,
labels=myDes,cex=1.8)
par(new=T)
r<-col2rgb(myColours[i])[1]
g<-col2rgb(myColours[i])[2]
b<-col2rgb(myColours[i])[3]
myC0[i]<-rgb(r,g,b,maxColorValue=255)
pie(Patients60,border=NA,radius=sqrt(Pcosts60[i])/myFactor,col=myC0,labels=NA)
myC0<-rep(NA,n)
}
# Titling
mtext("The Cost of Getting Sick",3,line=-1,adj=0,cex=3.5,family="Lato Black",outer=T)
mtext("The Medical Expenditure Panel Survey. Age: 60, Total Costs: 41.4 Mio. US $",3,line=-3.6,adj=0,cex=1.75,outer=T)
mtext("Inside: Personal Costs. Outside: Insurer Costs.",1,line=0,adj=0,cex=1.75,outer=T,font=3)
mtext("visualization.geblogs.com/visualization/health_costs/",1,line=0,adj=1.0,cex=1.75,outer=T,font=3)
33、分面雷达图（Radial Polygons (Panel)）
par(mfcol=c(2,3),omi=c(1,0.5,1,0.5),mai=c(0,0,0,0),cex.axis=0.9,cex.lab=1,xpd=T,col.axis="green",col.main="red",family="Lato Light",las=1)
library(plotrix)
library(gdata)
# Import data and prepare chart
myRegions<-read.xls("myData/worldenergymix.xlsx", encoding="latin1")
row.names(myRegions)<-myRegions$Region
myRegions$Region<-NULL
myLabelling<-c("Oil","Coal","Gas","Renewable E.","Nuclear Energy")
myRegions<-myRegions[, c(1,2,3,4,5)]
myLabelling<-myLabelling[c(1,2,3,4,5)]
# Create charts
for (i in 2:nrow(myRegions))
{
radial.plot(rep(100/length(myRegions),length(myRegions)),labels=myLabelling,rp.type="p",main="",line.col="grey",show.grid=T,show.grid.labels=F,radial.lim=c(0,55),poly.col="grey")
radial.plot(myRegions[i,],labels="",rp.type="p",main="",line.col="red",show.grid=F,radial.lim=c(0,55),poly.col="red",add=T)
mtext(row.names(myRegions)[i],line=2,family="Lato Black")
}
# Titling
mtext("World energy mix",line=2,cex=3,family="Lato Black",outer=T,adj=0)
mtext(line=-1,"Shares of different energy types in total energy use",cex=1.5,font=3,outer=T,adj=0)
mtext(side=1, "Source: German Federal Agency for Civic Education: keyword 'Enegiemix' [energy mix], www.bpb.de [website in German]",line=2,cex=1.3,font=3,outer=T,adj=1)
34、Radial Polygons Overlay
par(omi=c(1,0.25,1,1),mai=c(0,2,0,0.5),cex.axis=1.5,cex.lab=1,xpd=T,family="Lato Light",las=1)
library(plotrix)
# Import data and prepare chart
myRegions<-read.xls("myData/worldenergymix.xlsx", encoding="latin1")
myC1<-rgb(80,80,80,155,maxColorValue=255)
myC2<-rgb(255,97,0,155,maxColorValue=255)
myRegions$Region<-NULL
myLabelling<-c("Oil","Coal","Gas","Renewable Energies","Nuclear\nenergy")
# Create chart
radial.plot(myRegions[2:3,],start=1,grid.left=T,labels=myLabelling,rp.type="p",main="",line.col=c(myC1,myC2),poly.col=c(myC1,myC2),show.grid=T,radial.lim=c(0,55),lwd=8)
legend("bottomleft",c("OECD","Asia"),pch=15,col=c(myC1,myC2),bty="n",cex=1.5)
# Titling
mtext(line=3,"Energy mix: OECD and Asia by comparison",cex=2.5,adj=0,family="Lato Black")
mtext(line=1,"All values in percent",cex=1.5,adj=0,font=3)
mtext(side=1,line=2,"Source: German Federal Agency for Civic Education: keyword 'Enegiemix' [energy mix], www.bpb.de [website in German]",cex=1.05,adj=1,font=3,outer=T)
35、相关系数图
library(igraph)
library(RColorBrewer)
# Import data and prepare chart
df0 <- read.csv("myData/reg_flow.csv", stringsAsFactors=FALSE)
df1 <- read.csv("myData/reg_plot.csv", stringsAsFactors=FALSE)
net <- graph_from_data_frame(d=df0, vertices=df1, directed=T)
netm <- get.adjacency(net, attr="flow", sparse=F)
maxvalue<-max(netm)
n<-nrow(netm)
m<-n
par(mfrow=c(n,m), omi=c(1,4,4,2), mai=c(0,0,0,0), family="Lato Light")
mycolor1<-rgb(255,0,210,maxColorValue=255)
mycolor2<-rgb(0,208,226,maxColorValue=255)
# Create chart
for(i in 1:n)
{
for(j in 1:m)
{
plot(1:1, xlim=c(0,1), ylim=c(0,1), type="n", axes=F)
if(i<j) mycolor<-mycolor1
if(i==j) mycolor<-"grey80"
if(i>j) mycolor<-mycolor2
if (i==1) text(0.5,1.2, df1$region[j], cex=2, xpd=NA, adj=0, srt=45, col=mycolor1)
if (j==1) text(-0.1,0.5, df1$region[i], cex=2, xpd=NA, adj=1, col=mycolor2)
rect(0,0,1,1, col="grey95", border=NA)
rect(0,0,1,netm[i,j]/maxvalue, col=mycolor, border=NA)
text(0.5, 0.5, format(round(netm[i,j], 2), nsmall=2), cex=1.5, col="grey40")
}
}
# Titling
mtext("Migration to:", side=3, outer=T, cex=2.5, line=14, col=mycolor1, adj=0)
mtext("Migration from:", side=2, outer=T, cex=2.5, line=25, col=mycolor2, srt=90)
mtext("Migration 2010-2015", side=3, outer=T, cex=3, adj=1, at=0.4, , line=22, col="grey50", family="Lato Black")
mtext("All figures in millions. Data Source: https://github.com/cran/migest/tree/master/inst/vidwp",1,line=2.5, adj=1, at=0.6, font=3, outer=T)
36、和弦图(chord Diagram)
par(omi=c(0.25,0.25,0.25,0.25), mai=c(0,0,0,0), family="Lato Light")
library("circlize")
# Read data and prepare chart
df0 <- read.csv("myData/reg_flow.csv", stringsAsFactors=FALSE)
df1 <- read.csv("myData/reg_plot.csv", stringsAsFactors=FALSE)
circos.par(start.degree = 90, gap.degree = 4, track.margin = c(-0.1, 0.1), points.overflow.warning = FALSE)
par(mar = rep(0, 4))
# Create chart
chordDiagram(x = df0, grid.col = df1$col, transparency = 0.25,
order = df1$region, directional = 1,
direction.type = c("arrows", "diffHeight"), diffHeight = -0.04,
annotationTrack = "grid", annotationTrackHeight = c(0.05, 0.1),
link.arr.type = "big.arrow", link.sort = TRUE, link.largest.ontop = TRUE)
circos.trackPlotRegion(
track.index = 1,
bg.border = NA,
panel.fun = function(x, y) {
xlim = get.cell.meta.data("xlim")
sector.index = get.cell.meta.data("sector.index")
reg1 = df1$reg1[df1$region == sector.index]
reg2 = df1$reg2[df1$region == sector.index]
circos.text(x = mean(xlim), y = ifelse(test = nchar(reg2) == 0, yes = 5.2, no = 6.0),
labels = reg1, facing = "bending", cex = 1.2)
circos.text(x = mean(xlim), y = 4.4,
labels = reg2, facing = "bending", cex = 1.2)
circos.axis(h = "top",
major.at = seq(from = 0, to = xlim[2], by = ifelse(test = xlim[2]>10, yes = 2, no = 1)),
minor.ticks = 1, major.tick.length = 0.5,
labels.niceFacing = FALSE)
}
)
circos.clear()
# Titling
text(x = -1.1, y = -1, pos = 4, cex = 0.6,
labels = "Based on estimates from:")
text(x = -1.1, y = -1 - 1*0.03, pos = 4, cex = 0.6,
labels = expression(paste(
plain(" Abel G.J. (2016) "), italic("Estimates of Global Bilateral Migration Flows by Gender")
)))
text(x = -1.1, y = -1 - 2*0.03, pos = 4, cex = 0.6,
labels = expression(paste(
italic(" between 1960 and 2015. "), plain("Vienna Institute of Demography Working Papers. 2/2016")
)))
37、网络图（networks_directed_network）
par(mai=c(0.25,0.25,0.25,0.5),omi=c(0.25,0.25,0.25,0.25),
family="Lato Light",las=1)
library(igraph)
library(RColorBrewer)
# Import data and prepare chart
nodes <- read.csv("myData/reg_plot.csv", header=T, as.is=T)
links <- read.csv("myData/reg_flow.csv", header=T, as.is=T)
links <- links[order(links$orig_reg, links$dest_reg),]
colnames(links)[3] <- "weight"
rownames(links) <- NULL
binnen<-links[links$orig_reg==links$dest_reg, ]
nodes$inside<-binnen$weight[match(nodes$region, binnen$orig_reg)]
net <- graph_from_data_frame(d=links, vertices=nodes, directed=T)
net <- simplify(net, remove.multiple = F, remove.loops = T)
E(net)$width <- E(net)$weight*5
V(net)$size <- sqrt(V(net)$inside*100)
colrs <- brewer.pal(9, "Paired")
V(net)$color <- colrs[V(net)$order1]
edge.start <- ends(net, es=E(net), names=F)[,1]
edge.col <- V(net)$color[edge.start]
# Create chart
plot(net, edge.arrow.size=0, edge.color=edge.col,layout=layout_in_circle(net),
vertex.color=colrs, vertex.frame.color="#ffffff", edge.curved=.1,
vertex.label=V(net)$media, vertex.label.color="black", vertex.label.family="Lato Light")
legend(x=0.8, y=1.25, c("", " 2 M","", " 1 M"), pch=19,xpd=T,title="Internal Migration:",
col="#777777", pt.cex=c(0, sqrt(4),0,sqrt(2)), cex=.8, bty="n", ncol=1)
legend(x=-1.25, y=-1.15, c(" 3 M"," 2 M", " 1 M"), pch=15,xpd=T,horiz=T,
col="#777777", pt.cex=c(sqrt(3),sqrt(2),sqrt(1)), cex=.8, bty="n", ncol=1)
# Titling
mtext("Migration 2010-2015", line=-1.5, adj=0, cex=2, family="Lato Black", col="grey40", outer=T)
mtext("Data Source: https://github.com/cran/migest/tree/master/inst/vidwp", side=1, line=-1, adj=1, cex=0.9, font=3, outer=T)
38、 网络图
par(mai=c(0.25,0.25,0.25,0.5),omi=c(0.25,0.25,0.25,0.25), family="Lato Light",las=1)
library(igraph)
library(sqldf)
library(gdata)
# Import data and prepare chart
X2013_2014 <- read.csv("myData/2013_2014.txt",sep="\t", head=FALSE)
X2014_2015 <- read.csv("myData/2014_2015.txt",sep="\t", head=FALSE)
X2015_2016 <- read.csv("myData/2015_2016.txt",sep="\t", head=FALSE)
links<-rbind(X2013_2014, X2014_2015, X2015_2016)
teams<-as.data.frame(unique(c(links$V1, links$V2)))
teams<-sqldf("select team, count(*) games from (select V1 team from links union all select V2 team from links) a group by team")
teams$col<-"grey55"
teams$col[c(11, 12, 13, 14, 24, 51)]<-"#f768a1"
mySeed = as.POSIXlt(Sys.time())
mySeed = 1000*(mySeed$hour*3600 + mySeed$min*60 + mySeed$sec)
mySeed
set.seed(56313585)
net2 <- graph_from_data_frame(d=links, directed=F, vertices=teams)
net2simp<-simplify(net2, edge.attr.comb=list(weight="sum","ignore"))
# Crete chart
plot(net2simp, vertex.shape="none", vertex.label=V(net2simp)$media, vertex.label.font=2, vertex.label.color=teams$col, vertex.label.cex=0.7*sqrt(teams$games/23), edge.color="grey80", vertex.label.family=ifelse(teams$col=="grey95", "Avenir Next Condensed Ultra Light", "Avenir Next Condensed Demi Bold"))
# Titling
mtext("Champions League - Matches", line=-1.5, adj=0, cex=2, family="Lato Black", col="grey40", outer=T)
mtext("Base: all matches 2013-2016", line=-2.75, adj=0, cex=0.9, family="Lato Bold", col="grey40", outer=T)
mtext("Source: http://www.weltfussball.de/alle_spiele/champions-league-2015-2016/", side=1, line=-1, adj=1, cex=0.9, font=3, outer=T)
39、洛伦兹曲线（Lorenz curve）
par(mai=c(0,0,0,0),omi=c(0.75,0.5,0.85,0.2),pin=c(4,4),family="Lato Light",las=1)
# Read data and prepare chart
library(gdata)
myData<-read.xls("myData/income_ten_classes.xlsx",head=T,skip=1,dec=".",encoding="latin1")
attach(myData)
U<-rep(10,10)
U_cum<-c(0,cumsum(U/100))
U2_cum<-c(0,cumsum(U2/100))
# Define chart and other elements
plot(U_cum,U2_cum,type="n",axes=F,xlab="cumulative percentage of population",ylab="cumulative percentage of income",xlim=c(0,1),ylim=c(0,1))
lines(U_cum,U2_cum,lwd=2)
points(U_cum,U2_cum,pch=19)
x<-array(c(0,1,0,1),dim=c(2,2))
lines(x,lwd=2,col="black")
text(0.08,0.585,"Uniform distribution",adj=c(0,0))
text(0.72,0.265,"Inequality",adj=c(0,0))
arrows(0.4,0.28,0.7,0.28,length=0.10,angle=10,code=1,lwd=2,col="black")
arrows(0.49,0.6,0.6,0.60,length=0.10,angle=10,code=2,lwd=2,col="black")
xx<-c(U_cum,rev(U_cum))
yy<-c(U2_cum,rev(U_cum))
polygon(xx,yy,col=rgb(255,97,0,50,maxColorValue=255),border=F)
source("scripts/inc_axes_with_lines_lorenz.r")
# Titling
mtext("Income Distribution in the USA in 2000",side=3,line=1,cex=1.5,family="Lato Black",adj=0,outer=T)
mtext("(10 classes)",side=3,line=-1.5,cex=1.25,font=3,adj=0,outer=T)
mtext("Source: United Nations University, UNU-WIDER World Income Inequality Database",1,line=1,adj=1,cex=0.85,font=3,outer=T)
40、 比较堆积柱状图-1（Comparison with Bar Chart）
par(omi=c(0.5,0.5,1.1,0.5),mai=c(0,2,0,0.5),family="Lato Light",las=1)
library(fBasics)
library(gdata)
# Read data and prepare chart
myDataFile<-"myData/income_five_classes.xlsx"
myData<-read.xls(myDataFile,head=T,skip=1,dec=".",encoding="latin1")
layout(matrix(c(1,2),ncol=1),heights=c(80,20))
# Create chart
par(mai=c(0,1.75,1,0))
bp1<-barplot(as.matrix(myData),ylim=c(0,6),width=c(0.5),axes=F,horiz=T,col=c("grey",seqPalette(5,"OrRd")[2:5]),border=par("bg"),names.arg=gsub("."," ",names(myData),fixed=T),cex.names=1.55)
# Other elements
mtext(seq(0,100,by=20),at=seq(0,100,by=20),1,line=0,cex=1.15)
arrows(0,-0.03,0,7.30,lwd=1.5,length=0,xpd=T,col="grey")
text(100-(myData[5,]/2),bp1,cex=1.1,labels=paste(round(myData[5,],digits=0),"%",sep=" "),col="white",family="Lato Black",xpd=T)
# Create chart
par(mai=c(0.55,1.75,0,0))
bp2<-barplot(as.matrix(rep(20,5)),ylim=c(0,0.5),width=c(0.20),horiz=T,col=seqPalette(5,"Greys"),border=par("bg"),names.arg=c("Uniform distribution"),axes=F,cex.names=1.25)
# Other elements
arrows(0,-0.01,0,0.35,lwd=1.5,length=0,xpd=T,col="grey")
text(c(10,30,50,70,90),bp2,labels=c("20 %","20 %","20 %","20 %","20 %"),col=c("black","black","white","white","white"),xpd=T)
# Titling
title(main="Income Distribution over five Classes in different Countries",line=3,adj=0,cex.main=2.25,family="Lato Black",outer=T)
myBreak<-strsplit( strwrap("In Mexico the richest 10% of income recipients held over 45% of the overall income in 2000, in the USA
it was 29%, in Germany 24. Compared to 1984 the share did increase.",width=110),"\n")
for(i in seq(along=myBreak))
{
mtext(myBreak[[i]],line=(1.8-i)*1.5,adj=0,side=3,cex=1.25,outer=T)
}
mtext("Source: World Income Inequality Database V2.Oc 2008",side=1,adj=1,cex=0.95,font=3,outer=T)
41、比较堆积柱状图-2（Comparison with Bar Chart）
library(fBasics) # for seqPalette
library(gdata)
layout(matrix(c(1,2,1,2),2,2),heights=c(6,1))
par(omi=c(1,0.5,1.25,0.25),mai=c(0,2.65,0.75,0.25),cex=1.5,family="Lato Light",las=1)
# Read data
myData<-read.xls("myData/income_ten_classes.xlsx",head=T,skip=1,dec=".", encoding="latin1")
# Create chart and other elements
bp1<-barplot(as.matrix(myData),ylim=c(0,3),width=c(0.45),axes=F,horiz=T,col=c("grey",seqPalette(10,"OrRd")[2:10]),border=par("bg"),names.arg=c("2000","1986","2000","1984","2004","1984"))
arrows(0,-0.01,0,3.25,lwd=1.5,length=0,xpd=T,col="grey")
text(100-(myData[10,]/2),bp1,col="white",cex=1.1,family="Lato Black",labels=paste(round(myData[10,],digits=0),"%",sep=" "),xpd=T)
text(-15,bp1[2],"USA",family="Lato Black",adj=1,xpd=T)
text(-15,bp1[4],"Mexico",family="Lato Black",adj=1,xpd=T)
text(-15,bp1[6],"Germany",family="Lato Black",adj=1,xpd=T)
# Create chart and other elements
par(mai=c(0,2.65,0.1,0.25))
bp2<-barplot(as.matrix(rep(10,10)),ylim=c(0,0.5),width=c(0.25),axes=F,horiz=T,col=seqPalette(10,"Greys"),border=par("bg"),names.arg=c("Uniform distribution"))
arrows(0,-0.01,0,0.35,lwd=1.5,length=0,xpd=T,col="grey")
text(95,bp2,labels="10 %",col="white",xpd=T)
mtext(seq(0,100,by=20),at=seq(0,100,by=20),3,line=0,cex=1.15)
# Titling
mtext("Income Distribution over ten Classes in three Countries",line=2,adj=0,cex=2.25,family="Lato Black",outer=T)
myBreak<-strsplit( strwrap("In Mexico the richest 10% of income recipients held over 45% of the overall income in 2000, in the USA
it was 29%, in Germany 24. Compared to 1984 the share did increase.",width=110),"\n")
for(i in seq(along=myBreak))
{
mtext(myBreak[[i]],line=1.8-i,adj=0,side=3,cex=1.25,outer=T)
}
mtext("Source: World Income Inequality Database V2.Oc 2008",1,line=1.5,adj=1,cex=0.95,font=3,outer=T)
42、比较分面柱状图（Comparison with Bar Chart）
par(omi=c(0.5,0.5,1.1,0.5),family="Lato Light",las=1)
layout(matrix(data=c(1,2,3,4,5),nrow=1,ncol=5),widths=c(2.0,1,1,1,1),heights=c(1,1))
library(gdata)
# Read data and prepare chart
myData<-read.xls("myData/income_five_classes.xlsx",skip=1,dec=".", encoding="latin1")
tmyData<-t(myData)
transparency<-c(0,50,100,150,200)
number_colour<-c("black","black","black","black","white")
pos<-c(45,45,45,45,35)
par(cex=1.05)
# Create chart and other elements
for (i in 1:5) {
if (i == 1)
{
par(mai=c(0.25,1.75,0.25,0.15))
bp1<-barplot(tmyData[ ,i],horiz=T,cex.names=1.6,axes=F,names.arg=gsub("."," ",names(myData),fixed=T),xlim=c(0,60),col=rgb(43,15,52,0,maxColorValue=255))
} else
{
par(mai=c(0.25,0.1,0.25,0.15))
bp2<-barplot(tmyData[ ,i],horiz=T,axisnames=F,axes=F,xlim=c(0,60),col=rgb(200,0,0,transparency[i],maxColorValue=255),border=par("bg"))
}
text(pos[i],bp1,adj=1,labels=paste(round(myData[i ,],digits=0),"%",sep=" "),col=number_colour[i],xpd=T,cex=1.3)
mtext(seq(0,60,by=15),at=seq(0,60,by=15),1,line=0,cex=0.85)
arrows(0,-0.1,0,14.6,lwd=2.5,length=0,xpd=T,col="grey")
}
# Titling
title(main="Income Distribution over five Classes in different Countries",line=3,adj=0,cex.main=1.75,family="Lato Black",outer=T)
myBreak<-strsplit( strwrap("In Mexico the richest 20% of income recipients hold over 64% of the overall income, in Norway
the figure is 40%. Compared interntionally Germany is in the upper half.",width=110),"\n")
for(i in seq(along=myBreak))
{
mtext(myBreak[[i]],line=(1.8-i)*1.7,adj=0,side=3,cex=1.25,outer=T)
}
mtext("Source: World Income Inequality Database V2.Oc 2008",1,line=2,adj=1,font=3)
43、人口分布柱状图地图
par(omi=c(0.5,0,0.25,0.25),mai=c(0,0,0,0),lend=2,family="Lato Light",las=1)
library(scatterplot3d)
library(mapdata)
# Import data
dt.map<-map("worldHires","Germany",plot=F)
dt.map2<-map("rivers",plot=F,add=T)
data(world.cities)
Germany<-subset(world.cities,country.etc=="Germany")
attach(Germany)
# Create chart and other elements
s3d<-scatterplot3d(long,lat,pop**0.42,box=F,axis=F,grid=F,scale.y=2.2,mar=c(0,1.5,2,0),type="n",xlim=c(5,15),ylim=c(47,55),zlim=c(0,2000),angle=90,color="grey",pch=20,cex.symbols=2,col.axis="grey",col.grid="grey")
s3d$points3d(dt.map$x,dt.map$y,rep(0,length(dt.map$x)),col="grey",type="l")
s3d$points3d(dt.map2$x,dt.map2$y,rep(0,length(dt.map2$x)),col=rgb(0,0,255,170,maxColorValue=255),type="l")
s3d$points3d(long,lat,pop**0.42,col=rgb(255,0,0,pop**0.36,maxColorValue=255),type="h",lwd=5,pch=" ")
# Titling
mtext("Where we live...",adj=0.0,cex=3.5,line=-5,family="Lato Black",outer=T)
mtext("Source: Richard A. Becker, Allan R. Wilks, worldHires/mapdata, CIA World Data Bank II",1,adj=0.9,cex=1.5,line=0,font=3,outer=T)
44、聚合金字塔（Aggregated Pyramids）
par(mai=c(0.2,0.25,0.8,0.25),omi=c(0.75,0.2,0.85,0.2),cex=0.75,
family="Lato Light",las=1)
# Import data and prepare chart
x<-read.xls("myData/popclass.xlsx", encoding="latin1")
right<-t(as.matrix(data.frame(800,x$F)))
left<--t(as.matrix(data.frame(800,x$M)))
myColour_right<-c(par("bg"),rgb(255,0,210,150,maxColorValue=255))
myColour_left<-c(par("bg"),rgb(191,239,255,maxColorValue=255))
# Create charts and other elements
b1<-barplot(right,axes=F,horiz=T,axis.lty=0,border=NA,col=myColour_right,xlim=c(-8000,8000))
barplot(left,axes=F,horiz=T,axis.lty=0,border=NA,col=myColour_left,xlim=c(-7500,7500),add=T)
abline(v=seq(0,6000,by=2000)+800,col="darkgrey",lty=3)
abline(v=seq(-6000,0,by=2000)-800,col="darkgrey",lty=3)
mtext(format(seq(0,6000,by=2000),big.mark="."),at=seq(0,6000,by=2000)+800,1,line=0,cex=0.95)
mtext(format(abs(seq(-6000,0,by=2000)),big.mark="."),at=seq(-6000,0,by=2000)-800,1,line=0,cex=0.95)
text(0,b1,x$des,cex=1.25,font=3)
mtext("Men",3,line=1,adj=0.25,cex=1.5,col="darkgrey")
mtext("Women",3,line=1,adj=0.75,cex=1.5,col="darkgrey")
# Titling
mtext("Age structure of the population in Germany",3,line=2,adj=0,cex=1.75,family="Lato Black",outer=T)
mtext("Values in thousand per year of age",3,line=-0.5,adj=0,cex=1.25,font=3,outer=T)
mtext("Source: www.destatis.de/bevoelkerungspyramide, own calculations",1,line=2,adj=1.0,cex=0.95,font=3,outer=T)
mtext("...",1,line=2,adj=0,cex=0.95,font=3,outer=T)