Last active
February 12, 2022 19:48
-
-
Save richarddmorey/f7a18a67f55b8c8db37275ba7db76797 to your computer and use it in GitHub Desktop.
Rip of Lichtenstein et al 1978's table 5 (p. 564) doi:10.1037/0278-7393.4.6.551 (estimates of risks of death from various causes)
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Cause | Rate_outof_205000000 | MVA_geom_mean | MVA_resid | Elec_geom_mean | Elec_resid | |
|---|---|---|---|---|---|---|
| Smallpox | 0.00 | 88.00 | 37.00 | |||
| Poisoning by vitamins | 1.00 | 237.00 | 1.27 | 44.00 | 1.16 | |
| Botulism | 2.00 | 379.00 | 1.97 | 88.00 | 1.96 | |
| Measles | 5.00 | 331.00 | 1.39 | 85.00 | 1.47 | |
| Fireworks | 6.00 | 331.00 | 1.54 | 77.00 | 1.26 | |
| Smallpox vaccination | 8.00 | 38.00 | 0.17 | 14.00 | 0.22 | |
| Whooping cough | 15.00 | 171.00 | 0.69 | 51.00 | 0.62 | |
| Polio | 17.00 | 202.00 | 0.80 | 47.00 | 0.55 | |
| Venomous bite or sting | 48.00 | 535.00 | 1.67 | 233.00 | 1.85 | |
| Tornado | 90.00 | 688.00 | 1.82 | 463.00 | 2.86 | |
| Lightning | 107.00 | 128.00 | 0.32 | 64.00 | 0.37 | |
| Nonvenomous animal | 129.00 | 298.00 | 0.71 | 102.00 | 0.54 | |
| Flood | 205.00 | 863.00 | 1.77 | 627.00 | 2.71 | |
| Excess cold | 334.00 | 468.00 | 0.81 | 211.00 | 0.73 | |
| Syphilis | 410.00 | 717.00 | 1.15 | 338.00 | 1.05 | |
| Pregnancy, childbirth, and abortion | 451.00 | 1932.00 | 2.98 | 935.00 | 2.78 | |
| Infectious hepatitis | 677.00 | 907.00 | 1.19 | 328.00 | 0.80 | |
| Appendicitis | 902.00 | 880.00 | 1.03 | 416.00 | 0.87 | |
| Electrocution | 1025.00 | 586.00 | 0.65 | 1000.00 | 1.96 | |
| Motor-train collision | 1517.00 | 793.00 | 0.74 | 598.00 | 0.95 | |
| Asthma | 1886.00 | 769.00 | 0.65 | 333.00 | 0.47 | |
| Firearms | 2255.00 | 1623.00 | 1.26 | 1114.00 | 1.42 | |
| Poisoning | 2563.00 | 1318.00 | 0.96 | 778.00 | 92.00 | |
| Tuberculosis | 3690.00 | 966.00 | 0.59 | 448.00 | 0.43 | |
| Fire and flames | 7380.00 | 3814.00 | 1.62 | 2918.00 | 1.86 | |
| Drowning | 7380.00 | 1989.00 | 0.85 | 1425.00 | 0.91 | |
| Leukemia | 14555.00 | 2807.00 | 0.81 | 2220.00 | 0.92 | |
| Accidental falls | 17425.00 | 2585.00 | 0.68 | 2768.00 | 1.03 | |
| Homicide | 18860.00 | 8441.00 | 2.10 | 3691.00 | 1.30 | |
| Emphysema | 21730.00 | 3009.00 | 0.69 | 2696.00 | 0.86 | |
| Suicide | 24600.00 | 6675.00 | 1.42 | 3280.00 | 0.97 | |
| Breast cancer | 31160.00 | 3607.00 | 0.66 | 2436.00 | 0.61 | |
| Diabetes | 38950.00 | 2138.00 | 0.34 | 1019.00 | 0.22 | |
| Motor vehicle accident | 55350.00 | 50000.00 | 6.34 | 33884.00 | 5.76 | |
| Lung cancer | 75850.00 | 9723.00 | 1.00 | 9806.00 | 1.33 | |
| Stomach cancer | 95120.00 | 4878.00 | 0.43 | 2209.00 | 0.26 | |
| All accidents | 112750.00 | 86537.00 | 6.77 | 91285.00 | 9.32 | |
| Stroke | 209100.00 | 10668.00 | 0.54 | 4737.00 | 0.31 | |
| All cancer | 328000.00 | 47523.00 | 1.70 | 43772.00 | 2.00 | |
| Heart disease | 738000.00 | 25900.00 | 0.49 | 21503.00 | 0.51 | |
| All disease | 1740450.00 | 80779.00 | 0.75 | 97701.00 | 1.14 |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| library(ggplot2) | |
| library(dplyr) | |
| tens = withr::with_options( | |
| list(scipen=999), | |
| prettyNum(10^(0:10),big.mark = ',') | |
| ) | |
| readr::read_csv('Lichtenstein_etal_Tab5.csv') %>% | |
| mutate( | |
| Cause = trimws(Cause), | |
| MVA_geom_mean = case_when( | |
| Cause == 'Motor vehicle accident' ~ NA_real_, | |
| TRUE ~ MVA_geom_mean | |
| ), | |
| Elec_geom_mean = case_when( | |
| Cause == 'Electrocution' ~ NA_real_, | |
| TRUE ~ Elec_geom_mean | |
| ), | |
| both_geom_mean = exp(.5*sum(log(MVA_geom_mean),log(Elec_geom_mean), na.rm=TRUE)) | |
| ) %>% | |
| filter(Cause != 'Smallpox') %>% | |
| ggplot(aes(x = Rate_outof_205000000, y = MVA_geom_mean, label = Cause)) + | |
| scale_x_log10( | |
| limits =c(1,10e6), | |
| breaks =10^(0:6), | |
| labels = tens[1:7], | |
| expand = c(0,0) | |
| ) + | |
| scale_y_log10( | |
| limits=c(1,10e5), | |
| breaks=10^(0:5), | |
| labels = tens[1:6], | |
| expand = c(0,0) | |
| ) + | |
| geom_abline(slope = 1, intercept = 2, col = "gray", linetype = 'dashed') + | |
| annotate(geom = 'text', x = 10e2, y = 10e4, label = '100x too high', color = 'gray', angle = 45, size = 6) + | |
| geom_abline(slope = 1, intercept = 1, col = "gray", linetype = 'dashed') + | |
| annotate(geom = 'text', x = 10e2, y = 10e3, label = '10x too high', color = 'gray', angle = 45, size = 6) + | |
| geom_abline(slope = 1, intercept = -2, col = "gray", linetype = 'dashed') + | |
| annotate(geom = 'text', x = 10e2, y = 10e0, label = '1/100 too low', color = 'gray', angle = 45, size = 6) + | |
| geom_abline(slope = 1, intercept = -1, col = "gray", linetype = 'dashed') + | |
| annotate(geom = 'text', x = 10e1, y = 10e0, label = '1/10 too low', color = 'gray', angle = 45, size = 6) + | |
| geom_abline(slope = 1, intercept = 0, size = 1.5, alpha = .5) + | |
| geom_point(size = 2, color = 'darkred') + | |
| ylab('Estimated deaths per year (USA, c1970)') + | |
| xlab('Actual deaths per year (USA, 1968-1973)') + | |
| theme_minimal() + | |
| theme( | |
| axis.text.x = element_text(angle = 45, hjust = 1, vjust = 1) | |
| ) + | |
| coord_fixed() + | |
| ggrepel::geom_label_repel() + | |
| labs(caption = "Source: Lichtenstein et al (1978). Among Univ. of Oregon students. 1970 USA Pop.: 205,000,000") |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment