In these exercises, we build on what you did in the pre-lab exercises, using the “entropy” approximation, and applying the logic to Covid.

Note 1: There were about half-a-million additional Covid deaths in the US in 2020, compared to 3 million that would have been expected without Covid. So the increase in death rates was about 1/6 and we’re going to assume \(\delta = 1/6\).

Note 2: We’re going to use the following naming conventions.

Preliminaries

## Input data and convenience functions
library(data.table)
source("exercise_2_funs.R") ## get.lt() and get.e0()
dt <- fread("exercise_2_data.csv") ## contains baseline hazards 

## Create variables from data
x = dt$x ## age
hx.base = dt$hx ## US all-cause mortality by age in 2019 (without covid)

A. Use full life table to calculate change e0, assuming proportionality

In order to calculate life expectancy without Covid, we use age-specific mortality rates (hazards) fro 2019 US and our function that calculates life expectancy at birth from hazards. Note: If you’re curious about what get.e0() does, just type print(get.e0).

e0.base = get.e0(hx.base) ## [1] 79.11594
print("e0.base")
[1] "e0.base"
print(e0.base)
[1] 79.16156

Now calculate e0.covid.lt, assuming covid is proportional to baseline mortality and using our life-table function to calculate life expectancy from hazards

delta = 1/6 ## increase in hazards at all ages from Covid
e0.covid.lt = get.e0(hx.base * (1 + delta)) ## recalculation with new hazards
print("e0 with covid, life table calculation using proportional covid")
[1] "e0 with covid, life table calculation using proportional covid"
print(e0.covid.lt)
[1] 77.26688

And let’s also calculate drop in e0.

## By how many years does e0 change?
e0.change.lt = e0.covid.lt - e0.base
print("e0 change, life table calculation using proportional covid")
[1] "e0 change, life table calculation using proportional covid"
print(e0.change.lt)
[1] -1.894672

Q1. Did life expectancy decline by 1/6th? If not, how much did it decline by, and what value of entropy does this suggest?

B. Compare to entropy result

We start by getting Lx using our built in functions. Note: we could also calculate sum(lx *log(lx))/sum(lx), but better to use Lx.

lt = get.lt(hx.base) ## using our
x = lt$x
Lx = lt$Lx

Now compute Keyfitz \(H\)

e0 = sum(Lx)
keyfitz.H = -sum(log(Lx)*Lx)/e0 
print(keyfitz.H)
[1] 0.1541554
## Note: you can also calculate entropy as sum(ex*Lx*hx)/e0. If we had
## even finer age groups we would get the same number. With the 1-year
## age groups we get very close.

Q2. What is your estimate of H? Is this close to what you expected in Q1?

-keyfitz.H * delta * e0
[1] -2.033859

Now we can use \(H\) to calculate effect on life expectancy

## calculate estimate of proportional decline
e0.proportional.change.entropy = -keyfitz.H * delta

## convert to estimate of absolute decline
e0.change.entropy = e0.base * e0.proportional.change.entropy
print(e0.change.entropy)
[1] -2.033863

Now let’s compare:

result = c(e0.change.lt = e0.change.lt,
           e0.change.entropy= e0.change.entropy)
print(round(result, 2))
     e0.change.lt e0.change.entropy 
            -1.89             -2.03 

Q3. Does the entropy approximation give exactly the same answer as the life table calculation? Any ideas why they might differ?

C. Using a more realistic schedule

Instead of using proportional assumption, we can use observed age pattern of Covid mortality. For this we will use the “standard” estimated by Goldstein and Lee early in the pandemic.

hx.covid.realistic = dt$hx.covid ## Covid mortality in US
## Note: hx.covid.realistics is based on standard age schedule from
## Goldstein and Lee, rescaled to produce exactly the same number of
## deaths as a 1/6 increase in mortality at all ages.

And now use this hazard schedule to recalculate effect on e0

e0.covid.realistic = get.e0(hx.base + hx.covid.realistic)

## estimated drop
e0.change.realistic = e0.covid.realistic - e0.base

## print out results
result.again = c(e0.change.lt = e0.change.lt,
                 e0.change.entropy= e0.change.entropy,
                 e0.change.realistic = e0.change.realistic)
