R-ohjelmointi.org

Tilastotieteellistä ohjelmointia R-kielellä

Kuolleisuustrendit Suomessa 1998-2013

Sydänkuolleisuuden trendeihin liittyvä keskustelu on kerännyt runsaasti kommentteja Turun Sanomien blogissa. Keskustelu on useasti sivunnut tämänkin blogin aihepiiriin kuuluvia menetelmällisiä seikkoja, kuten ikävakiointia. Vaikuttaa siltä, että aineistolle, jossa on esitetty sekä havaitut että vakioidut tai odotetut kuolemat tai kuolleisuusluvut, voisi olla käyttöä laajemminkin. Koska kaikki tarvittava data on avoimena datana saatavilla Tilastokeskuksesta, voidaan kaikki siitä löytyvät diagnoosit- ja diagnoosiryhmät ikävakioida samalla vaivalla kuin vain jokin diagnoosien alajoukkokin. Tämän artikkelin tavoitteena on saattaa aineisto saataville helposti selailtavassa muodossa, enkä analysoi trendejä sen tarkemmin muutamaa esimerkinomaista huomiota lukuunottamatta.

Raakadatan (havaitut kuolemien lukumäärät) ja ”simuloidun” (odotetut kuolemien lukumäärät vuoden 1998 kuolleisuusluvuilla) datan esittäminen samassa kaaviossa mahdollistaa todellisen trendin ja väestön ikääntymisen aiheuttaman (oletuksella ettei kuolleisuus muutu vuosien välillä) odotetun trendin vertaamisen suoraan. Kaikille Tilastokeskuksesta saatavissa oleville diagnooseille tehdyt kaaviot ovat ladattavissa oheisesta linkistä: Havaitut ja odotetut kuolemat. Kokonaiskuolleisuuskaavio (sivu 1) on mielestäni huomiota herättävä: Jos kuolemanvaara olisi pysynyt samalla tasolla kuin vuonna 1998, kuolisi nykyisin vuositasolla noin 17 000 henkeä enemmän kuin tosiasiallisesti kuolee.

Koko ikäryhmäkohtaisen raakadatan ja laskennan tulokset sisältävä taulukko on pakattu ZIP-paketiksi.

TAUSTAA

Kuolleisuuden mittaaminen
Väestön kuolleisuutta voidaan kuvata tai mitata monella eri tavalla. Yksinkertaisin tapa on tarkastella kuolleiden lukumääriä. Tämä antaa kuitenkin mahdollisuuden tehdä harhaanjohtavia johtopäätöksiä, jos väestö samalla ikääntyy. Niinpä kuolleisuutta useimmiten mitataan suhteuttamalla kuolleiden määrä johonkin toiseen lukumäärään, esimerkiksi väestön keskimääräiseen kokoon. Koska suhteutetut luvut jäävät usein pieniksi, on tapana kertoa laskettu suhdeluku esimerkiksi tuhannella, jolloin saadaan kuolleiden lukumäärä tuhatta asukasta kohden.

Tällaista suhdelukua kutsutaan nimellä crude mortality rate (CMR). Tilastokeskuksen kuolemansyy- ja väestörakennetilastojen mukaan vuonna 2013 Suomessa kuoli 51 478 asukasta, ja vuoden keskiväkiluku oli 5 438 972, joten CMR ~ 51478 / 5438972 * 1000 ~ 9.5 / 1000 asukasta.

Jos väestö jaetaan ensin ikäryhmiin, esimerkiksi viiden vuoden välein (0-4, 5-9, … 90-94, 95-), ja kullekin ikäryhmälle lasketaan erikseen oma CMR, saadaan kullekin ikäryhmälle age-specific death rate (ASDR).

Suorassa ikävakioinnissa ASDR-arvot kerrotaan jonkinlaisen vakioväestön vastaavien ikäluokkien väestömäärillä. Tuloksena on standardized death rate (SDR). Käytetty vakioväestö voi olla todellinen tai kuvitteellinen. Esimerkiksi Tilastokeskus on hiljattain siirtynyt käyttämään Eurostatin vakioväestöä.

Sekoittavien tekijöiden huomioiminen epidemiologiassa ja ikävakiointi
Yllä mainittu Turun Sanomien blogin keskustelu on pyörinyt muun muassa aineiston ikävakioinnin ympärillä. Ikävakiointihan on aivan tamanomainen epidemiologinen menetelmä, jonka tarkoituksena on poistaa tuloksista sekoittavien tekijöiden vaikutus. Koska kuolleisuus painottuu selvästi vanhimpiin ikäryhmiin, on ikä eräs sekoittava tekijä, joka on poistettava tuloksista ennen johtopäätösten tekemistä. Muutoin voi olla vaarana päätellä, että kuolleisuuden kasvu johtuu jostakin muusta kuin väestön ikääntymisestä.

Sekoittavia tekijöitä voi olla paljon muitakin kuin ikä, ja nekin voidaan periaatteessa poistaa tuloksista vastaavankaltaisella vakiointimenettelyllä tai tilastollisilla malleilla.

