impact: An implementation of the IOMLIFET impact spreadsheets

In richardbroome2002/iomlifetR: An implementation of the IOMLIFET spreadsheets

Description

Implements a life table method for estimating the mortality benefits of reduction in exposure to risk

Usage

impact(demog_data, delta_pm = 1, lag_structure = 1, RR = 1.06,
  unit = 10, max_age = 105, base_year = 2013, min_age_at_risk = 30,
  neonatal_deaths = TRUE)

Arguments

demog_data	A data frame with three numeric columns headed "age" (the age at which each age group begins), "population" (the size of the population) and "deaths" (the number of deaths in the population).
delta_pm	The reduction in population-weighted PM2.5 concentration in each future year.
lag_structure	A numeric vector with values between 0 and 1 that defines the structure of any cessation lag.
RR	The relative risk (or hazard ratio) to use from the assessment. This is taken from epidemiological studies
unit	The unit change in PM2.5 concentration for the RR from an epidemiological study
max_age	The maximum age to use for the assessment
base_year	The base year for the assessment
neonatal_deaths	Logical. Are neonatal deaths included?

Value

A dataframe of five columns of:

• The year

• The difference in number of deaths over 120 years (extended population)

• The difference in number of deaths over 120 years (current cohort)

• The difference in number of Life-years over 120 years (extended population)

• The difference in number of Life-years over 120 years (current cohort).

Examples

# Reduce PM by 1mcg/m3. No cessation lag. RR = 1.06 per 10mcg/m3
head(single_year_data)
population <- subset(single_year_data,
                     time == 2011 & sex == "Persons" & measure == "Population")
population <- population[, c("age", "value")]
population$age <- as.numeric(gsub(" .+", "", population$age))
colnames(population)[2] <- "population"
deaths <- subset(single_year_data,
                 time == 2011 & sex == "Persons"& measure == "Deaths")
deaths <- deaths[, "value"]
demog_data <- data.frame(population, deaths = deaths)

no_lag <- impact(demog_data)
no_lag <- data.frame(lapply(no_lag, colSums))

# Plot the effect in the current cohort and the extended population
par(mfrow = c(2, 1), cex = 0.5, cex.main = 1.9,
    cex.lab = 1.5, cex.axis = 1.4)
plot(rownames(no_lag), no_lag$deaths_current,
     xlab = "Year", ylab = "Number",
     main = "Deaths avoided", type = "b")
points(rownames(no_lag), no_lag$deaths_ext, col = "red")
abline(h = 0)
legend(2100, 700, c("Current cohort", "Extended population"),
       col=c("black", "red"), pch = 16, cex = 1.5, lty=2)
plot(rownames(no_lag), no_lag$ly_current,
     xlab = "Year", ylab = "Number",
     main = "Life-years gained", , type = "b")
points(rownames(no_lag), no_lag$ly_ext, col = "red")
abline(h = 0)

# US EPA lag
lag <- cumsum(c(0.3, rep(0.5/4, 4), rep(0.2/15, 15)))
epa_lag <- impact(demog_data, lag_structure = lag)
epa_lag <- data.frame(lapply(epa_lag, colSums))

# Comparison of no lag and US EPA lag (Extended cohort)
plot(rownames(no_lag), no_lag$deaths_ext,
     xlab = "Year", ylab = "Number",
     main = "Deaths avoided", type = "b")
points(rownames(epa_lag), epa_lag$deaths_ext, col = "red", type = "b")
abline(h = 0)
legend(2100, 700, c("No lag", "US EPA lag"),
       col=c("black", "red"), pch = 21, cex = 2, lty=2)
plot(rownames(no_lag), no_lag$ly_ext,
     xlab = "Year", ylab = "Number",
     main = "Life-years gained", , type = "b")
points(rownames(epa_lag), epa_lag$ly_ext, col = "red", type = "b")
abline(h = 0)

# Assuming PM takes 10 years to fall by 1mcg and US EPA cessation lag
pm <- seq(0.1, 1, 0.1)
slow_pm <- impact(demog_data, delta_pm = pm, lag_structure = lag)
slow_pm <- data.frame(lapply(slow_pm, colSums))

plot(rownames(no_lag), no_lag$deaths_ext,
     xlab = "Year", ylab = "Number",
     main = "Deaths avoided", type = "b")
points(rownames(epa_lag), epa_lag$deaths_ext, col = "red", type = "b")
points(rownames(slow_pm), slow_pm$deaths_ext, col = "blue", type = "b")
abline(h = 0)
legend(2080, 700, c("No lag", "US EPA lag", "Lag and gradual fall in PM"),
       col=c("black", "red", "blue"), pch = 21, cex = 2, lty=2)
plot(rownames(no_lag), no_lag$ly_ext,
     xlab = "Year", ylab = "Number",
     main = "Life-years gained", type = "b")
points(rownames(epa_lag), epa_lag$ly_ext, col = "red", type = "b")
points(rownames(slow_pm), slow_pm$ly_ext, col = "blue", type = "b")
abline(h = 0)

richardbroome2002/iomlifetR documentation built on Aug. 19, 2019, 10:26 p.m.