| name | mendelian-randomization |
| description | Mendelian randomization in R, including instrument selection, two-sample MR, pleiotropy checks, and sensitivity analysis. |
Mendelian Randomization in R
Overview
Mendelian randomization (MR) methods for causal inference using genetic variants as instrumental variables. Covers instrument selection, two-sample MR, sensitivity analyses, pleiotropy assessment, multivariable MR, and advanced methods for robust causal inference.
Instrument Selection
Using TwoSampleMR
library(TwoSampleMR)
exposure_dat <- extract_instruments(
outcomes = "ieu-a-2",
p1 = 5e-8,
clump = TRUE,
r2 = 0.001,
kb = 10000
)
head(exposure_dat)
exposure_dat <- read_exposure_data(
filename = "exposure_gwas.txt",
sep = "\t",
snp_col = "SNP",
beta_col = "BETA",
se_col = "SE",
effect_allele_col = "A1",
other_allele_col = "A2",
pval_col = "P",
eaf_col = "EAF"
) |>
filter(pval.exposure < 5e-8)
exposure_dat <- clump_data(exposure_dat, clump_r2 = 0.001)
F-statistic Calculation
calculate_f_stat <- function(beta, se, n) {
r2 <- (beta^2) / (beta^2 + se^2 * n)
k <- 1
f_stat <- (r2 * (n - k - 1)) / ((1 - r2) * k)
return(f_stat)
}
exposure_dat$f_stat <- with(exposure_dat,
calculate_f_stat(beta.exposure, se.exposure, samplesize.exposure)
)
cat("Mean F-statistic:", mean(exposure_dat$f_stat), "\n")
cat("SNPs with F < 10:", sum(exposure_dat$f_stat < 10), "\n")
Two-Sample MR
Extract Outcome Data
library(TwoSampleMR)
outcome_dat <- extract_outcome_data(
snps = exposure_dat$SNP,
outcomes = "ieu-a-7"
)
dat <- harmonise_data(
exposure_dat = exposure_dat,
outcome_dat = outcome_dat,
action = 2
)
table(dat$mr_keep)
Primary MR Methods
library(TwoSampleMR)
results <- mr(
dat,
method_list = c(
"mr_ivw",
"mr_egger_regression",
"mr_weighted_median",
"mr_weighted_mode"
)
)
print(results)
or_results <- generate_odds_ratios(results)
print(or_results)
Using MendelianRandomization Package
library(MendelianRandomization)
mr_input <- mr_input(
bx = dat$beta.exposure,
bxse = dat$se.exposure,
by = dat$beta.outcome,
byse = dat$se.outcome,
exposure = "LDL Cholesterol",
outcome = "Coronary Heart Disease"
)
ivw_result <- mr_ivw(mr_input)
print(ivw_result)
egger_result <- mr_egger(mr_input)
print(egger_result)
median_result <- mr_median(mr_input, weighting = "weighted")
print(median_result)
mr_allmethods(mr_input, method = "main")
Sensitivity Analyses
MR-Egger Intercept Test
library(TwoSampleMR)
pleiotropy <- mr_pleiotropy_test(dat)
print(pleiotropy)
library(MendelianRandomization)
egger <- mr_egger(mr_input)
cat("Egger intercept:", egger@Intercept, "\n")
cat("Intercept p-value:", egger@Pvalue.Int, "\n")
Heterogeneity Assessment
library(TwoSampleMR)
het <- mr_heterogeneity(dat)
print(het)
het$I2 <- (het$Q - het$Q_df) / het$Q * 100
het$I2[het$I2 < 0] <- 0
Leave-One-Out Analysis
library(TwoSampleMR)
loo <- mr_leaveoneout(dat)
head(loo)
mr_leaveoneout_plot(loo)
influential <- loo |>
filter(abs(b - results$b[results$method == "Inverse variance weighted"]) >
2 * results$se[results$method == "Inverse variance weighted"])
MR-PRESSO
library(MRPRESSO)
presso <- mr_presso(
BetaOutcome = "beta.outcome",
BetaExposure = "beta.exposure",
SdOutcome = "se.outcome",
SdExposure = "se.exposure",
data = dat,
OUTLIERtest = TRUE,
DISTORTIONtest = TRUE,
NbDistribution = 1000,
SignifThreshold = 0.05
)
presso$`Main MR results`
presso$`MR-PRESSO results`$`Global Test`$Pvalue
presso$`MR-PRESSO results`$`Distortion Test`
Steiger Filtering
library(TwoSampleMR)
dat <- steiger_filtering(dat)
table(dat$steiger_dir)
dat_filtered <- dat[dat$steiger_dir == TRUE | is.na(dat$steiger_dir), ]
results_filtered <- mr(dat_filtered)
Visualization
Scatter Plot
library(TwoSampleMR)
p_scatter <- mr_scatter_plot(results, dat)
print(p_scatter[[1]])
p_scatter[[1]] +
ggplot2::theme_bw() +
ggplot2::labs(
title = "MR Scatter Plot",
x = "SNP effect on exposure",
y = "SNP effect on outcome"
)
Forest Plot
library(TwoSampleMR)
res_single <- mr_singlesnp(dat)
p_forest <- mr_forest_plot(res_single)
print(p_forest[[1]])
Funnel Plot
library(TwoSampleMR)
res_single <- mr_singlesnp(dat)
p_funnel <- mr_funnel_plot(res_single)
print(p_funnel[[1]])
Radial MR Plot
library(RadialMR)
radial_dat <- format_radial(
BXG = dat$beta.exposure,
BYG = dat$beta.outcome,
seBXG = dat$se.exposure,
seBYG = dat$se.outcome,
RSID = dat$SNP
)
ivw_radial <- ivw_radial(radial_dat, alpha = 0.05)
plot_radial(ivw_radial)
egger_radial <- egger_radial(radial_dat)
plot_radial(egger_radial)
Multivariable MR
library(TwoSampleMR)
exposure_ids <- c("ieu-a-299", "ieu-a-300", "ieu-a-302")
exposures <- mv_extract_exposures(exposure_ids)
outcome_dat <- extract_outcome_data(
snps = exposures$SNP,
outcomes = "ieu-a-7"
)
mvdat <- mv_harmonise_data(exposures, outcome_dat)
mv_results <- mv_multiple(mvdat)
print(mv_results$result)
library(MendelianRandomization)
mv_input <- mr_mvinput(
bx = cbind(dat1$beta.exposure, dat2$beta.exposure),
bxse = cbind(dat1$se.exposure, dat2$se.exposure),
by = dat1$beta.outcome,
byse = dat1$se.outcome,
exposure = c("Exposure 1", "Exposure 2"),
outcome = "Outcome"
)
mv_ivw <- mr_mvivw(mv_input)
print(mv_ivw)
mv_egger <- mr_mvegger(mv_input)
print(mv_egger)
Advanced Methods
MR-RAPS
library(mr.raps)
raps_result <- mr.raps(
b_exp = dat$beta.exposure,
b_out = dat$beta.outcome,
se_exp = dat$se.exposure,
se_out = dat$se.outcome,
over.dispersion = TRUE,
loss.function = "huber"
)
summary(raps_result)
MR-Lasso
library(MendelianRandomization)
lasso_result <- mr_lasso(mr_input)
print(lasso_result)
lasso_result@Valid
CAUSE Method
library(cause)
X <- gwas_merge(
exposure_gwas,
outcome_gwas,
snp_name_cols = c("SNP", "SNP"),
beta_hat_cols = c("BETA", "BETA"),
se_cols = c("SE", "SE"),
A1_cols = c("A1", "A1"),
A2_cols = c("A2", "A2")
)
set.seed(123)
variants <- X |>
filter(pval_exp < 1e-3) |>
pull(snp)
cause_result <- cause(
X = X,
variants = variants,
param_ests = params
)
summary(cause_result)
plot(cause_result)
Contamination Mixture Model
library(MendelianRandomization)
conmix <- mr_conmix(mr_input)
print(conmix)
mr_plot(conmix)
Bidirectional MR
library(TwoSampleMR)
forward_results <- mr(dat_forward)
outcome_instruments <- extract_instruments("ieu-a-7")
reverse_exposure <- extract_outcome_data(
snps = outcome_instruments$SNP,
outcomes = "ieu-a-2"
)
dat_reverse <- harmonise_data(outcome_instruments, reverse_exposure)
reverse_results <- mr(dat_reverse)
comparison <- data.frame(
Direction = c("X -> Y", "Y -> X"),
Beta = c(forward_results$b[1], reverse_results$b[1]),
SE = c(forward_results$se[1], reverse_results$se[1]),
P = c(forward_results$pval[1], reverse_results$pval[1])
)
print(comparison)
Reporting Results
create_mr_report <- function(dat, results, het, pleiotropy) {
report <- list(
n_snps = nrow(dat),
methods = results |>
select(method, nsnp, b, se, pval) |>
mutate(
or = exp(b),
ci_lower = exp(b - 1.96 * se),
ci_upper = exp(b + 1.96 * se)
),
heterogeneity = het,
pleiotropy = pleiotropy,
f_statistic = mean(dat$f_stat, na.rm = TRUE)
)
return(report)
}
mr_report <- create_mr_report(dat, results, het, pleiotropy)
Key Packages Summary
| Package | Purpose |
|---|
| TwoSampleMR | Two-sample MR with GWAS databases |
| MendelianRandomization | Classical MR methods |
| MRPRESSO | Outlier detection and correction |
| mr.raps | Robust adjusted profile score |
| RadialMR | Radial MR plots and analysis |
| cause | Causal Analysis Using Summary Effect |
| MVMR | Multivariable MR |
| MRMix | Mixture model MR |
Best Practices
- Instrument strength: Ensure F-statistic > 10 for all instruments
- Multiple methods: Report IVW, MR-Egger, weighted median, and MR-PRESSO
- Sensitivity analyses: Always check heterogeneity, pleiotropy, and leave-one-out
- Steiger filtering: Assess support for the assumed direction; it does not prove direction
- Visualization: Include scatter, forest, and funnel plots
- Bidirectional: Consider reverse causation when biologically plausible
- Biological plausibility: Interpret results in biological context
- Reporting: Follow STROBE-MR guidelines