Ikävakioinnin tulkinnasta
Yksinomaan SDR-lukuihin tuijottaminen ei aina ole asiallista. Jos käytetty vakioväestö on kovin erilainen kuin väestö, jossa kuolemat on havaittu, voi vakioitu tulos olla siinä mielessä harhainen, ettei se mahdollista päätelmien tekemistä ajallisista trendeistä. Näin voi käydä, jos käytetty vakioväestö olisi vaikkapa 1860-luvun esiteollisesta Suomesta ja tutkimusväestöt 2000-luvulta. Tällöin voisi olla parasta vertailla vain ikäryhmäkohtaisia ASDR-lukuja.

Lyhyellä aikavälillä tällaista ongelmaa ei yleensä ole, ja silloinkin voidaan vakioväestöksi valita jokin tarkasteluaikavälillä havaittu todellinen väestörakenne (kuten tässä) tai eri vuosien väestöjen yhdistelmä, siis eräänlainen keskiarvoväestö. CDC:n Statistical Note 6 vuodelta 1995 avaa näitä seikkoja tarkemmin.

Näistä syistä johtuen kehotan tulkitsemaan alla olevista tuloksista erityisesti niitä, joissa on esitetty sekä odotetut että havaitut kuolemat, koska tämä vertailu mallintaa vuoden 1998 kuolleisuustilanten muiden vuosien havaittuun väestöön.

Toinen tulkintaan oleellisesti liittyvä seikka on havaintojen lukumäärä. Pienten lukumäärien tapauksessa satunnaisvaihtelu voi olla suurta. Ym. Statistical note ehdottaa, että jos yhtenä aikajaksona havaittujen kuolemien lukumäärä on pienempi kuin 25, on ikävakioitu tulos epäluotettava. Tarkemman arvion saamiseksi olisi tällöin järkevintä yhdistää esimerkiksi useampien vuosien data yhteen.

TULOKSET
Tilastokeskuksen aineisto kattaa tällä hetkellä vuodet 1998-2013. Yksittäisiä diagnooseja tai diagnoosiryhmiä on yhteensä 1828 kpl. Ikävakioitua aineistoa voi tarkastella joko interaktiivisena pylväskaaviona tai tai PDF:nä:

SMR (interaktiivinen)
SMR (PDF)

Yhteenvetona voi sanoa, että kokonaiskuolleisuus on vähentynyt tarkasteluajanjaksolla runsaasti. Tuloksia tulkittaessa kannattaa pitää mielessä, että mukana on suuri määrä sellaisia diagnooseja, joihin väestön ikääntymisellä ei todennäköisesti ole suurta vaikutusta. Tällaisia ovat esimerkiksi monet tartuntataudit ja tapaturmat.

SMR-luvut voidaan esittää myös ikäryhmittäin, jolloin nähdään, miten kuolleisuus on kehittynyt eri ikäryhmissä:

SMR_ikäryhmät_kuvat (PDF)

Trendien hahmottaminen lienee kuitenkin helpompaa, jos samaan kuvaan merkitään sekä havaitut että odotetut kuolemat (laskettu huomioiden vain väestörakenteen muutos):

Havaitut ja odotetut kuolemat (PDF)

Jos näissä kuvissa musta käyrä nousee punaisen yläpuolelle, on sairauden kuolleisuus kasvanut enemmän kuin pelkän väestörakenteen muutoksen perusteella olisi voinut olettaa. Jos taas musta käyrä jää punaisen käyrän alapuolelle, on sairauden kuolleisuus ajan kuluessa pienentynyt.

Trendien hahmottamiseksi voidaan piirtää kaavioihin vain havaittujen ja odotettujen kuolemien lukumäärien erotus:

Odotetut – havaitut kuolemat (interaktiivinen)
Odotetut – havaitut kuolemat (PDF)

Näistä kuvista on jo varsin helppo havaita, että jos kuolemanvaara olisi pysynyt samalla tasolla kuin 1998, mutta vain väestörakenne olisi muuttunut, olisi vuonna 2013 kuollut noin 17 000 henkeä havaittua enemmän. Muutos on itse asiassa todella merkittävä, ja vastaa karkeasti nykyistä vuosittaista nettomaahanmuuttoa. Ilman maahanmuuttoa ja kuolleisuuden vähenemistä Suomen väestö olisi jo pienenemässä. Alla on esitettynä tämä kokonaiskuolleisuuden muutos:

MENETELMÄT

Aineiston hankkiminen
Aineistona tarvitaan Tilastokeskuksen avoimista aineistoista kuolemansyyt, väestörakenne ja Eurostatin vakioväestö.

Nämä aineistot voidaan ladata suoraan R:ään seuraavasti:

# Ladataan paketit
library(pxR)
library(XML)
library(RColorBrewer)
library(gtools)
library(reshape2)
library(rCharts)
library(RColorBrewer)
 
# Ladataan väestö- ja kuolemansyytiedot
v<-as.data.frame(read.px("http://pxnet2.stat.fi/PXWeb/Resources/PX/Databases/StatFin/vrm/vaerak/073_vaerak_tau_109_fi.px", encoding="ISO-8859-1"))
k<-as.data.frame(read.px("http://pxnet2.stat.fi/PXWeb/Resources/PX/Databases/StatFin/ter/ksyyt/050_ksyyt_tau_105.px", encoding="ISO-8859-1"))
 
# Ladataan vakioväestö
vv<-readHTMLTable("http://tilastokeskus.fi/til/ksyyt/2013/ksyyt_2013_2014-12-30_tau_007_fi.html", encoding="UTF8")

