Difference between revisions of "Health impact assessment"

From Testiwiki
Jump to: navigation, search
(Rationale)
(Ovariables for calculating cases)
 
(18 intermediate revisions by 3 users not shown)
Line 133: Line 133:
 
'''Personal lifetime risk
 
'''Personal lifetime risk
 
= Extra cases per year * life expectancy * population
 
= Extra cases per year * life expectancy * population
 +
 +
Attributable fraction is (RR-1)/RR=1-1/RR if RR>1. If smaller, you must compare the other way round: control group is considered an exposure to lack of a protective agent and thus the exposure group is the reference. In this comparison, the attributable fraction of lack of protection (AF<sub>lp</sub>) is calculated from a new rate ratio RR<sub>lp</sub> = 1/RR and
 +
 +
:<math>AF_{lp} = 1 - \frac{1}{RR_{lp}} = 1 - \frac{1}{1/RR} = 1 - RR</math>
 +
 +
When multiplied by the number of cases, we get the number of excess cases (that would not have occurred if the population had not been exposed to lack of protection). This comparison is symmetric and we can use either counterfactual situation as the reference just by calculating the difference the other way round, i.e. changing the sign of the value. Therefore, the number of cases avoided with exposure to a protective agent is '''-AF<sub>lp</sub> = RR - 1'''. So, AF is calculated as 1-1/RR or RR-1 depending on whether RR>1 or not, respectively.
  
 
===Calculations===
 
===Calculations===
  