print(round(result.again, 1))
       e0.change.lt   e0.change.entropy e0.change.realistic 
               -1.9                -2.0                -1.5 

Q4. You should see that life expectancy decline is smaller using the more realistic schedule. Why do you think this might be? Answer before (and after) looking at the plot below.

Here’s a plot to compare the age-schedules

You should see that observed Covid mortality increases by a bit more than proportionately at older ages and a bit less at younger ages. (Although there are many data issues that mean we’re still not that certain about the exact Covid mortality rates.)

You can also double check that the two schedules correspond to the same number of deaths.

Nx.usa <- dt$Nx
print(sum(hx.covid.prop*Nx.usa))
[1] 480524.3
print(sum(hx.covid.realistic*Nx.usa))
[1] 480524.3
## the should match!

Congratulations.

You’ve finished the 2nd set of exercises of Day 2 of the workshop. Only one more to go!

LS0tCnRpdGxlOiAiTW9ydGFsaXR5IEV4ZXJjaXNlcyAyOiBFbnRyb3B5IgphdXRob3I6IEpvc2h1YSBSLiBHb2xkc3RlaW4Kb3V0cHV0OiBodG1sX25vdGVib29rCi0tLQoKSW4gdGhlc2UgZXhlcmNpc2VzLCB3ZSBidWlsZCBvbiB3aGF0IHlvdSBkaWQgaW4gdGhlIHByZS1sYWIgZXhlcmNpc2VzLCB1c2luZyB0aGUgImVudHJvcHkiIGFwcHJveGltYXRpb24sIGFuZCBhcHBseWluZyB0aGUgbG9naWMgdG8gQ292aWQuCgpOb3RlIDE6IFRoZXJlIHdlcmUgYWJvdXQgaGFsZi1hLW1pbGxpb24gYWRkaXRpb25hbCBDb3ZpZCBkZWF0aHMgaW4gdGhlIFVTCmluIDIwMjAsIGNvbXBhcmVkIHRvIDMgbWlsbGlvbiB0aGF0IHdvdWxkIGhhdmUgYmVlbiBleHBlY3RlZAp3aXRob3V0IENvdmlkLiBTbyB0aGUgaW5jcmVhc2UgaW4gZGVhdGggcmF0ZXMgd2FzIGFib3V0IDEvNiBhbmQgd2UncmUgZ29pbmcgdG8gYXNzdW1lICRcZGVsdGEgPSAxLzYkLgoKTm90ZSAyOiBXZSdyZSBnb2luZyB0byB1c2UgdGhlIGZvbGxvd2luZyBuYW1pbmcgY29udmVudGlvbnMuCgoqIHN1ZmZpeCBvZiAiLmx0IiBtZWFucyBpdCdzICBiYXNlZCBvbiB0aGUgY2FsY3VsYXRpb24gb2YgdGhlIGZ1bGwgbGlmZSB0YWJsZSwgYXNzdW1pbmcgcHJvcG9ydGlvbmFsIGNoYW5nZSBpbiBoYXphcmRzCiogc3VmZml4IG9mICAiLmVudHJvcHkiIG1lYW5zIGl0J3MgYmFzZWQgb24gZW50cm9weSBhcHByb3hpbWF0aW9uCiogc3VmZml4IG9mICIucmVhbGlzdGljIiBtZWFucyBpdCdzIGJhc2VkIG9uIGZ1bGwgY2FsY3VsYXRpb24gb2YgbGlmZSB0YWJsZSBhc3N1bWluZyBhIHJlYWxpc3RpYywgbm90LWV4YWN0bHkgcHJvcG9ydGlvbmFsIGluY3JlYXNlIGluIGhhemFyZHMgYXQgYWxsIGFnZXMuCgojIyBQcmVsaW1pbmFyaWVzCgpgYGB7cn0KIyMgSW5wdXQgZGF0YSBhbmQgY29udmVuaWVuY2UgZnVuY3Rpb25zCmxpYnJhcnkoZGF0YS50YWJsZSkKc291cmNlKCJleGVyY2lzZV8yX2Z1bnMuUiIpICMjIGdldC5sdCgpIGFuZCBnZXQuZTAoKQpkdCA8LSBmcmVhZCgiZXhlcmNpc2VfMl9kYXRhLmNzdiIpICMjIGNvbnRhaW5zIGJhc2VsaW5lIGhhemFyZHMgCgojIyBDcmVhdGUgdmFyaWFibGVzIGZyb20gZGF0YQp4ID0gZHQkeCAjIyBhZ2UKaHguYmFzZSA9IGR0JGh4ICMjIFVTIGFsbC1jYXVzZSBtb3J0YWxpdHkgYnkgYWdlIGluIDIwMTkgKHdpdGhvdXQgY292aWQpCmBgYAoKCgojIyAgIEEuIFVzZSBmdWxsIGxpZmUgdGFibGUgdG8gY2FsY3VsYXRlIGNoYW5nZSBlMCwgYXNzdW1pbmcgcHJvcG9ydGlvbmFsaXR5CgoKSW4gb3JkZXIgdG8gY2FsY3VsYXRlIGxpZmUgZXhwZWN0YW5jeSB3aXRob3V0IENvdmlkLCB3ZSB1c2UgYWdlLXNwZWNpZmljIG1vcnRhbGl0eSByYXRlcyAoaGF6YXJkcykgZnJvIDIwMTkgVVMgYW5kIG91ciBmdW5jdGlvbiB0aGF0IGNhbGN1bGF0ZXMgbGlmZSBleHBlY3RhbmN5IGF0IGJpcnRoIGZyb20gaGF6YXJkcy4gTm90ZTogSWYgeW91J3JlIGN1cmlvdXMgYWJvdXQgd2hhdCBnZXQuZTAoKSBkb2VzLCBqdXN0IHR5cGUgcHJpbnQoZ2V0LmUwKS4KCmBgYHtyfQplMC5iYXNlID0gZ2V0LmUwKGh4LmJhc2UpICMjIFsxXSA3OS4xMTU5NApwcmludCgiZTAuYmFzZSIpCnByaW50KGUwLmJhc2UpCmBgYAoKTm93IGNhbGN1bGF0ZSBlMC5jb3ZpZC5sdCwgYXNzdW1pbmcgY292aWQgaXMgcHJvcG9ydGlvbmFsIHRvCmJhc2VsaW5lIG1vcnRhbGl0eSBhbmQgdXNpbmcgb3VyIGxpZmUtdGFibGUgZnVuY3Rpb24gdG8gY2FsY3VsYXRlCmxpZmUgZXhwZWN0YW5jeSBmcm9tIGhhemFyZHMKYGBge3J9CmRlbHRhID0gMS82ICMjIGluY3JlYXNlIGluIGhhemFyZHMgYXQgYWxsIGFnZXMgZnJvbSBDb3ZpZAplMC5jb3ZpZC5sdCA9IGdldC5lMChoeC5iYXNlICogKDEgKyBkZWx0YSkpICMjIHJlY2FsY3VsYXRpb24gd2l0aCBuZXcgaGF6YXJkcwpwcmludCgiZTAgd2l0aCBjb3ZpZCwgbGlmZSB0YWJsZSBjYWxjdWxhdGlvbiB1c2luZyBwcm9wb3J0aW9uYWwgY292aWQiKQpwcmludChlMC5jb3ZpZC5sdCkKYGBgCgoKQW5kIGxldCdzIGFsc28gY2FsY3VsYXRlIGRyb3AgaW4gZTAuCgpgYGB7cn0KIyMgQnkgaG93IG1hbnkgeWVhcnMgZG9lcyBlMCBjaGFuZ2U/CmUwLmNoYW5nZS5sdCA9IGUwLmNvdmlkLmx0IC0gZTAuYmFzZQpwcmludCgiZTAgY2hhbmdlLCBsaWZlIHRhYmxlIGNhbGN1bGF0aW9uIHVzaW5nIHByb3BvcnRpb25hbCBjb3ZpZCIpCnByaW50KGUwLmNoYW5nZS5sdCkKYGBgCgo+IFExLiBEaWQgbGlmZSBleHBlY3RhbmN5IGRlY2xpbmUgYnkgMS82dGg/IElmIG5vdCwgaG93IG11Y2ggZGlkIGl0IAo+IGRlY2xpbmUgYnksIGFuZCB3aGF0IHZhbHVlIG9mIGVudHJvcHkgZG9lcyB0aGlzIHN1Z2dlc3Q/CgoKCiMjICAgQi4gQ29tcGFyZSB0byBlbnRyb3B5IHJlc3VsdCAKCldlIHN0YXJ0IGJ5IGdldHRpbmcgTHggdXNpbmcgb3VyIGJ1aWx0IGluIGZ1bmN0aW9ucy4gTm90ZTogd2UgY291bGQgYWxzbyBjYWxjdWxhdGUgc3VtKGx4ICpsb2cobHgpKS9zdW0obHgpLCBidXQgYmV0dGVyIHRvIHVzZSBMeC4KCmBgYHtyfQpsdCA9IGdldC5sdChoeC5iYXNlKSAjIyB1c2luZyBvdXIKeCA9IGx0JHgKTHggPSBsdCRMeApgYGAKCk5vdyBjb21wdXRlIEtleWZpdHogJEgkCmBgYHtyfQplMCA9IHN1bShMeCkKa2V5Zml0ei5IID0gLXN1bShsb2coTHgpKkx4KS9lMCAKcHJpbnQoa2V5Zml0ei5IKQoKIyMgTm90ZTogeW91IGNhbiBhbHNvIGNhbGN1bGF0ZSBlbnRyb3B5IGFzIHN1bShleCpMeCpoeCkvZTAuIElmIHdlIGhhZAojIyBldmVuIGZpbmVyIGFnZSBncm91cHMgd2Ugd291bGQgZ2V0IHRoZSBzYW1lIG51bWJlci4gV2l0aCB0aGUgMS15ZWFyCiMjIGFnZSBncm91cHMgd2UgZ2V0IHZlcnkgY2xvc2UuCmBgYAoKPiBRMi4gV2hhdCBpcyB5b3VyIGVzdGltYXRlIG9mIEg/IElzIHRoaXMgY2xvc2UgdG8gd2hhdCB5b3UgZXhwZWN0ZWQgaW4gUTE/CgpgYGB7cn0KLWtleWZpdHouSCAqIGRlbHRhICogZTAKYGBgCgoKTm93IHdlIGNhbiB1c2UgJEgkIHRvIGNhbGN1bGF0ZSBlZmZlY3Qgb24gbGlmZSBleHBlY3RhbmN5CgpgYGB7cn0KIyMgY2FsY3VsYXRlIGVzdGltYXRlIG9mIHByb3BvcnRpb25hbCBkZWNsaW5lCmUwLnByb3BvcnRpb25hbC5jaGFuZ2UuZW50cm9weSA9IC1rZXlmaXR6LkggKiBkZWx0YQoKIyMgY29udmVydCB0byBlc3RpbWF0ZSBvZiBhYnNvbHV0ZSBkZWNsaW5lCmUwLmNoYW5nZS5lbnRyb3B5ID0gZTAuYmFzZSAqIGUwLnByb3BvcnRpb25hbC5jaGFuZ2UuZW50cm9weQpwcmludChlMC5jaGFuZ2UuZW50cm9weSkKYGBgCgpOb3cgbGV0J3MgY29tcGFyZToKCmBgYHtyfQpyZXN1bHQgPSBjKGUwLmNoYW5nZS5sdCA9IGUwLmNoYW5nZS5sdCwKICAgICAgICAgICBlMC5jaGFuZ2UuZW50cm9weT0gZTAuY2hhbmdlLmVudHJvcHkpCnByaW50KHJvdW5kKHJlc3VsdCwgMikpCmBgYAoKPiBRMy4gRG9lcyB0aGUgZW50cm9weSBhcHByb3hpbWF0aW9uIGdpdmUgZXhhY3RseSB0aGUgc2FtZSBhbnN3ZXIgYXMKPiB0aGUgbGlmZSB0YWJsZSBjYWxjdWxhdGlvbj8gQW55IGlkZWFzIHdoeSB0aGV5IG1pZ2h0IGRpZmZlcj8KCiMjIEMuIFVzaW5nIGEgbW9yZSByZWFsaXN0aWMgc2NoZWR1bGUKCkluc3RlYWQgb2YgdXNpbmcgcHJvcG9ydGlvbmFsIGFzc3VtcHRpb24sIHdlIGNhbiB1c2Ugb2JzZXJ2ZWQgYWdlIApwYXR0ZXJuIG9mIENvdmlkIG1vcnRhbGl0eS4gRm9yIHRoaXMgd2Ugd2lsbCB1c2UgdGhlICJzdGFuZGFyZCIgCmVzdGltYXRlZCBieSBHb2xkc3RlaW4gYW5kIExlZSBlYXJseSBpbiB0aGUgcGFuZGVtaWMuCgpgYGB7cn0KaHguY292aWQucmVhbGlzdGljID0gZHQkaHguY292aWQgIyMgQ292aWQgbW9ydGFsaXR5IGluIFVTCiMjIE5vdGU6IGh4LmNvdmlkLnJlYWxpc3RpY3MgaXMgYmFzZWQgb24gc3RhbmRhcmQgYWdlIHNjaGVkdWxlIGZyb20KIyMgR29sZHN0ZWluIGFuZCBMZWUsIHJlc2NhbGVkIHRvIHByb2R1Y2UgZXhhY3RseSB0aGUgc2FtZSBudW1iZXIgb2YKIyMgZGVhdGhzIGFzIGEgMS82IGluY3JlYXNlIGluIG1vcnRhbGl0eSBhdCBhbGwgYWdlcy4KYGBgCgpBbmQgbm93IHVzZSB0aGlzIGhhemFyZCBzY2hlZHVsZSB0byByZWNhbGN1bGF0ZSBlZmZlY3Qgb24gZTAKYGBge3J9CmUwLmNvdmlkLnJlYWxpc3RpYyA9IGdldC5lMChoeC5iYXNlICsgaHguY292aWQucmVhbGlzdGljKQoKIyMgZXN0aW1hdGVkIGRyb3AKZTAuY2hhbmdlLnJlYWxpc3RpYyA9IGUwLmNvdmlkLnJlYWxpc3RpYyAtIGUwLmJhc2UKCiMjIHByaW50IG91dCByZXN1bHRzCnJlc3VsdC5hZ2FpbiA9IGMoZTAuY2hhbmdlLmx0ID0gZTAuY2hhbmdlLmx0LAogICAgICAgICAgICAgICAgIGUwLmNoYW5nZS5lbnRyb3B5PSBlMC5jaGFuZ2UuZW50cm9weSwKICAgICAgICAgICAgICAgICBlMC5jaGFuZ2UucmVhbGlzdGljID0gZTAuY2hhbmdlLnJlYWxpc3RpYykKcHJpbnQocm91bmQocmVzdWx0LmFnYWluLCAxKSkKYGBgCgo+IFE0LiBZb3Ugc2hvdWxkIHNlZSB0aGF0IGxpZmUgZXhwZWN0YW5jeSBkZWNsaW5lIGlzIHNtYWxsZXIgdXNpbmcKPiB0aGUgbW9yZSByZWFsaXN0aWMgc2NoZWR1bGUuIFdoeSBkbyB5b3UgdGhpbmsgdGhpcyBtaWdodCBiZT8gQW5zd2VyCj4gYmVmb3JlIChhbmQgYWZ0ZXIpIGxvb2tpbmcgYXQgdGhlIHBsb3QgYmVsb3cuCgpIZXJlJ3MgYSBwbG90IHRvIGNvbXBhcmUgdGhlIGFnZS1zY2hlZHVsZXMKCmBgYHtyfQoKaHguY292aWQucHJvcCA9IGRlbHRhICogaHguYmFzZSAjIyBDb3ZpZCBtb3J0YWxpdHkgaW4gVVMsIGFzc3VtaW5nIHByb3BvcnRpb25hbCBpbmNyZWFzZQpwYXIobWZyb3cgPSBjKDIsMikpCnBsb3QoeCwgaHguY292aWQucmVhbGlzdGljLCB0eXBlID0gImwiLCBjb2wgPSAiYmx1ZSIsIGx0eSA9IDEsIGxvZyA9ICcnLAogICAgIG1haW4gPSAiQ292aWQgbW9ydGFsaXR5IGVzdGltYXRlcyIpCmxpbmVzKHgsIGh4LmNvdmlkLnByb3AsIGNvbCA9ICJyZWQiLCBsdHk9MikKbGVnZW5kKCJ0b3BsZWZ0IiwKICAgICAgIGxlZ2VuZCA9IGMoIlByb3BvcnRpb25hbCIsCiAgICAgICAgICAgICAgICAgICInUmVhbGlzdGljJyIpLAogICAgICAgY29sID0gYygicmVkIiwgImJsdWUiKSwKICAgICAgIGx0eSA9IGMoMiwxKSwKICAgICAgIGJ0eSA9ICJuIikKIyMgbG9nCnBsb3QoeCwgaHguY292aWQucmVhbGlzdGljLCB0eXBlID0gImwiLCBjb2wgPSAiYmx1ZSIsIGx0eSA9IDEsIGxvZyA9ICd5JywKICAgICBtYWluID0gIkNvdmlkIG1vcnRhbGl0eSBlc3RpbWF0ZXMgKGxvZykiKQpsaW5lcyh4LCBoeC5jb3ZpZC5wcm9wLCBsdHkgPSAyLCBjb2wgPSAicmVkIikKbGVnZW5kKCJ0b3BsZWZ0IiwKICAgICAgIGxlZ2VuZCA9IGMoIlByb3BvcnRpb25hbCIsCiAgICAgICAgICAgICAgICAgICInUmVhbGlzdGljJyIpLAogICAgICAgY29sID0gYygicmVkIiwgImJsdWUiKSwKICAgICAgIGx0eSA9IGMoMiwxKSwKICAgICAgIGJ0eSA9ICJuIikKIyMgTm90ZTogdGhlIGJsdWUgbGluZSBsb29rcyBwZXJmZWN0bHkgc3RyYWlnaHQgYnV0IGluIGFjdHVhbGl0eSBpdCdzIHNsb3BlIGRvZXMgdmFyeSBhIGJpdAojIyB6b29tIGluIG9uIGF0IHNsb3BlcyBvZiBsb2cgcGxvdApwbG90KHhbLTFdLCBkaWZmKGxvZyhoeC5jb3ZpZC5yZWFsaXN0aWMpKSwKICAgICBtYWluID0gIlNsb3BlcyBvZiBsb2cgb2YgXG4gIHJlYWxpc3RpYyBzY2hlZHVsZSIpCgpgYGAKCllvdSBzaG91bGQgc2VlIHRoYXQgb2JzZXJ2ZWQgQ292aWQgbW9ydGFsaXR5IGluY3JlYXNlcyBieSBhIGJpdCBtb3JlIHRoYW4gcHJvcG9ydGlvbmF0ZWx5IGF0IG9sZGVyIGFnZXMgYW5kIGEgYml0IGxlc3MgYXQgeW91bmdlciBhZ2VzLiAoQWx0aG91Z2ggdGhlcmUgYXJlIG1hbnkgZGF0YSBpc3N1ZXMgdGhhdCBtZWFuIHdlJ3JlIHN0aWxsIG5vdCB0aGF0IGNlcnRhaW4gYWJvdXQgdGhlIGV4YWN0IENvdmlkIG1vcnRhbGl0eSByYXRlcy4pCgpZb3UgY2FuIGFsc28gZG91YmxlIGNoZWNrIHRoYXQgdGhlIHR3byBzY2hlZHVsZXMgY29ycmVzcG9uZCB0byB0aGUgc2FtZSBudW1iZXIgb2YgZGVhdGhzLgoKYGBge3J9Ck54LnVzYSA8LSBkdCROeApwcmludChzdW0oaHguY292aWQucHJvcCpOeC51c2EpKQpwcmludChzdW0oaHguY292aWQucmVhbGlzdGljKk54LnVzYSkpCiMjIHRoZSBzaG91bGQgbWF0Y2ghCmBgYAoKIyMgQ29uZ3JhdHVsYXRpb25zLiAKCllvdSd2ZSBmaW5pc2hlZCB0aGUgMm5kIHNldCBvZiBleGVyY2lzZXMgb2YgRGF5IDIgb2YgdGhlIHdvcmtzaG9wLiBPbmx5IG9uZSBtb3JlIHRvIGdvIQoKCg==