Tilastokeskus jakaa aineistonsa PC-Axis-muodossa. Formaattia voi lukea R:ään laajennuspaketin pxR funktioilla. Vakioväestö on HTML-sivulla, joka puolestaan voidaan lukea XML-paketin funktiolla.

Aineisto vaatii hieman esikäsittelyä ennen varsinaista laskentaa. Esimerkiksi väestöaineistosta puuttuvat kuolemansyyaineiston kanssa yhteensopivat viisivuotisikäryhmät. Lisäksi aineistosta suodatetaan esiin mm. vain molempien sukupuolten yhteenlasketut lukumäärät. R:ssä siis seuraavasti:

# Manipuloidaan data sopivaan muotoon
# Koodataan iät ikäryhmiksi
v$Ikä<-as.numeric(gsub(" -", "", v$Ikä))
v$Ikäryhmä<-0
v$Ikäryhmä[v$Ikä>=1 & v$Ikä<=4]<-"1 - 4"
v$Ikäryhmä[v$Ikä>=5 & v$Ikä<=9]<-"5 - 9"
v$Ikäryhmä[v$Ikä>=10 & v$Ikä<=14]<-"10 - 14"
v$Ikäryhmä[v$Ikä>=15 & v$Ikä<=19]<-"15 - 19"
v$Ikäryhmä[v$Ikä>=20 & v$Ikä<=24]<-"20 - 24"
v$Ikäryhmä[v$Ikä>=25 & v$Ikä<=29]<-"25 - 29"
v$Ikäryhmä[v$Ikä>=30 & v$Ikä<=34]<-"30 - 34"
v$Ikäryhmä[v$Ikä>=35 & v$Ikä<=39]<-"35 - 40" # Kirjoitusvirhe, en jaksa korjata, pitäisi olla 35-39
v$Ikäryhmä[v$Ikä>=40 & v$Ikä<=44]<-"40 - 44"
v$Ikäryhmä[v$Ikä>=45 & v$Ikä<=49]<-"45 - 49"
v$Ikäryhmä[v$Ikä>=50 & v$Ikä<=54]<-"50 - 54"
v$Ikäryhmä[v$Ikä>=55 & v$Ikä<=59]<-"55 - 59"
v$Ikäryhmä[v$Ikä>=60 & v$Ikä<=64]<-"60 - 64"
v$Ikäryhmä[v$Ikä>=65 & v$Ikä<=69]<-"65 - 69"
v$Ikäryhmä[v$Ikä>=70 & v$Ikä<=74]<-"70 - 74"
v$Ikäryhmä[v$Ikä>=75 & v$Ikä<=79]<-"75 - 79"
v$Ikäryhmä[v$Ikä>=80 & v$Ikä<=84]<-"80 - 84"
v$Ikäryhmä[v$Ikä>=85 & v$Ikä<=89]<-"85 - 89"
v$Ikäryhmä[v$Ikä>=90 & v$Ikä<=94]<-"90 - 94"
v$Ikäryhmä[v$Ikä>=95]<-"95 -"
 
# Muokataan data laskentaa varten
v2<-v[which(v$Sukupuoli=="Sukupuolet yhteensä" & !is.na(v$Ikä) & v$Alue=="KOKO MAA" & as.numeric(as.character(v$Vuosi))>=1998),]
v2c<-aggregate(v2$value, list(v2$Ikäryhmä, v2$Vuosi), sum)
v2c<-v2c[mixedorder(paste(v2c$Group.1, v2c$Group.2, sep="_")),]
v2c<-v2c[-which(v2c$Group.2==2014),]
 
k2<-k[which(k$Sukupuoli=="Sukupuolet yhteensä" & k$Ikä != "Ikäluokat yhteensä"),]
k2s<-split(k2, k2$Peruskuolemansyy..ICD10.3.merkin.tarkkuus.)
 
vv<-vv[[1]][-22,]
vv$lkm<-gsub(" ", "", gsub(" ", "", as.character(vv[,2])))
 
# Lopputulos
# v2c = vuosi- ja ikäryhmäkohtainen keskiväkiluku
# k2s = diagnooseittain jaettu kuolemansyyaineisto
# vv  = vakioväestö

Muokatun aineiston perusteella lasketaan sekä crude että age-adjusted (standardized) death rate:

# Lasketaan crude ja adjusted mortality rate
# Kullekin diagnoosille
l<-vector("list", length(k2s))
names(l)<-names(k2s)
for(i in 1:length(l)) {
   #i<-688
   d<-cbind(v2c, k2s[i])
   d$CMR<-d[,8]/d$x
   d$SMR<-d$CMR*rep(as.numeric(vv$lkm), each=16)
   d2<-d[,c(1:3,8:10)]
   colnames(d2)<-c("Ikäryhmä", "Vuosi", "Keskiväestö", "Kuolleet", "CMR", "SMR")
   l[[i]]<-d2
}
 
