pdf_datei<-"streudiagramme_gapminder.pdf"
cairo_pdf(bg="grey98", pdf_datei,width=13,height=9)

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)

# Daten einlesen und Grafik vorbereiten

gdp<-read.xls("daten/gapminder/indicatorgapmindergdp_per_capita_ppp.xls")
auswahl<-c("X","X2010")
gdp2010<-gdp[auswahl]

exp<-read.xls("daten/gapminder/indicatorlife_expectancy_at_birth.xls")
auswahl<-c("Life.expectancy.at.birth","X2010")
exp2010<-exp[auswahl]

gdpexp2010<-merge(gdp2010,exp2010,by.x="X",by.y="Life.expectancy.at.birth",
	all =T)

pop<-read.xls("daten/gapminder/indicatorgapminderpopulation.xls",dec=".")
auswahl<-c("Total.population","X2010")
pop2010<-pop[auswahl]

gdpexppop2010<-merge(gdpexp2010,pop2010,by.x="X",by.y="Total.population",
	all =T)

regionen<-read.xls("daten/gapminder/regionen.xlsx")

daten<-merge(gdpexppop2010,regionen,by.x="X",by.y="Entity",all =T)
daten<-na.omit(daten)

attach(daten)
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)

groesse<-(X2010)^0.5
daten$groesse<-groesse

alt<-c("Sub-Saharan Africa","South Asia","Middle East &amp; North Africa",
	"America","Europe &amp; Central Asia","East Asia &amp; Pacific")
neu<-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))
farben<-as.character(Group)
for (i in 1:length(alt)) {farben[farben == alt[i]]<-neu[i]}

# Grafik definieren und weitere Elemente

plot(log10(X2010.x),X2010.y,type="n",axes=F,xlab="",ylab="")
points(log10(X2010.x),X2010.y,cex=groesse,pch=19,col=farben,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)

fit<-lm(X2010.y ~ log10(X2010.x))
daten$resid<-residuals(fit)
daten$fit<-fitted(fit)

daten.sort<-daten[order(-abs(daten$resid)) ,]
daten.sort_anfang<-daten.sort[1:5,]

attach(daten.sort_anfang)
text(log10(X2010.x),X2010.y,X,cex=0.95,pos=1,offset=0.8)

# Betitelung

mtext("Gapminder World Map 2010",3,line=3,adj=0,cex=3,family="Lato Black",outer=T)
mtext("More money often seems to lead to longer lives (i.e. better health).",3,line=0,adj=0,cex=1.75,font=3,outer=T)
mtext("Quelle: 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)

# Legende

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)

# Einbindung der Karte 

par(new=T, mai=c(1,9,3.5,0.75))
library(maptools) # enthält wrld_simpl
library(rgdal) # für spTransform

data(wrld_simpl) 
w<-wrld_simpl[wrld_simpl@data[,"NAME"] != "Antarctica",] 
m<-spTransform(w,CRS=CRS("+proj=merc"))

laender<-m@data$ISO2
n<-length(laender) 
kartenfarben<-numeric(n) 

r1<-"Sub-Saharan Africa"
r2<-"South Asia"
r3<-"Middle East &amp; North Africa"
r4<-"America"
r5<-"Europe &amp; Central Asia"
r6<-"East Asia &amp; Pacific"

f1<-rgb(0,115,157,150,maxColorValue=255)
f2<-rgb(158,202,229,150,maxColorValue=255)
f3<-rgb(84,196,153,150,maxColorValue=255)
f4<-rgb(255,255,0,150,maxColorValue=255)
f5<-rgb(246,161,82,150,maxColorValue=255)
f6<-rgb(255,0,0,150,maxColorValue=255)

region<-c(r1,r2,r3,r4,r5,r6)
farbe<-c(f1,f2,f3,f4,f5,f6)

regionen<-read.xls("daten/gapminder/regionen.xlsx")

for (i in 1:length(region)) 
{
regionauswahl<-subset(regionen$ID,regionen$Group==region[i])
laenderauswahl<-NULL
for (j in 1:length(regionauswahl)) laenderauswahl<-c(laenderauswahl, trim(as.character(regionauswahl[j])))
for (j in 1:length(laenderauswahl))
{
kartenfarben[grep(paste("^",laenderauswahl[j],"$",sep=""),laender)]<-farbe[i]
} 
}

plot(m,col=kartenfarben,border=F, bg=NA)
mtext("World Regions",3,line=-2,adj=0.5,cex=1.25,family="Lato Black")

 
dev.off()