See also Seturi: [[:heande:File:SETURI laskenta06.xls|Excel file]], [http://fi.opasnet.org/fi_wiki/index.php/Special:R-tools?id=Q46E0t9BLPUhIT1K]
+
==== Depreciated code ====
 +
 
 +
* The code was restructured and old code [http://en.opasnet.org/en-opwiki/index.php?title=Health_impact_assessment&oldid=37349 archived] 13 June, 2015.
 +
* Code AF (attributable fraction) was moved to page [[Population attributable fraction]].
 +
* See also Seturi: [[:heande:File:SETURI laskenta06.xls|Excel file]], [http://fi.opasnet.org/fi_wiki/index.php/Special:R-tools?id=Q46E0t9BLPUhIT1K]
 +
 
 +
<rcode name="initiate" embed=1 label="Create warning about old method">
 +
library(OpasnetUtils)
 +
 
 +
dummy <- 0
 +
 
 +
HIA <- Ovariable("HIA",
 +
dependencies = data.frame(Name = "dummy"),
 +
formula = function(...) {
 +
cat("This code is outdated. Instead, use Op_en2261/totcases on page Health impact assessment.\n")
 +
}
 +
)
 +
 
 +
totcases <- Ovariable("totcases",
 +
dependencies = data.frame(Name = "dummy"),
 +
formula = function(...) {
 +
cat("This code is outdated. Instead, use Op_en2261/totcases on page Health impact assessment.\n")
 +
}
 +
)
 +
 
 +
AF <- Ovariable("AF",
 +
dependencies = data.frame(Name = "dummy"),
 +
formula = function(...) {
 +
cat("This code is outdated. Instead, use Op_en6211/AF on page Population attributable fraction.\n")
 +
}
 +
)
 +
 
 +
objects.store(HIA, totcases, AF, dummy)
 +
cat("Warnings created about old method.\n")
 +
</rcode>
 +
 
 +
==== Ovariables for calculating RR ====
 +
 
 +
<rcode name="BW" label="Initiate BW body weight (for developers only)" embed=1>
 +
 
 +
# This is code Op_en2261/BW on page [[Health impact assessment]].
 +
library(OpasnetUtils)
 +
 
 +
BW <- Ovariable("BW", data = data.frame(Result = 70)) # 70 kg
 +
 
 +
objects.store(BW)
 +
cat("Ovariable BW (body weight) stored. page: Op_en2261, code_name: BW.\n")
 +
 
 +
</rcode>
 +
 
 +
<rcode name="frexposed" label="Initiate frexposed (for developers only)" embed=1>
  
<rcode name="initiate" embed=1 label="Initiate method">
+
# This is code Op_en2261/frexposed on page [[Health impact assessment]].
 
library(OpasnetUtils)
 
library(OpasnetUtils)
  
### ESTIMATES OF ATTRIBUTABLE CASES BASED ON ATTRIBUTABLE FRACTION
+
frexposed <- Ovariable("frexposed", data = data.frame(Result = 1))
# We estimate the number of cases and their attributable causes based on [[Population attributable fractions]].
+
 
 +
objects.store(frexposed)
 +
cat("Ovariable frexposed stored. page: Op_en2261, code_name: frexposed.\n")
 +
 
 +
</rcode>
  
#popfraction <- 1 # We don't need the fraction of exposed population, because exposure distribution is
+
<rcode name="exposure" label="Initiate exposure (for developers only)" embed=1>
# calculated for each population subroup separately. If there are unexposed people, they are already included
 
# in the exposure distribution.
 
  
testforrow <- function(o1, o2) { # Test if there are rows in output if o1 * o2
+
# This is code Op_en2261/exposure on page [[Health impact assessment]].
ints <- setdiff(
+
library(OpasnetUtils)
intersect(colnames(o1@output), colnames(o2@output)),  
+
 
c(paste(o1@name, "Result", sep = ""), paste(o2@name, "Result", sep = ""))
+
exposure <- Ovariable("exposure", data = data.frame(Result = 1))
)
+
 
if (nrow(o1@output) > 0 & length(ints) == 0) return(TRUE)
+
objects.store(exposure)
return(nrow(o1@output) > 0 & nrow(merge(unique(o1@output[ints]), unique(o2@output[ints]))) > 0)
+
cat("Ovariable exposure stored. page: Op_en2261, code_name: exposure.\n")
 +
</rcode>
 +
 
 +
<rcode name="bgexposure" label="Initiate bgexposure (for developers only)" embed=1>
 +
 
 +
# This is code Op_en2261/bgexposure on page [[Health impact assessment]].
 +
library(OpasnetUtils)
 +
 
 +
bgexposure <- Ovariable("bgexposure", data = data.frame(Result = 0))
 +
 
 +
objects.store(bgexposure)
 +
cat("Ovariable bgexposure stored. page: Op_en2261, code_name: bgexposure.\n")
 +
 
 +
</rcode>
 +
 
 +
<rcode name="population" label="Initiate population (for developers only)" embed=1>
 +
 
 +
# This is code Op_en2261/population on page [[Health impact assessment]].
 +
library(OpasnetUtils)
 +
 
 +
population <- Ovariable("population", data = data.frame(Result = 1))
 +
 
 +
objects.store(population)
 +
cat("Ovariable population stored. page: Op_en2261, code_name: population.\n")
 +
 
 +
</rcode>
 +
 
 +
<rcode name="incidence" label="Initiate incidence (for developers only)" embed=1>
 +
 
 +
# This is code Op_en2261/incidence on page [[Health impact assessment]].
 +
library(OpasnetUtils)
 +
 
 +
incidence <- Ovariable("incidence", data = data.frame(Result = 0.1))
 +
 
 +
objects.store(incidence)
 +
cat("Ovariable incidence stored. page: Op_en2261, code_name: incidence.\n")
 +
 
 +
</rcode>
 +
 
 +
<rcode name="dose" label="Initiate dose (for developers only)" embed=1>
 +
 
 +
# This is code Op_en2261/dose on page [[Health impact assessment]].
 +
library(OpasnetUtils)
 +
 
 +
dose <- Ovariable("dose", # This calculates the body-weight-scaled exposure or "dose" to be used with ERFs.
 +
  dependencies = data.frame(
 +
    Name = c(
 +
      "exposure", # Exposure to the pollutants
 +
      "bgexposure", # Background exposure (a level you use for comparison)
 +
      "BW" # body weight
 +
    ),
 +
    Ident = c(
 +
      "Op_en2261/exposure",
 +
      "Op_en2261/bgexposure",
 +
      "Op_en2261/BW"
 +
    )
 +
  ),
 +
  formula = function(...) {
 +
   
 +
    ########### Create a single ovariable with exposure and background exposure.
 +
   
 +
    temp <- Ovariable( # Create alternative scenario with background exposure bgexposure.
 +
      output = data.frame(Exposcen = c("BAU", "No exposure"), Result = c(1, 0)),
 +
      marginal = c(TRUE, FALSE)
 +
    )
 +
   
 +
    out <- temp * exposure + (1 - temp) * bgexposure # Adds exposure and background to respective scenarios
 +
   
 +
    ######### Body weight scaling: In some cases, exposure is given as per body weight and in some cases as absolute amounts.
 +
    # Here we add one index to define for this difference.
 +
    out2 <- out / BW
 +
    out3 <- log10(out)
 +
   
 +
    out$Scaling <- "None"
 +
    out2$Scaling <- "BW"
 +
    out3$Scaling <- "Log10"
 +
   
 +
    out <- combine(out, out2, out3)
 +
   
 +
    return(out)
 +
  }
 +
)
 +
 
 +
objects.store(dose)
 +
cat("Ovariable dose stored. page: Op_en2261, code_name: dose.\n")
 +
</rcode>
 +
 
 +
<rcode name="RR" label="Initiate RR (for developers only)" embed=1>
 +
 
 +
# This is code Op_en2261/RR on page [[Health impact assessment]].
 +
library(OpasnetUtils)
 +
 
 +
# Do we need testforrow any more, as RR does not use it?
 +
testforrow <- function(x, y) {
 +
  if (nrow(x@output) == 0 | nrow(y@output) == 0) return(FALSE)
 +
  commons <- intersect(colnames(x@output), colnames(y@output))
 +
  commons <- commons[!grepl("Result$", commons)]
 +
  for (i in commons) {
 +
    if (!any(unique(x@output[[i]]) %in% unique(y@output[[i]]))) return(FALSE)
 +
  }
 +
  return(TRUE)
 
}
 
}
  
#ooapply <- function( # A memory-saving function for oapply when there is exactly one row for each unique combination.
+
# This code produces non-unique index combinations. They multiply when
# # All non-marginal indices are removed.
+
# formula is run and probably cause bias in results. Check!
# X, # An ovariable
+
RR <- Ovariable(
# cols, # Names of columns to aggregrate over
+
  "RR", # This calculates the total number of cases in each population subgroup.
# FUN = "sum", # A function to used in aggregation. Only "sum", "mean", "min", "max" and "prod" are available atm.
+
  # The cases are calculated for specific (combinations of) causes. However, these causes are NOT visible in the result.
# ... # For compatibility.
+
  dependencies = data.frame(
# {
+
    Name = c(
#
+
      "dose", # Exposure to the pollutants
# rescol <- paste(X@name, "Result", sep = "")
+
      "ERF", # Exposure-response function of the pollutants or agents (RR for unit exposure)
# X <- unkeep(X, # Unkeep all columns except critical marginals and the result.
+
      "threshold", # exposure level below which the agent has no impact.
# cols = setdiff(colnames(X@output)[!X@marginal], rescol),
+
      "frexposed", # fraction of population that is exposed
# prevresults = TRUE,
+
      "incidence", # This is only needed for OR and omitted otherwise.
# sources = TRUE
+
      "mc2d"  # Function to run two-dimensional Monte Carlo
# )  
+
    ),
# keeps <- colnames(X@output)[X@marginal & !colnames(X@output) %in% cols] # Marginals to keep
+
    Ident = c(
# if(any(colnames(X@output)[X@marginal] %in% cols)) {
+
      "Op_en2261/dose",     # [[Health impact assessment]]
# ro <- unique(X@output[cols[1]]) # data.frame with all combinations of marginal locations
+
      "Op_en2031/initiate", # [[Exposure-response function]]
# ro <- ro[order(ro) , , drop = FALSE] # order the data.frame because rows may be in random order.
+
      "Op_en2031/initiate", # [[Exposure-response function]]
# if(length(cols) == 1) colu <- keeps else colu <- c(cols[2:length(cols)], keeps)
+
      "Op_en2261/frexposed",# [[Health impact assessment]]
# for(j in colu) {
+
      "Op_en2261/incidence", # [[Health impact assessment]]
# temp <- unique(X@output[j])
+
      "Op_en7805/mc2d" # [[Two-dimensional Monte Carlo]]
# ro <- merge(temp[order(temp) , , drop = FALSE], ro)
+
    )
# }
+
  ),
# ro <- ro[ncol(ro):1]
+
  formula = function(...) {
# res <- merge(ro, X@output, all.x = TRUE)[[rescol]] # Result column in the right order.
+
    # Make sure that these are not marginals
# if(length(res) != nrow(ro)) stop("The numbers of rows don't match.\n")
+
    ERF@marginal[colnames(ERF@output) %in% c("ERF_parameter", "Scaling")] <- FALSE
# if(FUN == "prod") out <- 1
+
    # Remove redundant columns
# if(FUN %in% c("sum", "mean")) out <- 0
+
    ERF <- ERF[ , !colnames(ERF@output) %in% c(
# if(FUN == "min") out <- Inf
+
      "Source",
# if(FUN == "max") out <- -Inf
+
      "Exposure_unit"
# res[is.na(res)] <- out
+
    )]
# block <- unique(ro[keeps]) # All combinations of locations of marginals to keep
+
    threshold <- threshold[ , !colnames(threshold@output) %in% c(
# keepn <- nrow(block)
+
      "Source",
# if(FUN == "mean") res <- res * keepn / nrow(ro)
+
      "Exposure_unit"
# for(i in 1:nrow(unique(ro[cols]))) { # Loop across all combinations of locations of marginals not to keep
+
    )]
# addi <- res[((i - 1) * keepn + 1):((i - 1) * keepn + keepn)]
+
    out <- NULL
# if(FUN == "prod") out <- out * addi
+
    dose <- dose * ERF # Do the merge now to avoid redundant rows
# if(FUN %in% c("sum", "mean")) out <- out + addi
+
    result(dose) <- dose$doseResult
# if(FUN == "min") out <- pmin(out, addi)
+
    dose <- unkeep(dose, sources=TRUE)
# if(FUN == "max") out <- pmax(out, addi)
+
   
# }
+
    ####################################################################
# out <- data.frame(block, Result = out)
+
    ####### This part is about risks relative to background.
# colnames(out)[colnames(out) == "Result"] <- rescol
+
    # Calcualte the risk ratio to each subgroup based on the exposure in that subgroup.
# X@output <- out
+
    # Combine pollutant-specific RRs by multiplying. For description, see [[Exposure-response function]].
# X@marginal <- colnames(X@output) %in% keeps
+
   
# }
+
    #First take the relative risk estimates. Convert ORs to RRs by using incidence.
# return(X)
+
    # We need OR but not yet crucial, so let's postpone this. See [[:op_en:Converting between exposure-response parameters]]
#}
+
    # #Then take the odds ratio estimates
 +
    # OR <- ERF[ERF$ERF_parameter %in% c("OR", "OR bw") , ]
 +
    # if(testforrow(OR, dose)) { # See ERFrr for explanation
 +
    # out <- OR / (1 - incidence + OR*incidence) # Actual function with background incidence.
 +
    # }
 +
   
 +
    temp <- dose[dose$ER_function %in% c("RR", "OR") , ]
 +
    if(nrow(temp@output)>0) {
 +
     
 +
      temp <- exp(log(ERF) * (temp - threshold)) # Actual function
 +
     
 +
      result(temp)[temp$doseResult < temp$thresholdResult] <- 1 # RR is 1 below threshold
 +
      out <- temp
 +
    }
 +
 
 +
    # Then take the relative Hill estimates
 +
   
 +
    temp <- dose[dose$ER_function %in% c("Relative Hill") , ]
 +
    if(nrow(temp@output)>0) {
 +
 
 +
      temp <- 1 + (temp * ERF) / (temp + threshold) # Actual function
 +
     
 +
      # ERF has parameter value for Imax. If Imax < 0, risk reduces.
 +
      # threshold has parameter value for ED50.
 +
      if(is.null(out)) out <- temp else out <- combine(out, temp)
 +
    }
 +
    temp <- NULL
 +
   
 +
    if(is.null(out)) {
 +
      out <- oapply(dose, cols = c("Iter","Exposure_agent","Scaling","Exposure"), FUN=sum)
 +
      result(out) <- 1
 +
    } else {
 +
     
 +
      # Dilute the risk in the population if not all are exposed i.e. frexposed < 1.
 +
      out <- frexposed * (out - 1) + 1
 +
      out <- unkeep(out, prevresults = TRUE, sources = TRUE, cols = c("Scaling", "ER_function"))  
 +
      if(length(unique(out$Exposure_agent)) > 1) { # Could we just oapply everything?
 +
        out <- oapply(out, cols = c("Exposure_agent", "Exposure"), FUN = prod)  
 +
      } else {
 +
        out <- unkeep(out, cols = c("Exposure_agent", "Exposure"))
 +
      }
 +
    }
 +
    if(mc2dparam$run2d) out <- mc2d(out) # Run two-dimensional Monte Carlo
 +
    return(out)
 +
  }
 +
)
 +
 
 +
objects.store(RR, testforrow)
 +
cat("Ovariables RR, testforrow saved. page: Op_en2261, code_name: RR.\n")
 +
 
 +
</rcode>
 +
 
 +
==== Ovariables for calculating cases ====
  
### ESTIMATES OF ATTRIBUTABLE CASES BASED ON ATTRIBUTABLE FRACTION
+
<rcode name="sumExposcen" label="Initiate sumExposcen (for developers only)" embed=1>
# We estimate the number of cases and their attributable causes based on [[Population attributable fractions]].
 
  
#popfraction <- 1 # We don't need the fraction of exposed population, because exposure distribution is  
+
# This is code Op_en2261/sumExposcen on page [[Health impact assessment]].
# calculated for each population subroup separately. If there are unexposed people, they are already included
+
library(OpasnetUtils)
# in the exposure distribution.
 
  
dose <- Ovariable("dose", # This calculates the body-weight-scaled exposure or "dose" to be used with ERFs.
+
# sumExposcen calculates the difference between scenarios BAU and No exposure.
dependencies = data.frame(Name = c(
+
sumExposcen <- function (out) {
# "ERF", # Exposure-response function of the pollutants or agents (RR for unit exposure)
+
  if ("Exposcen" %in% colnames(out@output)) {
"exposure", # Exposure to the pollutants
+
    out <- out * Ovariable(
"bgexposure", # Background exposure (a level you use for comparison)
+
      output = data.frame(Exposcen = c("BAU", "No exposure"), Result = c(1, -1)),
"BW" # body weight
+
      marginal = c(TRUE, FALSE)
)),
+
    )
formula = function(...) {
+
    # Remove ERF-related indices as they are no longer needed.
 +
    out <- oapply(out, NULL, sum, c("Exposcen","Exposure","ER_function","Exposure_unit","Scaling"))
 +
  }
 +
  return(out)
 +
}
 +
 
 +
objects.store(sumExposcen)
 +
cat("Function sumExposcen dose stored. page: Op_en2261, code_name: sumExposcen.\n")
 +
</rcode>
  
########### Create a single ovariable with exposure and background exposure.
+
<rcode name="casesabs" label="Initiate caseabs (for developers only)" embed=1>
  
temp <- Ovariable( # Create alternative scenario with background exposure bgexposure.
+
# This is code Op_en2261/casesabs on page [[Health impact assessment]].
output = data.frame(Exposcen = c("BAU", "No exposure"), Result = c(1, 0)),
+
library(OpasnetUtils)
marginal = c(TRUE, FALSE)
 
)
 
  
out <- temp * exposure + (1 - temp) * bgexposure # Adds exposure and background to respective scenarios
+
casesabs <- Ovariable(
 +
  "casesabs", # This calculates the burden of disease for background-independent endpoints.
 +
  dependencies = data.frame(
 +
    Name = c(
 +
      "population", # Population divided into subgroups as necessary
 +
      "dose", # Exposure to the pollutants
 +
      "ERF", # Other ERFs than those that are relative to background.
 +
      "threshold", # exposure level below which the agent has no impact.
 +
      "frexposed", # fraction of population that is exposed
 +
      "sumExposcen", # function that calculates difference between exposure scenarios
 +
      "mc2d"  # Function to run two-dimensional Monte Carlo
 +
    ),
 +
    Ident = c(
 +
      "Op_en2261/population", # [[Health impact assessment]]
 +
      "Op_en2261/dose",      # [[Health impact assessment]]
 +
      "Op_en2031/initiate",  # [[Exposure-response function]]
 +
      "Op_en2031/initiate",  # [[Exposure-response function]]
 +
      "Op_en2261/frexposed",  # [[Health impact assessment]]
 +
      "Op_en2261/sumExposcen",# [[Health impact assessment]]
 +
      "Op_en7805/mc2d"        # [[Two-dimensional Monte Carlo]]
 +
    )
 +
  ),
 +
  formula = function(...) {
 +
    out <- NULL
 +
    dose2 <- dose * ERF # Do the merge first
 +
    result(dose2) <- dose2$doseResult
  
######### Body weight scaling: In some cases, exposure is given as per body weight and in some cases as absolute amounts.
+
    temp <- dose2[dose2$ER_function %in% c("UR", "CSF", "ERS"), ]
# Here we add one index to define for this difference.
+
   
 +
    # Dose could be simplified with combine.
 +
    if(nrow(temp@output)>0) {
 +
      out <- (threshold + temp * ERF * frexposed) * population # Actual equation
 +
      # threshold is here interpreted as the baseline response (intercept of the line). It should be 0 for
 +
      # UR and CSF but it may have meaningful values with ERS
 +
      # But this interpretation is problematic. Threshold should have same units as exposure, not response.
 +
    }
  
out2 <- out / BW
+
    # Step estimates: value is 1 below threshold and above ERF, and 0 in between.
+
   
out3 <- log10(out)
+
    temp <- dose2[dose2$ER_function %in% c("Step", "ADI", "TDI", "RDI", "NOAEL") , ]
+
    if(nrow(temp@output)>0) {
out@output$Scaling <- "None"
+
     
out2@output$Scaling <- "BW"
+
      temp <- (1 - (temp >= threshold) * (temp <= ERF)) * frexposed * population # Actual equation
out3@output$Scaling <- "Log10"
+
     
+
      if(is.null(out)) out <- temp else out <- combine(out, temp)
marg <- colnames(out@output)[out@marginal]
+
    }
marg <- union(marg, colnames(out2@output)[out2@marginal])
+
    out <- oapply(out, NULL, sum, c("Exposure_agent", "Exposure", "ER_function", "Scaling"))
+
    if(mc2dparam$run2d) out <- mc2d(out) # Run two-dimensional Monte Carlo
out@output <- orbind(out, out2)
+
   
out@output <- orbind(out, out3)
+
    return(sumExposcen(out))
out@marginal <- colnames(out@output) %in% marg
+
  }
#out@output <- rbind(rbind(out@output, out2@output), out3@output)
 
#out@marginal <- c(out@marginal, FALSE) # Assumes that Scaling does not exist and is therefore located the last.
 
# Scaling does NOT bring a new dimension but simply describes details of ERF_parameter.
 
 
# scaling <- unique(ERF@output[c("ERF_parameter", "Exposure_agent")])
 
#
 
# scaling <- Ovariable("scaling", data = data.frame(
 
# scaling,
 
# Result = 1 * grepl("bw", scaling$ERF_parameter) # if ERF parameter contains bw, scaling is TRUE, i.e. 1.
 
# ))
 
# out <- out / (((BW - 1) * scaling) + 1) # If scaling is 0, BW cancels out.
 
 
return(out)
 
}
 
 
)
 
)
  
RR <- Ovariable("RR", # This calculates the total number of cases in each population subgroup.
+
objects.store(casesabs)
# The cases are calculated for specific (combinations of) causes. However, these causes are NOT visible in the result.
+
cat("Ovariable casesabs stored. page: Op_en2261, code_name: casesabs.\n")
dependencies = data.frame(
+
</rcode>
Name = c(
+
 
"ERF", # Exposure-response function of the pollutants or agents (RR for unit exposure)
+
<rcode name="casesrr" label="Initiate casesrr (for developers only)" embed=1>
"dose", # Exposure to the pollutants
+
 
"frexposed", # fraction of population that is exposed
+
# This is code Op_en2261/casesrr on page [[Health impact assessment]].
"threshold" # exposure level below which the agent has no impact.
+
library(OpasnetUtils)
),
+
 
Ident = c("Op_en2031/initiate", NA, NA, NA)
+
casesrr <- Ovariable(
),
+
  "casesrr", # This calculates the burden of disease for endpoints using RR.
formula = function(...) {
+
  dependencies = data.frame(
+
    Name = c(
ERF@marginal[colnames(ERF@output) %in% c("ERF_parameter", "Scaling")] <- FALSE # Make sure that these are not marginals
+
      "population", # Population divided into subgroups as necessary
+
      "RR", # Relative risks for the given exposure
####################################################################
+
      "incidence", # incidence of responses
####### This part is about risks relative to background.
+
      "sumExposcen" # function that calculates difference between exposure scenarios
# Calcualte the risk ratio to each subgroup based on the exposure in that subgroup.
+
    ),  
# Combine pollutant-specific RRs by multiplying. For description, see [[Exposure-response function]].
+
    Ident = c(
test <- list()
+
      "Op_en2261/population", # [[Health impact assessment]]
marginals <- character()
+
      "Op_en2261/RR",         # [[Health impact assessment]]
+
      "Op_en5917/initiate",   # [[Disease risk]]
#First take the relative risk estimates
+
      "Op_en2261/sumExposcen" # [[Health impact assessment]]
RRrr <- ERF
+
    )
RRrr@output <- RRrr@output[RRrr@output$ER_function %in% c("RR") , ]
+
  ),
if(testforrow(RRrr, dose)) {
+
  formula = function(...) {
# If an ovariable whose nrow(ova@output) == 0 is used in Ops, it is re-EvalOutput'ed,
+
    AF <- (RR > 1) * (1 - 1/RR) + (RR <= 1) * (RR - 1)
# and therefore ERFrr*dose may have rows even if ERFrr doesn't.
+
    out <- population * incidence * AF
RRrr <- exp(log(RRrr) * (dose - threshold)) # Actual function
+
 
RRrr <- (RRrr - 1) * (dose > threshold) + 1 # RR is 1 below threshold
+
    return(sumExposcen(out))
test <- c(test, RRrr)
+
  }
marginals <- c(marginals, colnames(RRrr@output)[RRrr@marginal])
 
}
 
RRrr <- NULL # These are not needed any more, so removed to save memory
 
 
# Then take the relative Hill estimates
 
ED50 <- threshold
 
ED50@output <- ED50@output[ED50@output$ER_function %in% c("Relative Hill") , ]
 
if(testforrow(ED50, dose)) { # See ERFrr for explanation
 
ED50 <- 1 + (dose * ERF) / (dose + ED50) # ERF has parameter value for Imax. If Imax < 0, risk reduces.
 
test <- c(test, ED50)
 
marginals <- c(marginals, colnames(ED50@output)[ED50@marginal])
 
}
 
ED50 <- NULL
 
 
# We need OR but not yet crucial, so let's postpone this. See [[:op_en:Converting between exposure-response parameters]]
 
# #Then take the odds ratio estimates
 
# OR <- ERF
 
# OR@output <- ERF@output[ERF@output$ERF_parameter %in% c("OR", "OR bw") , ]
 
# if(testforrow(OR, dose)) { # See ERFrr for explanation
 
# OR <- RR = OR/( 1-PX0+OR*PX0 ) # Actual function where PX0 is the background incidence. How to write a code?
 
# RRor <- (RRrr - 1) * (dose > threshold) + 1 # RR is 1 below threshold
 
# test <- c(test, RRor)
 
# marginals <- c(marginals, colnames(OR@output)[OR@marginal]
 
# }
 
 
if(length(test) == 0) return(data.frame(Result = 1))
 
if(length(test) == 1) out <- test[[1]]@output
 
if(length(test) == 2) out <- orbind(test[[1]], test[[2]])
 
if(length(test) == 3) out <- orbind(orbind(test[[1]], test[[2]]), test[3])
 
 
# Find out the right marginals for the output
 
marginals <- character()
 
nonmarginals <- character()
 
for(i in length(test)) {
 
marginals <- c(marginals, colnames(test[[i]]@output)[test[[i]]@marginal])
 
nonmarginals <- c(nonmarginals, colnames(test[[i]]@output)[!test[[i]]@marginal])
 
}
 
 
test <- NULL
 
 
out <- Ovariable(output = out, marginal = colnames(out) %in% setdiff(marginals, nonmarginals))
 
 
# Dilute the risk in the population if not all are exposed i.e. frexposed < 1.
 
out <- frexposed * (out - 1) + 1
 
out <- unkeep(out, prevresults = TRUE, sources = TRUE, cols = c("Scaling", "ERF_parameter"))
 
if(length(unique(out@output$Exposure_agent)) > 1) {
 
out <- oapply(out, cols = "Exposure_agent", FUN = prod)
 
#out <- ooapply(out, cols = "Exposure_agent", FUN = "prod", use_plyr = TRUE)
 
# out <- oprod(out, cols = "Exposure_agent")
 
} else {
 
out <- unkeep(out, cols = c("Exposure_agent"))
 
}
 
 
return(out)
 
}
 
 
)
 
)
 +
 +
objects.store(casesrr)
 +
cat("Ovariable casesrr stored. page: Op_en2261, code_name: casesrr.\n")
 +
</rcode>
 +
 +
==== Totcases (old version) ====
 +
 +
<rcode name="totcases" label="Initiate totcases (for developers only)" embed=1>
 +
 +
# This is code Op_en2261/totcases on page [[Health impact assessment]].
 +
library(OpasnetUtils)
  
 
totcases <- Ovariable("totcases", # This calculates the total number of cases in each population subgroup.
 
totcases <- Ovariable("totcases", # This calculates the total number of cases in each population subgroup.
Line 357: Line 545:
 
Name = c(
 
Name = c(
 
"population", # Population divided into subgroups as necessary
 
"population", # Population divided into subgroups as necessary
 +
"dose", # Exposure to the pollutants
 
"disincidence", # Incidence of the disease of interest
 
"disincidence", # Incidence of the disease of interest
 
"RR", # Relative risks for the given exposure
 
"RR", # Relative risks for the given exposure
 
"ERF", # Other ERFs than those that are relative to background.
 
"ERF", # Other ERFs than those that are relative to background.
"dose", # Exposure to the pollutants
+
"threshold", # exposure level below which the agent has no impact.
"frexposed", # fraction of population that is exposed
+
"frexposed" # fraction of population that is exposed
"threshold" # exposure level below which the agent has no impact.
 
 
),  
 
),  
Ident = c(NA, NA, NA, "Op_en2031/initiate", NA, NA, NA)
+
Ident = c(
 +
"Op_en2261/population", # [[Health impact assessment]]
 +
"Op_en2261/dose",       # [[Health impact assessment]]
 +
"Op_en5917/initiate",   # [[Disease risk]]
 +
"Op_en2261/RR",        # [[Health impact assessment]]
 +
"Op_en2031/initiate",   # [[Exposure-response function]]
 +
"Op_en2031/initiate",   # [[Exposure-response function]]
 +
"Op_en2261/frexposed"  # [[Health impact assessment]]
 +
)
 
),
 
),
 
formula = function(...) {
 
formula = function(...) {
Line 385: Line 581:
 
if(length(takeout) > 0) {# Aggregate to larger subgroups.
 
if(length(takeout) > 0) {# Aggregate to larger subgroups.
 
pop <- oapply(population, NULL, sum, takeout)
 
pop <- oapply(population, NULL, sum, takeout)
# pop <- ooapply(population, cols = takeout, FUN = "sum", use_plyr = TRUE)
 
# pop <- osum(population, cols = takeout)
 
 
} else {
 
} else {
 
pop <- population
 
pop <- population
Line 433: Line 627:
 
# threshold is here interpreted as the baseline response (intercept of the line). It should be 0 for
 
# threshold is here interpreted as the baseline response (intercept of the line). It should be 0 for
 
# UR and CSF but it may have meaningful values with ERS
 
# UR and CSF but it may have meaningful values with ERS
# UR <- unkeep(UR, prevresults = TRUE, sources = TRUE)
 
# marg <- UR@marginal & colnames(UR@output) != "Exposure_agent"
 
  
 
UR <- oapply(UR, NULL, sum, "Exposure_agent")
 
UR <- oapply(UR, NULL, sum, "Exposure_agent")
#UR <- ooapply(UR, cols = "Exposure_agent", FUN = "sum", use_plyr = TRUE)
 
# UR <- osum(UR, cols = "Exposure_agent")
 
  
 
UR <- population * UR
 
UR <- population * UR
Line 451: Line 641:
 
if(testforrow(Step, dose)) { # See RR for explanation.
 
if(testforrow(Step, dose)) { # See RR for explanation.
 
Step <- 1 - (dose >= threshold) * (dose <= Step) # Actual equation
 
Step <- 1 - (dose >= threshold) * (dose <= Step) # Actual equation
# Step <- unkeep(Step, prevresults = TRUE, sources = TRUE)
 
 
# Population size should be taken into account here. Otherwise different population indices may go unnoticed.(?)
 
# Population size should be taken into account here. Otherwise different population indices may go unnoticed.(?)
  
 
Step <- oapply(Step, NULL, sum, "Exposure_agent")
 
Step <- oapply(Step, NULL, sum, "Exposure_agent")
#Step <- ooapply(Step, cols = "Exposure_agent", FUN = "sum", use_plyr = TRUE)
 
# Step <- osum(Step, cols = "Exposure_agent")
 
  
 
test <- c(test, Step)
 
test <- c(test, Step)
Line 475: Line 662:
 
marginals <- c(marginals, colnames(test[[i]]@output)[test[[i]]@marginal])
 
marginals <- c(marginals, colnames(test[[i]]@output)[test[[i]]@marginal])
 
nonmarginals <- c(nonmarginals, colnames(test[[i]]@output)[!test[[i]]@marginal])
 
nonmarginals <- c(nonmarginals, colnames(test[[i]]@output)[!test[[i]]@marginal])
 
# print(head(test[[i]]@output))
 
# print(test[[i]]@marginal)
 
 
}
 
}
 
 
Line 491: Line 675:
 
)
 
)
 
out <- oapply(out, NULL, sum, "Exposcen")
 
out <- oapply(out, NULL, sum, "Exposcen")
#out <- ooapply(out, cols = "Exposcen", FUN = "sum", use_plyr = TRUE)
 
# out <- osum(out, cols = "Exposcen")
 
 
}
 
}
 
 
Line 499: Line 681:
 
)
 
)
  
# UPDATE AF TO REFLECT THE CURRENT IMPLEMENTATION OF ERF [[Exposure-response function]]
+
objects.store(totcases)
 +
cat("Ovariable totcases saved. page: Op_en2261, code_name: totcases.\n")
  
AF <- Ovariable("AF", # Cases attributed to specific (combinations of) causal exposures.
+
</rcode>
dependencies = data.frame(Name = c(
 
"ERF", # Exposure-response function
 
"exposure", # Total exposure to an agent or pollutant
 
"frexposed", # fraction of population that is exposed
 
"bgexposure" # Background exposure to an agent (a level below which you cannot get in practice)
 
)),
 
 
formula = function(...) {
 
 
 
# First calculate risk ratio and remove redundant columns because they cause harm when operated with itself.
 
RR <- frexposed * exp(log(ERF) * (exposure - bgexposure)) - frexposed + 1
 
PAF <- (RR - 1) / unkeep(RR, sources = TRUE, prevresults = TRUE)
 
 
 
# pollutants is a vector of pollutants considered.
 
pollutants <- as.character(unique(exposure@output$Pollutant))
 
 
 
expname <- paste(exposure@name, "Result", sep = "")
 
 
 
out <- 1
 
for(i in 1:length(pollutants)) {
 
 
# Attributable fraction of a particular pollutant is combined with all pollutant AFs.
 
# The combination has 2^n rows (n = number of pollutants). Pollutant is either + or - depending on
 
# whether it caused the disease or not.
 
temp <- Ovariable("temp", data = data.frame(
 
Pollutant = pollutants[i],
 
Temp1 = c(paste(pollutants[i], "-", sep = ""), paste(pollutants[i], "+", sep = "")),
 
Result = c(-1, 1) # Non-causes are temporarily marked with negative numbers.
 
))
 
temp <- temp * PAF
 
 
 
# Non-causes are given the remainder (1-AF) of temporary attributable fraction AF.
 
result(temp) <- ifelse(result(temp) > 0, result(temp), 1 + result(temp))
 
# Causes with 0 AF are marked 1. This must be corrected.
 
result(temp) <- ifelse(result(temp) == 1 & grepl("\\+", temp@output$Temp1), 0, result(temp))
 
 
 
#If exists, the exposureResult is renamed so that it can be kept without side effects.
 
#These should not be marginals but there seems to be problems in this respect.
 
if(expname != "Result"){
 
colnames(temp@output)[colnames(temp@output) == expname] <- paste("expo", pollutants[i], sep = "")
 
}
 
 
out <- out * temp
 
out <- unkeep(out, cols = "Pollutant", sources = TRUE, prevresults = TRUE)
 
 
 
# Combine and rename columns.
 
if(i == 1) {
 
colnames(out@output)[colnames(out@output) == "Temp1"] <- "Causes"
 
} else {
 
out@output$Causes <- paste(out@output$Causes, out@output$Temp1)
 
out@output$Temp1 <- NULL
 
}
 
}
 
return(out)
 
}
 
)
 
  
########### HIA ovariable is outdated and should not be used.
+
NOTE! These ovariables used to utilise ooapply function, but it was [http://en.opasnet.org/en-opwiki/index.php?title=Health_impact_assessment&oldid=37456#Calculations archived] after improved oapply.
  
HIA <- new("ovariable",
+
The codes above are based on these input variables:
name        = "HIA",
+
* [[Exposure-response function]]
dependencies = data.frame(
 
Name = c(
 
"diseaseRisk",
 
"Exposure",
 
"Exposed.Fraction",
 
"Background.Exposure",
 
"ERF",
 
"BoD"
 
),
 
Ident = c(
 
NA, # "Op_en5917/initiate", # Disease risk
 
NA, # "Op_en5918/initiate", # Exposures in Finland
 
NA, # "Op_en5918/initiate", # Exposures in Finland
 
NA, # "Op_en5918/initiate", # Exposures in Finland
 
"Op_en5827/initiate",
 
"Op_en5453/initiate"
 
)
 
),
 
formula      = function(dependencies, ...){
 
ComputeDependencies(dependencies, ...)
 
 
 
ERF@output$ERFResult <- as.numeric(as.character(ERF@output$ERFResult))
 
Exposed.Fraction@output$Exposed.FractionResult <-
 
as.numeric(as.character(Exposed.Fraction@output$Exposed.FractionResult))
 
Exposure@output$ExposureResult <- as.numeric(as.character(Exposure@output$ExposureResult))
 
BoD@output$BoDResult <- as.numeric(as.character(BoD@output$BoDResult))
 
ERF@output <- ERF@output[ERF@output$ERF.Parameter == "RR" , ]
 
 
 
if(verbose) {
 
cat("ERF\n")
 
oprint(summary(ERF), digits = 4)
 
cat("Exposure\n")
 
oprint(summary(Exposure))
 
cat("Exposed.Fraction\n")
 
oprint(summary(Exposed.Fraction))
 
cat("Background.Exposure\n")
 
oprint(summary(Background.Exposure))
 
cat("diseaseRisk\n")
 
oprint(summary(diseaseRisk))
 
cat("BoD\n")
 
oprint(summary(BoD))
 
}
 
 
 
RR <- exp(log(ERF) * (Exposure  - Background.Exposure)) # Relative risk with given exposure
 
PAF <- Exposed.Fraction * (RR-1)/(Exposed.Fraction*(RR-1)+1) #Population attributable fraction
 
out <- PAF *BoD # DALYs
 
#out <- (RR - 1) / RR * diseaseRisk * Exposed.Fraction # Number of cases.
 
# Based on PAF * incidence * population size, where diseaseRisk = incidence * total population size
 
 
 
return(out)
 
}
 
)
 
 
 
# Common looped implementations
 
 
 
oloop <- function(
 
    X,
 
    INDEX = NULL,
 
    FUN = NULL, # two parameter function, first previous value then current (recursive algorithm)
 
    cols = NULL
 
) {
 
    marginals <- c(colnames(X@output)[X@marginal], "TempMarginal")
 
X@output$TempMarginal <- 1 # We want to be sure there is at least 1 marginal with cols
 
    if (is.null(INDEX) & is.null(cols)) stop("No INDEX nor cols defined!\n")
 
    if (!is.null(cols)) INDEX <- X@output[marginals[!marginals %in% cols]]
 
    if (length(INDEX) == 0) stop("No marginals!\n")
 
    if (!is.character(INDEX)) INDEX <- colnames(INDEX)
 
 
 
    out <- list()
 
 
 
    for (i in 1:nrow(X@output)) {
 
        ind <- paste(
 
            sapply(as.list(X@output[i, INDEX]), as.character),
 
            collapse = "<ind_sep>"
 
        )
 
        out[[ind]] <- FUN(
 
            out[[ind]],
 
            X@output[i, paste(X@name, "Result", sep = "")]
 
        )
 
    }
 
 
 
    X@output <- as.data.frame(
 
        t(
 
            as.data.frame(
 
                strsplit(names(out), "<ind_sep>", TRUE)
 
            )
 
        )
 
    )
 
    rownames(X@output) <- 1:nrow(X@output)
 
    colnames(X@output) <- INDEX
 
    #cat("test")
 
    X@output[[paste(X@name, "Result", sep = "")]] <- unlist(out)
 
X@output$TempMarginal <- NULL
 
 
 
    X@marginal <- colnames(X@output) %in% marginals # Marginals can be easily corrected here disrequiring CheckMarginals
 
    return(X)
 
}
 
 
 
ocount <- function(
 
    ...
 
) {
 
    return(
 
        oloop(
 
            ...,
 
            FUN = function(e1, e2){
 
                if (is.null(e1)) e1 <- 0;
 
                return(e1 + 1)
 
            }
 
        )
 
    )
 
}
 
 
 
osum <- function(
 
        ...
 
) {
 
    return(
 
            oloop(
 
                    ...,
 
                    FUN = function(e1, e2){
 
                        if (is.null(e1)) e1 <- 0;
 
                        return(e1 + e2)
 
                    }
 
            )
 
    )
 
}
 
 
 
oprod <- function(
 
        ...
 
) {
 
    return(
 
            oloop(
 
                    ...,
 
                    FUN = function(e1, e2){
 
                        if (is.null(e1)) e1 <- 1;
 
                        return(e1 * e2)
 
                    }
 
            )
 
    )
 
}
 
 
 
omean <- function(
 
    ...
 
) {
 
    return(osum(...) / ocount(...))
 
}
 
 
 
objects.store(dose, ooapply, RR, totcases, AF, HIA, oloop, osum, ocount, oprod, omean, testforrow)
 
cat("Ovariables dose, ooapply, RR, totcases, AF, HIA, oloop, osum, ocount, oprod, omean and testforrow saved. page: Op_en2261, code_name: initiate.\n")
 
 
 
</rcode>
 
 
 
The code above is based on these input variables:
 
* [[ERF of several environmental pollutions]]
 
 
* [[Disease risk]] (case-spacific data)
 
* [[Disease risk]] (case-spacific data)
 
* [[Exposures in Finland]] (case-specific data)
 
* [[Exposures in Finland]] (case-specific data)
Line 722: Line 696:
 
* [[Duration of morbidity]] (not used yet)
 
* [[Duration of morbidity]] (not used yet)
 
* [[:heande:File:Impact Calculation Tool.ana]] (not used, but functionalities should be merged to this page)
 
* [[:heande:File:Impact Calculation Tool.ana]] (not used, but functionalities should be merged to this page)
 +
 +
See also related page: [[ISTE EBD]].
  
 
==See also==
 
==See also==
  
 +
* [[Population attributable fraction]]
 
* [http://www.euro.who.int/en/health-topics/health-determinants/social-determinants/activities/data-analysis-and-monitoring/health-impact-assessment-tool WHO Health impact assessment tools]
 
* [http://www.euro.who.int/en/health-topics/health-determinants/social-determinants/activities/data-analysis-and-monitoring/health-impact-assessment-tool WHO Health impact assessment tools]
 
* [http://www.who.int/hia/tools/xtra_tools/en/index.html WHO: HIA tools]
 
* [http://www.who.int/hia/tools/xtra_tools/en/index.html WHO: HIA tools]
Line 753: Line 730:
 
* [[:en:Life cycle assessment|Life cycle assessment]]
 
* [[:en:Life cycle assessment|Life cycle assessment]]
 
* [[:en:Four-step impact assessment|Four-step impact assessment]] by HSPH.
 
* [[:en:Four-step impact assessment|Four-step impact assessment]] by HSPH.
 +
* [[OpasnetUtils/Drafts]]
  
 
=== Assessments that use this HIA model ===
 
=== Assessments that use this HIA model ===

Latest revision as of 10:18, 6 September 2017

<section begin=glossary />

Health impact assessment is an assessment method that is used to estimate the health impacts of a particular event or policy. In Europe, it is most widely used in UK, Finland, and the Netherlands.

<section end=glossary />

Question

How to calculate health impacts based on information about exposure, population, disease, and exposure-response function?

Answer

For simple calculations, you can use the concept of attributable fraction. This is presented here. For more complex and comprehensive methods, you may want to consider these:

An example model run by the model below [1].

Number of iterations:

+ Show code


Inputs

If you are able to describe your data in the format similar to the tables below, you can use ready-made tools in Opasnet and things are quite straightforward. The example tables show data about radon in indoor air.

Exposure

  • The table has an index Observation with four locations: Exposed fraction, Background, Exposure, and Description.
Pollutant Exposure route Exposure metric Exposure parameter Population Exposure unit Exposed fraction Background Exposure Description
Radon Inhalation Annual average concentration Population average Finland Bq/m3 1 5 100 Kurttio Päivi, 2006: STUK otantatutkimus 100 (95 – 105); background 5 (4 – 9)
Radon Inhalation Annual average concentration Guidance value for new apartments Finland Bq/m3 1 0 200 STM decision 944/92 for new apartments [2]
Radon Inhalation Annual average concentration Guidance value for old apartments Finland Bq/m3 1 0 400 STM decision 944/92 for old apartments [3]


Disease response

  • The table has index Observation with two locations: Response and Description.
Disease Response metric Population Unit Response Description
Lung cancer Incidence Finland 1/100000 py 38.058 2020/5307690*100000 [4]
Lung cancer Burden of disease Finland DALY 14000 Olli Leino 2010: Includes trachea, bronchus, and lung cancers. [5]


Exposure-response function

Pollutant Disease Response metric Exposure route Exposure metric Exposure unit Threshold ERF parameter ERF Description
Radon Lung cancer Incidence Inhalation Annual average concentration Bq/m3 0 RR 1.0016 Darby 2004: 1.0016 (1.0005 – 1.0031)


Population

Population Year Sex Age Amount Description
Finland 2010 Total All 5307690 [6]

Rationale

These are the equations you should use:

RR for exposure = EXP(LN(RR)*(Exposure Result - MAX(Exposure Background, Exposure-response function threshold)))

Attributable fraction in the whole population = Exposed fraction * (RR for exposure – 1) / (Exposed fraction *(RR for exposure – 1)+1)

Extra cases per year =Disease incidence * Population * attributable fraction

Burden of disease of exposure = Burden of disease of the disase * attributable fraction

Personal lifetime risk = Extra cases per year * life expectancy * population

Attributable fraction is (RR-1)/RR=1-1/RR if RR>1. If smaller, you must compare the other way round: control group is considered an exposure to lack of a protective agent and thus the exposure group is the reference. In this comparison, the attributable fraction of lack of protection (AFlp) is calculated from a new rate ratio RRlp = 1/RR and

Failed to parse (Missing <code>texvc</code> executable. Please see math/README to configure.): AF_{lp} = 1 - \frac{1}{RR_{lp}} = 1 - \frac{1}{1/RR} = 1 - RR

When multiplied by the number of cases, we get the number of excess cases (that would not have occurred if the population had not been exposed to lack of protection). This comparison is symmetric and we can use either counterfactual situation as the reference just by calculating the difference the other way round, i.e. changing the sign of the value. Therefore, the number of cases avoided with exposure to a protective agent is -AFlp = RR - 1. So, AF is calculated as 1-1/RR or RR-1 depending on whether RR>1 or not, respectively.

Calculations

Depreciated code

+ Show code

Ovariables for calculating RR

+ Show code

+ Show code

+ Show code

+ Show code

+ Show code

+ Show code

+ Show code

+ Show code

Ovariables for calculating cases

+ Show code

+ Show code

+ Show code

Totcases (old version)

+ Show code

NOTE! These ovariables used to utilise ooapply function, but it was archived after improved oapply.

The codes above are based on these input variables:

See also related page: ISTE EBD.

See also

Assessments that use this HIA model

Helsinki energy decision 2015
In English
Assessment Main page | Helsinki energy decision options 2015
Helsinki data Building stock in Helsinki | Helsinki energy production | Helsinki energy consumption | Energy use of buildings | Emission factors for burning processes | Prices of fuels in heat production | External cost
Models Building model | Energy balance | Health impact assessment | Economic impacts
Related assessments Climate change policies in Helsinki | Climate change policies and health in Kuopio | Climate change policies in Basel
In Finnish
Yhteenveto Helsingin energiapäätös 2015 | Helsingin energiapäätöksen vaihtoehdot 2015 | Helsingin energiapäätökseen liittyviä arvoja | Helsingin energiapäätös 2015.pptx



Further reading

The text below is a description of HIA by A. Knol and B. Staatsen from RIVM. It was originally written for use in Intarese project.

Health Impact Assessment

One way to compare different policy options is by carrying out a health impact assessment (HIA). HIA is a combination of procedures, methods and instruments used for assessing the potential health impacts of certain matters. These can vary from a single environmental factor to a more complicated set of factors, for instance in an infrastructural or industrial project. For quantifying health impacts, the following steps can be distinguished (Hertz-Picciotto, 1998):

  • Selection of health endpoints with sufficient proof (based on expert judgements) of a causal relationship with the risk factor
  • Assessment of population exposure (combination of measurements, models and demographic data)
  • Identification of exposure-response relations (relative risks, threshold values) based on (meta) analyses and epidemiological and toxicological research.
  • Estimation of the (extra) number of cases with the specific health state, attributable to exposure to the risk factor. This is a function of the population distribution, exposure-response relation and base prevalence of the health state in the population.
  • Computation of the total health burden, or costs to society of all risk factors (if wanted/necessary)


A common problem is that the health effects of environmental factors can vary considerably with regard to their severity, duration and magnitude. These differences hamper the comparison of policies (comparative risk assessment) or the costs of policy measures (cost effectiveness analysis). An integrated health measure, using the same denominator for all health effects, can help with interpretation and comparison of health problems and policies.

Integrated health measures

Common health measures include mortality, morbidity, healthy life expectancy, attributable burden of disease measures, and monetary valuation. Some of these measures will be further described below. All methods have several associated difficulties, such as imprecision of the population exposure assessment; uncertain shapes of the exposure-response curves for the low environmental exposure levels; insufficient (quality of) epidemiological data; extrapolation from animal to man or from occupational to the general population; generalisation of exposure-response relations from locally collected data for use on regional, national or global scale; combined effects in complex mixtures, etc.

Mortality figures The annual mortality risk or the number of deaths related to a certain (environment-related) disease can be compared with this risk or number in another region or country, or with data from another period in time. Subsequently, different policies can be compared and policies that do or do not work can be identified. Within a country, time trends can be analyzed. This method is easy to comprehend. No ethical questions are attached; everyone is treated equal. Since this method only includes mortality, it is not suitable for assessing factors with less severe consequences (morbidity). Also, it is difficult to attribute mortality to specific environmental causes.

Morbidity figures Similar to mortality figures, morbidity numbers (prevalences or incidences based on hospital admissions or doctor visits) can be used to evaluate a (population) health state. Advantages and drawbacks are comparable to those applying to using mortality figures. The use of morbidity numbers is therefore similarly limited, especially when (environmental) causes of the diseases vary.

Healthy life expectancy Using mortality tables, one can calculate the total average life expectancy for different age groups in a population, subdivided into years with good and years with less-than-good health. This measure is especially useful to review the generic health state in a country for the long term, but it doesn’t give insight into specific health effects, effects of specific policy interventions, or trends in certain subgroups.

Attributable burden of disease Health impact assessments can also be executed by calculating the attributable burden of disease. There are several ways to assess the burden of disease attributable to an (environmental) factor, such as the QALY and the DALY. Quality Adjusted Life Years, QALYs, capture both the quality and quantity elements of health in one indicator. Essentially, time spent in ill health (measured in years) is multiplied by a weight measuring the relative (un)desirability of the illness state. Thereby a number is obtained which represents the equivalent number of years with full health. QALYs are commonly used for cost-utility analysis and to appraise different forms of health care. To do that, QALYs combine life years gained as a result of these health interventions/health care programs with a judgment about the quality of these life years. Disability adjusted life years, DALYs, are comparable to QALYs in that they both combine information on quality and quantity of life. However, contrary to QALYs, DALYs give an indication of the (potential) number of healthy life years lost due to premature mortality or morbidity and are estimated for particular diseases, instead of a health state. Morbidity is weighted for the severity of the disorder.

With QALY, the focus is on assessing individual preference for different non-fatal health outcomes that might result from a specific intervention, whereas the DALY was developed primarily to compare relative burdens among different diseases and among different populations (Morrow and Bryant, 1995). DALYs are suitable for analyzing particular disorders or specific factors that influence health. Problems associated with the DALY approach include the difficulty of estimating the duration of the effects (which have hardly been studied) and the severity of a disease; and allowing for combined effects in the same individual (first you have symptoms, then you go to a hospital and then you may die). The DALY concept, which has been used in our study, will be further described in the next chapter. More information on the drawbacks of the method can be found in Chapter 6.4.

Monetary valuation Another approach to health impact assessment is monetary valuation. In this measure, money is used as a unit to express health loss or gain, thereby facilitating the comparison of policy costs and benefits. It can help policy makers in allocating limited (health care) resources and setting priorities. There are different approaches to monetary valuation such as ‘cost of illness’ and ‘willingness to pay/accept’.

The cost of illness (COI) approach estimates the material costs related to mortality and morbidity. It includes the costs for the whole society and considers loss of income, productivity and medical costs. This approach does not include immaterial costs, such as impact of disability (pain, fear) or decrease in quality of life. This could lead to an underestimation of the health costs. Furthermore, individual preferences are not considered.

The willingness to pay (WTP) approach measures how much money one would be willing to pay for improvement of a certain health state or for a reduction in health risk. The willingness to accept (WTA) approach measures how much money one wants to receive to accept an increased risk. WTP and WTA can be estimated by observing the individual’s behaviour and expenditures on related goods (revealed preference). For example, the extra amount of money people are willing to pay for safer or healthier products (e.g. cars with air bags), or the extra salary they accept for compensation of a risky occupation (De Hollander, 2004). Another similar method is contingent valuation (CV), in which people are asked directly how much money they would be willing to pay (under hypothetical circumstances) for obtaining a certain benefit (e.g. clean air or good health).


Source: Knol, A.B. en Staatsen, B.A.M. (2005). Trends in the environmental burden of disease in the Netherlands, 1980-2020. Rapport 500029001, RIVM, Bilthoven. Downloadable at http://www.rivm.nl/bibliotheek/rapporten/500029001.html