# Lasketaan crude mortality rate lisäksi vuoden 1998 ja 2013 väestöllä
pop1998<-rep(v2c[v2c$Group.2==1998,"x"], each=16)
pop2013<-rep(v2c[v2c$Group.2==2013,"x"], each=16)
for(i in 1:length(l)) {
   d<-l[[i]]
   d$exp1998<-round(d$CMR*pop1998)
   d$exp2013<-round(d$CMR*pop2013)
   d$ero1998<-d$Kuolleet-d$exp1998
   d$ero2013<-d$Kuolleet-d$exp2013
   d$exp<-round(v2c$x*rep(d[d$Vuosi==1998,"CMR"], each=16))
   d$ero<-d$Kuolleet-d$exp
   l[[i]]<-d
}

Lopuksi kirjoitetaan kaikkien diagnoosien tulokset samaan tiedostoon:

# Liitetään kaikki diagnoosit samaan tiedostoon
d<-data.frame(diagnoosi=names(l)[1], l[[1]])
write.table(d, "full_data.csv", col.names=T, row.names=F, sep=";", quote=F)
for(i in 2:length(l)) {
   d<-data.frame(diagnoosi=names(l)[i], l[[i]])
   write.table(d, "full_data.csv", col.names=F, row.names=F, sep=";", quote=F, append=TRUE)
   cat(paste0(i, "\n"))
}

Tuloksena syntyy yli 55 MB:n tiedosto, joka on oheisessa
zip-paketissa (4,4 MB). Sarakkeeseen exp on laskettu odotettu kuolleiden lukumäärä olettaen, että kuolleisuus säilyisi samana kuin vuonna 1998, mutta väestön rakenne olisi muuttunut kuin sen on havaittu muuttuneen. Sarakkeeseen ero on laskettu havaittujen ja oletettujen kuolemien lukumäärien erotus. Jos erotus on suurempi kuin nolla, on sairauden kuolleisuus kasvanut nopeammin kuin pelkän väestön ikärakenteen perusteella olisi voinut olettaa. Negatiiviset luvut puolestaan vastaavat tilannetta, jossa kuolleisuus on kasvanut vähemmän kuin ikärakenteen muutoksen perusteella olisi voinut olettaa. Näissä tapauksissa kuolleisuus on siis käytännössä pienentynyt tarkastellulla aikajaksolla.

Kaikki kuvat, interaktiiviset tai staattiset, on piirretty seuraavalla koodilla. Interaktiiviset kuvat on piirretty laajennuspaketin rCharts-funktioilla, staattiset R:n base-grafiikalla.

 
# Muutetaan data leveään formaattiin (vuodet sarakkeissa, ikäryhmät riveillä)
# Standardized mortality rate
l2<-vector("list", length(l))
names(l2)<-names(l)
for(i in 1:length(l2)) {
   d<-l[[i]]
   #d2<-reshape(d[,c(1,2,9)], v.names = "ero1998", idvar = "Ikäryhmä", timevar = "Vuosi", direction = "wide")
   d2<-reshape(d[,c(1,2,6)], v.names = "SMR", idvar = "Ikäryhmä", timevar = "Vuosi", direction = "wide")
   #d2<-reshape(d[,c(1,2,7)], v.names = "exp1998", idvar = "Ikäryhmä", timevar = "Vuosi", direction = "wide")
   l2[[i]]<-d2
}
 
# Liitetään kaikki diagnoosit samaan tiedostoon
res1<-c()
for(i in 1:length(l2)) {
   d<-data.frame(diagnoosi=names(l2)[i], l2[[i]])
   res1<-rbind(res1, d)
}
 
# Lasketaan yksi rivi kullekin diagnoosille
res2<-data.frame(matrix(ncol=17, nrow=length(l2), data=NA))
colnames(res2)<-c("diagnoosi", paste0("v", 1998:2013))
res2$diagnoosi<-as.character(names(l2))
for(i in 1:length(l2)) {
   res2[i,2:17]<-as.vector(colSums(l2[[i]][-1]))
}
 
# Muokataan data piirrettävään muotoon
res3<-as.data.frame(t(res2[,2:17]))
res3$vuosi<-paste0("v", as.character(1998:2013))
colnames(res3)<-res2$diagnoosi
colnames(res3)<-gsub("Ö", "O", gsub("ö", "o", gsub("Ä", "A", gsub("ä", "a", gsub(" ", "_", colnames(res3))))))
colnames(res3)<-gsub("\\)", "", gsub("\\(", "", colnames(res3)))
colnames(res3)<-gsub("-", "_", colnames(res3))
colnames(res3)<-gsub(",", "_", colnames(res3))
colnames(res3)<-gsub("/", "_", colnames(res3))
colnames(res3)<-gsub(":", "_", colnames(res3))
colnames(res3)<-gsub("'", "_", colnames(res3))
colnames(res3)[ncol(res3)]<-"vuosi"
 
# Piirretään Java-chart
#res4<-res3[,c(1,1829)]
#colnames(res4)<-gsub("_", "", colnames(res4))
colnames(res3)<-substr(colnames(res3), 1, 80)
res3<-res3[,colSums(res3[-ncol(res3)], na.rm=T)!=0]
options(browser="C:\\Program Files (x86)\\Google\\Chrome\\Application\\chrome.exe")
n1 <- rPlot(KUOLLEITA_YHTEENSA_A00_Y89 ~ vuosi, data = res3, type="bar")
n1$addControls("y", value = "Diagnoosi", values = names(res3))
#n1$set(width=1600, height=900)
print(n1)
n1$save('SMR.html', standalone = TRUE)
 
