Age-Period-Cohort - Age adjustment: additional plots. See Chapter 3 in Regression and Other Stories.
Load packages
library("rprojroot")
root<-has_file(".ROS-Examples-root")$make_fix_file()
Initialize running the first part
source(root("AgePeriodCohort/births.R"))








par(mar=c(2.5, 3, 3, .2), mgp=c(2,.5,0), tck=-.01)
plot(years_1, number_of_deaths/number_of_people, xaxt="n", type="l", bty="l", xaxs="i", xlab="", ylab="Death rate among non-Hisp whites 45-54", main="Raw death rates\nfor 45-54-year-old non-Hisp whites", cex.main=1.1)
axis(1, seq(1990,2020,5))
grid(col="gray")

par(mar=c(2.5, 3, 3, .2), mgp=c(2,.5,0), tck=-.01)
plot(years_1, avg_age, xaxt="n", type="l", bty="l", xaxs="i", xlab="", ylab="Avg age among non-Hisp whites 45-54", main="But the average age in this group is going up!", cex.main=1.1)
axis(1, seq(1990,2020,5))
grid(col="gray")

par(mar=c(2.5, 3, 3, .2), mgp=c(2,.5,0), tck=-.01)
plot(years_1, number_of_deaths/number_of_people, xaxt="n", type="l", bty="l", xaxs="i", xlab="", ylab="Death rate for 45-54 non-Hisp whites", main="The trend in raw death rates since 2005\ncan be explained by age-aggregation bias", cex.main=1.1)
lines(years_1, death_rate_extrap_2013, col="green4")
axis(1, seq(1990,2020,5))
text(2003.5, .00395, "Raw death rate", cex=1)
text(2001.5, .00408, "Expected just from\nage shift", col="green4", cex=1)
grid(col="gray")

par(mar=c(2.5, 3, 3, .2), mgp=c(2,.5,0), tck=-.01)
plot(years_1, number_of_deaths/number_of_people, xaxt="n", type="l", bty="l", xaxs="i", xlab="", ylab="Death rate for 45-54 non-Hisp whites", main="The trend in raw death rates since 2005\ncan be explained by age-aggregation bias", cex.main=1.1)
lines(years_1, death_rate_extrap_2013)
axis(1, seq(1990,2020,5))
text(2003.5, .00395, "Raw death rate", cex=1)
text(2001.5, .00408, "Expected just from\nage shift", cex=1)
grid(col="gray")

par(mar=c(2.5, 3, 3, .2), mgp=c(2,.5,0), tck=-.01)
plot(years_1, age_adj_rate_flat/age_adj_rate_flat[1], xaxt="n", type="l", bty="l", xaxs="i", xlab="", ylab="Age-adj death rate, relative to 1999", main="Trend in age-adjusted death rate\nfor 45-54-year-old non-Hisp whites", cex.main=1.1)
axis(1, seq(1990,2020,5))
grid(col="gray")

par(mar=c(2.5, 3, 3, .2), mgp=c(2,.5,0), tck=-.01)
rng <- range(age_adj_rate_flat/age_adj_rate_flat[1], age_adj_rate_1999/age_adj_rate_1999[1], age_adj_rate_2013/age_adj_rate_2013[1])
plot(years_1, age_adj_rate_flat/age_adj_rate_flat[1], ylim=rng, xaxt="n", type="l", bty="l", xaxs="i", xlab="", ylab="Age-adj death rate, relative to 1999", main="It doesn't matter too much what age adjustment\nyou use for 45-54-year-old non-Hisp whites", cex.main=1.1)
lines(years_1, age_adj_rate_1999/age_adj_rate_1999[1], lty=2)
lines(years_1, age_adj_rate_2013/age_adj_rate_2013[1], lty=3)
text(2003, 1.055, "Using 1999\nage dist")
text(2004, 1.030, "Using 2013\nage dist")
axis(1, seq(1990,2020,5))
grid(col="gray")

par(mar=c(2.5, 3, 3, .2), mgp=c(2,.5,0), tck=-.01)
plot(range(years_1), c(1, 1.1), xaxt="n", yaxt="n", type="n", bty="l", xaxs="i", xlab="", ylab="Death rate relative to 1999", main="Age-adjusted death rates for non-Hispanic whites\naged 45-54: Trends for women and men", cex.main=1.1)
lines(years_1, male_avg_death_rate[,2,1]/male_avg_death_rate[1,2,1], col="blue")
lines(years_1, female_avg_death_rate[,2,1]/female_avg_death_rate[1,2,1], col="red")
axis(1, seq(1990,2020,5))
axis(2, seq(1, 1.1, .05))
text(2011.5, 1.068, "Women", col="red", cex=1.2)
text(2010.5, 1.014, "Men", col="blue", cex=1.2)
grid(col="gray")

par(mar=c(2.5, 3, 3, .2), mgp=c(2,.5,0), tck=-.01)
plot(range(years_1), c(1, 1.1), xaxt="n", yaxt="n", type="n", bty="l", xaxs="i", xlab="", ylab="Death rate relative to 1999", main="Age-adjusted death rates for non-Hispanic whites\naged 45-54: Trends for women and men", cex.main=1.1)
lines(years_1, male_avg_death_rate[,2,1]/male_avg_death_rate[1,2,1])
lines(years_1, female_avg_death_rate[,2,1]/female_avg_death_rate[1,2,1])
axis(1, seq(1990,2020,5))
axis(2, seq(1, 1.1, .05))
text(2011.5, 1.068, "Women", cex=1.2)
text(2010.5, 1.014, "Men", cex=1.2)
grid(col="gray")

