Description Usage Arguments Details Value Author(s) References See Also Examples
View source: R/counterfactual_plot.R
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.
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)
|
X |
Random sample (one-dimensional |
cft |
Function **Optional** |
weights |
Normalized survey |
adjust |
Adjust bandwith parameter (for |
n |
Number of equally spaced points at which the density
(for |
ktype |
|
bw |
Smoothing bandwith parameter
(for |
title |
String with plot's title. |
dnames |
String vector indicating the labels for the plot's legend. |
exposure.type |
Either |
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 ( |
fill_limits |
Vector with lower and upper bounds of a subset of the
exposure |
fill |
Boolean that indicates whether there is interior colouring. Default |
check_exposure |
Check exposure |
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.
cft_plot ggplot
object plotting the shift
from observed to counterfactual distribution of exposure X
under cft
.
Rodrigo Zepeda-Tello rzepeda17@gmail.com
Dalia Camacho-Garc<c3><ad>a-Forment<c3><ad> daliaf172@gmail.com
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.
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
.
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)
|
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.