# Muutetaan data leveään formaattiin (vuodet sarakkeissa, ikäryhmät riveillä)
# Standardized mortality rate
l2<-vector("list", length(l))
names(l2)<-names(l)
for(i in 1:length(l2)) {
   d<-l[[i]]
   #d2<-reshape(d[,c(1,2,9)], v.names = "ero1998", idvar = "Ikäryhmä", timevar = "Vuosi", direction = "wide")
   d2<-reshape(d[,c(1,2,6)], v.names = "SMR", idvar = "Ikäryhmä", timevar = "Vuosi", direction = "wide")
   #d2<-reshape(d[,c(1,2,7)], v.names = "exp1998", idvar = "Ikäryhmä", timevar = "Vuosi", direction = "wide")
   l2[[i]]<-d2
}
 
# Liitetään kaikki diagnoosit samaan tiedostoon
res1<-c()
for(i in 1:length(l2)) {
   d<-data.frame(diagnoosi=names(l2)[i], l2[[i]])
   res1<-rbind(res1, d)
}
 
# Lasketaan yksi rivi kullekin diagnoosille
res2<-data.frame(matrix(ncol=17, nrow=length(l2), data=NA))
colnames(res2)<-c("diagnoosi", paste0("v", 1998:2013))
res2$diagnoosi<-as.character(names(l2))
for(i in 1:length(l2)) {
   res2[i,2:17]<-as.vector(colSums(l2[[i]][-1]))
}
 
# Muokataan data piirrettävään muotoon
res3<-as.data.frame(t(res2[,2:17]))
res3$vuosi<-paste0("v", as.character(1998:2013))
colnames(res3)<-res2$diagnoosi
colnames(res3)<-gsub("Ö", "O", gsub("ö", "o", gsub("Ä", "A", gsub("ä", "a", gsub(" ", "_", colnames(res3))))))
colnames(res3)<-gsub("\\)", "", gsub("\\(", "", colnames(res3)))
colnames(res3)<-gsub("-", "_", colnames(res3))
colnames(res3)<-gsub(",", "_", colnames(res3))
colnames(res3)<-gsub("/", "_", colnames(res3))
colnames(res3)<-gsub(":", "_", colnames(res3))
colnames(res3)<-gsub("'", "_", colnames(res3))
colnames(res3)[ncol(res3)]<-"vuosi"
 
# Piirretään Java-chart
#res4<-res3[,c(1,1829)]
#colnames(res4)<-gsub("_", "", colnames(res4))
colnames(res3)<-substr(colnames(res3), 1, 80)
res3<-res3[,colSums(res3[-ncol(res3)], na.rm=T)!=0]
options(browser="C:\\Program Files (x86)\\Google\\Chrome\\Application\\chrome.exe")
n1 <- rPlot(KUOLLEITA_YHTEENSA_A00_Y89 ~ vuosi, data = res3, type="bar")
n1$addControls("y", value = "Diagnoosi", values = names(res3))
#n1$set(width=1600, height=900)
print(n1)
n1$save('SMR.html', standalone = TRUE)
 
# Muutetaan data leveään formaattiin (vuodet sarakkeissa, ikäryhmät riveillä)
# Odotettujen kuolemien määrä vuoden 1998 CMR:llä
l2<-vector("list", length(l))
names(l2)<-names(l)
for(i in 1:length(l2)) {
   d<-l[[i]]
   #d2<-reshape(d[,c(1,2,9)], v.names = "ero1998", idvar = "Ikäryhmä", timevar = "Vuosi", direction = "wide")
   #d2<-reshape(d[,c(1,2,6)], v.names = "SMR", idvar = "Ikäryhmä", timevar = "Vuosi", direction = "wide")
   d2<-reshape(d[,c(1,2,11)], v.names = "exp", idvar = "Ikäryhmä", timevar = "Vuosi", direction = "wide")
   l2[[i]]<-d2
}
 
# Liitetään kaikki diagnoosit samaan tiedostoon
res1<-c()
for(i in 1:length(l2)) {
   d<-data.frame(diagnoosi=names(l2)[i], l2[[i]])
   res1<-rbind(res1, d)
}
 
# Lasketaan yksi rivi kullekin diagnoosille
res2<-data.frame(matrix(ncol=17, nrow=length(l2), data=NA))
colnames(res2)<-c("diagnoosi", paste0("v", 1998:2013))
res2$diagnoosi<-as.character(names(l2))
for(i in 1:length(l2)) {
   res2[i,2:17]<-as.vector(colSums(l2[[i]][-1]))
}
 
# Muokataan data piirrettävään muotoon
res3<-as.data.frame(t(res2[,2:17]))
res3$vuosi<-paste0("v", as.character(1998:2013))
colnames(res3)<-res2$diagnoosi
colnames(res3)<-gsub("Ö", "O", gsub("ö", "o", gsub("Ä", "A", gsub("ä", "a", gsub(" ", "_", colnames(res3))))))
colnames(res3)<-gsub("\\)", "", gsub("\\(", "", colnames(res3)))
colnames(res3)<-gsub("-", "_", colnames(res3))
colnames(res3)<-gsub(",", "_", colnames(res3))
colnames(res3)<-gsub("/", "_", colnames(res3))
colnames(res3)<-gsub(":", "_", colnames(res3))
colnames(res3)<-gsub("'", "_", colnames(res3))
colnames(res3)[ncol(res3)]<-"vuosi"
 
