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

Description Usage Arguments Details Value Author(s) References See Also Examples

View source: R/counterfactual_plot.R

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

1
2
3
4
5
6
7
8
9
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 [email protected]

Dalia Camacho-Garc<c3><ad>a-Forment<c3><ad> [email protected]

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

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
#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 Sept. 29, 2017, 1:03 a.m.