Weiterführende formale Demographie — Übung

Weiterführende formale Demographie — Übung
Roland Rau
[email protected]
22. Juni 2015
“Cause-Elimination Life Tables”
In der heutigen Sitzung berechnen wir — wie in der Vorlesung grob gezeigt — sogenannte
“Cause-Eliminated Life Tables”. Damit können wir die Frage analysieren, wie stark die Lebenserwartung steigen würde, wenn man aufgrund einer bestimmten Todesursache nicht sterben würde. Wie realistisch solch ein Szenario ist, wurde schon vorhin kurz in der Vorlesung
diskutiert. Eine (sehr gute) Übersicht über die problematischen Aspekte einer solchen Berechnung wird bei Manton et al. (1991) gegeben.
Die Berechnungen selbst basieren auf den Methoden, wie sie von Kintner (2004) dargelegt
werden (und ein bisschen etwas von Preston et al. (2001)).
Die Daten, die wir heute verwenden basieren auf Daten der “Human Mortality Database”
und des “National Centers for Health Statistics” der USA.
Wie üblich müssen wir zuerst die Daten laden. Diese befinden sich heute in zwei Datensätzen.
Die Sterbefalldaten liegen in deaths-sommer-2015.txt:
sterbe <- read.table("deaths-sommer-2015.txt", header=TRUE, skip=1, sep=",")
head(sterbe)
##
##
##
##
##
##
##
1
2
3
4
5
6
Age Deaths canc resp circ
0 12548
69 278 243
1
866
53
58
47
2
549
46
34
29
3
362
56
20
15
4
313
53
14
15
5
280
45
9
16
Wie Sie sehen, haben wir heute drei verschiedene Todesursachen zur Auswahl:
• canc: bösartige Neubildungen
• resp: Atemwegserkrankungen
• circ: “Diseases of the circulatory system”, also Erkrankungen des Kreislaufsystems.
Dazu gehören Herzkrankheiten ebenso wie der Schlaganfall.
Die Sterbetafel der USA laden wir mittels:
1
ltb <- read.table("ltbusa-sommer-2015.txt", header=TRUE, sep=",")
head(ltb)
##
##
##
##
##
##
##
1
2
3
4
5
6
Year Age
mx
qx
ax
lx dx
Lx
Tx
ex
2006
0 0.00614 0.00610 0.07 100000 610 99433 8064855 80.65
2006
1 0.00043 0.00043 0.50 99390 43 99368 7965422 80.14
2006
2 0.00027 0.00027 0.50 99347 27 99333 7866054 79.18
2006
3 0.00018 0.00018 0.50 99320 18 99310 7766721 78.20
2006
4 0.00016 0.00016 0.50 99301 16 99294 7667410 77.21
2006
5 0.00014 0.00014 0.50 99286 14 99279 7568117 76.23
Der erste Schritt besteht nun darin, festzulegen, welche Todesursache analysiert werden
soll. Ich würde vorschlagen wir nehmen die sogenannten “circulatory diseaes” nachdem wir
in der Vorlesung “cancer” bereits berechnet haben. “Respiratory diseases” können Sie ja dann
freiwillig zu Hause berechnen.
In einem ersten Schritt müssen wir nun die
R−i
x
Dx − Dix
=
Dx
berechnen. Zu diesem Zweck definieren wir zuerst die Dx sowie die Dix :
Dx <- sterbe$Deaths
Dxi <- sterbe$circ
#Dxi <- sterbe$canc
#Dxi <- sterbe$resp
Damit berechnen wir:
R.x.minus.i <- (Dx-Dxi)/Dx
Somit wird die Berechnung der
(−i)
n px
(
R −i)
= n px x
(−i)
n qx
;
(−i)
= 1 − n px
relativ einfach.
px <- 1 - ltb$qx
px.minus.i <- px^(R.x.minus.i)
(−i)
Nun müssen wir die lx
berechnen:
(−i)
lx
(−i)
(−i)
= lx−1 px−1 ;
(−i)
lx=0 = 100, 000
lx <- ltb$lx
lx.minus.i <- rep(0, length(lx))
lx.minus.i[1] <- 100000
for (i in 2:(length(lx.minus.i))) {
lx.minus.i[i] <- lx.minus.i[i-1] * px.minus.i[i-1]
}
2
(−i)
Zur Berechnung der Lx
benötigen wir zuerst die fx -Werte:
n fx
=
nlx − n Lx
lx − lx+n
n <- 1
Lx <- ltb$Lx
fx <- (n * lx - Lx) / (lx - c(lx[-1],0))
(−i)
n Lx
(−i)
= (n − n fx )lx
(−i)
+ n fx lx+n
Lx.minus.i <- (n-fx)*lx.minus.i + fx*c(lx.minus.i[-1],0)
(−i)
In der höchsten Altersstufe berechnen wir n Lx
via:
(−i)
(−i)
Lω
eω lω
=
i
1 − n rω−n
ex <- ltb$ex
omega <- length(ex)
Lx.minus.i[omega] <- (ex[omega]*lx.minus.i[omega]) / ( R.x.minus.i[omega])
Der Rest ist nun “Standard”:
Tx.minus.i <- rev(cumsum(rev(Lx.minus.i)))
ex.minus.i <- Tx.minus.i / lx.minus.i
Der Gewinn in der Lebenserwartung ist damit:
ex.minus.i[1] - ex[1]
## [1] 4.504
Alternativ können wir nun auch noch berechnen, welchen Fehler wir gemacht hätten, wenn
wir einfacherweise a(x) = 0.5 gesetzt hätten und nach Berechnung der p−i
x einfach eine “normale” Sterbetafel berechnet hätten:
px.minus.i <- px^(R.x.minus.i)
lx2 <- ltb$lx
lx.minus.i2 <- rep(0, length(lx2))
lx.minus.i2[1] <- 100000
for (i in 2:(length(lx.minus.i2))) {
lx.minus.i2[i] <- lx.minus.i2[i-1] * px.minus.i[i-1]
}
dx.minus.i2 <- lx.minus.i2 - c(lx.minus.i2[-1],0)
ax <- rep(0.5, length(lx2))
3
Lx.minus.i2 <Tx.minus.i2 <ex.minus.i2 <ex.minus.i2[1]
c(lx.minus.i2[-1] * n,0) + ax * dx.minus.i2
rev(cumsum(rev(Lx.minus.i2)))
Tx.minus.i2 / lx.minus.i2
- ex[1]
## [1] 4.477
Literatur
Kintner, H. J. (2004). The Life Table. In J. B. Siegel and D. A. Swanson (Eds.), The Methods
and Materials of Demography. Second Edition, Chapter 13, pp. 301–340. San Diego, CA:
Elsevier.
Manton, K. G., E. Stallard, and H. D. Tolley (1991). Limits to human life expectancy: Evidence,
prospects, and implications. Population and Development Review 17(4), 603–637.
Preston, S. H., P. Heuveline, and M. Guillot (2001). Demography. Measuring and Modeling
Population Processes. Oxford, UK: Blackwell Publishers.
4

Download Report