# Piirretään Java-chart
#res4<-res3[,c(1,1829)]
#colnames(res4)<-gsub("_", "", colnames(res4))
colnames(res3)<-substr(colnames(res3), 1, 80)
res3<-res3[,colSums(res3[-ncol(res3)], na.rm=T)!=0]
options(browser="C:\\Program Files (x86)\\Google\\Chrome\\Application\\chrome.exe")
n1 <- rPlot(KUOLLEITA_YHTEENSA_A00_Y89 ~ vuosi, data = res3, type="bar")
n1$addControls("y", value = "Diagnoosi", values = names(res3))
#n1$set(width=1600, height=900)
print(n1)
n1$save('expected_deaths.html', standalone = TRUE)
 
# Muutetaan data leveään formaattiin (vuodet sarakkeissa, ikäryhmät riveillä)
# Odotettujen kuolemien määrä vuoden 1998 CMR:llä
l2<-vector("list", length(l))
names(l2)<-names(l)
for(i in 1:length(l2)) {
   d<-l[[i]]
   #d2<-reshape(d[,c(1,2,9)], v.names = "ero1998", idvar = "Ikäryhmä", timevar = "Vuosi", direction = "wide")
   #d2<-reshape(d[,c(1,2,6)], v.names = "SMR", idvar = "Ikäryhmä", timevar = "Vuosi", direction = "wide")
   d2<-reshape(d[,c(1,2,4)], v.names = "Kuolleet", idvar = "Ikäryhmä", timevar = "Vuosi", direction = "wide")
   l2[[i]]<-d2
}
 
# Liitetään kaikki diagnoosit samaan tiedostoon
res1<-c()
for(i in 1:length(l2)) {
   d<-data.frame(diagnoosi=names(l2)[i], l2[[i]])
   res1<-rbind(res1, d)
}
 
# Lasketaan yksi rivi kullekin diagnoosille
res2<-data.frame(matrix(ncol=17, nrow=length(l2), data=NA))
colnames(res2)<-c("diagnoosi", paste0("v", 1998:2013))
res2$diagnoosi<-as.character(names(l2))
for(i in 1:length(l2)) {
   res2[i,2:17]<-as.vector(colSums(l2[[i]][-1]))
}
 
# Muokataan data piirrettävään muotoon
res3<-as.data.frame(t(res2[,2:17]))
res3$vuosi<-paste0("v", as.character(1998:2013))
colnames(res3)<-res2$diagnoosi
colnames(res3)<-gsub("Ö", "O", gsub("ö", "o", gsub("Ä", "A", gsub("ä", "a", gsub(" ", "_", colnames(res3))))))
colnames(res3)<-gsub("\\)", "", gsub("\\(", "", colnames(res3)))
colnames(res3)<-gsub("-", "_", colnames(res3))
colnames(res3)<-gsub(",", "_", colnames(res3))
colnames(res3)<-gsub("/", "_", colnames(res3))
colnames(res3)<-gsub(":", "_", colnames(res3))
colnames(res3)<-gsub("'", "_", colnames(res3))
colnames(res3)[ncol(res3)]<-"vuosi"
 
# Piirretään Java-chart
#res4<-res3[,c(1,1829)]
#colnames(res4)<-gsub("_", "", colnames(res4))
colnames(res3)<-substr(colnames(res3), 1, 80)
res3<-res3[,colSums(res3[-ncol(res3)], na.rm=T)!=0]
options(browser="C:\\Program Files (x86)\\Google\\Chrome\\Application\\chrome.exe")
n1 <- rPlot(KUOLLEITA_YHTEENSA_A00_Y89 ~ vuosi, data = res3, type="bar")
n1$addControls("y", value = "Diagnoosi", values = names(res3))
#n1$set(width=1600, height=900)
print(n1)
n1$save('observed_deaths.html', standalone = TRUE)
 
# Muutetaan data leveään formaattiin (vuodet sarakkeissa, ikäryhmät riveillä)
# Odotettujen kuolemien määrä vuoden 1998 CMR:llä
l2<-vector("list", length(l))
names(l2)<-names(l)
for(i in 1:length(l2)) {
   d<-l[[i]]
   #d2<-reshape(d[,c(1,2,9)], v.names = "ero1998", idvar = "Ikäryhmä", timevar = "Vuosi", direction = "wide")
   #d2<-reshape(d[,c(1,2,6)], v.names = "SMR", idvar = "Ikäryhmä", timevar = "Vuosi", direction = "wide")
   d2<-reshape(d[,c(1,2,5)], v.names = "CMR", idvar = "Ikäryhmä", timevar = "Vuosi", direction = "wide")
   l2[[i]]<-d2
}
 
# Liitetään kaikki diagnoosit samaan tiedostoon
res1<-c()
for(i in 1:length(l2)) {
   d<-data.frame(diagnoosi=names(l2)[i], l2[[i]])
   res1<-rbind(res1, d)
}
 
# Lasketaan yksi rivi kullekin diagnoosille
res2<-data.frame(matrix(ncol=17, nrow=length(l2), data=NA))
colnames(res2)<-c("diagnoosi", paste0("v", 1998:2013))
res2$diagnoosi<-as.character(names(l2))
for(i in 1:length(l2)) {
   res2[i,2:17]<-as.vector(colSums(l2[[i]][-1]))
}
 
