R-ohjelmointi.org

Tilastotieteellistä ohjelmointia R-kielellä

Väestöpyramidi

Blogin pitkähkön kesätauon aikana huomasin Jorge Camoen tehneen populaatiopyramideja vähän epätavalliseen tapaan. Pakkohan samaa oli yrittää R:llä!

Suomen väestöhistoria ja -ennuste näyttävät siis Jorge Camoen tyyliin kuvattuna tältä:

Väestötiedot on haettu Tilastokeskuksen tietokannoista (historia, ennuste), ja toteutunut väestöhistoria vuosilta 1980-2010 on talletettu kahteen tiedostoon, miehet.txt ja naiset.txt. Väestöennuste vuosille 2011-2050 on talletettu tiedostoon ennuste.txt. Käyriä on itse asiassa vähän siloiteltu liukuvalla mediaanilla kauniimman kuvan aikaansaamiseksi.

Kuvan piirtämiseen käytetty R-koodi on kyllä hieman pitkä, mutta hoitaa tehtävänsä:

pdf("population.pdf", width=210/25.4, height=210/25.4)
 
m<-read.table("miehet.txt", header=T, sep="\t")
n<-read.table("naiset.txt", header=T, sep="\t")
 
par(bg="black", lend=1)
plot(m[,2], dat$age, col="black", xlim=c(-50000,50000), las=1)
abline(v=0, col="grey50")
for(i in 1:31) {
   cols<-rgb(250,20+i*3,0,alpha=200, max=255)
   lines(runmed(m[,i+1], 5), dat$age, type="l", col=cols, xlim=c(-50000, 50000), las=1, lwd=2)
   lines(runmed(-n[,i+1], 5), dat$age, type="l", col=cols, xlim=c(-50000, 50000), lwd=2)
}
 
e<-read.table("ennuste.txt", header=T, sep="\t")
em<-e[,substr(colnames(e), 1, 6)=="Miehet"]
en<-e[,substr(colnames(e), 1, 6)=="Naiset"]
 
for(i in 1:40) {
   cols<-rgb(250,113+i*3,0,alpha=200, max=255)
   lines(runmed(em[,i], 5), dat$age, type="l", col=cols, xlim=c(-50000, 50000), las=1, lwd=2)
   lines(runmed(-en[,i], 5), dat$age, type="l", col=cols, xlim=c(-50000, 50000), lwd=2)
}
 
axis(side=2, font=2, col="grey50", col.ticks="grey50", lwd=3, las=1, col.axis="grey50", cex.axis=1)
mtext(text="Age", side=2, at=50, col="grey50", cex=1, las=1, line=2, font=2)
 
axis(side=1, font=2, col="grey50", col.ticks="grey50", lwd=3, las=1, col.axis="grey50", cex.axis=1)
mtext(text="Inhabitants", side=1, at=50, col="grey50", cex=1, las=1, line=2, font=2)
 
text(x=-10000, y=5, labels="female", col="grey50", cex=1.5, font=2)
text(x=10000, y=5, labels="male", col="grey50", cex=1.5, font=2)
 
title(main="Finland", cex.main=2, col.main="grey50")
 
cols<-rep(NA, 71)
for(i in 1:71) {
   cols[i]<-rgb(250, 20+i*3, 0, alpha=200, max=255)
}
 
for(i in 1:71) {
   lines(x=c(47500,50000), y=c(75+20/71*i, 75+20/71*i), col=cols[i], lwd=3)
}
text(x=48750, y=72.5, labels="1980", col="grey50")
text(x=48750, y=97.5, labels="2050", col="grey50")
 
dev.off()

3 Responses to “Väestöpyramidi”


Vastaa

Sähköpostiosoitettasi ei julkaista. Pakolliset kentät on merkitty *