Piramida wieku w Polsce a projekt kubek

I dziś ponownie wrócimy do projektu kubek, czyli jak mieć pod ręką różne charakterystyki związane z Polską (więcej informacji tutaj). Dzisiaj napiszę o tym jak powstawał wykres przedstawiający strukturę wieku w Polsce.

Będzie technicznie, będzie kod w R, będzie o kolorach, będzie ciekawie!

Dane

Najlepszym (najbardziej wiarogodnym) źródłem danych o strukturze wieku wydawały się dane zebrane podczas Narodowego Spisu Powszechnego 2011. Ponieważ nie ma publicznego API do danych GUSowych więc trzeba te dane wydzierać porcjami. Ta konkretna porcja została wydarta z raportu pdf i skopiowana do pliku csv dostępnego tutaj.

Wykres

Zacząłem od wersji klasycznej, dwa wykresy pudełkowe sklejone grzbietami, czyli tzw. ,,back to back histogram”.
Z dwom drobnymi modyfikacjami, po pierwsze, aby zobaczyć w której grupie wiekowej jest przewaga kobiet lub mężczyzn kolorem czerwonym zaznaczono ,,nadwyżki”. Widać z nich, że rodzi się więcej chłopców, ale mężczyźni żyją krócej, więc powyżej 60 roku życia widać coraz wyraźniejszą przewagę kobiet. Zaznaczanie nadwyżek ma kilka zalet, widać np. że w grupie 80+ jest dwa razy więcej kobiet niż mężczyzn. Z słupków łatwo też odczytywać proporcje.
Do tego dodałem pionowe białe linie pomocnicze. Ułatwiają one odczytanie poprawne długości paska. Bez tych linii trudno odgadnąć jak długie są te paski (bolączka większości tego typu wykresów).

Ponownie, potrzebowałem kilku dni by zaczęła mi przeszkadzać szarość tego wykresu. W kolejnym podejściu ,,nadwyżki” zaznaczałem wersją ciemniejszą danego koloru, a czas życia podzieliłem na cztery etapy, ,,przedprodukcyjny” (do 18 roku życia), ,,produkcyjny mobilny” (do 44 roku życia, to definicja GUS), ,,produkcyjny niemobilny” (do ,,starej” emerytury), ,,poprodukcyjny”. Dobór kolorów wydawał się intuicyjny, produkcyjność to zieleń, młodość to róż lub błękit, poprodukcyjny okres to złoto.

Po jakimś czasie stwierdziłem jednak, że kolorów jest za dużo i zrezygnowałem z podziału na mobilny i niemobilny podokres okresu produkcyjnego.

Etap ,,konsultacji” w gronie znajomych zakończył się druzgoczącą krytyką ,,seksistowskiej indoktrynacji”, której wyrazem było używanie różowego i błękitnego do kodowania płci. Krytyka ze strony przedstawicieli obu płci przekonała mnie i doprowadziła do ujednolicenia koloru podstawy piramidy (ok, ta nasza piramid wygląda bardziej jak wazon).

Wykończenie polegało na dodaniu kilku szczegółów.
Standardowo zwiększyłem opisy czcionek, dodałem informację o całkowitej liczbie osobników każdej z płci (dzięki temu nie było potrzebne kodowanie kolorami każdej z płci). Powstała poniższa wersja, która trafiła na kubek.

A tutaj jest kod w R, wczytujący dane i rysujący końcową wersję.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33

#
# wczytujemy dane o piramidzie
library(XML)
library(SmarterPoland)
 
piramida <- read.table("http://tofesi.mimuw.edu.pl/~cogito/smarterpoland/projektKubek/piramida.csv",sep=";",h=T)
 
#
# rysujemy wykres
par(mfrow=c(1,2), mar=c(1,1,1,1), oma=c(3,5,1,5),xpd=T)
kolory <- c(rep("violetred3",4), rep("orange3",0), rep("seagreen4",8), rep("gold3",9))
barplot(-piramida[-1,4],horiz=TRUE,xaxt="n",border=kolory,col=kolory,space=0.4,width=0.8)
kolory <- c(rep("violetred1",4), rep("orange2",0), rep("seagreen3",8), rep("gold2",9))
gdzie <- barplot(-pmin(piramida[-1,3],piramida[-1,4]),horiz=TRUE,add=T,xaxt="n",border=kolory,col=kolory,space=0.4,width=0.8)
rect(-piramida[5,4],gdzie[4]+0.2,0,gdzie[5]-0.65,border="seagreen3",col="seagreen3")
abline(v=seq(-250,-1500,-250),col="white",lty="dotted")
abline(v=seq(-500,-1500,-500),col="white",lty=1)
 
axis(1,seq(-1000,0,500),c("1 000k","500k","0"),col="white",col.ticks="black",cex.axis=0.75)
kolory <- c(rep("steelblue3",4), rep("orange3",0), rep("seagreen4",9), rep("gold3",8))
barplot(piramida[-1,3],horiz=TRUE,xaxt="n",xaxt="n",border=kolory,col=kolory,space=0.4,width=0.8)
kolory <- c(rep("steelblue1",4), rep("orange2",0), rep("seagreen3",9), rep("gold2",8))
gdzie <- barplot(pmin(piramida[-1,3],piramida[-1,4]),horiz=TRUE,add=T,xaxt="n",border=kolory,col=kolory,space=0.4,width=0.8)
rect(piramida[5,3],gdzie[4]+0.2,0,gdzie[5]-0.65,border="seagreen4",col="seagreen4")
rect(piramida[5,4],gdzie[4]+0.2,0,gdzie[5]-0.65,border="seagreen3",col="seagreen3")
rect(piramida[15,3],gdzie[14]-0.45,0,gdzie[15]-1.1,border=kolory[12],col=kolory[12])
abline(v=seq(250,1500,250),col="white",lty="dotted")
abline(v=seq(500,1500,500),col="white",lty=1)
axis(1,seq(1000,0,-500),c( "1 000k","500k","0"),col="white",col.ticks="black",cex.axis=0.75)
 
etykiety <- sapply(strsplit(as.character(piramida[-1,1]), split=" "), '[', 1)
par(mfrow=c(1,2), mar=c(1,1,1,1), oma=c(3,5,1,5),xpd=NA)
text(-150,gdzie, etykiety, cex=0.7)