# Muokataan data piirrettävään muotoon
res3<-as.data.frame(t(res2[,2:17]))
res3$vuosi<-paste0("v", as.character(1998:2013))
colnames(res3)<-res2$diagnoosi
colnames(res3)<-gsub("Ö", "O", gsub("ö", "o", gsub("Ä", "A", gsub("ä", "a", gsub(" ", "_", colnames(res3))))))
colnames(res3)<-gsub("\\)", "", gsub("\\(", "", colnames(res3)))
colnames(res3)<-gsub("-", "_", colnames(res3))
colnames(res3)<-gsub(",", "_", colnames(res3))
colnames(res3)<-gsub("/", "_", colnames(res3))
colnames(res3)<-gsub(":", "_", colnames(res3))
colnames(res3)<-gsub("'", "_", colnames(res3))
colnames(res3)[ncol(res3)]<-"vuosi"
 
# Piirretään Java-chart
#res4<-res3[,c(1,1829)]
#colnames(res4)<-gsub("_", "", colnames(res4))
colnames(res3)<-substr(colnames(res3), 1, 80)
res3<-res3[,colSums(res3[-ncol(res3)], na.rm=T)!=0]
options(browser="C:\\Program Files (x86)\\Google\\Chrome\\Application\\chrome.exe")
n1 <- rPlot(KUOLLEITA_YHTEENSA_A00_Y89 ~ vuosi, data = res3, type="bar")
n1$addControls("y", value = "Diagnoosi", values = names(res3))
#n1$set(width=1600, height=900)
print(n1)
n1$save('CMR.html', standalone = TRUE)
 
# PDF:t
# Hirveä nippu kuvia
pdf("Kuolemat_kuvat.pdf", width=297/25.4, height=210/25.4)
for(i in 1:length(l)) {
   d<-l[[i]]
   d[is.na(d)]<-0
   d2<-data.frame(obs=aggregate(d$Kuolleet, list(d$Vuosi), sum)$x, exp=aggregate(d$exp, list(d$Vuosi), sum)$x)
   par(mar=c(5,5,4,2))
   plot(x=1998:2013, y=d2$obs, type="b", lwd=4, xlab="Vuosi", ylab="", ylim=c(0, max(d2)), las=1, main=names(l)[i])
   mtext(side=2, line=4, text="Kuolleet (lkm)")
   grid(lty=1, col="grey75")
   lines(x=1998:2013, y=d2$obs, type="b", lwd=4, col="black")
   lines(x=1998:2013, y=d2$exp, type="b", lwd=4, col="#CC0000")
   legend(x="top", ncol=2, col=c("black", "#CC0000"), lwd=4, legend=c("Havaitut kuolemat", "Odotetut kuolemat"), bg="white", box.col="white")
   box()
}
dev.off()
 
# Hirveä nippu kuvia 2
pdf("SMR_kuvat.pdf", width=297/25.4, height=210/25.4)
for(i in 1:length(l)) {
   d<-l[[i]]
   d[is.na(d)]<-0
   d2<-data.frame(smr=aggregate(d$SMR, list(d$Vuosi), sum)$x)
   par(mar=c(5,5,4,2))
   plot(x=1998:2013, y=d2$smr, type="b", lwd=4, xlab="Vuosi", ylab="", ylim=c(0, max(d2)), las=1, main=names(l)[i])
   mtext(side=2, line=4, text="Ikävakioitu kuolleisuus (/100 000)")
   grid(lty=1, col="grey75")
   lines(x=1998:2013, y=d2$smr, type="b", lwd=4, col="black")
   #lines(x=1998:2013, y=d2$exp, type="b", lwd=4, col="#CC0000")
   #legend(x="top", ncol=2, col=c("black", "#CC0000"), lwd=4, legend=c("Havaitut kuolemat", "Odotetut kuolemat"), bg="white", box.col="white")
   box()
}
dev.off()
 
# Hirveä nippu kuvia 3
# 1-19: vihreät
# 20-39: siniset
# 40-59: violetit
# 60-79: punaiset
# 80-99: mustat
cols<-c(brewer.pal(9, "Greens")[c(3,4,5,7,9)],
        brewer.pal(9, "Blues")[c(3,5,7,9)],
        brewer.pal(9, "Purples")[c(3,5,7,9)],
        brewer.pal(9, "Reds")[c(3,5,7,9)],
        brewer.pal(9, "Greys")[c(3,5,7,9)])
 
cols1<-brewer.pal(9, "Greens")[c(3,4,5,7,9)]
cols2<-brewer.pal(9, "Blues")[c(3,5,7,9)]
cols3<-brewer.pal(9, "Purples")[c(3,5,7,9)]
cols4<-brewer.pal(9, "Reds")[c(3,5,7,9)]
cols5<-brewer.pal(9, "Greys")[c(3,5,7,9)]
 