LS0tCnRpdGxlOiAiUmVncmVzc2lvbiBhbmQgT3RoZXIgU3RvcmllczogQWdlUGVyaW9kQ29ob3J0IgphdXRob3I6ICJBbmRyZXcgR2VsbWFuLCBKZW5uaWZlciBIaWxsLCBBa2kgVmVodGFyaSIKZGF0ZTogImByIGZvcm1hdChTeXMuRGF0ZSgpKWAiCm91dHB1dDoKICBodG1sX2RvY3VtZW50OgogICAgdGhlbWU6IHJlYWRhYmxlCiAgICB0b2M6IHRydWUKICAgIHRvY19kZXB0aDogMgogICAgdG9jX2Zsb2F0OiB0cnVlCiAgICBjb2RlX2Rvd25sb2FkOiB0cnVlCi0tLQpBZ2UtUGVyaW9kLUNvaG9ydCAtIEFnZSBhZGp1c3RtZW50OiBhZGRpdGlvbmFsIHBsb3RzLiAgU2VlIENoYXB0ZXIKMyBpbiBSZWdyZXNzaW9uIGFuZCBPdGhlciBTdG9yaWVzLgoKLS0tLS0tLS0tLS0tLQoKCmBgYHtyIHNldHVwLCBpbmNsdWRlPUZBTFNFfQprbml0cjo6b3B0c19jaHVuayRzZXQobWVzc2FnZT1GQUxTRSwgZXJyb3I9RkFMU0UsIHdhcm5pbmc9RkFMU0UsIGNvbW1lbnQ9TkEpCiMgc3dpdGNoIHRoaXMgdG8gVFJVRSB0byBzYXZlIGZpZ3VyZXMgaW4gc2VwYXJhdGUgZmlsZXMKc2F2ZWZpZ3MgPC0gRkFMU0UKYGBgCgoqKkxvYWQgcGFja2FnZXMqKgoKYGBge3IgfQpsaWJyYXJ5KCJycHJvanJvb3QiKQpyb290PC1oYXNfZmlsZSgiLlJPUy1FeGFtcGxlcy1yb290IikkbWFrZV9maXhfZmlsZSgpCmBgYAoKKipJbml0aWFsaXplIHJ1bm5pbmcgdGhlIGZpcnN0IHBhcnQqKgoKYGBge3IgcmVzdWx0cz0naGlkZSd9CnNvdXJjZShyb290KCJBZ2VQZXJpb2RDb2hvcnQvYmlydGhzLlIiKSkKCmBgYApgYGB7ciBldmFsPUZBTFNFLCBpbmNsdWRlPUZBTFNFfQppZiAoc2F2ZWZpZ3MpIHBkZihyb290KCJBZ2VQZXJpb2RDb2hvcnQvZmlncyIsImZpZzFhLnBkZiIpLCBoZWlnaHQ9NCwgd2lkdGg9NSkKYGBgCmBgYHtyIH0KcGFyKG1hcj1jKDIuNSwgMywgMywgLjIpLCBtZ3A9YygyLC41LDApLCB0Y2s9LS4wMSkKcGxvdCh5ZWFyc18xLCAgbnVtYmVyX29mX2RlYXRocy9udW1iZXJfb2ZfcGVvcGxlLCB4YXh0PSJuIiwgdHlwZT0ibCIsIGJ0eT0ibCIsIHhheHM9ImkiLCB4bGFiPSIiLCB5bGFiPSJEZWF0aCByYXRlIGFtb25nIG5vbi1IaXNwIHdoaXRlcyA0NS01NCIsIG1haW49IlJhdyBkZWF0aCByYXRlc1xuZm9yIDQ1LTU0LXllYXItb2xkIG5vbi1IaXNwIHdoaXRlcyIsIGNleC5tYWluPTEuMSkKYXhpcygxLCBzZXEoMTk5MCwyMDIwLDUpKQpncmlkKGNvbD0iZ3JheSIpCmBgYApgYGB7ciBldmFsPUZBTFNFLCBpbmNsdWRlPUZBTFNFfQppZiAoc2F2ZWZpZ3MpIGRldi5vZmYoKQoKYGBgCmBgYHtyIGV2YWw9RkFMU0UsIGluY2x1ZGU9RkFMU0V9CmlmIChzYXZlZmlncykgcGRmKHJvb3QoIkFnZVBlcmlvZENvaG9ydC9maWdzIiwiZmlnMWIucGRmIiksIGhlaWdodD00LCB3aWR0aD01KQpgYGAKYGBge3IgfQpwYXIobWFyPWMoMi41LCAzLCAzLCAuMiksIG1ncD1jKDIsLjUsMCksIHRjaz0tLjAxKQpwbG90KHllYXJzXzEsIGF2Z19hZ2UsIHhheHQ9Im4iLCB0eXBlPSJsIiwgYnR5PSJsIiwgeGF4cz0iaSIsIHhsYWI9IiIsIHlsYWI9IkF2ZyBhZ2UgYW1vbmcgbm9uLUhpc3Agd2hpdGVzIDQ1LTU0IiwgbWFpbj0iQnV0IHRoZSBhdmVyYWdlIGFnZSBpbiB0aGlzIGdyb3VwIGlzIGdvaW5nIHVwISIsIGNleC5tYWluPTEuMSkKYXhpcygxLCBzZXEoMTk5MCwyMDIwLDUpKQpncmlkKGNvbD0iZ3JheSIpCmBgYApgYGB7ciBldmFsPUZBTFNFLCBpbmNsdWRlPUZBTFNFfQppZiAoc2F2ZWZpZ3MpIGRldi5vZmYoKQoKYGBgCmBgYHtyIGV2YWw9RkFMU0UsIGluY2x1ZGU9RkFMU0V9CmlmIChzYXZlZmlncykgcGRmKHJvb3QoIkFnZVBlcmlvZENvaG9ydC9maWdzIiwiZmlnMWMucGRmIiksIGhlaWdodD00LCB3aWR0aD01KQpgYGAKYGBge3IgfQpwYXIobWFyPWMoMi41LCAzLCAzLCAuMiksIG1ncD1jKDIsLjUsMCksIHRjaz0tLjAxKQpwbG90KHllYXJzXzEsIG51bWJlcl9vZl9kZWF0aHMvbnVtYmVyX29mX3Blb3BsZSwgeGF4dD0ibiIsIHR5cGU9ImwiLCBidHk9ImwiLCB4YXhzPSJpIiwgeGxhYj0iIiwgeWxhYj0iRGVhdGggcmF0ZSBmb3IgNDUtNTQgbm9uLUhpc3Agd2hpdGVzIiwgbWFpbj0iVGhlIHRyZW5kIGluIHJhdyBkZWF0aCByYXRlcyBzaW5jZSAyMDA1XG5jYW4gYmUgZXhwbGFpbmVkIGJ5IGFnZS1hZ2dyZWdhdGlvbiBiaWFzIiwgY2V4Lm1haW49MS4xKQpsaW5lcyh5ZWFyc18xLCBkZWF0aF9yYXRlX2V4dHJhcF8yMDEzLCBjb2w9ImdyZWVuNCIpCmF4aXMoMSwgc2VxKDE5OTAsMjAyMCw1KSkKdGV4dCgyMDAzLjUsIC4wMDM5NSwgIlJhdyBkZWF0aCByYXRlIiwgY2V4PTEpCnRleHQoMjAwMS41LCAuMDA0MDgsICJFeHBlY3RlZCBqdXN0IGZyb21cbmFnZSBzaGlmdCIsIGNvbD0iZ3JlZW40IiwgY2V4PTEpCmdyaWQoY29sPSJncmF5IikKYGBgCmBgYHtyIGV2YWw9RkFMU0UsIGluY2x1ZGU9RkFMU0V9CmlmIChzYXZlZmlncykgZGV2Lm9mZigpCgpgYGAKYGBge3IgZXZhbD1GQUxTRSwgaW5jbHVkZT1GQUxTRX0KaWYgKHNhdmVmaWdzKSBwZGYocm9vdCgiQWdlUGVyaW9kQ29ob3J0L2ZpZ3MiLCJmaWcxY19ncmF5c2NhbGUucGRmIiksIGhlaWdodD00LCB3aWR0aD01KQpgYGAKYGBge3IgfQpwYXIobWFyPWMoMi41LCAzLCAzLCAuMiksIG1ncD1jKDIsLjUsMCksIHRjaz0tLjAxKQpwbG90KHllYXJzXzEsIG51bWJlcl9vZl9kZWF0aHMvbnVtYmVyX29mX3Blb3BsZSwgeGF4dD0ibiIsIHR5cGU9ImwiLCBidHk9ImwiLCB4YXhzPSJpIiwgeGxhYj0iIiwgeWxhYj0iRGVhdGggcmF0ZSBmb3IgNDUtNTQgbm9uLUhpc3Agd2hpdGVzIiwgbWFpbj0iVGhlIHRyZW5kIGluIHJhdyBkZWF0aCByYXRlcyBzaW5jZSAyMDA1XG5jYW4gYmUgZXhwbGFpbmVkIGJ5IGFnZS1hZ2dyZWdhdGlvbiBiaWFzIiwgY2V4Lm1haW49MS4xKQpsaW5lcyh5ZWFyc18xLCBkZWF0aF9yYXRlX2V4dHJhcF8yMDEzKQpheGlzKDEsIHNlcSgxOTkwLDIwMjAsNSkpCnRleHQoMjAwMy41LCAuMDAzOTUsICJSYXcgZGVhdGggcmF0ZSIsIGNleD0xKQp0ZXh0KDIwMDEuNSwgLjAwNDA4LCAiRXhwZWN0ZWQganVzdCBmcm9tXG5hZ2Ugc2hpZnQiLCBjZXg9MSkKZ3JpZChjb2w9ImdyYXkiKQpgYGAKYGBge3IgZXZhbD1GQUxTRSwgaW5jbHVkZT1GQUxTRX0KaWYgKHNhdmVmaWdzKSBkZXYub2ZmKCkKCmBgYApgYGB7ciBldmFsPUZBTFNFLCBpbmNsdWRlPUZBTFNFfQppZiAoc2F2ZWZpZ3MpIHBkZihyb290KCJBZ2VQZXJpb2RDb2hvcnQvZmlncyIsImZpZzJhLnBkZiIpLCBoZWlnaHQ9NCwgd2lkdGg9NSkKYGBgCmBgYHtyIH0KcGFyKG1hcj1jKDIuNSwgMywgMywgLjIpLCBtZ3A9YygyLC41LDApLCB0Y2s9LS4wMSkKcGxvdCh5ZWFyc18xLCBhZ2VfYWRqX3JhdGVfZmxhdC9hZ2VfYWRqX3JhdGVfZmxhdFsxXSwgeGF4dD0ibiIsIHR5cGU9ImwiLCBidHk9ImwiLCB4YXhzPSJpIiwgeGxhYj0iIiwgeWxhYj0iQWdlLWFkaiBkZWF0aCByYXRlLCByZWxhdGl2ZSB0byAxOTk5IiwgbWFpbj0iVHJlbmQgaW4gYWdlLWFkanVzdGVkIGRlYXRoIHJhdGVcbmZvciA0NS01NC15ZWFyLW9sZCBub24tSGlzcCB3aGl0ZXMiLCBjZXgubWFpbj0xLjEpCmF4aXMoMSwgc2VxKDE5OTAsMjAyMCw1KSkKZ3JpZChjb2w9ImdyYXkiKQpgYGAKYGBge3IgZXZhbD1GQUxTRSwgaW5jbHVkZT1GQUxTRX0KaWYgKHNhdmVmaWdzKSBkZXYub2ZmKCkKCmBgYApgYGB7ciBldmFsPUZBTFNFLCBpbmNsdWRlPUZBTFNFfQppZiAoc2F2ZWZpZ3MpIHBkZihyb290KCJBZ2VQZXJpb2RDb2hvcnQvZmlncyIsImZpZzJiLnBkZiIpLCBoZWlnaHQ9NCwgd2lkdGg9NSkKYGBgCmBgYHtyIH0KcGFyKG1hcj1jKDIuNSwgMywgMywgLjIpLCBtZ3A9YygyLC41LDApLCB0Y2s9LS4wMSkKcm5nIDwtIHJhbmdlKGFnZV9hZGpfcmF0ZV9mbGF0L2FnZV9hZGpfcmF0ZV9mbGF0WzFdLCBhZ2VfYWRqX3JhdGVfMTk5OS9hZ2VfYWRqX3JhdGVfMTk5OVsxXSwgYWdlX2Fkal9yYXRlXzIwMTMvYWdlX2Fkal9yYXRlXzIwMTNbMV0pCnBsb3QoeWVhcnNfMSwgYWdlX2Fkal9yYXRlX2ZsYXQvYWdlX2Fkal9yYXRlX2ZsYXRbMV0sIHlsaW09cm5nLCB4YXh0PSJuIiwgdHlwZT0ibCIsIGJ0eT0ibCIsIHhheHM9ImkiLCB4bGFiPSIiLCB5bGFiPSJBZ2UtYWRqIGRlYXRoIHJhdGUsIHJlbGF0aXZlIHRvIDE5OTkiLCBtYWluPSJJdCBkb2Vzbid0IG1hdHRlciB0b28gbXVjaCB3aGF0IGFnZSBhZGp1c3RtZW50XG55b3UgdXNlIGZvciA0NS01NC15ZWFyLW9sZCBub24tSGlzcCB3aGl0ZXMiLCBjZXgubWFpbj0xLjEpCmxpbmVzKHllYXJzXzEsIGFnZV9hZGpfcmF0ZV8xOTk5L2FnZV9hZGpfcmF0ZV8xOTk5WzFdLCBsdHk9MikKbGluZXMoeWVhcnNfMSwgYWdlX2Fkal9yYXRlXzIwMTMvYWdlX2Fkal9yYXRlXzIwMTNbMV0sIGx0eT0zKQp0ZXh0KDIwMDMsIDEuMDU1LCAiVXNpbmcgMTk5OVxuYWdlIGRpc3QiKQp0ZXh0KDIwMDQsIDEuMDMwLCAiVXNpbmcgMjAxM1xuYWdlIGRpc3QiKQpheGlzKDEsIHNlcSgxOTkwLDIwMjAsNSkpCmdyaWQoY29sPSJncmF5IikKYGBgCmBgYHtyIGV2YWw9RkFMU0UsIGluY2x1ZGU9RkFMU0V9CmlmIChzYXZlZmlncykgZGV2Lm9mZigpCgpgYGAKYGBge3IgZXZhbD1GQUxTRSwgaW5jbHVkZT1GQUxTRX0KaWYgKHNhdmVmaWdzKSBwZGYocm9vdCgiQWdlUGVyaW9kQ29ob3J0L2ZpZ3MiLCJmaWcyYy5wZGYiKSwgaGVpZ2h0PTQsIHdpZHRoPTUpCmBgYApgYGB7ciB9CnBhcihtYXI9YygyLjUsIDMsIDMsIC4yKSwgbWdwPWMoMiwuNSwwKSwgdGNrPS0uMDEpCnBsb3QocmFuZ2UoeWVhcnNfMSksIGMoMSwgMS4xKSwgeGF4dD0ibiIsIHlheHQ9Im4iLCB0eXBlPSJuIiwgYnR5PSJsIiwgeGF4cz0iaSIsIHhsYWI9IiIsIHlsYWI9IkRlYXRoIHJhdGUgcmVsYXRpdmUgdG8gMTk5OSIsIG1haW49IkFnZS1hZGp1c3RlZCBkZWF0aCByYXRlcyBmb3Igbm9uLUhpc3BhbmljIHdoaXRlc1xuYWdlZCA0NS01NDogVHJlbmRzIGZvciB3b21lbiBhbmQgbWVuIiwgY2V4Lm1haW49MS4xKQpsaW5lcyh5ZWFyc18xLCBtYWxlX2F2Z19kZWF0aF9yYXRlWywyLDFdL21hbGVfYXZnX2RlYXRoX3JhdGVbMSwyLDFdLCBjb2w9ImJsdWUiKQpsaW5lcyh5ZWFyc18xLCBmZW1hbGVfYXZnX2RlYXRoX3JhdGVbLDIsMV0vZmVtYWxlX2F2Z19kZWF0aF9yYXRlWzEsMiwxXSwgY29sPSJyZWQiKQpheGlzKDEsIHNlcSgxOTkwLDIwMjAsNSkpCmF4aXMoMiwgc2VxKDEsIDEuMSwgLjA1KSkKdGV4dCgyMDExLjUsIDEuMDY4LCAiV29tZW4iLCBjb2w9InJlZCIsIGNleD0xLjIpCnRleHQoMjAxMC41LCAxLjAxNCwgIk1lbiIsIGNvbD0iYmx1ZSIsIGNleD0xLjIpCmdyaWQoY29sPSJncmF5IikKYGBgCmBgYHtyIGV2YWw9RkFMU0UsIGluY2x1ZGU9RkFMU0V9CmlmIChzYXZlZmlncykgZGV2Lm9mZigpCgpgYGAKYGBge3IgZXZhbD1GQUxTRSwgaW5jbHVkZT1GQUxTRX0KaWYgKHNhdmVmaWdzKSBwZGYocm9vdCgiQWdlUGVyaW9kQ29ob3J0L2ZpZ3MiLCJmaWcyY19ncmF5c2NhbGUucGRmIiksIGhlaWdodD00LCB3aWR0aD01KQpgYGAKYGBge3IgfQpwYXIobWFyPWMoMi41LCAzLCAzLCAuMiksIG1ncD1jKDIsLjUsMCksIHRjaz0tLjAxKQpwbG90KHJhbmdlKHllYXJzXzEpLCBjKDEsIDEuMSksIHhheHQ9Im4iLCB5YXh0PSJuIiwgdHlwZT0ibiIsIGJ0eT0ibCIsIHhheHM9ImkiLCB4bGFiPSIiLCB5bGFiPSJEZWF0aCByYXRlIHJlbGF0aXZlIHRvIDE5OTkiLCBtYWluPSJBZ2UtYWRqdXN0ZWQgZGVhdGggcmF0ZXMgZm9yIG5vbi1IaXNwYW5pYyB3aGl0ZXNcbmFnZWQgNDUtNTQ6IFRyZW5kcyBmb3Igd29tZW4gYW5kIG1lbiIsIGNleC5tYWluPTEuMSkKbGluZXMoeWVhcnNfMSwgbWFsZV9hdmdfZGVhdGhfcmF0ZVssMiwxXS9tYWxlX2F2Z19kZWF0aF9yYXRlWzEsMiwxXSkKbGluZXMoeWVhcnNfMSwgZmVtYWxlX2F2Z19kZWF0aF9yYXRlWywyLDFdL2ZlbWFsZV9hdmdfZGVhdGhfcmF0ZVsxLDIsMV0pCmF4aXMoMSwgc2VxKDE5OTAsMjAyMCw1KSkKYXhpcygyLCBzZXEoMSwgMS4xLCAuMDUpKQp0ZXh0KDIwMTEuNSwgMS4wNjgsICJXb21lbiIsIGNleD0xLjIpCnRleHQoMjAxMC41LCAxLjAxNCwgIk1lbiIsICBjZXg9MS4yKQpncmlkKGNvbD0iZ3JheSIpCmBgYApgYGB7ciBldmFsPUZBTFNFLCBpbmNsdWRlPUZBTFNFfQppZiAoc2F2ZWZpZ3MpIGRldi5vZmYoKQpgYGAKCg==