counterfactual.plot: Plot exposure's distribution under counterfactual scenario

In pifpaf: Potential Impact Fraction and Population Attributable Fraction for Cross-Sectional Data

Description

Generates a ggplot2 plot of the current distribution of exposure X (continuous or discrete) as well as the distribution of X after a counterfactual function cft(X) is applied.

Usage

counterfactual.plot(X, cft, weights = rep(1/nrow(as.matrix(X)),
  nrow(as.matrix(X))), adjust = 1, n = 512, ktype = "gaussian",
  bw = "SJ",
  title = "Exposure distribution under current and counterfactual scenarios",
  dnames = c("Current distribution", "Counterfactual distribution"),
  exposure.type = NA, legendtitle = "Scenario", xlab = "Exposure",
  ylab = "Density", colors = c("deepskyblue", "tomato3"),
  x_axis_order = unique(X[, 1]), fill_limits = c(-Inf, Inf), fill = TRUE,
  check_exposure = TRUE)

Arguments

X	Random sample (one-dimensional data.frame) of exposure.
cft	Function cft(X) for counterfactual. **Optional**
weights	Normalized survey weights for the sample X.
adjust	Adjust bandwith parameter (for "continuous" exposure) from density.
n	Number of equally spaced points at which the density (for "continuous" exposure) is to be estimated (see density).
ktype	kernel type: "gaussian", "epanechnikov", "rectangular", "triangular", "biweight", "cosine", "optcosine" (for "continuous" exposure) . Additional information on kernels in density.
bw	Smoothing bandwith parameter (for "continuous" exposure) from density. Default "SJ".
title	String with plot's title.
dnames	String vector indicating the labels for the plot's legend.
exposure.type	Either "continuous" if distribution is continuous or "discrete" if distribution is discrete.
legendtitle	String title for the plot's legend.
xlab	String label for the X-axis of the plot.
ylab	String label for the Y-axis of the plot.
colors	String vector specifying the fill-colors for the plotted distributions.
x_axis_order	String vector of names in X-axis for plot ("discrete" case).
fill_limits	Vector with lower and upper bounds of a subset of the exposure X such that only the Xs satisfying fill_limits[1] < X < fill_limits[2] are filled with color.
fill	Boolean that indicates whether there is interior colouring. Default TRUE.
check_exposure	Check exposure X is positive and numeric (if "continuous").

Details

The function automatically tries to distinguish between "continuous" and "discrete" distribution inputs. By "continuous" we mean a vector of real numbers; by "discrete" a vector of strings or factor variables.

Value

cft_plot ggplot object plotting the shift from observed to counterfactual distribution of exposure X under cft.

Author(s)

Rodrigo Zepeda-Tello [e-mail]

Dalia Camacho-Garc<c3><ad>a-Forment<c3><ad> [e-mail]

References

Vander Hoorn, S., Ezzati, M., Rodgers, A., Lopez, A. D., & Murray, C. J. (2004). Estimating attributable burden of disease from exposure and hazard data. Comparative quantification of health risks: global and regional burden of disease attributable to selected major risk factors. Geneva: World Health Organization, 2129-40.

See Also

pif for Potential Impact Fraction estimation, pif.heatmap for sensitivity analysis of the counterfactual, pif.plot for a plot of pif as a function of the relative risk's parameter theta.

Examples

#Example 1: Bivariate exposure
#--------------------------------------------------------
set.seed(2783569)
X   <- data.frame(Exposure = 
           sample(c("Exposed","Unexposed"), 100, replace = TRUE, 
           prob = c(0.3, 0.7)))
cft <- function(X){

     #Find which indivuals are exposed
     exposed    <- which(X[,"Exposure"] == "Exposed")
     
     #Change 1/3 of exposed to unexposed
     reduced               <- sample(exposed, length(exposed)/3)
     X[reduced,"Exposure"] <- "Unexposed"
     
     return(X)
}  
counterfactual.plot(X, cft)
  
## Not run:    
#Example 2: Multivariate discrete
#--------------------------------------------------------
set.seed(2783569)
X   <- data.frame(Exposure = 
         sample(c("Underweight","Normal","Overweight","Obese"), 1000, 
                replace = TRUE, prob = c(0.05, 0.3, 0.25, 0.4)))
               
#Complex counterfactual of changing half of underweights to normal,
#1/2 of overweights to normal, 1/3 of obese to normal and 
#1/3 of obese to overweight
cft <- function(X){

     #Classify the individuals
     underweights    <- which(X[,"Exposure"] == "Underweight")
     overweights     <- which(X[,"Exposure"] == "Overweight")
     obese           <- which(X[,"Exposure"] == "Obese")
     
     #Sample 1/2 underweights and overweights and 2/3 of obese
     changed_under    <- sample(underweights, length(underweights)/2)
     changed_over     <- sample(overweights,  length(overweights)/2)
     changed_obese    <- sample(obese,        2*length(obese)/3)
     
     #Assign those obese that go to normal and those that go to overweight
     obese_to_normal  <- sample(changed_obese, length(changed_obese)/2)
     obese_to_over    <- which(!(changed_obese %in% obese_to_normal))
     
     #Change the individuals to normal and overweight
     X[changed_under,"Exposure"]   <- "Normal"
     X[changed_over,"Exposure"]    <- "Normal"
     X[obese_to_normal,"Exposure"] <- "Normal"
     X[obese_to_over,"Exposure"]   <- "Overweight"
     
     return(X)
}  

#Create plot of counterfactual distribution
cftplot <- counterfactual.plot(X, cft, 
               x_axis_order = c("Underweight","Normal","Obese","Overweight")) 
cftplot 

#Objects returned are ggplot objects and you can play with them
#require(ggplot2)
#cftplot + coord_flip() + theme_grey()


#Example 3: Normal distribution and linear counterfactual
#--------------------------------------------------------
set.seed(2783569)
X   <- data.frame(Exposure = rnorm(1000, 150, 15))
cft <- function(X){0.35*X + 75}  
counterfactual.plot(X, cft, xlab = "Usual SBP (mmHg)", 
ylab = "Relative risk of ischemic heart disease",
dnames = c("Current distribution", "Theoretical Minimum Risk Distribution"),
title = paste0("Effect of a non-linear hazard function and choice", 
               "\nof baseline on total population risk", 
               "\n(Fig 25 from Vander Hoorn et al)"))
  
#Example 4: Counterfactual of BMI reduction only for those 
#with excess-weight (BMI > 25)
#--------------------------------------------------------
set.seed(2783569)
X <- data.frame(Exposure = rlnorm(1000, 3, 0.2))
cft <- function(X){

     #Find individuals with excess weight
     excess_weight <- which(X[,"Exposure"] > 25)
     
     #Set those with excess weight to BMI of 25
     X[excess_weight, "Exposure"] <- 25
     
     return(X)
}     

counterfactual.plot(X, cft, ktype = "epanechnikov")   

#Change bandwidth method to reduce noise
counterfactual.plot(X, cft, ktype = "epanechnikov", bw = "nrd0")   

## End(Not run) 
  

pifpaf documentation built on May 1, 2019, 9:11 p.m.