pdf("SMR_ikäryhmät_kuvat.pdf", width=210/25.4, height=297/25.4)
for(i in 1:length(l)) {
   par(mfrow=c(5,1))
 
   d<-l[[i]]
   d[is.na(d)]<-0
   #d2<-data.frame(smr=aggregate(d$SMR, list(d$Vuosi), sum)$x)
   d2<-reshape(d[,c(1,2,6)], v.names = "SMR", idvar = "Ikäryhmä", timevar = "Vuosi", direction = "wide")
 
   d3<-d2[1:5,]
   par(mar=c(5,5,4,4))
   matplot(t(d3[,-1]), type="l", lty=1, col=cols1, lwd=4, axes=F, xlab="Vuosi", ylab="SMR", main=names(l)[i], ylim=c(0,max(d2[,2:17])))
   grid(lty=1, col="grey75")
   matplot(t(d3[,-1]), type="l", lty=1, col=cols1, lwd=4, axes=F, xlab="Vuosi", ylab="SMR", add=T)
   mtext(side=4, at=d3[,17], text=d3$Ikäryhmä, las=1, cex=0.75, col=cols1)
   axis(side=1, at=c(5,10,15), labels=c("2002", "2007", "2012"), las=1)   
   axis(side=2, las=1)
   box(bty="c")
 
   d3<-d2[6:9,]
   par(mar=c(5,5,4,4))
   matplot(t(d3[,-1]), type="l", lty=1, col=cols2, lwd=4, axes=F, xlab="Vuosi", ylab="SMR", main=names(l)[i], ylim=c(0,max(d2[,2:17])))
   grid(lty=1, col="grey75")
   matplot(t(d3[,-1]), type="l", lty=1, col=cols2, lwd=4, axes=F, xlab="Vuosi", ylab="SMR", add=T)
   mtext(side=4, at=d3[,17], text=d3$Ikäryhmä, las=1, cex=0.75, col=cols2)
   axis(side=1, at=c(5,10,15), labels=c("2002", "2007", "2012"), las=1)   
   axis(side=2, las=1)
   box(bty="c")
 
   d3<-d2[10:13,]
   par(mar=c(5,5,4,4))
   matplot(t(d3[,-1]), type="l", lty=1, col=cols3, lwd=4, axes=F, xlab="Vuosi", ylab="SMR", main=names(l)[i], ylim=c(0,max(d2[,2:17])))
   grid(lty=1, col="grey75")
   matplot(t(d3[,-1]), type="l", lty=1, col=cols3, lwd=4, axes=F, xlab="Vuosi", ylab="SMR", add=T)
   mtext(side=4, at=d3[,17], text=d3$Ikäryhmä, las=1, cex=0.75, col=cols3)
   axis(side=1, at=c(5,10,15), labels=c("2002", "2007", "2012"), las=1)   
   axis(side=2, las=1)
   box(bty="c")
 
   d3<-d2[14:17,]
   par(mar=c(5,5,4,4))
   matplot(t(d3[,-1]), type="l", lty=1, col=cols4, lwd=4, axes=F, xlab="Vuosi", ylab="SMR", main=names(l)[i], ylim=c(0,max(d2[,2:17])))
   grid(lty=1, col="grey75")
   matplot(t(d3[,-1]), type="l", lty=1, col=cols4, lwd=4, axes=F, xlab="Vuosi", ylab="SMR", add=T)
   mtext(side=4, at=d3[,17], text=d3$Ikäryhmä, las=1, cex=0.75, col=cols4)
   axis(side=1, at=c(5,10,15), labels=c("2002", "2007", "2012"), las=1)   
   axis(side=2, las=1)
   box(bty="c")
 
   d3<-d2[18:21,]
   par(mar=c(5,5,4,4))
   matplot(t(d3[,-1]), type="l", lty=1, col=cols5, lwd=4, axes=F, xlab="Vuosi", ylab="SMR", main=names(l)[i], ylim=c(0,max(d2[,2:17])))
   grid(lty=1, col="grey75")
   matplot(t(d3[,-1]), type="l", lty=1, col=cols5, lwd=4, axes=F, xlab="Vuosi", ylab="SMR", add=T)
   mtext(side=4, at=d3[,17], text=d3$Ikäryhmä, las=1, cex=0.75, col=cols5)
   axis(side=1, at=c(5,10,15), labels=c("2002", "2007", "2012"), las=1)   
   axis(side=2, las=1)
   box(bty="c")
 
}
dev.off()
 
# Hirveä nippu kuvia 4
pdf("exp-obs_kuolemat_kuvat.pdf", width=297/25.4, height=210/25.4)
for(i in 1:length(l)) {
   d<-l[[i]]
   d[is.na(d)]<-0
   d2<-data.frame(ero=aggregate(d$ero, list(d$Vuosi), sum)$x)
   par(mar=c(5,5,4,2))
   plot(x=1998:2013, y=d2$ero, type="b", lwd=4, xlab="Vuosi", ylab="", ylim=c(min(d2), max(d2)), las=1, main=names(l)[i])
   mtext(side=2, line=4, text="Kuolleet (lkm)")
   grid(lty=1, col="grey75")
   abline(h=0, col="grey75", lwd=3)
   lines(x=1998:2013, y=d2$ero, type="b", lwd=4, col="black")
   #lines(x=1998:2013, y=d2$exp, type="b", lwd=4, col="#CC0000")
   legend(x="top", ncol=1, col=c("black"), lwd=4, legend=c("Havaittujen ja odotettujen kuolemien erotus"), bg="white", box.col="white")
   box()
}
dev.off()


Vastaa

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