├── .Rbuildignore ├── .github └── workflows │ └── R-CMD-check.yaml ├── .gitignore ├── DESCRIPTION ├── LICENSE ├── LICENSE.md ├── NAMESPACE ├── R ├── epistasis.r ├── fast_assoc.r ├── format_mr.r ├── generate_individuals.r ├── globals.r ├── ld.r ├── ldetect.r ├── mr_system.r ├── risk.r ├── rsq_liability.r ├── simulateGP-package.r ├── summary_data.R ├── summary_set.r ├── theoretical_gwas.R └── utils-pipe.R ├── README.md ├── _pkgdown.yml ├── codecov.yml ├── data └── ldetect.rdata ├── docs ├── 404.html ├── LICENSE-text.html ├── LICENSE.html ├── articles │ ├── 2smr.png │ ├── fast_linreg.html │ ├── generate_ldobj.html │ ├── generate_ldobj_files │ │ └── accessible-code-block-0.0.1 │ │ │ └── empty-anchor.js │ ├── gwas_summary_data.html │ ├── gwas_summary_data_files │ │ ├── accessible-code-block-0.0.1 │ │ │ └── empty-anchor.js │ │ └── figure-html │ │ │ ├── unnamed-chunk-10-1.png │ │ │ ├── unnamed-chunk-10-2.png │ │ │ ├── unnamed-chunk-12-1.png │ │ │ ├── unnamed-chunk-15-1.png │ │ │ ├── unnamed-chunk-16-1.png │ │ │ ├── unnamed-chunk-17-1.png │ │ │ ├── unnamed-chunk-19-1.png │ │ │ ├── unnamed-chunk-20-1.png │ │ │ ├── unnamed-chunk-4-1.png │ │ │ ├── unnamed-chunk-4-2.png │ │ │ ├── unnamed-chunk-4-3.png │ │ │ ├── unnamed-chunk-5-1.png │ │ │ ├── unnamed-chunk-5-2.png │ │ │ ├── unnamed-chunk-6-1.png │ │ │ ├── unnamed-chunk-7-1.png │ │ │ ├── unnamed-chunk-8-1.png │ │ │ ├── unnamed-chunk-8-2.png │ │ │ ├── unnamed-chunk-8-3.png │ │ │ ├── unnamed-chunk-8-4.png │ │ │ ├── unnamed-chunk-8-5.png │ │ │ ├── unnamed-chunk-8-6.png │ │ │ ├── unnamed-chunk-9-1.png │ │ │ └── unnamed-chunk-9-2.png │ ├── gwas_summary_data_ld.html │ ├── gwas_summary_data_ld_files │ │ ├── accessible-code-block-0.0.1 │ │ │ └── empty-anchor.js │ │ └── figure-html │ │ │ ├── unnamed-chunk-2-1.png │ │ │ ├── unnamed-chunk-2-2.png │ │ │ ├── unnamed-chunk-2-3.png │ │ │ └── unnamed-chunk-7-1.png │ ├── index.html │ ├── individual_gwas.html │ ├── ld_matrices.html │ ├── ld_matrices_files │ │ └── accessible-code-block-0.0.1 │ │ │ └── empty-anchor.js │ ├── mr_dgp.html │ ├── mr_dgp_files │ │ ├── accessible-code-block-0.0.1 │ │ │ └── empty-anchor.js │ │ └── figure-html │ │ │ ├── unnamed-chunk-11-1.png │ │ │ ├── unnamed-chunk-13-1.png │ │ │ ├── unnamed-chunk-16-1.png │ │ │ ├── unnamed-chunk-17-1.png │ │ │ ├── unnamed-chunk-17-2.png │ │ │ ├── unnamed-chunk-19-1.png │ │ │ ├── unnamed-chunk-2-1.png │ │ │ ├── unnamed-chunk-21-1.png │ │ │ ├── unnamed-chunk-4-1.png │ │ │ ├── unnamed-chunk-5-1.png │ │ │ ├── unnamed-chunk-6-1.png │ │ │ └── unnamed-chunk-9-1.png │ ├── mrdag.png │ ├── risk.html │ ├── sample_overlap.html │ ├── sample_overlap_files │ │ ├── accessible-code-block-0.0.1 │ │ │ └── empty-anchor.js │ │ └── figure-html │ │ │ ├── unnamed-chunk-2-1.png │ │ │ ├── unnamed-chunk-2-2.png │ │ │ └── unnamed-chunk-3-1.png │ ├── sample_overlap_theory.html │ ├── sample_overlap_theory_files │ │ └── accessible-code-block-0.0.1 │ │ │ └── empty-anchor.js │ ├── simplemr.html │ ├── simplemr_files │ │ └── accessible-code-block-0.0.1 │ │ │ └── empty-anchor.js │ ├── simulate_gwas.html │ ├── simulate_gwas_files │ │ └── accessible-code-block-0.0.1 │ │ │ └── empty-anchor.js │ ├── simulate_individual_2smr.html │ ├── susie_check.html │ ├── twosamplemr.html │ ├── twosamplemr_files │ │ └── accessible-code-block-0.0.1 │ │ │ └── empty-anchor.js │ ├── weak_instruments.html │ └── weak_instruments_files │ │ ├── accessible-code-block-0.0.1 │ │ └── empty-anchor.js │ │ └── figure-html │ │ ├── unnamed-chunk-14-1.png │ │ ├── unnamed-chunk-5-1.png │ │ ├── unnamed-chunk-5-2.png │ │ ├── unnamed-chunk-8-1.png │ │ ├── unnamed-chunk-8-2.png │ │ ├── unnamed-chunk-8-3.png │ │ ├── unnamed-chunk-8-4.png │ │ ├── unnamed-chunk-8-5.png │ │ ├── unnamed-chunk-8-6.png │ │ └── unnamed-chunk-9-1.png ├── authors.html ├── bootstrap-toc.css ├── bootstrap-toc.js ├── docsearch.css ├── docsearch.js ├── index.html ├── link.svg ├── pkgdown.css ├── pkgdown.js ├── pkgdown.yml ├── reference │ ├── add_ld_to_params.html │ ├── add_u.html │ ├── allele_frequency.html │ ├── arbitrary_map.html │ ├── ascertain_samples.html │ ├── choose_effects.html │ ├── contingency.html │ ├── correlated_binomial.html │ ├── create_system.html │ ├── estimate_system_effects.html │ ├── expected_gwas.html │ ├── expected_mse.html │ ├── expected_se.html │ ├── expected_ssx.html │ ├── fast_assoc.html │ ├── generate_gwas_params.html │ ├── generate_gwas_ss.html │ ├── generate_gwas_ss_1.html │ ├── generate_ldobj.html │ ├── get_effs.html │ ├── get_ld.html │ ├── get_population_allele_frequency.html │ ├── get_regions_from_ldobjdir.html │ ├── gwas.html │ ├── gwas_se.html │ ├── gx_to_gp.html │ ├── hap_freqs.html │ ├── index.html │ ├── init_parameters.html │ ├── ldetect.html │ ├── lor_to_rsq.html │ ├── make_dat.html │ ├── make_geno.html │ ├── make_mvdat.html │ ├── make_phen.html │ ├── merge_exp_out.html │ ├── pipe.html │ ├── range01.html │ ├── read_ldobjdir.html │ ├── recode_dat.html │ ├── recode_dat_intercept.html │ ├── recode_dat_simple.html │ ├── risk_cross_plot.html │ ├── risk_simulation.html │ ├── sample_beta.html │ ├── sample_system_effects.html │ ├── simulateGP-package.html │ ├── simulate_geno.html │ ├── simulate_haplotypes.html │ ├── simulate_population.html │ ├── stuff.html │ ├── summary_set.html │ ├── test_ldobj.html │ ├── test_system.html │ ├── theoretical_gwas.html │ └── y_to_binary.html └── sitemap.xml ├── inst ├── extdata │ ├── ldetect │ │ ├── AFR.bed │ │ ├── ASN.bed │ │ └── EUR.bed │ └── ldobj_5_141345062_141478055.rds └── sandpit │ ├── disease_rsq.r │ ├── dunno.r │ ├── expected_gwas.r │ ├── expected_gwas2.r │ ├── risk.r │ ├── simulate_from_dag.r │ └── system.r ├── man ├── add_u.Rd ├── allele_frequency.Rd ├── arbitrary_map.Rd ├── ascertain_samples.Rd ├── choose_effects.Rd ├── contingency.Rd ├── correlated_binomial.Rd ├── create_system.Rd ├── estimate_system_effects.Rd ├── expected_mse.Rd ├── expected_se.Rd ├── expected_ssx.Rd ├── fast_assoc.Rd ├── generate_gwas_params.Rd ├── generate_gwas_ss.Rd ├── generate_gwas_ss_1.Rd ├── generate_ldobj.Rd ├── get_effs.Rd ├── get_ld.Rd ├── get_population_allele_frequency.Rd ├── get_regions_from_ldobjdir.Rd ├── gwas.Rd ├── gx_to_gp.Rd ├── hap_freqs.Rd ├── init_parameters.Rd ├── ldetect.Rd ├── lor_to_rsq.Rd ├── make_geno.Rd ├── make_mvdat.Rd ├── make_phen.Rd ├── merge_exp_out.Rd ├── pipe.Rd ├── range01.Rd ├── read_ldobjdir.Rd ├── recode_dat.Rd ├── recode_dat_intercept.Rd ├── recode_dat_simple.Rd ├── risk_cross_plot.Rd ├── risk_simulation.Rd ├── sample_beta.Rd ├── sample_system_effects.Rd ├── simulateGP-package.Rd ├── simulate_geno.Rd ├── simulate_haplotypes.Rd ├── simulate_population.Rd ├── stuff.Rd ├── summary_set.Rd ├── test_ldobj.Rd ├── test_system.Rd └── y_to_binary.Rd ├── tests ├── testthat.R └── testthat │ ├── test_fastassoc.R │ ├── test_format_mr.R │ ├── test_generate_individuals.R │ ├── test_ld.R │ ├── test_mr_system.r │ ├── test_summary_set.R │ └── test_theoreticalgwas.R └── vignettes ├── .gitignore ├── 2smr.png ├── generate_ldobj.Rmd ├── gwas_summary_data.Rmd ├── gwas_summary_data_ld.Rmd ├── ld_matrices.Rmd ├── mr_dgp.rmd ├── mrdag.png ├── sample_overlap.Rmd ├── sample_overlap_theory.Rmd ├── simplemr.Rmd ├── simulate_gwas.Rmd ├── susie_check.Rmd ├── twosamplemr.Rmd └── weak_instruments.Rmd /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^doc$ 2 | ^Meta$ 3 | ^LICENSE\.md$ 4 | ^_pkgdown\.yml$ 5 | ^docs$ 6 | ^pkgdown$ 7 | ^\.github$ 8 | ^codecov\.yml$ 9 | ^test\.R$ 10 | ^\.vscode$ 11 | -------------------------------------------------------------------------------- /.github/workflows/R-CMD-check.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | branches: [main, master] 8 | 9 | name: R-CMD-check 10 | 11 | jobs: 12 | R-CMD-check: 13 | runs-on: ${{ matrix.config.os }} 14 | 15 | name: ${{ matrix.config.os }} (${{ matrix.config.r }}) 16 | 17 | strategy: 18 | fail-fast: false 19 | matrix: 20 | config: 21 | - {os: macos-latest, r: 'release'} 22 | - {os: windows-latest, r: 'release'} 23 | - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} 24 | - {os: ubuntu-latest, r: 'release'} 25 | - {os: ubuntu-latest, r: 'oldrel-1'} 26 | 27 | env: 28 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 29 | R_KEEP_PKG_SOURCE: yes 30 | 31 | steps: 32 | - uses: actions/checkout@v3 33 | 34 | - uses: r-lib/actions/setup-pandoc@v2 35 | 36 | - uses: r-lib/actions/setup-r@v2 37 | with: 38 | r-version: ${{ matrix.config.r }} 39 | http-user-agent: ${{ matrix.config.http-user-agent }} 40 | use-public-rspm: true 41 | 42 | - uses: r-lib/actions/setup-r-dependencies@v2 43 | with: 44 | extra-packages: any::rcmdcheck 45 | needs: check 46 | 47 | - uses: r-lib/actions/check-r-package@v2 48 | with: 49 | upload-snapshots: true 50 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | inst/doc 5 | doc 6 | Meta 7 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: simulateGP 2 | Title: Functions for Simulating Genotype-Phenotype Relationships 3 | Version: 0.1.3 4 | Authors@R: c( 5 | person("Gibran", "Hemani", , "explodecomputer@gmail.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0003-0920-1055")), 6 | person("John", "Ferguson", , "john.ferguson@nuigalway.ie", role = "aut"), 7 | person("Rita", "Rasteiro", , "rita.rasteiro@bristol.ac.uk", role = c("aut"), comment = c(ORCID = "0000-0002-4217-3060")) 8 | ) 9 | Description: Functions for simulating SNP effects on phenotypes. Functions 10 | for simulating disease risk on probability and liability scales. 11 | Simulations to quickly obtain estimates of effect sizes for simulated 12 | genotype-phenotypes. 13 | License: MIT + file LICENSE 14 | URL: https://explodecomputer.github.io/simulateGP/ 15 | BugReports: https://github.com/explodecomputer/simulateGP/issues 16 | Depends: 17 | R (>= 4.0.0) 18 | Imports: 19 | data.table, 20 | dplyr, 21 | genetics.binaRies, 22 | ggplot2, 23 | graphics, 24 | gwasglue2, 25 | ieugwasr, 26 | magrittr, 27 | MASS, 28 | parallel, 29 | pbapply, 30 | rlang, 31 | stats, 32 | TwoSampleMR 33 | Suggests: 34 | covr, 35 | dagitty, 36 | ggdag, 37 | jsonlite, 38 | knitr, 39 | mvtnorm, 40 | rmarkdown, 41 | systemfit, 42 | testthat, 43 | tidyverse 44 | VignetteBuilder: 45 | knitr 46 | Remotes: 47 | mrcieu/genetics.binaRies, 48 | mrcieu/gwasglue2, 49 | mrcieu/ieugwasr, 50 | mrcieu/TwoSampleMR 51 | Encoding: UTF-8 52 | LazyData: true 53 | Roxygen: list(markdown = TRUE) 54 | RoxygenNote: 7.3.1 55 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2021 2 | COPYRIGHT HOLDER: Gibran Hemani 3 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | # MIT License 2 | 3 | Copyright (c) 2021 Gibran Hemani 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | export("%>%") 4 | export(add_u) 5 | export(allele_frequency) 6 | export(arbitrary_map) 7 | export(ascertain_samples) 8 | export(choose_effects) 9 | export(contingency) 10 | export(correlated_binomial) 11 | export(create_system) 12 | export(estimate_system_effects) 13 | export(expected_mse) 14 | export(expected_se) 15 | export(expected_ssx) 16 | export(fast_assoc) 17 | export(generate_gwas_params) 18 | export(generate_gwas_ss) 19 | export(generate_gwas_ss_1) 20 | export(generate_ldobj) 21 | export(get_effs) 22 | export(get_ld) 23 | export(get_population_allele_frequency) 24 | export(get_regions_from_ldobjdir) 25 | export(gwas) 26 | export(gx_to_gp) 27 | export(hap_freqs) 28 | export(init_parameters) 29 | export(lor_to_rsq) 30 | export(make_geno) 31 | export(make_mvdat) 32 | export(make_phen) 33 | export(merge_exp_out) 34 | export(range01) 35 | export(read_ldobjdir) 36 | export(recode_dat) 37 | export(recode_dat_intercept) 38 | export(recode_dat_simple) 39 | export(risk_cross_plot) 40 | export(risk_simulation) 41 | export(sample_beta) 42 | export(sample_system_effects) 43 | export(simulate_geno) 44 | export(simulate_haplotypes) 45 | export(simulate_population) 46 | export(summary_set) 47 | export(test_ldobj) 48 | export(test_system) 49 | export(y_to_binary) 50 | importFrom(graphics,hist) 51 | importFrom(magrittr,"%>%") 52 | importFrom(rlang,.data) 53 | importFrom(stats,anova) 54 | importFrom(stats,cor) 55 | importFrom(stats,cov) 56 | importFrom(stats,glm) 57 | importFrom(stats,lm) 58 | importFrom(stats,na.exclude) 59 | importFrom(stats,pf) 60 | importFrom(stats,plogis) 61 | importFrom(stats,pnorm) 62 | importFrom(stats,pt) 63 | importFrom(stats,qnorm) 64 | importFrom(stats,quantile) 65 | importFrom(stats,rbinom) 66 | importFrom(stats,rnorm) 67 | importFrom(stats,runif) 68 | importFrom(stats,start) 69 | importFrom(stats,uniroot) 70 | importFrom(stats,var) 71 | importFrom(utils,write.table) 72 | -------------------------------------------------------------------------------- /R/epistasis.r: -------------------------------------------------------------------------------- 1 | epistasis_problem.simulate_system <- function(nid, r, p1, p2, p3, rsq) 2 | { 3 | cis <- simulate_geno(nid, r, p1, p2) 4 | trans <- rbinom(nid, 2, p3) 5 | y <- scale(cis[,1]) * sqrt(rsq) + stats::rnorm(nid, sd=sqrt(1-rsq)) 6 | dat <- data.frame( 7 | cis=cis[,1], 8 | cist=cis[,2], 9 | trans=trans, 10 | y=y 11 | ) 12 | return(dat) 13 | } 14 | 15 | epistasis_problem.run1 <- function(param, i) 16 | { 17 | set.seed(param$seed[i]) 18 | a <- with(param[i, ], simulate_system(nid, r, p1, p2, p3, rsq)) 19 | moda1 <- lm(y ~ as.factor(cis) + as.factor(trans), a) 20 | moda2 <- lm(y ~ as.factor(cis) * as.factor(trans), a) 21 | moda <- anova(moda1, moda2) 22 | modb1 <- lm(y ~ as.factor(cist) + as.factor(trans), a) 23 | modb2 <- lm(y ~ as.factor(cist) * as.factor(trans), a) 24 | modb <- anova(modb1, modb2) 25 | param$pint[i] <- moda$P[2] 26 | param$pintt[i] <- modb$P[2] 27 | return(param) 28 | } 29 | 30 | epistasis_problem <- function() 31 | { 32 | a <- simulate_haplotypes(563, 0.9, 0.5, 0.5) 33 | b <- simulate_geno(1000, 0.9, 0.5, 0.5) 34 | a <- correlated_binomial(10000, 0.5, 0.5, 0.1) 35 | a <- simulate_system(1000, 0.8, 0.5, 0.5, 0.5, 0.3) 36 | 37 | param <- expand.grid( 38 | sim=1:300, 39 | nid=1000, 40 | r=c(sqrt(0.1), sqrt(0.5), sqrt(0.9)), 41 | p1=0.5, 42 | p2=0.5, 43 | p3=0.5, 44 | rsq=c(0.01, 0.1, 0.5), 45 | seed=NA, 46 | pint=NA, 47 | pintt=NA 48 | ) 49 | param$seed <- 1:nrow(param) 50 | 51 | 52 | for(i in 1:nrow(param)) 53 | { 54 | message(i) 55 | param <- run1(param, i) 56 | } 57 | 58 | graphics::hist(param$pintt) 59 | min(param$pintt) 60 | 61 | graphics::hist(param$pint, breaks=20) 62 | min(param$pint) 63 | 64 | } 65 | -------------------------------------------------------------------------------- /R/fast_assoc.r: -------------------------------------------------------------------------------- 1 | #' Get summary statistics in simple linear regression 2 | #' 3 | #' @param y Vector of dependent variable 4 | #' @param x Vector of independent variable 5 | #' 6 | #' @export 7 | #' @return List 8 | fast_assoc <- function(y, x) 9 | { 10 | index <- is.finite(y) & is.finite(x) 11 | n <- sum(index) 12 | y <- y[index] 13 | x <- x[index] 14 | vx <- var(x) 15 | bhat <- stats::cov(y, x) / vx 16 | ahat <- mean(y) - bhat * mean(x) 17 | # fitted <- ahat + x * bhat 18 | # residuals <- y - fitted 19 | # SSR <- sum((residuals - mean(residuals))^2) 20 | # SSF <- sum((fitted - mean(fitted))^2) 21 | 22 | rsq <- (bhat * vx)^2 / (vx * var(y)) 23 | fval <- rsq * (n-2) / (1-rsq) 24 | tval <- sqrt(fval) 25 | se <- abs(bhat / tval) 26 | 27 | # Fval <- (SSF) / (SSR/(n-2)) 28 | # pval <- pf(Fval, 1, n-2, lowe=F) 29 | p <- stats::pf(fval, 1, n-2, lower.tail=FALSE) 30 | return(list( 31 | ahat=ahat, bhat=bhat, se=se, fval=fval, pval=p, n=n 32 | )) 33 | } 34 | 35 | logistic_assoc <- function(y, x) 36 | { 37 | mod <- summary(glm(y ~ x, family="binomial"))$coefficients 38 | n <- sum(is.finite(y) & is.finite(x)) 39 | 40 | return(list( 41 | ahat=mod[1,1], 42 | bhat=mod[2,1], 43 | se=mod[2,2], 44 | fval=mod[2,3]^2, 45 | pval=mod[2,4], 46 | n=n 47 | )) 48 | } 49 | 50 | #' Perform association of many SNPs against phenotype 51 | #' 52 | #' @param y Vector of phenotypes 53 | #' @param g Matrix of genotypes 54 | #' @param logistic Use logistic regression (much slower)? Default=FALSE 55 | #' @importFrom stats glm 56 | #' 57 | #' @export 58 | #' @return Data frame 59 | gwas <- function(y, g, logistic=FALSE) 60 | { 61 | out <- matrix(0, ncol(g), 6) 62 | if(logistic) 63 | { 64 | stopifnot(all(y %in% c(0,1))) 65 | for(i in 1:ncol(g)) 66 | { 67 | o <- logistic_assoc(y, g[,i]) 68 | out[i, ] <- unlist(o) 69 | } 70 | } else { 71 | for(i in 1:ncol(g)) 72 | { 73 | o <- fast_assoc(y, g[,i]) 74 | out[i, ] <- unlist(o) 75 | } 76 | } 77 | 78 | out <- dplyr::as_tibble(out, .name_repair="minimal") 79 | names(out) <- names(o) 80 | out$snp <- 1:ncol(g) 81 | return(out) 82 | } 83 | 84 | #' Get effs for two traits and make dat format 85 | #' 86 | #' @param x Vector of exposure phenotype 87 | #' @param y Vector of outcome phenotype 88 | #' @param g Matrix of genotypes 89 | #' @param xname xname 90 | #' @param yname yname 91 | #' 92 | #' @export 93 | #' @return Data frame 94 | get_effs <- function(x, y, g, xname="X", yname="Y") 95 | { 96 | gwasx <- gwas(x, g) 97 | gwasy <- gwas(y, g) 98 | return(merge_exp_out(gwasx, gwasy, xname, yname)) 99 | } 100 | -------------------------------------------------------------------------------- /R/format_mr.r: -------------------------------------------------------------------------------- 1 | #' Organise outputs from \code{gwas} into harmonised dat format 2 | #' 3 | #' @param gwasx Output from \code{gwas} 4 | #' @param gwasy Output from \code{gwas} 5 | #' @param xname exposure name 6 | #' @param yname outcome name 7 | #' 8 | #' @export 9 | #' @return data frame 10 | merge_exp_out <- function(gwasx, gwasy, xname="X", yname="Y") 11 | { 12 | d <- dplyr::inner_join(gwasx, gwasy, by='snp') 13 | dat <- dplyr::tibble( 14 | SNP = d$snp, 15 | exposure=xname, 16 | id.exposure=xname, 17 | outcome=yname, 18 | id.outcome=yname, 19 | beta.exposure=d$bhat.x, 20 | beta.outcome=d$bhat.y, 21 | se.exposure=d$se.x, 22 | se.outcome=d$se.y, 23 | pval.exposure=d$pval.x, 24 | pval.outcome=d$pval.y, 25 | samplesize.exposure=d$n.x, 26 | samplesize.outcome=d$n.y, 27 | units.exposure = "SD", 28 | units.outcome = "SD", 29 | rsq.exposure = d$fval.x / (d$fval.x + d$n.x - 2), 30 | rsq.outcome = d$fval.y / (d$fval.y + d$n.y - 2), 31 | mr_keep=TRUE 32 | ) 33 | return(dat) 34 | } 35 | 36 | #' Simple recoding to have every effect on x positive 37 | #' 38 | #' @param dat Output from get_effs 39 | #' 40 | #' @export 41 | #' @return Data frame 42 | recode_dat_simple <- function(dat) 43 | { 44 | .Deprecated('recode_dat') 45 | sign0 <- function(x) { 46 | x[x == 0] <- 1 47 | return(sign(x)) 48 | } 49 | index <- sign0(dat$beta.exposure) == -1 50 | dat$beta.exposure <- abs(dat$beta.exposure) 51 | dat$beta.outcome[index] <- dat$beta.outcome[index] * -1 52 | return(dat) 53 | } 54 | 55 | #' Intercept recoding to have every effect on x positive 56 | #' 57 | #' Tries to avoid issue of recoding by finding intercept and pivoting negative g-x associations around intercept 58 | #' 59 | #' @param dat Output from get_effs 60 | #' 61 | #' @export 62 | #' @return Data frame 63 | recode_dat_intercept <- function(dat) 64 | { 65 | .Deprecated('recode_dat') 66 | a <- lm(beta.outcome ~ beta.exposure, dat)$coefficients[1] 67 | index <- dat$beta.exposure < 0 68 | dat$beta.exposure[index] <- dat$beta.exposure[index] * -1 69 | dat$beta.outcome[index] <- dat$beta.outcome[index] * -1 + 2 * a 70 | dat$index <- index 71 | return(dat) 72 | } 73 | 74 | #' Recode data to make every effect on x positive 75 | #' 76 | #' Can use simple method or by pivoting around intercept 77 | #' 78 | #' @param dat Output from get_effs 79 | #' @param method Default 'intercept'. Alternatively can specify 'simple' 80 | #' 81 | #' @export 82 | #' @return Data frame 83 | recode_dat <- function(dat, method='intercept') 84 | { 85 | if(method == 'intercept') 86 | { 87 | a <- lm(beta.outcome ~ beta.exposure, dat)$coefficients[1] 88 | index <- dat$beta.exposure < 0 89 | dat$beta.exposure[index] <- dat$beta.exposure[index] * -1 90 | dat$beta.outcome[index] <- dat$beta.outcome[index] * -1 + 2 * a 91 | dat$index <- index 92 | return(dat) 93 | } else if(method == 'simple') { 94 | sign0 <- function(x) { 95 | x[x == 0] <- 1 96 | return(sign(x)) 97 | } 98 | index <- sign0(dat$beta.exposure) == -1 99 | dat$beta.exposure <- abs(dat$beta.exposure) 100 | dat$beta.outcome[index] <- dat$beta.outcome[index] * -1 101 | return(dat) 102 | } else { 103 | stop('method must be intercept or simple') 104 | } 105 | } 106 | 107 | 108 | #' Take several exposures and one outcome and make the data required for multivariable MR 109 | #' 110 | #' @param exposures List of exposure vectors 111 | #' @param y Vector of outcomes 112 | #' @param g Matrix of genotypes 113 | #' 114 | #' @export 115 | #' @return mv_harmonise_data output 116 | make_mvdat <- function(exposures, y, g) 117 | { 118 | stopifnot(is.list(exposures)) 119 | message("There are ", length(exposures), " exposures") 120 | if(is.null(names(exposures))) 121 | { 122 | names(exposures) <- paste0("x", 1:length(exposures)) 123 | } 124 | exposure_dat <- lapply(exposures, function(x) gwas(x, g)) 125 | # exposure_dat1 <- gwas(x1, g) 126 | # exposure_dat2 <- gwas(x2, g) 127 | af <- colSums(g) / (nrow(g) * 2) 128 | out <- gwas(y, g) 129 | mvexp <- data.frame( 130 | SNP=1:ncol(g), 131 | effect_allele.exposure="A", 132 | other_allele.exposure="G", 133 | eaf.exposure=rep(af, times=length(exposures)), 134 | exposure=rep(names(exposures), each=ncol(g)), 135 | id.exposure=rep(names(exposures), each=ncol(g)), 136 | beta.exposure = lapply(exposure_dat, function(x) x$bhat) %>% unlist, 137 | se.exposure = lapply(exposure_dat, function(x) x$se) %>% unlist, 138 | pval.exposure = lapply(exposure_dat, function(x) x$pval) %>% unlist 139 | ) 140 | outcome_dat <- data.frame( 141 | SNP=rep(1:ncol(g), times=length(exposures)), 142 | outcome="y", 143 | id.outcome="y", 144 | effect_allele.outcome="A", 145 | other_allele.outcome="G", 146 | eaf.outcome=rep(af, times=length(exposures)), 147 | beta.outcome = rep(out$bhat, times=length(exposures)), 148 | se.outcome = rep(out$se, times=length(exposures)), 149 | pval.outcome = rep(out$pval, times=length(exposures)) 150 | ) 151 | mvdat <- TwoSampleMR::mv_harmonise_data(mvexp, outcome_dat) 152 | return(mvdat) 153 | } 154 | -------------------------------------------------------------------------------- /R/generate_individuals.r: -------------------------------------------------------------------------------- 1 | 2 | #' Simulate variable based on the influences of other variables 3 | #' 4 | #' I need a function that takes some variables, and an effect size for each of them, and this creates a new variable where y = Xb + e, where X is the matrix of independent variables, b is their effect sizes, and e is a noise term. By default it's easier if b relates to the variance explained by each vector in X, and e has variance of 1 - sum(b). 5 | #' 6 | #' @param effs An array of effect sizes that the variables in indep have on the variable that you are simulating 7 | #' @param indep A matrix of variables, rows = Samples and columns = variables that have an influence on the variable that you are simulating 8 | #' @param vy What variance the output should have. Default = 1, meaning effs relate to the signed rsq of the influence of the indep variables on the outcome 9 | #' @param vx What variance the indep variables should have. Default is to set to 1, meaning that the effects are the signed variance explained 10 | #' @param my mean value of y to be output 11 | #' 12 | #' @export 13 | #' @return Vector of y values 14 | make_phen <- function(effs, indep, vy=1, vx=rep(1, length(effs)), my=0) 15 | { 16 | if(is.null(dim(indep))) indep <- cbind(indep) 17 | stopifnot(ncol(indep) == length(effs)) 18 | stopifnot(length(vx) == length(effs)) 19 | cors <- effs * vx / sqrt(vx) / sqrt(vy) 20 | sc <- sum(cors^2) 21 | if(sc >= 1) 22 | { 23 | print(sc) 24 | stop("effects explain more than 100% of variance") 25 | } 26 | cors <- c(cors, sqrt(1-sum(cors^2))) 27 | indep <- t(t(scale(cbind(indep, stats::rnorm(nrow(indep))))) * cors * c(vx, 1)) 28 | y <- drop(scale(rowSums(indep)) * sqrt(vy)) + my 29 | return(y) 30 | } 31 | 32 | #' Create genotype matrix 33 | #' 34 | #' @param nid Number of samples 35 | #' @param nsnp Number of SNPs 36 | #' @param af Allele frequency of all SNPs (all SNPs have the same allele frequency) 37 | #' 38 | #' @export 39 | #' @return Matrix of genotypes, rows = individuals, columns = snps 40 | make_geno <- function(nid, nsnp, af) 41 | { 42 | return(matrix(rbinom(nid * nsnp, 2, af), nid, nsnp)) 43 | } 44 | 45 | #' Get vector of effects that explain some amount of variance 46 | #' 47 | #' @param nsnp Number of SNPs 48 | #' @param totvar Total variance explained by all SNPs 49 | #' @param sqrt Output effect sizes in terms of standard deviations. Default=TRUE 50 | #' @param mua Constant term to be added to effects. Default = 0 51 | #' 52 | #' @export 53 | #' @return Vector of effects 54 | choose_effects <- function(nsnp, totvar, sqrt=TRUE, mua=0) 55 | { 56 | eff <- stats::rnorm(nsnp) 57 | eff <- sign(eff) * eff^2 58 | aeff <- abs(eff) 59 | sc <- sum(aeff) / totvar 60 | out <- eff / sc 61 | if(sqrt) 62 | { 63 | out <- sqrt(abs(out)) * sign(out) 64 | } 65 | return(out + mua) 66 | } 67 | 68 | #' Convert continuous trait to binary 69 | #' 70 | #' @param y Phenotype vector 71 | #' @param prevalence Disease prevalence. Default = NULL 72 | #' @param threshold Disease threshold Default = NULL 73 | #' 74 | #' @export 75 | #' @return Vector of binary trait 76 | y_to_binary <- function(y, prevalence=NULL, threshold=NULL) 77 | { 78 | if(is.null(prevalence) & is.null(threshold)) stop("Prevalence or threshold needs to be non-null") 79 | if(!is.null(prevalence)) 80 | { 81 | d <- y 82 | t <- quantile(d, 1-prevalence) 83 | d[y >= t] <- 1 84 | d[y < t] <- 0 85 | return(d) 86 | } 87 | if(!is.null(threshold)) 88 | { 89 | d <- y 90 | d[y >= threshold] <- 1 91 | d[y < threshold] <- 0 92 | return(d) 93 | } 94 | } 95 | 96 | 97 | #' Ascertain some proportion of cases and controls from binary phenotype 98 | #' 99 | #' @param d Vector of 1/0 100 | #' @param prop_cases Proportion of 1s to retain 101 | #' 102 | #' @export 103 | #' @return Array of IDs 104 | ascertain_samples <- function(d, prop_cases) 105 | { 106 | d <- d[!is.na(d)] 107 | d <- d[d %in% c(0,1)] 108 | x1 <- sum(d==1) 109 | x0 <- sum(d==0) 110 | exp_cases <- x1 111 | exp_controls <- (x1 - prop_cases * x1) / prop_cases 112 | if(round(exp_controls) > x0) 113 | { 114 | exp_controls <- x0 115 | exp_cases <- (x0 - (1 - prop_cases) * x0) / (1 - prop_cases) 116 | } 117 | i0 <- which(d == 0) 118 | i0 <- sample(i0, exp_controls, replace=FALSE) 119 | i1 <- which(d == 1) 120 | i1 <- sample(i1, exp_cases, replace=FALSE) 121 | 122 | return(sort(c(i0, i1))) 123 | } 124 | 125 | -------------------------------------------------------------------------------- /R/globals.r: -------------------------------------------------------------------------------- 1 | utils::globalVariables(c("CHR", "EAF", "POS", "SNP", "b", "beta.exposure", "beta.outcome", "bhat", "bind_rows", "both", "chr", "counts", "fval", "fval.exposure", "fval.outcome", "gr", "hypothesis", "key", "n", "outlier", "pval.exposure", "run1", "se", "se.exposure", "se.outcome", "selection", "simulate_system", "steiger", "type", "value", "af", "pos", "gp", "region", "snp", ".", "beta_ld", "glm")) 2 | -------------------------------------------------------------------------------- /R/ldetect.r: -------------------------------------------------------------------------------- 1 | #' Data frame of independent LD regions 2 | #' 3 | #' Taken from Berisa and Pickrell (2016) - \url{https://www.ncbi.nlm.nih.gov/pmc/articles/PMC4731402/} - a list of independent LD regions for Africans, Europeans and Asians. All in build hg19 4 | #' 5 | #' @format A data frame with 5731 rows and 4 columns 6 | #' \describe{ 7 | #' \item{chr}{chromosome} 8 | #' \item{start}{start position} 9 | #' \item{stop}{stop position} 10 | #' \item{pop}{Population} 11 | #' } 12 | #' 13 | #' @source \url{https://bitbucket.org/nygcresearch/ldetect-data](https://bitbucket.org/nygcresearch/ldetect-data/src/master/} 14 | "ldetect" -------------------------------------------------------------------------------- /R/risk.r: -------------------------------------------------------------------------------- 1 | #' Scale variable to have range between 0 and 1 2 | #' 3 | #' @param x Vector 4 | #' 5 | #' @export 6 | #' @return Vector 7 | range01 <- function(x) 8 | { 9 | (x-min(x))/(max(x)-min(x)) 10 | } 11 | 12 | #' Translate risk from liability to probability scale 13 | #' 14 | #' @param gx score on liability scale 15 | #' @param h2x Disease heritability on liability scale 16 | #' @param prev Prevalence 17 | #' 18 | #' @export 19 | #' @return Vector of disease probabilities 20 | gx_to_gp <- function(gx, h2x, prev) 21 | { 22 | x_prime <- qnorm(prev, 0, 1, lower.tail=FALSE) 23 | p <- pnorm(x_prime, mean=gx, sd = sqrt(1 - h2x), lower.tail=FALSE) 24 | return(p) 25 | } 26 | 27 | #' Plot liability vs probability disease risk 28 | #' 29 | #' @param x Disease risk on liability scale 30 | #' @param o Disease risk on probability scale 31 | #' @param xlab default="Values (low to high)" 32 | #' @param ylab default="" 33 | #' @param title default="" 34 | #' @param xname Name of liability. Default="GRS" 35 | #' @param oname Name of disease. Default="Disease" 36 | #' 37 | #' @export 38 | #' @return ggplot 39 | risk_cross_plot <- function(x, o, xlab="Values (low to high)", ylab="", title="", xname="GRS", oname="Disease") 40 | { 41 | d <- dplyr::tibble( 42 | value = c(range01(o), range01(x)), 43 | key = c(rep(oname, length(o)), rep(xname, length(x))), 44 | gr = rep(1:length(x), times=2) 45 | ) 46 | d$key <- factor(d$key, levels=c(xname, oname)) 47 | ggplot2::ggplot(d, ggplot2::aes(x=value, y=key)) + 48 | ggplot2::geom_line(ggplot2::aes(group=gr), alpha=0.1) + 49 | ggplot2::geom_point(ggplot2::aes(colour=key)) + 50 | ggplot2::labs(x=xlab,y=ylab,title=title) + 51 | ggplot2::scale_colour_discrete(guide=FALSE) + 52 | ggplot2::theme(axis.text.x=ggplot2::element_blank(),axis.ticks.x=ggplot2::element_blank()) 53 | } 54 | 55 | #' Make simulation to compare disease and liability scales 56 | #' 57 | #' Compares the liability and probability of disease under two scenarios - where all SNPs are known, and where only some SNPs are known 58 | #' 59 | #' @param G Matrix of genotypes 60 | #' @param eff SNP effects on liability scale 61 | #' @param prevalence Disease prevalence 62 | #' @param prop_discovered Proportion of SNPs discovered 63 | #' 64 | #' @export 65 | #' @return Data frame 66 | risk_simulation <- function(G, eff, prevalence, prop_discovered) 67 | { 68 | nid <- nrow(G) 69 | nsnp <- ncol(G) 70 | gx_true <- scale(G) %*% eff 71 | h2x <- var(gx_true) 72 | prob_disease <- gx_to_gp(gx_true, h2x, 1-prevalence) 73 | disease <- rbinom(nid, 1, prob_disease) 74 | eff_pred <- eff 75 | eff_pred[sample(1:nsnp, nsnp * (1-prop_discovered))] <- 0 76 | gx_pred <- as.numeric(G %*% eff_pred / sqrt(nsnp)) 77 | dat <- dplyr::tibble(gx_true=as.numeric(gx_true), gx_pred=gx_pred, prob_disease=as.numeric(prob_disease), disease=disease) 78 | return(dat) 79 | } 80 | 81 | -------------------------------------------------------------------------------- /R/rsq_liability.r: -------------------------------------------------------------------------------- 1 | #' Obtain 2x2 contingency table from marginal parameters and odds ratio 2 | #' 3 | #' Columns are the case and control frequencies 4 | #' Rows are the frequencies for allele 1 and allele 2 5 | #' 6 | #' @param af Allele frequency of effect allele 7 | #' @param prop Proportion of cases 8 | #' @param odds_ratio Odds ratio 9 | #' @param eps tolerance. Default = 1e-15 10 | #' 11 | #' @export 12 | #' @return 2x2 contingency table as matrix 13 | contingency <- function(af, prop, odds_ratio, eps=1e-15) 14 | { 15 | a <- odds_ratio-1 16 | b <- (af+prop)*(1-odds_ratio)-1 17 | c_ <- odds_ratio*af*prop 18 | 19 | if (abs(a) < eps) 20 | { 21 | z <- -c_ / b 22 | } else { 23 | d <- b^2 - 4*a*c_ 24 | if (d < eps*eps) 25 | { 26 | s <- 0 27 | } else { 28 | s <- c(-1,1) 29 | } 30 | z <- (-b + s*sqrt(max(0, d))) / (2*a) 31 | } 32 | y <- vapply(z, function(a) zapsmall(matrix(c(a, prop-a, af-a, 1+a-af-prop), 2, 2)), matrix(0.0, 2, 2)) 33 | i <- apply(y, 3, function(u) all(u >= 0)) 34 | return(y[,,i]) 35 | } 36 | 37 | #' Estimate allele frequency from SNP 38 | #' 39 | #' @param g Vector of 0/1/2 40 | #' 41 | #' @export 42 | #' @return Allele frequency 43 | allele_frequency <- function(g) 44 | { 45 | (sum(g == 1) + 2 * sum(g == 2)) / (2 * sum(!is.na(g))) 46 | } 47 | 48 | 49 | #' Estimate the allele frequency in population from case/control summary data 50 | #' 51 | #' @param af Effect allele frequency (or MAF) 52 | #' @param prop Proportion of samples that are cases 53 | #' @param odds_ratio Odds ratio 54 | #' @param prevalence Population disease prevalence 55 | #' 56 | #' @export 57 | #' @return Population allele frequency 58 | get_population_allele_frequency <- function(af, prop, odds_ratio, prevalence) 59 | { 60 | co <- contingency(af, prop, odds_ratio) 61 | af_controls <- co[1,2] / (co[1,2] + co[2,2]) 62 | af_cases <- co[1,1] / (co[1,1] + co[2,1]) 63 | af <- af_controls * (1 - prevalence) + af_cases * prevalence 64 | return(af) 65 | } 66 | 67 | 68 | #' Estimate proportion of variance of liability explained by SNP in general population 69 | #' 70 | #' This uses equation 10 in Genetic Epidemiology 36 : 214–224 (2012) 71 | #' 72 | #' @param b Log odds ratio 73 | #' @param af allele frequency 74 | #' @param ncase Number of cases 75 | #' @param ncontrol number of controls 76 | #' @param prevalence prevalence 77 | #' @param model Is the effect size estiamted in "logit" (default) or "probit" model 78 | #' 79 | #' @export 80 | #' @return Rsq 81 | lor_to_rsq <- function(b, af, ncase, ncontrol, prevalence, model="logit") 82 | { 83 | if(model == "logit") 84 | { 85 | ve <- pi^2/3 86 | } else if(model == "probit") { 87 | ve <- 1 88 | } else { 89 | stop("Model must be probit or logit") 90 | } 91 | af <- get_population_allele_frequency(af, ncase / (ncase + ncontrol), exp(b), prevalence) 92 | vg <- b^2 * af * (1-af) 93 | return(vg / (vg + ve) / 0.58) 94 | } 95 | 96 | -------------------------------------------------------------------------------- /R/simulateGP-package.r: -------------------------------------------------------------------------------- 1 | #' simulateGP: Functions for Simulating Genotype-Phenotype Relationships 2 | #' 3 | #' This package is a collection of utilities relating to simulating genotype phenotype maps 4 | #' The simulations are largely used for Mendelian randomisation, and link up with the TwoSampleMR R package 5 | #' 6 | #' **Full documentation available here:** [https://explodecomputer.github.io/simulateGP](https://explodecomputer.github.io/simulateGP) 7 | #' 8 | #' @name simulateGP-package 9 | #' @aliases simulateGP simulategp 10 | #' @docType package 11 | NULL 12 | -------------------------------------------------------------------------------- /R/summary_data.R: -------------------------------------------------------------------------------- 1 | variant_reference <- function(bfile, plink_bin=genetics.binaRies::get_plink_binary(), fn=tempfile()) 2 | { 3 | shell <- ifelse(Sys.info()['sysname'] == "Windows", "cmd", "sh") 4 | 5 | fun1 <- paste0( 6 | shQuote(plink_bin, type=shell), 7 | " --bfile ", shQuote(bfile, type=shell), 8 | " --freq ", 9 | " --out ", shQuote(fn, type=shell) 10 | ) 11 | message("Generating MAF") 12 | system(fun1, ignore.stdout=TRUE) 13 | 14 | message("Reading variant info") 15 | frq <- data.table::fread(paste0(fn, ".frq")) 16 | bim <- data.table::fread(paste0(bfile, ".bim")) 17 | 18 | names(bim) <- c("CHR", "RSID", "GP", "POS", "EA", "NEA") 19 | bim$EAF <- frq$MAF 20 | bim <- subset(bim, !is.na(EAF)) 21 | return(bim) 22 | } 23 | 24 | 25 | get_regions <- function(pop="ASN") 26 | { 27 | system.file(paste0("extdata/ldetect/", pop, ".bed"), package="simulateGP") %>% 28 | data.table::fread(.data, header=TRUE) %>% 29 | dplyr::mutate( 30 | chr=as.numeric(gsub("chr", "", chr)), 31 | start=as.numeric(start), 32 | stop=as.numeric(stop) 33 | ) %>% 34 | dplyr::as_tibble() 35 | } 36 | 37 | 38 | generate_ld_matrices <- function(regions, varref, bfile, plink_bin=genetics.binaRies::get_plink_binary(), fn=tempfile()) 39 | { 40 | shell <- ifelse(Sys.info()['sysname'] == "Windows", "cmd", "sh") 41 | message("Calculating LD for ", nrow(regions), " regions") 42 | l <- list() 43 | for(i in 1:nrow(regions)) 44 | { 45 | message("Region ", i, " of ", nrow(regions)) 46 | variants <- subset(varref, CHR == regions$chr[i] & POS > regions$start[i] & POS < regions$stop[i]) 47 | l[[i]] <- list( 48 | info=variants, 49 | ld=ieugwasr::ld_matrix(variants$RSID, bfile=bfile, plink_bin=plink_bin, with_alleles=FALSE) 50 | ) 51 | } 52 | } 53 | 54 | # LD from 55 | generate_ld_matrices_slow <- function(regions, varref, bfile, plink_bin=genetics.binaRies::get_plink_binary(), fn=tempfile()) 56 | { 57 | shell <- ifelse(Sys.info()['sysname'] == "Windows", "cmd", "sh") 58 | message("Calculating LD for ", nrow(regions), " regions") 59 | l <- list() 60 | for(i in 1:nrow(regions)) 61 | { 62 | message("Region ", i, " of ", nrow(regions)) 63 | variants <- subset(varref, CHR == regions$chr[i] & POS > regions$start[i] & POS < regions$stop[i]) 64 | write.table(data.frame(variants$RSID), file=fn, row.names=F, col.names=F, quote=F) 65 | fun2 <- paste0( 66 | shQuote(plink_bin, type=shell), 67 | " --bfile ", shQuote(bfile, type=shell), 68 | " --extract ", shQuote(fn, type=shell), 69 | " --recode A ", 70 | " --out ", shQuote(fn, type=shell) 71 | ) 72 | system(fun2, ignore.stdout=TRUE) 73 | x <- data.table::fread(paste0(fn, ".raw")) %>% {.data[,-c(1:6)]} %>% as.matrix() 74 | l[[i]] <- list( 75 | info=variants, 76 | ld=stats::cor(x, use="pair") 77 | ) 78 | unlink(paste0(fn, ".raw")) 79 | } 80 | } 81 | 82 | write_ld_matrices <- function(r, fn) 83 | { 84 | y <- r[lower.tri(r, diag=FALSE)] 85 | yi <- round(y*127) %>% as.integer 86 | fn <- file(fn, "wb") 87 | writeBin(nrow(r)-1, fn, integer()) 88 | writeBin(yi, fn, size=1) 89 | close(fn) 90 | } 91 | 92 | read_ld_matrices <- function(fn) 93 | { 94 | fn <- file(fn, "rb") 95 | n <- readBin(fn, 1, integer()) 96 | r <- readBin(fn, integer(), n*(n-1)/2, size=1, signed=TRUE) / 127 97 | R <- diag(n+1) 98 | R[lower.tri(R, diag=FALSE)] <- r 99 | R[upper.tri(R, diag=FALSE)] <- r 100 | return(R) 101 | } 102 | 103 | 104 | 105 | greedy_remove <- function(r, threshold=0.99) 106 | { 107 | diag(r) <- 0 108 | flag <- 1 109 | rem <- c() 110 | nom <- colnames(r) 111 | while(flag == 1) 112 | { 113 | message("iteration") 114 | count <- apply(r, 2, function(x) sum(x >= threshold)) 115 | if(any(count > 0)) 116 | { 117 | worst <- which.max(count)[1] 118 | rem <- c(rem, names(worst)) 119 | r <- r[-worst,-worst] 120 | } else { 121 | flag <- 0 122 | } 123 | } 124 | return(which(nom %in% rem)) 125 | } 126 | 127 | 128 | ld_multiplier <- function(varref, ld) 129 | { 130 | varref$beta_rho <- NA 131 | varref$b_rho <- NA 132 | for(i in 1:length(ld)) 133 | { 134 | message("Region ", i, " of ", length(ld)) 135 | m1 <- match(ld[[i]]$info$RSID, varref$RSID) %>% na.exclude %>% as.numeric 136 | variants_dat <- varref$RSID[m1] 137 | if(length(variants_dat) > 0) 138 | { 139 | m2 <- match(variants_dat, rownames(ld[[i]]$ld)) 140 | r <- ld[[i]]$ld[m2,m2] 141 | varref$beta_rho[m1] <- varref$beta[m1] %*% r 142 | varref$b_rho[m1] <- varref$b[m1] %*% r 143 | } 144 | } 145 | varref$beta_rho_se <- expected_se(varref$beta_rho, varref$EAF, varref$N, varref$vy) 146 | varref$b_rho_se <- expected_se(varref$b_rho, varref$EAF, varref$N, varref$vy) 147 | return(varref) 148 | } 149 | 150 | 151 | draw_betas_multi_sample <- function(b, se, N, pcor, Nrep=1) 152 | { 153 | stopifnot(length(b) == length(se)) 154 | stopifnot(length(b) == nrow(N)) 155 | stopifnot(nrow(N) == nrow(N)) 156 | stopifnot(all(dim(N) == dim(pcor))) 157 | stopifnot(all(diag(N) == 1)) 158 | stopifnot(all(diag(pcor) == 1)) 159 | ses <- diag(se) 160 | covmat <- ses %*% (pcor * N) %*% ses 161 | MASS::mvrnorm(Nrep, b, covmat) 162 | } 163 | 164 | 165 | calculate_overlap_2 <- function(n1, n2, n_overlap) 166 | { 167 | n_overlap / sqrt(n1 * n2) 168 | } 169 | 170 | 171 | calculate_overlap <- function(n, N_overlap) 172 | { 173 | stopifnot(length(n) == nrow(N_overlap)) 174 | stopifnot(nrow(N_overlap) == ncol(N_overlap)) 175 | N_overlap / sqrt(n %*% t(n)) 176 | } 177 | 178 | 179 | -------------------------------------------------------------------------------- /R/utils-pipe.R: -------------------------------------------------------------------------------- 1 | #' Pipe operator 2 | #' 3 | #' See \code{magrittr::\link[magrittr:pipe]{\%>\%}} for details. 4 | #' 5 | #' @name %>% 6 | #' @rdname pipe 7 | #' @keywords internal 8 | #' @export 9 | #' @importFrom magrittr %>% 10 | #' @usage lhs \%>\% rhs 11 | NULL 12 | 13 | 14 | #' General funcs 15 | #' @name stuff 16 | #' @importFrom graphics hist 17 | #' @importFrom stats anova cor cov lm na.exclude pf plogis pnorm pt qnorm quantile rbinom rnorm runif start uniroot var 18 | #' @importFrom utils write.table 19 | #' @importFrom rlang .data 20 | NULL 21 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | [![Lifecycle: 3 | experimental](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](https://www.tidyverse.org/lifecycle/#experimental) 4 | [![R build status](https://github.com/explodecomputer/simulateGP/workflows/R-CMD-check/badge.svg)](https://github.com/explodecomputer/simulateGP/actions) 5 | [![Codecov test coverage](https://codecov.io/gh/explodecomputer/simulateGP/branch/master/graph/badge.svg)](https://codecov.io/gh/explodecomputer/simulateGP?branch=master) 6 | [![DOI](https://zenodo.org/badge/91170950.svg)](https://zenodo.org/doi/10.5281/zenodo.10907885) 7 | 8 | 9 | # Simulate genotype-phenotype data or GWAS summary data 10 | 11 | This package contains functions that simulate individual-level genotype and phenotype data arising from pre-specified directed acyclic graphs. It can also simulate large scale GWAS summary data for arbitrary sample sizes rapidly, with realistic genetic architectures, sample overlap effects and LD structures. 12 | 13 | # Installation 14 | 15 | ``` 16 | remotes::install_github("explodecomputer/simulateGP") 17 | ``` 18 | -------------------------------------------------------------------------------- /_pkgdown.yml: -------------------------------------------------------------------------------- 1 | template: 2 | params: 3 | bootswatch: united 4 | 5 | navbar: 6 | left: 7 | - text: "Guide" 8 | href: articles/index.html 9 | - text: "Functions" 10 | href: reference/index.html 11 | right: 12 | - text: "Source" 13 | href: https://github.com/explodecomputer/simulateGP 14 | 15 | articles: 16 | - title: "Guides" 17 | desc: > 18 | The following pages provide illustrations of how to conduct simulations. 19 | contents: 20 | - simplemr 21 | - twosamplemr 22 | - simulate_gwas 23 | - title: "Theory and experiments" 24 | desc: > 25 | A set of notebooks that give some background to the functions in the package 26 | contents: 27 | - sample_overlap 28 | - weak_instruments 29 | - gwas_summary_data 30 | - ld_matrices 31 | - mr_dgp 32 | - gwas_summary_data_ld 33 | - generate_ldobj 34 | - susie_check 35 | - sample_overlap_theory 36 | -------------------------------------------------------------------------------- /codecov.yml: -------------------------------------------------------------------------------- 1 | comment: false 2 | 3 | coverage: 4 | status: 5 | project: 6 | default: 7 | target: auto 8 | threshold: 1% 9 | informational: true 10 | patch: 11 | default: 12 | target: auto 13 | threshold: 1% 14 | informational: true 15 | -------------------------------------------------------------------------------- /data/ldetect.rdata: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/data/ldetect.rdata -------------------------------------------------------------------------------- /docs/404.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | Page not found (404) • simulateGP 9 | 10 | 11 | 12 | 13 | 14 | 15 | 19 | 20 | 21 | 22 | 23 |
24 |
58 | 59 | 60 | 61 | 62 |
63 |
64 |
65 |

Page not found (404)

66 |
67 | 68 | Content not found. Please use links in the navbar. 69 | 70 |
71 | 72 | 76 | 77 |
78 | 79 | 80 | 81 | 92 |
93 | 94 | 95 | 96 | 97 | 98 | 99 | 100 | 101 | -------------------------------------------------------------------------------- /docs/LICENSE-text.html: -------------------------------------------------------------------------------- 1 | 2 | License • simulateGP 6 | 7 | 8 |
9 |
37 | 38 | 39 | 40 |
41 |
42 |
43 |

License

44 |
45 | 46 | 
YEAR: 2021
47 | COPYRIGHT HOLDER: Gibran Hemani
48 |
49 | 50 |
51 | 52 | 55 | 56 |
57 | 58 | 59 | 60 |
69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | -------------------------------------------------------------------------------- /docs/articles/2smr.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/docs/articles/2smr.png -------------------------------------------------------------------------------- /docs/articles/generate_ldobj_files/accessible-code-block-0.0.1/empty-anchor.js: -------------------------------------------------------------------------------- 1 | // Hide empty tag within highlighted CodeBlock for screen reader accessibility (see https://github.com/jgm/pandoc/issues/6352#issuecomment-626106786) --> 2 | // v0.0.1 3 | // Written by JooYoung Seo (jooyoung@psu.edu) and Atsushi Yasumoto on June 1st, 2020. 4 | 5 | document.addEventListener('DOMContentLoaded', function() { 6 | const codeList = document.getElementsByClassName("sourceCode"); 7 | for (var i = 0; i < codeList.length; i++) { 8 | var linkList = codeList[i].getElementsByTagName('a'); 9 | for (var j = 0; j < linkList.length; j++) { 10 | if (linkList[j].innerHTML === "") { 11 | linkList[j].setAttribute('aria-hidden', 'true'); 12 | } 13 | } 14 | } 15 | }); 16 | -------------------------------------------------------------------------------- /docs/articles/gwas_summary_data_files/accessible-code-block-0.0.1/empty-anchor.js: -------------------------------------------------------------------------------- 1 | // Hide empty tag within highlighted CodeBlock for screen reader accessibility (see https://github.com/jgm/pandoc/issues/6352#issuecomment-626106786) --> 2 | // v0.0.1 3 | // Written by JooYoung Seo (jooyoung@psu.edu) and Atsushi Yasumoto on June 1st, 2020. 4 | 5 | document.addEventListener('DOMContentLoaded', function() { 6 | const codeList = document.getElementsByClassName("sourceCode"); 7 | for (var i = 0; i < codeList.length; i++) { 8 | var linkList = codeList[i].getElementsByTagName('a'); 9 | for (var j = 0; j < linkList.length; j++) { 10 | if (linkList[j].innerHTML === "") { 11 | linkList[j].setAttribute('aria-hidden', 'true'); 12 | } 13 | } 14 | } 15 | }); 16 | -------------------------------------------------------------------------------- /docs/articles/gwas_summary_data_files/figure-html/unnamed-chunk-10-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/docs/articles/gwas_summary_data_files/figure-html/unnamed-chunk-10-1.png -------------------------------------------------------------------------------- /docs/articles/gwas_summary_data_files/figure-html/unnamed-chunk-10-2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/docs/articles/gwas_summary_data_files/figure-html/unnamed-chunk-10-2.png -------------------------------------------------------------------------------- /docs/articles/gwas_summary_data_files/figure-html/unnamed-chunk-12-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/docs/articles/gwas_summary_data_files/figure-html/unnamed-chunk-12-1.png -------------------------------------------------------------------------------- /docs/articles/gwas_summary_data_files/figure-html/unnamed-chunk-15-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/docs/articles/gwas_summary_data_files/figure-html/unnamed-chunk-15-1.png -------------------------------------------------------------------------------- /docs/articles/gwas_summary_data_files/figure-html/unnamed-chunk-16-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/docs/articles/gwas_summary_data_files/figure-html/unnamed-chunk-16-1.png -------------------------------------------------------------------------------- /docs/articles/gwas_summary_data_files/figure-html/unnamed-chunk-17-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/docs/articles/gwas_summary_data_files/figure-html/unnamed-chunk-17-1.png -------------------------------------------------------------------------------- /docs/articles/gwas_summary_data_files/figure-html/unnamed-chunk-19-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/docs/articles/gwas_summary_data_files/figure-html/unnamed-chunk-19-1.png -------------------------------------------------------------------------------- /docs/articles/gwas_summary_data_files/figure-html/unnamed-chunk-20-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/docs/articles/gwas_summary_data_files/figure-html/unnamed-chunk-20-1.png -------------------------------------------------------------------------------- /docs/articles/gwas_summary_data_files/figure-html/unnamed-chunk-4-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/docs/articles/gwas_summary_data_files/figure-html/unnamed-chunk-4-1.png -------------------------------------------------------------------------------- /docs/articles/gwas_summary_data_files/figure-html/unnamed-chunk-4-2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/docs/articles/gwas_summary_data_files/figure-html/unnamed-chunk-4-2.png -------------------------------------------------------------------------------- /docs/articles/gwas_summary_data_files/figure-html/unnamed-chunk-4-3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/docs/articles/gwas_summary_data_files/figure-html/unnamed-chunk-4-3.png -------------------------------------------------------------------------------- /docs/articles/gwas_summary_data_files/figure-html/unnamed-chunk-5-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/docs/articles/gwas_summary_data_files/figure-html/unnamed-chunk-5-1.png -------------------------------------------------------------------------------- /docs/articles/gwas_summary_data_files/figure-html/unnamed-chunk-5-2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/docs/articles/gwas_summary_data_files/figure-html/unnamed-chunk-5-2.png -------------------------------------------------------------------------------- /docs/articles/gwas_summary_data_files/figure-html/unnamed-chunk-6-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/docs/articles/gwas_summary_data_files/figure-html/unnamed-chunk-6-1.png -------------------------------------------------------------------------------- /docs/articles/gwas_summary_data_files/figure-html/unnamed-chunk-7-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/docs/articles/gwas_summary_data_files/figure-html/unnamed-chunk-7-1.png -------------------------------------------------------------------------------- /docs/articles/gwas_summary_data_files/figure-html/unnamed-chunk-8-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/docs/articles/gwas_summary_data_files/figure-html/unnamed-chunk-8-1.png -------------------------------------------------------------------------------- /docs/articles/gwas_summary_data_files/figure-html/unnamed-chunk-8-2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/docs/articles/gwas_summary_data_files/figure-html/unnamed-chunk-8-2.png -------------------------------------------------------------------------------- /docs/articles/gwas_summary_data_files/figure-html/unnamed-chunk-8-3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/docs/articles/gwas_summary_data_files/figure-html/unnamed-chunk-8-3.png -------------------------------------------------------------------------------- /docs/articles/gwas_summary_data_files/figure-html/unnamed-chunk-8-4.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/docs/articles/gwas_summary_data_files/figure-html/unnamed-chunk-8-4.png -------------------------------------------------------------------------------- /docs/articles/gwas_summary_data_files/figure-html/unnamed-chunk-8-5.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/docs/articles/gwas_summary_data_files/figure-html/unnamed-chunk-8-5.png -------------------------------------------------------------------------------- /docs/articles/gwas_summary_data_files/figure-html/unnamed-chunk-8-6.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/docs/articles/gwas_summary_data_files/figure-html/unnamed-chunk-8-6.png -------------------------------------------------------------------------------- /docs/articles/gwas_summary_data_files/figure-html/unnamed-chunk-9-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/docs/articles/gwas_summary_data_files/figure-html/unnamed-chunk-9-1.png -------------------------------------------------------------------------------- /docs/articles/gwas_summary_data_files/figure-html/unnamed-chunk-9-2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/docs/articles/gwas_summary_data_files/figure-html/unnamed-chunk-9-2.png -------------------------------------------------------------------------------- /docs/articles/gwas_summary_data_ld_files/accessible-code-block-0.0.1/empty-anchor.js: -------------------------------------------------------------------------------- 1 | // Hide empty tag within highlighted CodeBlock for screen reader accessibility (see https://github.com/jgm/pandoc/issues/6352#issuecomment-626106786) --> 2 | // v0.0.1 3 | // Written by JooYoung Seo (jooyoung@psu.edu) and Atsushi Yasumoto on June 1st, 2020. 4 | 5 | document.addEventListener('DOMContentLoaded', function() { 6 | const codeList = document.getElementsByClassName("sourceCode"); 7 | for (var i = 0; i < codeList.length; i++) { 8 | var linkList = codeList[i].getElementsByTagName('a'); 9 | for (var j = 0; j < linkList.length; j++) { 10 | if (linkList[j].innerHTML === "") { 11 | linkList[j].setAttribute('aria-hidden', 'true'); 12 | } 13 | } 14 | } 15 | }); 16 | -------------------------------------------------------------------------------- /docs/articles/gwas_summary_data_ld_files/figure-html/unnamed-chunk-2-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/docs/articles/gwas_summary_data_ld_files/figure-html/unnamed-chunk-2-1.png -------------------------------------------------------------------------------- /docs/articles/gwas_summary_data_ld_files/figure-html/unnamed-chunk-2-2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/docs/articles/gwas_summary_data_ld_files/figure-html/unnamed-chunk-2-2.png -------------------------------------------------------------------------------- /docs/articles/gwas_summary_data_ld_files/figure-html/unnamed-chunk-2-3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/docs/articles/gwas_summary_data_ld_files/figure-html/unnamed-chunk-2-3.png -------------------------------------------------------------------------------- /docs/articles/gwas_summary_data_ld_files/figure-html/unnamed-chunk-7-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/docs/articles/gwas_summary_data_ld_files/figure-html/unnamed-chunk-7-1.png -------------------------------------------------------------------------------- /docs/articles/ld_matrices_files/accessible-code-block-0.0.1/empty-anchor.js: -------------------------------------------------------------------------------- 1 | // Hide empty tag within highlighted CodeBlock for screen reader accessibility (see https://github.com/jgm/pandoc/issues/6352#issuecomment-626106786) --> 2 | // v0.0.1 3 | // Written by JooYoung Seo (jooyoung@psu.edu) and Atsushi Yasumoto on June 1st, 2020. 4 | 5 | document.addEventListener('DOMContentLoaded', function() { 6 | const codeList = document.getElementsByClassName("sourceCode"); 7 | for (var i = 0; i < codeList.length; i++) { 8 | var linkList = codeList[i].getElementsByTagName('a'); 9 | for (var j = 0; j < linkList.length; j++) { 10 | if (linkList[j].innerHTML === "") { 11 | linkList[j].setAttribute('aria-hidden', 'true'); 12 | } 13 | } 14 | } 15 | }); 16 | -------------------------------------------------------------------------------- /docs/articles/mr_dgp_files/accessible-code-block-0.0.1/empty-anchor.js: -------------------------------------------------------------------------------- 1 | // Hide empty tag within highlighted CodeBlock for screen reader accessibility (see https://github.com/jgm/pandoc/issues/6352#issuecomment-626106786) --> 2 | // v0.0.1 3 | // Written by JooYoung Seo (jooyoung@psu.edu) and Atsushi Yasumoto on June 1st, 2020. 4 | 5 | document.addEventListener('DOMContentLoaded', function() { 6 | const codeList = document.getElementsByClassName("sourceCode"); 7 | for (var i = 0; i < codeList.length; i++) { 8 | var linkList = codeList[i].getElementsByTagName('a'); 9 | for (var j = 0; j < linkList.length; j++) { 10 | if (linkList[j].innerHTML === "") { 11 | linkList[j].setAttribute('aria-hidden', 'true'); 12 | } 13 | } 14 | } 15 | }); 16 | -------------------------------------------------------------------------------- /docs/articles/mr_dgp_files/figure-html/unnamed-chunk-11-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/docs/articles/mr_dgp_files/figure-html/unnamed-chunk-11-1.png -------------------------------------------------------------------------------- /docs/articles/mr_dgp_files/figure-html/unnamed-chunk-13-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/docs/articles/mr_dgp_files/figure-html/unnamed-chunk-13-1.png -------------------------------------------------------------------------------- /docs/articles/mr_dgp_files/figure-html/unnamed-chunk-16-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/docs/articles/mr_dgp_files/figure-html/unnamed-chunk-16-1.png -------------------------------------------------------------------------------- /docs/articles/mr_dgp_files/figure-html/unnamed-chunk-17-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/docs/articles/mr_dgp_files/figure-html/unnamed-chunk-17-1.png -------------------------------------------------------------------------------- /docs/articles/mr_dgp_files/figure-html/unnamed-chunk-17-2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/docs/articles/mr_dgp_files/figure-html/unnamed-chunk-17-2.png -------------------------------------------------------------------------------- /docs/articles/mr_dgp_files/figure-html/unnamed-chunk-19-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/docs/articles/mr_dgp_files/figure-html/unnamed-chunk-19-1.png -------------------------------------------------------------------------------- /docs/articles/mr_dgp_files/figure-html/unnamed-chunk-2-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/docs/articles/mr_dgp_files/figure-html/unnamed-chunk-2-1.png -------------------------------------------------------------------------------- /docs/articles/mr_dgp_files/figure-html/unnamed-chunk-21-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/docs/articles/mr_dgp_files/figure-html/unnamed-chunk-21-1.png -------------------------------------------------------------------------------- /docs/articles/mr_dgp_files/figure-html/unnamed-chunk-4-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/docs/articles/mr_dgp_files/figure-html/unnamed-chunk-4-1.png -------------------------------------------------------------------------------- /docs/articles/mr_dgp_files/figure-html/unnamed-chunk-5-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/docs/articles/mr_dgp_files/figure-html/unnamed-chunk-5-1.png -------------------------------------------------------------------------------- /docs/articles/mr_dgp_files/figure-html/unnamed-chunk-6-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/docs/articles/mr_dgp_files/figure-html/unnamed-chunk-6-1.png -------------------------------------------------------------------------------- /docs/articles/mr_dgp_files/figure-html/unnamed-chunk-9-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/docs/articles/mr_dgp_files/figure-html/unnamed-chunk-9-1.png -------------------------------------------------------------------------------- /docs/articles/mrdag.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/docs/articles/mrdag.png -------------------------------------------------------------------------------- /docs/articles/sample_overlap_files/accessible-code-block-0.0.1/empty-anchor.js: -------------------------------------------------------------------------------- 1 | // Hide empty tag within highlighted CodeBlock for screen reader accessibility (see https://github.com/jgm/pandoc/issues/6352#issuecomment-626106786) --> 2 | // v0.0.1 3 | // Written by JooYoung Seo (jooyoung@psu.edu) and Atsushi Yasumoto on June 1st, 2020. 4 | 5 | document.addEventListener('DOMContentLoaded', function() { 6 | const codeList = document.getElementsByClassName("sourceCode"); 7 | for (var i = 0; i < codeList.length; i++) { 8 | var linkList = codeList[i].getElementsByTagName('a'); 9 | for (var j = 0; j < linkList.length; j++) { 10 | if (linkList[j].innerHTML === "") { 11 | linkList[j].setAttribute('aria-hidden', 'true'); 12 | } 13 | } 14 | } 15 | }); 16 | -------------------------------------------------------------------------------- /docs/articles/sample_overlap_files/figure-html/unnamed-chunk-2-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/docs/articles/sample_overlap_files/figure-html/unnamed-chunk-2-1.png -------------------------------------------------------------------------------- /docs/articles/sample_overlap_files/figure-html/unnamed-chunk-2-2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/docs/articles/sample_overlap_files/figure-html/unnamed-chunk-2-2.png -------------------------------------------------------------------------------- /docs/articles/sample_overlap_files/figure-html/unnamed-chunk-3-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/docs/articles/sample_overlap_files/figure-html/unnamed-chunk-3-1.png -------------------------------------------------------------------------------- /docs/articles/sample_overlap_theory_files/accessible-code-block-0.0.1/empty-anchor.js: -------------------------------------------------------------------------------- 1 | // Hide empty tag within highlighted CodeBlock for screen reader accessibility (see https://github.com/jgm/pandoc/issues/6352#issuecomment-626106786) --> 2 | // v0.0.1 3 | // Written by JooYoung Seo (jooyoung@psu.edu) and Atsushi Yasumoto on June 1st, 2020. 4 | 5 | document.addEventListener('DOMContentLoaded', function() { 6 | const codeList = document.getElementsByClassName("sourceCode"); 7 | for (var i = 0; i < codeList.length; i++) { 8 | var linkList = codeList[i].getElementsByTagName('a'); 9 | for (var j = 0; j < linkList.length; j++) { 10 | if (linkList[j].innerHTML === "") { 11 | linkList[j].setAttribute('aria-hidden', 'true'); 12 | } 13 | } 14 | } 15 | }); 16 | -------------------------------------------------------------------------------- /docs/articles/simplemr_files/accessible-code-block-0.0.1/empty-anchor.js: -------------------------------------------------------------------------------- 1 | // Hide empty tag within highlighted CodeBlock for screen reader accessibility (see https://github.com/jgm/pandoc/issues/6352#issuecomment-626106786) --> 2 | // v0.0.1 3 | // Written by JooYoung Seo (jooyoung@psu.edu) and Atsushi Yasumoto on June 1st, 2020. 4 | 5 | document.addEventListener('DOMContentLoaded', function() { 6 | const codeList = document.getElementsByClassName("sourceCode"); 7 | for (var i = 0; i < codeList.length; i++) { 8 | var linkList = codeList[i].getElementsByTagName('a'); 9 | for (var j = 0; j < linkList.length; j++) { 10 | if (linkList[j].innerHTML === "") { 11 | linkList[j].setAttribute('aria-hidden', 'true'); 12 | } 13 | } 14 | } 15 | }); 16 | -------------------------------------------------------------------------------- /docs/articles/simulate_gwas_files/accessible-code-block-0.0.1/empty-anchor.js: -------------------------------------------------------------------------------- 1 | // Hide empty tag within highlighted CodeBlock for screen reader accessibility (see https://github.com/jgm/pandoc/issues/6352#issuecomment-626106786) --> 2 | // v0.0.1 3 | // Written by JooYoung Seo (jooyoung@psu.edu) and Atsushi Yasumoto on June 1st, 2020. 4 | 5 | document.addEventListener('DOMContentLoaded', function() { 6 | const codeList = document.getElementsByClassName("sourceCode"); 7 | for (var i = 0; i < codeList.length; i++) { 8 | var linkList = codeList[i].getElementsByTagName('a'); 9 | for (var j = 0; j < linkList.length; j++) { 10 | if (linkList[j].innerHTML === "") { 11 | linkList[j].setAttribute('aria-hidden', 'true'); 12 | } 13 | } 14 | } 15 | }); 16 | -------------------------------------------------------------------------------- /docs/articles/twosamplemr_files/accessible-code-block-0.0.1/empty-anchor.js: -------------------------------------------------------------------------------- 1 | // Hide empty tag within highlighted CodeBlock for screen reader accessibility (see https://github.com/jgm/pandoc/issues/6352#issuecomment-626106786) --> 2 | // v0.0.1 3 | // Written by JooYoung Seo (jooyoung@psu.edu) and Atsushi Yasumoto on June 1st, 2020. 4 | 5 | document.addEventListener('DOMContentLoaded', function() { 6 | const codeList = document.getElementsByClassName("sourceCode"); 7 | for (var i = 0; i < codeList.length; i++) { 8 | var linkList = codeList[i].getElementsByTagName('a'); 9 | for (var j = 0; j < linkList.length; j++) { 10 | if (linkList[j].innerHTML === "") { 11 | linkList[j].setAttribute('aria-hidden', 'true'); 12 | } 13 | } 14 | } 15 | }); 16 | -------------------------------------------------------------------------------- /docs/articles/weak_instruments_files/accessible-code-block-0.0.1/empty-anchor.js: -------------------------------------------------------------------------------- 1 | // Hide empty tag within highlighted CodeBlock for screen reader accessibility (see https://github.com/jgm/pandoc/issues/6352#issuecomment-626106786) --> 2 | // v0.0.1 3 | // Written by JooYoung Seo (jooyoung@psu.edu) and Atsushi Yasumoto on June 1st, 2020. 4 | 5 | document.addEventListener('DOMContentLoaded', function() { 6 | const codeList = document.getElementsByClassName("sourceCode"); 7 | for (var i = 0; i < codeList.length; i++) { 8 | var linkList = codeList[i].getElementsByTagName('a'); 9 | for (var j = 0; j < linkList.length; j++) { 10 | if (linkList[j].innerHTML === "") { 11 | linkList[j].setAttribute('aria-hidden', 'true'); 12 | } 13 | } 14 | } 15 | }); 16 | -------------------------------------------------------------------------------- /docs/articles/weak_instruments_files/figure-html/unnamed-chunk-14-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/docs/articles/weak_instruments_files/figure-html/unnamed-chunk-14-1.png -------------------------------------------------------------------------------- /docs/articles/weak_instruments_files/figure-html/unnamed-chunk-5-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/docs/articles/weak_instruments_files/figure-html/unnamed-chunk-5-1.png -------------------------------------------------------------------------------- /docs/articles/weak_instruments_files/figure-html/unnamed-chunk-5-2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/docs/articles/weak_instruments_files/figure-html/unnamed-chunk-5-2.png -------------------------------------------------------------------------------- /docs/articles/weak_instruments_files/figure-html/unnamed-chunk-8-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/docs/articles/weak_instruments_files/figure-html/unnamed-chunk-8-1.png -------------------------------------------------------------------------------- /docs/articles/weak_instruments_files/figure-html/unnamed-chunk-8-2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/docs/articles/weak_instruments_files/figure-html/unnamed-chunk-8-2.png -------------------------------------------------------------------------------- /docs/articles/weak_instruments_files/figure-html/unnamed-chunk-8-3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/docs/articles/weak_instruments_files/figure-html/unnamed-chunk-8-3.png -------------------------------------------------------------------------------- /docs/articles/weak_instruments_files/figure-html/unnamed-chunk-8-4.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/docs/articles/weak_instruments_files/figure-html/unnamed-chunk-8-4.png -------------------------------------------------------------------------------- /docs/articles/weak_instruments_files/figure-html/unnamed-chunk-8-5.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/docs/articles/weak_instruments_files/figure-html/unnamed-chunk-8-5.png -------------------------------------------------------------------------------- /docs/articles/weak_instruments_files/figure-html/unnamed-chunk-8-6.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/docs/articles/weak_instruments_files/figure-html/unnamed-chunk-8-6.png -------------------------------------------------------------------------------- /docs/articles/weak_instruments_files/figure-html/unnamed-chunk-9-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/docs/articles/weak_instruments_files/figure-html/unnamed-chunk-9-1.png -------------------------------------------------------------------------------- /docs/bootstrap-toc.css: -------------------------------------------------------------------------------- 1 | /*! 2 | * Bootstrap Table of Contents v0.4.1 (http://afeld.github.io/bootstrap-toc/) 3 | * Copyright 2015 Aidan Feldman 4 | * Licensed under MIT (https://github.com/afeld/bootstrap-toc/blob/gh-pages/LICENSE.md) */ 5 | 6 | /* modified from https://github.com/twbs/bootstrap/blob/94b4076dd2efba9af71f0b18d4ee4b163aa9e0dd/docs/assets/css/src/docs.css#L548-L601 */ 7 | 8 | /* All levels of nav */ 9 | nav[data-toggle='toc'] .nav > li > a { 10 | display: block; 11 | padding: 4px 20px; 12 | font-size: 13px; 13 | font-weight: 500; 14 | color: #767676; 15 | } 16 | nav[data-toggle='toc'] .nav > li > a:hover, 17 | nav[data-toggle='toc'] .nav > li > a:focus { 18 | padding-left: 19px; 19 | color: #563d7c; 20 | text-decoration: none; 21 | background-color: transparent; 22 | border-left: 1px solid #563d7c; 23 | } 24 | nav[data-toggle='toc'] .nav > .active > a, 25 | nav[data-toggle='toc'] .nav > .active:hover > a, 26 | nav[data-toggle='toc'] .nav > .active:focus > a { 27 | padding-left: 18px; 28 | font-weight: bold; 29 | color: #563d7c; 30 | background-color: transparent; 31 | border-left: 2px solid #563d7c; 32 | } 33 | 34 | /* Nav: second level (shown on .active) */ 35 | nav[data-toggle='toc'] .nav .nav { 36 | display: none; /* Hide by default, but at >768px, show it */ 37 | padding-bottom: 10px; 38 | } 39 | nav[data-toggle='toc'] .nav .nav > li > a { 40 | padding-top: 1px; 41 | padding-bottom: 1px; 42 | padding-left: 30px; 43 | font-size: 12px; 44 | font-weight: normal; 45 | } 46 | nav[data-toggle='toc'] .nav .nav > li > a:hover, 47 | nav[data-toggle='toc'] .nav .nav > li > a:focus { 48 | padding-left: 29px; 49 | } 50 | nav[data-toggle='toc'] .nav .nav > .active > a, 51 | nav[data-toggle='toc'] .nav .nav > .active:hover > a, 52 | nav[data-toggle='toc'] .nav .nav > .active:focus > a { 53 | padding-left: 28px; 54 | font-weight: 500; 55 | } 56 | 57 | /* from https://github.com/twbs/bootstrap/blob/e38f066d8c203c3e032da0ff23cd2d6098ee2dd6/docs/assets/css/src/docs.css#L631-L634 */ 58 | nav[data-toggle='toc'] .nav > .active > ul { 59 | display: block; 60 | } 61 | -------------------------------------------------------------------------------- /docs/bootstrap-toc.js: -------------------------------------------------------------------------------- 1 | /*! 2 | * Bootstrap Table of Contents v0.4.1 (http://afeld.github.io/bootstrap-toc/) 3 | * Copyright 2015 Aidan Feldman 4 | * Licensed under MIT (https://github.com/afeld/bootstrap-toc/blob/gh-pages/LICENSE.md) */ 5 | (function() { 6 | 'use strict'; 7 | 8 | window.Toc = { 9 | helpers: { 10 | // return all matching elements in the set, or their descendants 11 | findOrFilter: function($el, selector) { 12 | // http://danielnouri.org/notes/2011/03/14/a-jquery-find-that-also-finds-the-root-element/ 13 | // http://stackoverflow.com/a/12731439/358804 14 | var $descendants = $el.find(selector); 15 | return $el.filter(selector).add($descendants).filter(':not([data-toc-skip])'); 16 | }, 17 | 18 | generateUniqueIdBase: function(el) { 19 | var text = $(el).text(); 20 | var anchor = text.trim().toLowerCase().replace(/[^A-Za-z0-9]+/g, '-'); 21 | return anchor || el.tagName.toLowerCase(); 22 | }, 23 | 24 | generateUniqueId: function(el) { 25 | var anchorBase = this.generateUniqueIdBase(el); 26 | for (var i = 0; ; i++) { 27 | var anchor = anchorBase; 28 | if (i > 0) { 29 | // add suffix 30 | anchor += '-' + i; 31 | } 32 | // check if ID already exists 33 | if (!document.getElementById(anchor)) { 34 | return anchor; 35 | } 36 | } 37 | }, 38 | 39 | generateAnchor: function(el) { 40 | if (el.id) { 41 | return el.id; 42 | } else { 43 | var anchor = this.generateUniqueId(el); 44 | el.id = anchor; 45 | return anchor; 46 | } 47 | }, 48 | 49 | createNavList: function() { 50 | return $(''); 51 | }, 52 | 53 | createChildNavList: function($parent) { 54 | var $childList = this.createNavList(); 55 | $parent.append($childList); 56 | return $childList; 57 | }, 58 | 59 | generateNavEl: function(anchor, text) { 60 | var $a = $(''); 61 | $a.attr('href', '#' + anchor); 62 | $a.text(text); 63 | var $li = $('
  • '); 64 | $li.append($a); 65 | return $li; 66 | }, 67 | 68 | generateNavItem: function(headingEl) { 69 | var anchor = this.generateAnchor(headingEl); 70 | var $heading = $(headingEl); 71 | var text = $heading.data('toc-text') || $heading.text(); 72 | return this.generateNavEl(anchor, text); 73 | }, 74 | 75 | // Find the first heading level (`

    `, then `

    `, etc.) that has more than one element. Defaults to 1 (for `

    `). 76 | getTopLevel: function($scope) { 77 | for (var i = 1; i <= 6; i++) { 78 | var $headings = this.findOrFilter($scope, 'h' + i); 79 | if ($headings.length > 1) { 80 | return i; 81 | } 82 | } 83 | 84 | return 1; 85 | }, 86 | 87 | // returns the elements for the top level, and the next below it 88 | getHeadings: function($scope, topLevel) { 89 | var topSelector = 'h' + topLevel; 90 | 91 | var secondaryLevel = topLevel + 1; 92 | var secondarySelector = 'h' + secondaryLevel; 93 | 94 | return this.findOrFilter($scope, topSelector + ',' + secondarySelector); 95 | }, 96 | 97 | getNavLevel: function(el) { 98 | return parseInt(el.tagName.charAt(1), 10); 99 | }, 100 | 101 | populateNav: function($topContext, topLevel, $headings) { 102 | var $context = $topContext; 103 | var $prevNav; 104 | 105 | var helpers = this; 106 | $headings.each(function(i, el) { 107 | var $newNav = helpers.generateNavItem(el); 108 | var navLevel = helpers.getNavLevel(el); 109 | 110 | // determine the proper $context 111 | if (navLevel === topLevel) { 112 | // use top level 113 | $context = $topContext; 114 | } else if ($prevNav && $context === $topContext) { 115 | // create a new level of the tree and switch to it 116 | $context = helpers.createChildNavList($prevNav); 117 | } // else use the current $context 118 | 119 | $context.append($newNav); 120 | 121 | $prevNav = $newNav; 122 | }); 123 | }, 124 | 125 | parseOps: function(arg) { 126 | var opts; 127 | if (arg.jquery) { 128 | opts = { 129 | $nav: arg 130 | }; 131 | } else { 132 | opts = arg; 133 | } 134 | opts.$scope = opts.$scope || $(document.body); 135 | return opts; 136 | } 137 | }, 138 | 139 | // accepts a jQuery object, or an options object 140 | init: function(opts) { 141 | opts = this.helpers.parseOps(opts); 142 | 143 | // ensure that the data attribute is in place for styling 144 | opts.$nav.attr('data-toggle', 'toc'); 145 | 146 | var $topContext = this.helpers.createChildNavList(opts.$nav); 147 | var topLevel = this.helpers.getTopLevel(opts.$scope); 148 | var $headings = this.helpers.getHeadings(opts.$scope, topLevel); 149 | this.helpers.populateNav($topContext, topLevel, $headings); 150 | } 151 | }; 152 | 153 | $(function() { 154 | $('nav[data-toggle="toc"]').each(function(i, el) { 155 | var $nav = $(el); 156 | Toc.init($nav); 157 | }); 158 | }); 159 | })(); 160 | -------------------------------------------------------------------------------- /docs/docsearch.js: -------------------------------------------------------------------------------- 1 | $(function() { 2 | 3 | // register a handler to move the focus to the search bar 4 | // upon pressing shift + "/" (i.e. "?") 5 | $(document).on('keydown', function(e) { 6 | if (e.shiftKey && e.keyCode == 191) { 7 | e.preventDefault(); 8 | $("#search-input").focus(); 9 | } 10 | }); 11 | 12 | $(document).ready(function() { 13 | // do keyword highlighting 14 | /* modified from https://jsfiddle.net/julmot/bL6bb5oo/ */ 15 | var mark = function() { 16 | 17 | var referrer = document.URL ; 18 | var paramKey = "q" ; 19 | 20 | if (referrer.indexOf("?") !== -1) { 21 | var qs = referrer.substr(referrer.indexOf('?') + 1); 22 | var qs_noanchor = qs.split('#')[0]; 23 | var qsa = qs_noanchor.split('&'); 24 | var keyword = ""; 25 | 26 | for (var i = 0; i < qsa.length; i++) { 27 | var currentParam = qsa[i].split('='); 28 | 29 | if (currentParam.length !== 2) { 30 | continue; 31 | } 32 | 33 | if (currentParam[0] == paramKey) { 34 | keyword = decodeURIComponent(currentParam[1].replace(/\+/g, "%20")); 35 | } 36 | } 37 | 38 | if (keyword !== "") { 39 | $(".contents").unmark({ 40 | done: function() { 41 | $(".contents").mark(keyword); 42 | } 43 | }); 44 | } 45 | } 46 | }; 47 | 48 | mark(); 49 | }); 50 | }); 51 | 52 | /* Search term highlighting ------------------------------*/ 53 | 54 | function matchedWords(hit) { 55 | var words = []; 56 | 57 | var hierarchy = hit._highlightResult.hierarchy; 58 | // loop to fetch from lvl0, lvl1, etc. 59 | for (var idx in hierarchy) { 60 | words = words.concat(hierarchy[idx].matchedWords); 61 | } 62 | 63 | var content = hit._highlightResult.content; 64 | if (content) { 65 | words = words.concat(content.matchedWords); 66 | } 67 | 68 | // return unique words 69 | var words_uniq = [...new Set(words)]; 70 | return words_uniq; 71 | } 72 | 73 | function updateHitURL(hit) { 74 | 75 | var words = matchedWords(hit); 76 | var url = ""; 77 | 78 | if (hit.anchor) { 79 | url = hit.url_without_anchor + '?q=' + escape(words.join(" ")) + '#' + hit.anchor; 80 | } else { 81 | url = hit.url + '?q=' + escape(words.join(" ")); 82 | } 83 | 84 | return url; 85 | } 86 | -------------------------------------------------------------------------------- /docs/link.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 5 | 8 | 12 | 13 | -------------------------------------------------------------------------------- /docs/pkgdown.js: -------------------------------------------------------------------------------- 1 | /* http://gregfranko.com/blog/jquery-best-practices/ */ 2 | (function($) { 3 | $(function() { 4 | 5 | $('.navbar-fixed-top').headroom(); 6 | 7 | $('body').css('padding-top', $('.navbar').height() + 10); 8 | $(window).resize(function(){ 9 | $('body').css('padding-top', $('.navbar').height() + 10); 10 | }); 11 | 12 | $('[data-toggle="tooltip"]').tooltip(); 13 | 14 | var cur_path = paths(location.pathname); 15 | var links = $("#navbar ul li a"); 16 | var max_length = -1; 17 | var pos = -1; 18 | for (var i = 0; i < links.length; i++) { 19 | if (links[i].getAttribute("href") === "#") 20 | continue; 21 | // Ignore external links 22 | if (links[i].host !== location.host) 23 | continue; 24 | 25 | var nav_path = paths(links[i].pathname); 26 | 27 | var length = prefix_length(nav_path, cur_path); 28 | if (length > max_length) { 29 | max_length = length; 30 | pos = i; 31 | } 32 | } 33 | 34 | // Add class to parent
  • , and enclosing
  • if in dropdown 35 | if (pos >= 0) { 36 | var menu_anchor = $(links[pos]); 37 | menu_anchor.parent().addClass("active"); 38 | menu_anchor.closest("li.dropdown").addClass("active"); 39 | } 40 | }); 41 | 42 | function paths(pathname) { 43 | var pieces = pathname.split("/"); 44 | pieces.shift(); // always starts with / 45 | 46 | var end = pieces[pieces.length - 1]; 47 | if (end === "index.html" || end === "") 48 | pieces.pop(); 49 | return(pieces); 50 | } 51 | 52 | // Returns -1 if not found 53 | function prefix_length(needle, haystack) { 54 | if (needle.length > haystack.length) 55 | return(-1); 56 | 57 | // Special case for length-0 haystack, since for loop won't run 58 | if (haystack.length === 0) { 59 | return(needle.length === 0 ? 0 : -1); 60 | } 61 | 62 | for (var i = 0; i < haystack.length; i++) { 63 | if (needle[i] != haystack[i]) 64 | return(i); 65 | } 66 | 67 | return(haystack.length); 68 | } 69 | 70 | /* Clipboard --------------------------*/ 71 | 72 | function changeTooltipMessage(element, msg) { 73 | var tooltipOriginalTitle=element.getAttribute('data-original-title'); 74 | element.setAttribute('data-original-title', msg); 75 | $(element).tooltip('show'); 76 | element.setAttribute('data-original-title', tooltipOriginalTitle); 77 | } 78 | 79 | if(ClipboardJS.isSupported()) { 80 | $(document).ready(function() { 81 | var copyButton = ""; 82 | 83 | $("div.sourceCode").addClass("hasCopyButton"); 84 | 85 | // Insert copy buttons: 86 | $(copyButton).prependTo(".hasCopyButton"); 87 | 88 | // Initialize tooltips: 89 | $('.btn-copy-ex').tooltip({container: 'body'}); 90 | 91 | // Initialize clipboard: 92 | var clipboardBtnCopies = new ClipboardJS('[data-clipboard-copy]', { 93 | text: function(trigger) { 94 | return trigger.parentNode.textContent.replace(/\n#>[^\n]*/g, ""); 95 | } 96 | }); 97 | 98 | clipboardBtnCopies.on('success', function(e) { 99 | changeTooltipMessage(e.trigger, 'Copied!'); 100 | e.clearSelection(); 101 | }); 102 | 103 | clipboardBtnCopies.on('error', function() { 104 | changeTooltipMessage(e.trigger,'Press Ctrl+C or Command+C to copy'); 105 | }); 106 | }); 107 | } 108 | })(window.jQuery || window.$) 109 | -------------------------------------------------------------------------------- /docs/pkgdown.yml: -------------------------------------------------------------------------------- 1 | pandoc: 2.19.2 2 | pkgdown: 2.0.7 3 | pkgdown_sha: ~ 4 | articles: 5 | generate_ldobj: generate_ldobj.html 6 | gwas_summary_data: gwas_summary_data.html 7 | gwas_summary_data_ld: gwas_summary_data_ld.html 8 | ld_matrices: ld_matrices.html 9 | mr_dgp: mr_dgp.html 10 | sample_overlap: sample_overlap.html 11 | sample_overlap_theory: sample_overlap_theory.html 12 | simplemr: simplemr.html 13 | simulate_gwas: simulate_gwas.html 14 | susie_check: susie_check.html 15 | twosamplemr: twosamplemr.html 16 | weak_instruments: weak_instruments.html 17 | last_built: 2024-04-02T11:08Z 18 | 19 | -------------------------------------------------------------------------------- /docs/reference/allele_frequency.html: -------------------------------------------------------------------------------- 1 | 2 | Estimate allele frequency from SNP — allele_frequency • simulateGP 6 | 7 | 8 |
    9 |
    37 | 38 | 39 | 40 |
    41 |
    42 |
    43 |

    Estimate allele frequency from SNP

    44 | Source: R/rsq_liability.r 45 | 46 |
    47 | 48 |
    49 |

    Estimate allele frequency from SNP

    50 |
    51 | 52 |
    53 | 
    allele_frequency(g)
    54 |
    55 | 56 |
    57 |

    Arguments

    58 |
    g
    59 |

    Vector of 0/1/2

    60 | 61 |
    62 |
    63 |

    Value

    64 | 65 | 66 |

    Allele frequency

    67 |
    68 | 69 |
    70 | 73 |
    74 | 75 | 76 |
    77 |

    Developed by Gibran Hemani, John Ferguson, Rita Rasteiro.

    78 |
    79 | 80 |
    81 |

    Site built with pkgdown 2.0.7.

    82 |
    83 | 84 |
    85 | 86 | 87 | 88 | 89 | 90 | 91 | 92 | 93 | -------------------------------------------------------------------------------- /docs/reference/arbitrary_map.html: -------------------------------------------------------------------------------- 1 | 2 | Create an arbitrary map — arbitrary_map • simulateGP 6 | 7 | 8 |
    9 |
    37 | 38 | 39 | 40 |
    41 |
    42 |
    43 |

    Create an arbitrary map

    44 | Source: R/theoretical_gwas.R 45 | 46 |
    47 | 48 |
    49 |

    Create an arbitrary map

    50 |
    51 | 52 |
    53 | 
    arbitrary_map(af)
    54 |
    55 | 56 |
    57 |

    Arguments

    58 |
    af
    59 |

    vectory of allele frequencies

    60 | 61 |
    62 |
    63 |

    Value

    64 | 65 | 66 |

    data frame with snp name, chr, pos, ea, oa

    67 |
    68 | 69 |
    70 | 73 |
    74 | 75 | 76 |
    77 |

    Developed by Gibran Hemani, John Ferguson, Rita Rasteiro.

    78 |
    79 | 80 |
    81 |

    Site built with pkgdown 2.0.7.

    82 |
    83 | 84 |
    85 | 86 | 87 | 88 | 89 | 90 | 91 | 92 | 93 | -------------------------------------------------------------------------------- /docs/reference/expected_ssx.html: -------------------------------------------------------------------------------- 1 | 2 | Calculate expected SSX — expected_ssx • simulateGP 6 | 7 | 8 |
    9 |
    37 | 38 | 39 | 40 |
    41 |
    42 |
    43 |

    Calculate expected SSX

    44 | Source: R/theoretical_gwas.R 45 | 46 |
    47 | 48 |
    49 |

    Calculate expected SSX

    50 |
    51 | 52 |
    53 | 
    expected_ssx(af, n)
    54 |
    55 | 56 |
    57 |

    Arguments

    58 |
    af
    59 |

    array of allele frequencies

    60 | 61 | 62 |
    n
    63 |

    sample size

    64 | 65 |
    66 |
    67 |

    Value

    68 | 69 | 70 |

    Numeric

    71 |
    72 | 73 |
    74 | 77 |
    78 | 79 | 80 |
    81 |

    Developed by Gibran Hemani, John Ferguson, Rita Rasteiro.

    82 |
    83 | 84 |
    85 |

    Site built with pkgdown 2.0.7.

    86 |
    87 | 88 |
    89 | 90 | 91 | 92 | 93 | 94 | 95 | 96 | 97 | -------------------------------------------------------------------------------- /docs/reference/get_regions_from_ldobjdir.html: -------------------------------------------------------------------------------- 1 | 2 | Determine regions from LD file — get_regions_from_ldobjdir • simulateGP 6 | 7 | 8 |
    9 |
    37 | 38 | 39 | 40 |
    41 |
    42 |
    43 |

    Determine regions from LD file

    44 | Source: R/ld.r 45 | 46 |
    47 | 48 |
    49 |

    Determine regions from LD file

    50 |
    51 | 52 |
    53 | 
    get_regions_from_ldobjdir(ldobjdir)
    54 |
    55 | 56 |
    57 |

    Arguments

    58 |
    ldobjdir
    59 |

    Directory containing output from generate_ldobj

    60 | 61 |
    62 |
    63 |

    Value

    64 | 65 | 66 |

    Data frame

    67 |
    68 | 69 |
    70 | 73 |
    74 | 75 | 76 |
    77 |

    Developed by Gibran Hemani, John Ferguson, Rita Rasteiro.

    78 |
    79 | 80 |
    81 |

    Site built with pkgdown 2.0.7.

    82 |
    83 | 84 |
    85 | 86 | 87 | 88 | 89 | 90 | 91 | 92 | 93 | -------------------------------------------------------------------------------- /docs/reference/pipe.html: -------------------------------------------------------------------------------- 1 | 2 | Pipe operator — %>% • simulateGP 6 | 7 | 8 |
    9 |
    37 | 38 | 39 | 40 |
    41 |
    42 |
    43 |

    Pipe operator

    44 | Source: R/utils-pipe.R 45 | 46 |
    47 | 48 |
    49 |

    See magrittr::%>% for details.

    50 |
    51 | 52 |
    53 | 
    lhs %>% rhs
    54 |
    55 | 56 | 57 |
    58 | 61 |
    62 | 63 | 64 |
    65 |

    Developed by Gibran Hemani, John Ferguson, Rita Rasteiro.

    66 |
    67 | 68 |
    69 |

    Site built with pkgdown 2.0.7.

    70 |
    71 | 72 |
    73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | 81 | -------------------------------------------------------------------------------- /docs/reference/range01.html: -------------------------------------------------------------------------------- 1 | 2 | Scale variable to have range between 0 and 1 — range01 • simulateGP 6 | 7 | 8 |
    9 |
    37 | 38 | 39 | 40 |
    41 |
    42 |
    43 |

    Scale variable to have range between 0 and 1

    44 | Source: R/risk.r 45 | 46 |
    47 | 48 |
    49 |

    Scale variable to have range between 0 and 1

    50 |
    51 | 52 |
    53 | 
    range01(x)
    54 |
    55 | 56 |
    57 |

    Arguments

    58 |
    x
    59 |

    Vector

    60 | 61 |
    62 |
    63 |

    Value

    64 | 65 | 66 |

    Vector

    67 |
    68 | 69 |
    70 | 73 |
    74 | 75 | 76 |
    77 |

    Developed by Gibran Hemani, John Ferguson, Rita Rasteiro.

    78 |
    79 | 80 |
    81 |

    Site built with pkgdown 2.0.7.

    82 |
    83 | 84 |
    85 | 86 | 87 | 88 | 89 | 90 | 91 | 92 | 93 | -------------------------------------------------------------------------------- /docs/reference/stuff.html: -------------------------------------------------------------------------------- 1 | 2 | General funcs — stuff • simulateGP 6 | 7 | 8 |
    9 |
    37 | 38 | 39 | 40 |
    41 |
    42 |
    43 |

    General funcs

    44 | Source: R/utils-pipe.R 45 | 46 |
    47 | 48 |
    49 |

    General funcs

    50 |
    51 | 52 | 53 | 54 |
    55 | 58 |
    59 | 60 | 61 |
    62 |

    Developed by Gibran Hemani, John Ferguson, Rita Rasteiro.

    63 |
    64 | 65 |
    66 |

    Site built with pkgdown 2.0.7.

    67 |
    68 | 69 |
    70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | -------------------------------------------------------------------------------- /docs/reference/test_ldobj.html: -------------------------------------------------------------------------------- 1 | 2 | Create test LD object — test_ldobj • simulateGP 6 | 7 | 8 |
    9 |
    37 | 38 | 39 | 40 |
    41 |
    42 |
    43 |

    Create test LD object

    44 | Source: R/ld.r 45 | 46 |
    47 | 48 |
    49 |

    Create test LD object

    50 |
    51 | 52 |
    53 | 
    test_ldobj(nsnp, chunksize)
    54 |
    55 | 56 |
    57 |

    Arguments

    58 |
    nsnp
    59 |

    Number of SNPs

    60 | 61 | 62 |
    chunksize
    63 |

    Chunksize for splitting

    64 | 65 |
    66 |
    67 |

    Value

    68 | 69 | 70 |

    list of chunks, which each contain map and LD matrix

    71 |
    72 | 73 |
    74 | 77 |
    78 | 79 | 80 |
    89 | 90 | 91 | 92 | 93 | 94 | 95 | 96 | 97 | -------------------------------------------------------------------------------- /inst/extdata/ldobj_5_141345062_141478055.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/inst/extdata/ldobj_5_141345062_141478055.rds -------------------------------------------------------------------------------- /inst/sandpit/dunno.r: -------------------------------------------------------------------------------- 1 | library(devtools) 2 | load_all() 3 | n <- 10000 4 | maf <- 0.3 5 | g <- make_geno(n, 1, maf) 6 | table(g) 7 | e <- rnorm(n) 8 | beta <- 2 9 | y <- g * beta + e 10 | 11 | summary(lm(y ~ g)) 12 | 13 | sigma <- 1 / (n-2) * sum(e^2) 14 | denom <- sum((g - mean(g))^2) 15 | sqrt(sigma / denom) 16 | 17 | vy <- var(y) 18 | vg <- var(g) 19 | 20 | r2 <- 2^2 * 2 * 0.3 * 0.7 / vy 21 | 22 | r2 <- vg / vy = vg / (vg + ve) 23 | r2*vg + r2*ve = vg 24 | ve = (vg - r2*vg)/r2 25 | 26 | ve = vg*(1-r2)/r2 27 | 28 | vy 29 | 30 | tsigma <- vy - vy * r2 31 | 32 | 33 | 34 | y <- make_phen(sqrt(0.4), g) 35 | 36 | 37 | nsnp <- 10000 38 | nid <- 10000 39 | maf <- runif(nsnp) 40 | g <- make_geno(nid, nsnp, maf) 41 | eff <- rnorm(nsnp, sd=sqrt(0.2)) 42 | y <- g %*% eff + rnorm(nid, sd=sqrt(0.8)) 43 | # out <- gwas(y, g) 44 | # summary(lm(y ~ g)) 45 | sum(eff^2 * 2 * maf * (1-maf)) 46 | mean(abs(eff))^2 * 2 * mean(maf) * (1-mean(maf)) * length(maf) 47 | 48 | sqrt(0.2) * sqrt(2)/sqrt(pi) 49 | 50 | 51 | 52 | 53 | 54 | library(simulateGP) 55 | 56 | beta <- c(100) 57 | hist(beta, breaks=100) 58 | maf <- rbeta(length(beta), 0.8, 1)/2 59 | hist(maf) 60 | dat <- theoretical_gwas(beta, maf, 0.2, c(300000, 150000), minmaf=0.01) 61 | 62 | library(ggplot2) 63 | 64 | o <- subset(dat[[1]], pval < 5e-8) 65 | ggplot(o, aes(x=abs(beta), y=abs(betahat))) + 66 | geom_point() + 67 | geom_smooth(method=lm) + 68 | geom_abline(slope=1,intercept=0) 69 | 70 | summary(lm(abs(betahat) ~ abs(beta), o)) 71 | 72 | 73 | -------------------------------------------------------------------------------- /inst/sandpit/expected_gwas.r: -------------------------------------------------------------------------------- 1 | library(devtools) 2 | load_all() 3 | ss <- try(simulateGP::create_system( 4 | nidx=400000, 5 | nidy=400000, 6 | nidu=0, 7 | nu=3, 8 | na=0, 9 | nb=0, 10 | var_x.y=sample(c(0, runif(5, 0.001, 0.1)), 1), 11 | nsnp_x=80, 12 | nsnp_y=80, 13 | var_gx.x=runif(1, 0.01, 0.1), 14 | var_gy.y=runif(1, 0.01, 0.1), 15 | var_gx.y=runif(1, 0.001, 0.01), 16 | mu_gx.y=runif(1, -0.005, 0.005), 17 | prop_gx.y=runif(1, 0, 1), 18 | var_gy.x=runif(1, 0.001, 0.01), 19 | mu_gy.x=runif(1, -0.005, 0.005), 20 | prop_gy.x=runif(1, 0, 1) 21 | )) 22 | 23 | 24 | o <- test_system(ss) 25 | 26 | 27 | 28 | 29 | theoretical approach to simulating ss 30 | 31 | 32 | g -> x 33 | g -> y 34 | g -> u -> x 35 | g -> u -> y 36 | g -> x -> y 37 | 38 | 39 | a <- init_parameters( 40 | var_x.y=sample(c(0, runif(5, 0.001, 0.1)), 1), 41 | nsnp_x=80, 42 | nsnp_y=80, 43 | var_gx.x=runif(1, 0.01, 0.1), 44 | var_gy.y=runif(1, 0.01, 0.1), 45 | var_gx.y=runif(1, 0.001, 0.01), 46 | mu_gx.y=runif(1, -0.005, 0.005), 47 | prop_gx.y=runif(1, 0, 1), 48 | var_gy.x=runif(1, 0.001, 0.01), 49 | mu_gy.x=runif(1, -0.005, 0.005), 50 | prop_gy.x=runif(1, 0, 1) 51 | ) 52 | a <- sample_system_effects(a) 53 | 54 | u <- rnorm(1000) 55 | x <- rnorm(1000) + u*2 56 | y <- rnorm(1000) + u + x*4 57 | 58 | lm(x ~ u) 59 | lm(y ~ u) 60 | 61 | expected_gwas(9, 10000, 5, 99) 62 | 63 | expected_gwas(0, 10000, 1, 2) 64 | 65 | x <- rnorm(10000) 66 | y <- rnorm(10000) + x 67 | summary(lm(y ~ x))$coeff[2,3]^2 68 | 69 | (cor(x,y)^2 * 10000-2) / (1-cor(x,y)^2) 70 | 71 | pop <- simulate_population(a, 500000) 72 | 73 | 74 | # direct effects 75 | emp <- estimate_system_effects(pop) 76 | 77 | 78 | expx <- expected_gwas(a$eff_gx.x/sqrt(0.5), 500000, 1, 1) 79 | plot(x$x$bhat[x$x$inst == 'x'], expx$bhat) 80 | abline(0,1) 81 | 82 | expyx <- expected_gwas(a$eff_gy.x/sqrt(0.5), 500000, 1, 1) 83 | plot(x$x$bhat[x$x$inst == 'y'], expyx$bhat) 84 | abline(0,1) 85 | 86 | expxy <- expected_gwas(a$eff_gx.x/sqrt(0.5) * a$eff_x.y + a$eff_gx.y/sqrt(0.5), 500000, 1, 1) 87 | plot(x$y$bhat[x$y$inst == 'x'], expxy$bhat) 88 | abline(0,1) 89 | 90 | expy <- expected_gwas(a$eff_gy.y/sqrt(0.5), 500000, 1, 1) 91 | plot(x$y$bhat[x$y$inst == 'y'], expy$bhat) 92 | abline(0,1) 93 | 94 | 95 | 96 | expx <- expected_gwas(a$eff_gx.x/sqrt(0.5), 500000, 1, 1) 97 | plot(emp$x$se[emp$x$inst == 'x'], expx$se) 98 | abline(0,1) 99 | 100 | expyx <- expected_gwas(a$eff_gy.x/sqrt(0.5), 500000, 1, 1) 101 | plot(emp$x$se[emp$x$inst == 'y'], expyx$se) 102 | abline(0,1) 103 | 104 | expxy <- expected_gwas(a$eff_gx.x/sqrt(0.5) * a$eff_x.y + a$eff_gx.y/sqrt(0.5), 500000, 1, 1) 105 | plot(emp$y$se[emp$y$inst == 'x'], expxy$se) 106 | abline(0,1) 107 | 108 | expy <- expected_gwas(a$eff_gy.y/sqrt(0.5), 500000, 1, 1) 109 | plot(emp$y$se[emp$y$inst == 'y'], expy$se) 110 | abline(0,1) 111 | 112 | F = rsq / () 113 | 114 | alternative_expected_gwas <- function(eff, n, vx, vy) 115 | { 116 | rsq <- eff^2 * vx / vy 117 | fval = (rsq * (n-2)) / (1 - rsq) 118 | tval = sqrt(fval) 119 | se = abs(eff / tval) 120 | p <- pt(abs(tval), n-1, lower.tail=FALSE) 121 | dat <- tibble::data_frame(bhat=eff, se=se, fval=tval^2, pval=p, n=n) 122 | return(dat) 123 | } 124 | 125 | # problem - not getting correct standard error 126 | # fval seems to be only correct if half sample size is assumed?? 127 | 128 | 129 | 130 | 131 | n <- 10000 132 | nsnp <- 100 133 | eff <- rnorm(nsnp) 134 | maf <- runif(nsnp)/2 135 | h2 <- 0.5 136 | g <- make_geno(n, nsnp, maf) 137 | grs <- g %*% eff 138 | y <- grs + rnorm(n, sd=sqrt(var(grs))) 139 | 140 | 141 | 142 | 143 | 144 | 145 | 146 | 147 | -------------------------------------------------------------------------------- /inst/sandpit/expected_gwas2.r: -------------------------------------------------------------------------------- 1 | library(devtools) 2 | load_all() 3 | ss <- try(simulateGP::create_system( 4 | nidx=400000, 5 | nidy=400000, 6 | nidu=0, 7 | nu=3, 8 | na=0, 9 | nb=0, 10 | var_x.y=sample(c(0, runif(5, 0.001, 0.1)), 1), 11 | nsnp_x=80, 12 | nsnp_y=80, 13 | var_gx.x=runif(1, 0.01, 0.1), 14 | var_gy.y=runif(1, 0.01, 0.1), 15 | var_gx.y=runif(1, 0.001, 0.01), 16 | mu_gx.y=runif(1, -0.005, 0.005), 17 | prop_gx.y=runif(1, 0, 1), 18 | var_gy.x=runif(1, 0.001, 0.01), 19 | mu_gy.x=runif(1, -0.005, 0.005), 20 | prop_gy.x=runif(1, 0, 1) 21 | )) 22 | 23 | 24 | o <- test_system(ss) 25 | 26 | 27 | 28 | 29 | theoretical approach to simulating ss 30 | 31 | 32 | g -> x 33 | g -> y 34 | g -> u -> x 35 | g -> u -> y 36 | g -> x -> y 37 | 38 | 39 | a <- init_parameters( 40 | var_x.y=sample(c(0, runif(5, 0.001, 0.1)), 1), 41 | nsnp_x=80, 42 | nsnp_y=80, 43 | var_gx.x=runif(1, 0.01, 0.1), 44 | var_gy.y=runif(1, 0.01, 0.1), 45 | var_gx.y=runif(1, 0.001, 0.01), 46 | mu_gx.y=runif(1, -0.005, 0.005), 47 | prop_gx.y=runif(1, 0, 1), 48 | var_gy.x=runif(1, 0.001, 0.01), 49 | mu_gy.x=runif(1, -0.005, 0.005), 50 | prop_gy.x=runif(1, 0, 1) 51 | ) 52 | a <- sample_system_effects(a) 53 | 54 | u <- rnorm(1000) 55 | x <- rnorm(1000) + u*2 56 | y <- rnorm(1000) + u + x*4 57 | 58 | lm(x ~ u) 59 | lm(y ~ u) 60 | 61 | expected_gwas(9, 10000, 5, 99) 62 | 63 | expected_gwas(0, 10000, 1, 2) 64 | 65 | x <- rnorm(10000) 66 | y <- rnorm(10000) + x 67 | summary(lm(y ~ x))$coeff[2,3]^2 68 | 69 | (cor(x,y)^2 * 10000-2) / (1-cor(x,y)^2) 70 | 71 | pop <- simulate_population(a, 500000) 72 | 73 | 74 | # direct effects 75 | emp <- estimate_system_effects(pop) 76 | 77 | 78 | expx <- expected_gwas(a$eff_gx.x/sqrt(0.5), 500000, 1, 1) 79 | plot(x$x$bhat[x$x$inst == 'x'], expx$bhat) 80 | abline(0,1) 81 | 82 | expyx <- expected_gwas(a$eff_gy.x/sqrt(0.5), 500000, 1, 1) 83 | plot(x$x$bhat[x$x$inst == 'y'], expyx$bhat) 84 | abline(0,1) 85 | 86 | expxy <- expected_gwas(a$eff_gx.x/sqrt(0.5) * a$eff_x.y + a$eff_gx.y/sqrt(0.5), 500000, 1, 1) 87 | plot(x$y$bhat[x$y$inst == 'x'], expxy$bhat) 88 | abline(0,1) 89 | 90 | expy <- expected_gwas(a$eff_gy.y/sqrt(0.5), 500000, 1, 1) 91 | plot(x$y$bhat[x$y$inst == 'y'], expy$bhat) 92 | abline(0,1) 93 | 94 | 95 | 96 | expx <- expected_gwas(a$eff_gx.x/sqrt(0.5), 500000, 1, 1) 97 | plot(emp$x$se[emp$x$inst == 'x'], expx$se) 98 | abline(0,1) 99 | 100 | expyx <- expected_gwas(a$eff_gy.x/sqrt(0.5), 500000, 1, 1) 101 | plot(emp$x$se[emp$x$inst == 'y'], expyx$se) 102 | abline(0,1) 103 | 104 | expxy <- expected_gwas(a$eff_gx.x/sqrt(0.5) * a$eff_x.y + a$eff_gx.y/sqrt(0.5), 500000, 1, 1) 105 | plot(emp$y$se[emp$y$inst == 'x'], expxy$se) 106 | abline(0,1) 107 | 108 | expy <- expected_gwas(a$eff_gy.y/sqrt(0.5), 500000, 1, 1) 109 | plot(emp$y$se[emp$y$inst == 'y'], expy$se) 110 | abline(0,1) 111 | 112 | F = rsq / () 113 | 114 | alternative_expected_gwas <- function(eff, n, vx, vy) 115 | { 116 | rsq <- eff^2 * vx / vy 117 | fval = (rsq * (n-2)) / (1 - rsq) 118 | tval = sqrt(fval) 119 | se = abs(eff / tval) 120 | p <- pt(abs(tval), n-1, lower.tail=FALSE) 121 | dat <- tibble::data_frame(bhat=eff, se=se, fval=tval^2, pval=p, n=n) 122 | return(dat) 123 | } 124 | 125 | # problem - not getting correct standard error 126 | # fval seems to be only correct if half sample size is assumed?? 127 | 128 | 129 | 130 | 131 | n <- 100000 132 | nsnp <- 1000 133 | h2 <- 0.5 134 | g <- make_geno(n, nsnp, runif(nsnp)) 135 | eff <- choose_effects(nsnp, h2) 136 | # y <- make_phen(eff, g) 137 | # y <- g %*% eff + rnorm(n, sd=sd(g %*% eff)) 138 | y <- g %*% eff + rnorm(n) 139 | res <- gwas(y, g) 140 | plot(res$bhat, eff) 141 | 142 | 143 | 144 | 145 | maf <- colMeans(g)/2 146 | grs <- g %*% eff 147 | y <- grs 148 | 149 | 150 | 151 | res <- gwas(y, g) 152 | plot(res$bhat, eff) 153 | tres <- theoretical_gwas(eff, maf, h2, n) 154 | plot(tres$betahat, eff) 155 | 156 | summary(lm(y ~ g[,1])) 157 | fast_assoc(y, g[,1]) 158 | 159 | ggplot(tibble(tse=tres$se,ese=res$se,maf=maf,tb=tres$beta,eb=res$bhat), aes(x=tse, y=ese)) + 160 | geom_point(aes(colour=maf)) 161 | 162 | ggplot(tibble(tse=tres$se,ese=res$se,maf=maf,tb=tres$beta,eb=res$bhat), aes(x=tse, y=ese)) + 163 | geom_point(aes(colour=maf)) 164 | 165 | ggplot(tibble(tse=tres$se,ese=res$se,maf=maf,tb=tres$beta,eb=res$bhat), aes(x=tb/tse, y=eb/ese)) + 166 | geom_point(aes(colour=tb)) 167 | 168 | 169 | -------------------------------------------------------------------------------- /inst/sandpit/risk.r: -------------------------------------------------------------------------------- 1 | library(pROC) 2 | library(ggplot2) 3 | library(dplyr) 4 | library(tidyr) 5 | 6 | # h2l <- h2o * k^2 * (1-k)^2 / (p * (1 - p) * dnorm(threshold)^2) 7 | 8 | # Calculating disease risk on observed scale 9 | # Requires some 10 | # Check that gx to go works 11 | 12 | d <- expand.grid( 13 | g = seq(-4,4,by=0.1), 14 | h2x = c(0.35, 0.5, 1), 15 | prev = c(0.004, 0.2, 0.5) 16 | ) 17 | d$gr <- 1:nrow(d) 18 | d$x_prime <- qnorm(d$prev, 0, 1) 19 | d$e2x <- 1 - d$h2x 20 | d$z <- dnorm(d$x_prime, mean=d$g, sd = sqrt(d$e2x)) 21 | d$p <- pnorm(d$x_prime, mean=d$g, sd = sqrt(d$e2x), lower.tail=FALSE) 22 | d$p1 <- gx_to_gp(d$g, d$h2x, d$prev) 23 | 24 | d <- group_by(d, h2x, prev) %>% 25 | mutate(p = range01(p), g = range01(g)) 26 | 27 | 28 | d1 <- gather(d, key, value, g, p) 29 | 30 | 31 | ggplot(d1, aes(x=value, y=key)) + 32 | geom_point(aes(colour=key)) + 33 | geom_line(aes(group=gr)) + 34 | facet_grid(h2x ~ prev) 35 | 36 | 37 | # Model 1 38 | # Common variant-common disease 39 | 40 | nid <- 1000 41 | nsnp <- 1000 42 | h2x <- 0.3 43 | prev <- 0.5 44 | G_cdcv <- scale(make_geno(nid, nsnp, 0.5)) 45 | eff_cdcv <- rnorm(nsnp, sd=sqrt(h2x)) 46 | dat_cdcv <- risk_simulation( 47 | G=G_cdcv, 48 | eff=eff_cdcv, 49 | prevalence=prev, 50 | prop_discovered=0.1 51 | ) 52 | plot(roc(disease ~ gx_true, dat_cdcv)) 53 | 54 | 55 | 56 | table(dat_cdcv$disease) 57 | var(dat_cdcv$gx_true) 58 | plot(roc(disease ~ gx_true, dat_cdcv)) 59 | plot(roc(disease ~ gx_pred, dat_cdcv)) 60 | risk_cross_plot(o=dat_cdcv$prob_disease, x=dat_cdcv$gx_true) 61 | risk_cross_plot(o=dat_cdcv$disease, x=dat_cdcv$gx_true, title="Genetic values mapped to disease") 62 | risk_cross_plot(o=dat_cdcv$disease, x=dat_cdcv$gx_pred, title="Genetic predictor of disease") 63 | 64 | 65 | nid <- 100 66 | nsnp <- 1000 67 | h2x <- 0.8 68 | prev <- 0.5 69 | G_cdcv <- scale(make_geno(nid, nsnp, 0.5)) 70 | eff_cdcv <- rnorm(nsnp, sd=sqrt(h2x)) 71 | dat_cdcv <- risk_simulation( 72 | G=G_cdcv, 73 | eff=eff_cdcv, 74 | prevalence=prev, 75 | prop_discovered=0.1 76 | ) 77 | pdf(file="roc_0.8_0.5.pdf") 78 | plot(roc(disease ~ gx_true, dat_cdcv)) 79 | dev.off() 80 | 81 | pdf(file="roc_0.8_0.5_0.1.pdf") 82 | plot(roc(disease ~ gx_pred, dat_cdcv)) 83 | dev.off() 84 | 85 | risk_cross_plot(o=dat_cdcv$disease, x=dat_cdcv$gx_true, title="Genetic values mapped to disease") 86 | ggsave(file="cp_0.8_0.5.pdf", width=8,height=3) 87 | risk_cross_plot(o=dat_cdcv$disease, x=dat_cdcv$gx_pred, title="Genetic predictor of disease using only 10% of causal variants") 88 | ggsave(file="cp_0.8_0.5_0.1.pdf", width=8,height=3) 89 | 90 | 91 | 92 | nid <- 1000 93 | nsnp <- 1000 94 | h2x <- 0.3 95 | prev <- 0.5 96 | G_cdcv <- scale(make_geno(nid, nsnp, 0.5)) 97 | eff_cdcv <- rnorm(nsnp, sd=sqrt(h2x)) 98 | dat_cdcv <- risk_simulation( 99 | G=G_cdcv, 100 | eff=eff_cdcv, 101 | prevalence=prev, 102 | prop_discovered=0.1 103 | ) 104 | pdf(file="roc_0.3_0.5.pdf") 105 | plot(roc(disease ~ gx_true, dat_cdcv)) 106 | dev.off() 107 | 108 | pdf(file="roc_0.3_0.5_0.1.pdf") 109 | plot(roc(disease ~ gx_pred, dat_cdcv)) 110 | dev.off() 111 | 112 | risk_cross_plot(o=dat_cdcv$disease, x=dat_cdcv$gx_pred, title="Genetic predictor of disease using only 10% of causal variants") 113 | 114 | 115 | nid <- 10000 116 | nsnp <- 1000 117 | h2x <- 0.3 118 | prev <- 0.01 119 | G_cdcv <- scale(make_geno(nid, nsnp, 0.5)) 120 | eff_cdcv <- rnorm(nsnp, sd=sqrt(h2x)) 121 | dat_cdcv <- risk_simulation( 122 | G=G_cdcv, 123 | eff=eff_cdcv, 124 | prevalence=prev, 125 | prop_discovered=0.1 126 | ) 127 | pdf(file="roc_0.3_0.01.pdf") 128 | plot(roc(disease ~ gx_true, dat_cdcv)) 129 | dev.off() 130 | 131 | 132 | # Model 2 133 | # Every case has a specific mutation 134 | # Rare variant-common disease 135 | 136 | nid <- 1000 137 | nsnp <- 1000 138 | h2x <- 0.3 139 | prev <- 0.5 140 | G_cdrv <- diag(nid) 141 | diag(G_cdrv)[1:(nid/2)] <- 0 142 | eff_cdrv <- scale(rnorm(nid, diag(G_cdrv), 0.001)) * sqrt(h2x) 143 | dat_cdrv <- risk_simulation( 144 | G=G_cdrv, 145 | eff=eff_cdrv, 146 | prevalence=prev, 147 | prop_discovered=0.1 148 | ) 149 | 150 | table(dat_cdrv$disease) 151 | var(dat_cdrv$gx_true) 152 | 153 | pdf("roc_0.3_0.5_rare.pdf") 154 | plot(roc(disease ~ gx_true, dat_cdrv)) 155 | dev.off() 156 | 157 | pdf("roc_0.3_0.5_0.1_rare.pdf") 158 | plot(roc(disease ~ gx_pred, dat_cdrv)) 159 | dev.off() 160 | 161 | risk_cross_plot(o=dat_cdrv$prob_disease, x=dat_cdrv$gx_true) 162 | risk_cross_plot(o=dat_cdrv$disease, x=dat_cdrv$gx_true, title="Genetic values mapped to disease") 163 | risk_cross_plot(o=dat_cdrv$disease, x=dat_cdrv$gx_pred, title="Genetic predictor of disease") 164 | 165 | -------------------------------------------------------------------------------- /inst/sandpit/simulate_from_dag.r: -------------------------------------------------------------------------------- 1 | install.packages("mvtnorm") 2 | install.packages("Rfast") 3 | library(Rfast) 4 | 5 | library(mvtnorm) 6 | 7 | rdag <- function(n, p, s, a = 0, m = NULL, A = NULL, seed = FALSE) { 8 | ## n in the sample size 9 | ## p is the number of (nodes or) variables 10 | ## s is the success probability of the binomial distribution 11 | ## a is the percentage of outliers, is set to zero by default 12 | ## a number between 0 and 1 13 | ## m is the mean vector which is used only if you want outliers, i.e. if a > 0 14 | ## A is an adjancey matrix given by the user 15 | if ( is.null(A) ) { ## no adjacency matrix is given 16 | if ( s > 1 || s < 0 ) s <- 0.5 17 | if ( a > 1 || a < 0 ) a <- 0 18 | if ( seed ) set.seed(1234567) 19 | A <- matrix( 0, p, p ) 20 | nu <- 0.5 * p * (p - 1) 21 | A[ lower.tri(A) ] <- rbinom(nu, 1, s) 22 | A[ A == 1 ] <- runif( sum(A), 0.1, 1 ) 23 | } else { 24 | A <- A 25 | p <- ncol(A) 26 | } 27 | 28 | Ip <- diag(p) 29 | sigma <- solve( Ip - A ) 30 | sigma <- tcrossprod( sigma ) 31 | nout <- 0 32 | if ( seed ) set.seed(1234567) 33 | 34 | if (a > 0) { 35 | y <- mvtnorm::rmvnorm( n - nout, numeric(p), sigma) 36 | nout <- round( a * n ) 37 | yout <- mvtnorm::rmvnorm(nout, m, sigma) 38 | x <- rbind(y, yout) 39 | } else x <- mvtnorm::rmvnorm(n, numeric(p), sigma) 40 | 41 | G <- t( A ) 42 | G[ G > 0 ] <- 2 43 | ind <- which( t(G) == 2 ) 44 | G[ind] <- 3 45 | 46 | V <- colnames(A) 47 | if ( is.null(V) ) V <- paste("X", 1:p, sep = "") 48 | colnames(x) <- V 49 | colnames(G) <- rownames(G) <- V 50 | colnames(A) <- rownames(A) <- V 51 | list(nout = nout, G = G, A = A, x = x) 52 | } 53 | 54 | library(dplyr) 55 | A <- matrix(c( 56 | 0,0,0, 57 | 1,0,0, 58 | 0,1,0 59 | ), 3) %>% t 60 | 61 | 62 | A <- matrix(c( 63 | 0,0,0,0, 64 | 0.1,0,0,0, 65 | 0,0.5,0,0, 66 | 0,0,0.5,0 67 | ), 4) %>% t 68 | 69 | A <- matrix(c( 70 | 0,0,0,0,0,0, 71 | 0,0,0,0,0,0, 72 | 0,0,0,0,0,0, 73 | 1,0,0,0,0,0, 74 | 0,1,0,1,0,0, 75 | 0,0,1,0,1,0 76 | ),6,6) %>% t 77 | 78 | 79 | (Ip - A) %>% solve %>% tcrossprod 80 | 81 | t(A) %*% A 82 | 83 | crossprod(A) 84 | 85 | o <- rdag(10000, A=A) 86 | dim(o) 87 | x <- o$x 88 | 89 | apply(x, 2, var) 90 | cor(x)^2 91 | 92 | 93 | x <- rmvnorm(10000, numeric(3), matrix(c(1, 0.5, 0.25, 94 | 0.5, 1, 0.5, 95 | 0.25, 0.5, 1), 3,3)) 96 | 97 | 98 | 99 | library(pcalg) 100 | -------------------------------------------------------------------------------- /inst/sandpit/system.r: -------------------------------------------------------------------------------- 1 | library(devtools) 2 | load_all() 3 | library(TwoSampleMR) 4 | 5 | 6 | ss <- try(create_system( 7 | nidx=sample(20000:500000, 1), 8 | nidy=sample(20000:500000, 1), 9 | nidu=0, 10 | nu=sample(0:10, 1), 11 | na=0, 12 | nb=0, 13 | var_x.y=sample(c(0, runif(5, 0.001, 0.1)), 1), 14 | nsnp_x=sample(1:200, 1), 15 | nsnp_y=sample(1:200, 1), 16 | var_gx.x=runif(1, 0.01, 0.1), 17 | var_gy.y=runif(1, 0.01, 0.1), 18 | var_gx.y=runif(1, 0.001, 0.01), 19 | mu_gx.y=runif(1, -0.005, 0.005), 20 | prop_gx.y=runif(1, 0, 1), 21 | var_gy.x=runif(1, 0.001, 0.01), 22 | mu_gy.x=runif(1, -0.005, 0.005), 23 | prop_gy.x=runif(1, 0, 1) 24 | )) 25 | 26 | 27 | 28 | 29 | 30 | nop <- try(create_system( 31 | nidx=100000, 32 | nidy=100000, 33 | nidu=0, 34 | nu=0, 35 | na=0, 36 | nb=0, 37 | var_x.y=0, 38 | nsnp_x=100, 39 | nsnp_y=100, 40 | var_gx.x=0.15, 41 | var_gy.y=0.15, 42 | var_gx.y=0, 43 | mu_gx.y=0, 44 | prop_gx.y=0, 45 | var_gy.x=0, 46 | mu_gy.x=0, 47 | prop_gy.x=0 48 | )) 49 | 50 | 51 | 52 | 53 | withu <- try(create_system( 54 | nidx=10000, 55 | nidy=10000, 56 | nidu=10000, 57 | nu=2, 58 | na=2, 59 | nb=2, 60 | var_x.y=0, 61 | nsnp_x=100, 62 | nsnp_y=100, 63 | var_gx.x=0.15, 64 | var_gy.y=0.15, 65 | var_gx.y=0, 66 | mu_gx.y=0, 67 | prop_gx.y=0, 68 | var_gy.x=0, 69 | mu_gy.x=0, 70 | prop_gy.x=0 71 | )) 72 | 73 | a <- make_dat(withu$x$x, withu$y$y) %>% filter(pval.exposure < 1e-8) 74 | b <- make_dat(nop$x$x, nop$y$y) %>% filter(grepl("x", SNP), pval.exposure < 1e-8) 75 | 76 | mr_scatter_plot(mr(a), a) 77 | mr_scatter_plot(mr(b), b) 78 | mr_heterogeneity(a) 79 | mr_heterogeneity(b) 80 | 81 | 82 | 83 | nop1 <- try(create_system( 84 | nidx=10000, 85 | nidy=10000, 86 | nidu=0, 87 | nu=0, 88 | na=0, 89 | nb=0, 90 | var_x.y=0.1, 91 | nsnp_x=100, 92 | nsnp_y=100, 93 | var_gx.x=0.15, 94 | var_gy.y=0.15, 95 | var_gx.y=0, 96 | mu_gx.y=0, 97 | prop_gx.y=0, 98 | var_gy.x=0, 99 | mu_gy.x=0, 100 | prop_gy.x=0 101 | )) 102 | 103 | 104 | 105 | 106 | withu1 <- try(create_system( 107 | nidx=10000, 108 | nidy=10000, 109 | nidu=10000, 110 | nu=2, 111 | na=2, 112 | nb=2, 113 | var_x.y=0.1, 114 | nsnp_x=100, 115 | nsnp_y=100, 116 | var_gx.x=0.15, 117 | var_gy.y=0.15, 118 | var_gx.y=0, 119 | mu_gx.y=0, 120 | prop_gx.y=0, 121 | var_gy.x=0, 122 | mu_gy.x=0, 123 | prop_gy.x=0 124 | )) 125 | 126 | 127 | a <- make_dat(withu1$x$x, withu1$y$y) %>% filter(pval.exposure < 1e-8) 128 | b <- make_dat(nop1$x$x, nop1$y$y) %>% filter(grepl("x", SNP), pval.exposure < 1e-8) 129 | 130 | mr_scatter_plot(mr(a), a) 131 | mr_scatter_plot(mr(b), b) 132 | mr_heterogeneity(a) 133 | mr_heterogeneity(b) 134 | 135 | -------------------------------------------------------------------------------- /man/add_u.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/mr_system.r 3 | \name{add_u} 4 | \alias{add_u} 5 | \title{Add confounder variables and their instruments} 6 | \usage{ 7 | add_u(parameters, nsnp_u, var_u.x, var_u.y, var_gu.u) 8 | } 9 | \arguments{ 10 | \item{parameters}{Output from \code{init_parameters}} 11 | 12 | \item{nsnp_u}{nsnp_u} 13 | 14 | \item{var_u.x}{var_u.x} 15 | 16 | \item{var_u.y}{var_u.y} 17 | 18 | \item{var_gu.u}{var_gu.u} 19 | } 20 | \value{ 21 | List of model parameters 22 | } 23 | \description{ 24 | Add confounder variables and their instruments 25 | } 26 | -------------------------------------------------------------------------------- /man/allele_frequency.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/rsq_liability.r 3 | \name{allele_frequency} 4 | \alias{allele_frequency} 5 | \title{Estimate allele frequency from SNP} 6 | \usage{ 7 | allele_frequency(g) 8 | } 9 | \arguments{ 10 | \item{g}{Vector of 0/1/2} 11 | } 12 | \value{ 13 | Allele frequency 14 | } 15 | \description{ 16 | Estimate allele frequency from SNP 17 | } 18 | -------------------------------------------------------------------------------- /man/arbitrary_map.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/theoretical_gwas.R 3 | \name{arbitrary_map} 4 | \alias{arbitrary_map} 5 | \title{Create an arbitrary map} 6 | \usage{ 7 | arbitrary_map(af) 8 | } 9 | \arguments{ 10 | \item{af}{vectory of allele frequencies} 11 | } 12 | \value{ 13 | data frame with snp name, chr, pos, ea, oa 14 | } 15 | \description{ 16 | Create an arbitrary map 17 | } 18 | -------------------------------------------------------------------------------- /man/ascertain_samples.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/generate_individuals.r 3 | \name{ascertain_samples} 4 | \alias{ascertain_samples} 5 | \title{Ascertain some proportion of cases and controls from binary phenotype} 6 | \usage{ 7 | ascertain_samples(d, prop_cases) 8 | } 9 | \arguments{ 10 | \item{d}{Vector of 1/0} 11 | 12 | \item{prop_cases}{Proportion of 1s to retain} 13 | } 14 | \value{ 15 | Array of IDs 16 | } 17 | \description{ 18 | Ascertain some proportion of cases and controls from binary phenotype 19 | } 20 | -------------------------------------------------------------------------------- /man/choose_effects.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/generate_individuals.r 3 | \name{choose_effects} 4 | \alias{choose_effects} 5 | \title{Get vector of effects that explain some amount of variance} 6 | \usage{ 7 | choose_effects(nsnp, totvar, sqrt = TRUE, mua = 0) 8 | } 9 | \arguments{ 10 | \item{nsnp}{Number of SNPs} 11 | 12 | \item{totvar}{Total variance explained by all SNPs} 13 | 14 | \item{sqrt}{Output effect sizes in terms of standard deviations. Default=TRUE} 15 | 16 | \item{mua}{Constant term to be added to effects. Default = 0} 17 | } 18 | \value{ 19 | Vector of effects 20 | } 21 | \description{ 22 | Get vector of effects that explain some amount of variance 23 | } 24 | -------------------------------------------------------------------------------- /man/contingency.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/rsq_liability.r 3 | \name{contingency} 4 | \alias{contingency} 5 | \title{Obtain 2x2 contingency table from marginal parameters and odds ratio} 6 | \usage{ 7 | contingency(af, prop, odds_ratio, eps = 1e-15) 8 | } 9 | \arguments{ 10 | \item{af}{Allele frequency of effect allele} 11 | 12 | \item{prop}{Proportion of cases} 13 | 14 | \item{odds_ratio}{Odds ratio} 15 | 16 | \item{eps}{tolerance. Default = 1e-15} 17 | } 18 | \value{ 19 | 2x2 contingency table as matrix 20 | } 21 | \description{ 22 | Columns are the case and control frequencies 23 | Rows are the frequencies for allele 1 and allele 2 24 | } 25 | -------------------------------------------------------------------------------- /man/correlated_binomial.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ld.r 3 | \name{correlated_binomial} 4 | \alias{correlated_binomial} 5 | \title{Simulate two correlated binomial variables} 6 | \usage{ 7 | correlated_binomial(nid, p1, p2, rho, n = 2, round = TRUE, print = FALSE) 8 | } 9 | \arguments{ 10 | \item{nid}{Number of samples} 11 | 12 | \item{p1}{Frequency 1} 13 | 14 | \item{p2}{Frequency 2} 15 | 16 | \item{rho}{Target correlation} 17 | 18 | \item{n}{Binomial parameter, should be 2 (default) for genotypes} 19 | 20 | \item{round}{Round or not Default=TRUE} 21 | 22 | \item{print}{Print or not Default=FALSE} 23 | } 24 | \value{ 25 | Matrix 26 | } 27 | \description{ 28 | Simulate two correlated binomial variables 29 | } 30 | -------------------------------------------------------------------------------- /man/create_system.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/mr_system.r 3 | \name{create_system} 4 | \alias{create_system} 5 | \title{Wrapper for simulation pipeline} 6 | \usage{ 7 | create_system( 8 | nidx, 9 | nidy, 10 | nidu = 0, 11 | nu = 0, 12 | na = 0, 13 | nb = 0, 14 | var_x.y, 15 | nsnp_x, 16 | var_gx.x, 17 | var_gx.y = 0, 18 | mu_gx.y = 0, 19 | prop_gx.y = 1, 20 | nsnp_y = 0, 21 | var_gy.y = 0, 22 | var_gy.x = 0, 23 | mu_gy.x = 0, 24 | prop_gy.x = 1 25 | ) 26 | } 27 | \arguments{ 28 | \item{nidx}{number of individuals for x} 29 | 30 | \item{nidy}{number of individuals for y} 31 | 32 | \item{nidu}{Default=0 If 0 then don't simulate separate populations for the u variables} 33 | 34 | \item{nu}{Default=0 Number of confounders influencing x and y} 35 | 36 | \item{na}{Default=0 Number of traits upstream of x} 37 | 38 | \item{nb}{Default=0 Number of traits upstream of y} 39 | 40 | \item{var_x.y}{var in y explained by x} 41 | 42 | \item{nsnp_x}{nsnp influencing x} 43 | 44 | \item{var_gx.x}{variance in x explained by instruments for x} 45 | 46 | \item{var_gx.y}{Default=0} 47 | 48 | \item{mu_gx.y}{Default=0} 49 | 50 | \item{prop_gx.y}{Default=1} 51 | 52 | \item{nsnp_y}{Default=0} 53 | 54 | \item{var_gy.y}{Default=0} 55 | 56 | \item{var_gy.x}{Default=0} 57 | 58 | \item{mu_gy.x}{Default=0} 59 | 60 | \item{prop_gy.x}{Default=1} 61 | } 62 | \value{ 63 | List of effects across system 64 | } 65 | \description{ 66 | Based on the parameters specified this function will call \code{init_parameters}, \code{add_u}, \code{sample_system_effects}, \code{simulate_population} and \code{estimate_system_effects}. A separate population is generated for each phenotype (x, y and each of u) to allow 2SMR and PRS analyses 67 | } 68 | -------------------------------------------------------------------------------- /man/estimate_system_effects.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/mr_system.r 3 | \name{estimate_system_effects} 4 | \alias{estimate_system_effects} 5 | \title{Estimate the effects of all SNPs on all phenotypes} 6 | \usage{ 7 | estimate_system_effects(sim) 8 | } 9 | \arguments{ 10 | \item{sim}{Output from \code{simulate_population}} 11 | } 12 | \value{ 13 | Lists of SNP-trait effect estimates 14 | } 15 | \description{ 16 | Estimate the effects of all SNPs on all phenotypes 17 | } 18 | -------------------------------------------------------------------------------- /man/expected_mse.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/theoretical_gwas.R 3 | \name{expected_mse} 4 | \alias{expected_mse} 5 | \title{Calculate expected MSE} 6 | \usage{ 7 | expected_mse(beta, af, vy) 8 | } 9 | \arguments{ 10 | \item{beta}{array of effect sizes} 11 | 12 | \item{af}{array of allele frequencies} 13 | 14 | \item{vy}{variance of y} 15 | } 16 | \value{ 17 | Numeric 18 | } 19 | \description{ 20 | Calculate expected MSE 21 | } 22 | -------------------------------------------------------------------------------- /man/expected_se.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/theoretical_gwas.R 3 | \name{expected_se} 4 | \alias{expected_se} 5 | \title{Expected se given beta, af, n and vy} 6 | \usage{ 7 | expected_se(beta, af, n, vy) 8 | } 9 | \arguments{ 10 | \item{beta}{array of effect sizes} 11 | 12 | \item{af}{array of allele frequencies} 13 | 14 | \item{n}{sample size} 15 | 16 | \item{vy}{variance of y} 17 | } 18 | \value{ 19 | array of standard errors 20 | } 21 | \description{ 22 | se = sqrt(sigma_e^2 / ss(x)) 23 | } 24 | -------------------------------------------------------------------------------- /man/expected_ssx.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/theoretical_gwas.R 3 | \name{expected_ssx} 4 | \alias{expected_ssx} 5 | \title{Calculate expected SSX} 6 | \usage{ 7 | expected_ssx(af, n) 8 | } 9 | \arguments{ 10 | \item{af}{array of allele frequencies} 11 | 12 | \item{n}{sample size} 13 | } 14 | \value{ 15 | Numeric 16 | } 17 | \description{ 18 | Calculate expected SSX 19 | } 20 | -------------------------------------------------------------------------------- /man/fast_assoc.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/fast_assoc.r 3 | \name{fast_assoc} 4 | \alias{fast_assoc} 5 | \title{Get summary statistics in simple linear regression} 6 | \usage{ 7 | fast_assoc(y, x) 8 | } 9 | \arguments{ 10 | \item{y}{Vector of dependent variable} 11 | 12 | \item{x}{Vector of independent variable} 13 | } 14 | \value{ 15 | List 16 | } 17 | \description{ 18 | Get summary statistics in simple linear regression 19 | } 20 | -------------------------------------------------------------------------------- /man/generate_gwas_params.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/theoretical_gwas.R 3 | \name{generate_gwas_params} 4 | \alias{generate_gwas_params} 5 | \title{Generate SNP effects given MAF, h2 and selection} 6 | \usage{ 7 | generate_gwas_params(map, h2, S = 0, Pi = 1) 8 | } 9 | \arguments{ 10 | \item{map}{Data frame containing at least \code{af} allele frequency and \code{snp} SNP columns. SNPs must be unique, \code{af} must be between 0 and 1. Optionally also include the chr, pos, ref, alt columns if using LD-aware simulations} 11 | 12 | \item{h2}{Variance explained by all SNPs} 13 | 14 | \item{S}{Selection coefficient on trait. Default = 0} 15 | 16 | \item{Pi}{Proportion of variants that have an effect - sampled randomly. Default=1} 17 | } 18 | \value{ 19 | data frame 20 | } 21 | \description{ 22 | Generate SNP effects given MAF, h2 and selection 23 | } 24 | -------------------------------------------------------------------------------- /man/generate_gwas_ss.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/theoretical_gwas.R 3 | \name{generate_gwas_ss} 4 | \alias{generate_gwas_ss} 5 | \title{Modify SNP effects to account for LD} 6 | \usage{ 7 | generate_gwas_ss( 8 | params, 9 | nid, 10 | vy = 1, 11 | minmaf = 0.001, 12 | ld = NULL, 13 | ldobj = NULL, 14 | ldobjlist = NULL, 15 | ldobjfiles = NULL, 16 | ldobjdir = NULL, 17 | gwasglue2 = FALSE, 18 | nthreads = 1 19 | ) 20 | } 21 | \arguments{ 22 | \item{params}{Output from \code{generate_gwas_params}} 23 | 24 | \item{nid}{sample size} 25 | 26 | \item{vy}{Variance of trait} 27 | 28 | \item{minmaf}{minimum allowed maf. default=0.01 to prevent instability} 29 | 30 | \item{ld}{LD correlation matrix. Must be same dimension as params} 31 | 32 | \item{ldobj}{LD objects (e.g. see test_ldobj)} 33 | 34 | \item{ldobjlist}{List of LD objects} 35 | 36 | \item{ldobjfiles}{Array of filenames containing LD object files (e.g. see \code{generate_ldobj})} 37 | 38 | \item{ldobjdir}{Directory containing output from \code{generate_ldobj}} 39 | 40 | \item{gwasglue2}{Logical, creates a gwasglue2 SummarySet when @param ldobj is not NULL (default FALSE).} 41 | 42 | \item{nthreads}{Number of threads (can be slow for complete GWAS and large LD regions)} 43 | } 44 | \value{ 45 | Updated params 46 | } 47 | \description{ 48 | After generating the set of causal effects at each SNP, use an LD correlation matrix to transform the effects to reflect the correlation structure at the SNPs. Note if running many repeats, only need to generate the LD-modified params once and then can repeatedly re-sample using generate_gwas_ss 49 | } 50 | -------------------------------------------------------------------------------- /man/generate_gwas_ss_1.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/theoretical_gwas.R 3 | \name{generate_gwas_ss_1} 4 | \alias{generate_gwas_ss_1} 5 | \title{Create a GWAS summary dataset} 6 | \usage{ 7 | generate_gwas_ss_1(params, nid, vy = 1, minmaf = 0.01, r = NULL) 8 | } 9 | \arguments{ 10 | \item{params}{Output from \code{generate_gwas_params}} 11 | 12 | \item{nid}{sample size} 13 | 14 | \item{vy}{Variance of trait} 15 | 16 | \item{minmaf}{minimum allowed maf. default=0.01 to prevent instability} 17 | 18 | \item{r}{LD correlation matrix. If NULL (default) then creates LD unaware sampling errors} 19 | } 20 | \value{ 21 | list of data frames 22 | } 23 | \description{ 24 | Determines SE and generates effect estimates given input parameters 25 | } 26 | -------------------------------------------------------------------------------- /man/generate_ldobj.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ld.r 3 | \name{generate_ldobj} 4 | \alias{generate_ldobj} 5 | \title{Generate LD matrix objects from reference panel} 6 | \usage{ 7 | generate_ldobj( 8 | outdir, 9 | bfile, 10 | regions, 11 | plink_bin = genetics.binaRies::get_plink_binary(), 12 | nthreads = 1 13 | ) 14 | } 15 | \arguments{ 16 | \item{outdir}{Directory in which to store the ldobj files} 17 | 18 | \item{bfile}{Binary plink dataset} 19 | 20 | \item{regions}{A data frame containing the independent regions (see \code{data(ldetect)})} 21 | 22 | \item{plink_bin}{Plink executable. Default=genetics.binaRies::get_plink_binary()} 23 | 24 | \item{nthreads}{How many threads. Default=1} 25 | } 26 | \value{ 27 | map file 28 | } 29 | \description{ 30 | Creates a set of ldobj files, each corresponding to a single independent LD region from the reference panel. It also generates a map file. 31 | } 32 | -------------------------------------------------------------------------------- /man/get_effs.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/fast_assoc.r 3 | \name{get_effs} 4 | \alias{get_effs} 5 | \title{Get effs for two traits and make dat format} 6 | \usage{ 7 | get_effs(x, y, g, xname = "X", yname = "Y") 8 | } 9 | \arguments{ 10 | \item{x}{Vector of exposure phenotype} 11 | 12 | \item{y}{Vector of outcome phenotype} 13 | 14 | \item{g}{Matrix of genotypes} 15 | 16 | \item{xname}{xname} 17 | 18 | \item{yname}{yname} 19 | } 20 | \value{ 21 | Data frame 22 | } 23 | \description{ 24 | Get effs for two traits and make dat format 25 | } 26 | -------------------------------------------------------------------------------- /man/get_ld.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ld.r 3 | \name{get_ld} 4 | \alias{get_ld} 5 | \title{Get LD matrix for a specified region from bfile reference panel} 6 | \usage{ 7 | get_ld( 8 | chr, 9 | from, 10 | to, 11 | bfile, 12 | plink_bin = genetics.binaRies::get_plink_binary(), 13 | nref = NULL 14 | ) 15 | } 16 | \arguments{ 17 | \item{chr}{Chromosome} 18 | 19 | \item{from}{from bp} 20 | 21 | \item{to}{to bp} 22 | 23 | \item{bfile}{LD reference panel} 24 | 25 | \item{plink_bin}{Plink binary default=genetics.binaRies::get_plink_binary()} 26 | 27 | \item{nref}{Sample size of reference panel} 28 | } 29 | \value{ 30 | List of LD matrix and map info including MAF 31 | } 32 | \description{ 33 | Get LD matrix for a specified region from bfile reference panel 34 | } 35 | -------------------------------------------------------------------------------- /man/get_population_allele_frequency.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/rsq_liability.r 3 | \name{get_population_allele_frequency} 4 | \alias{get_population_allele_frequency} 5 | \title{Estimate the allele frequency in population from case/control summary data} 6 | \usage{ 7 | get_population_allele_frequency(af, prop, odds_ratio, prevalence) 8 | } 9 | \arguments{ 10 | \item{af}{Effect allele frequency (or MAF)} 11 | 12 | \item{prop}{Proportion of samples that are cases} 13 | 14 | \item{odds_ratio}{Odds ratio} 15 | 16 | \item{prevalence}{Population disease prevalence} 17 | } 18 | \value{ 19 | Population allele frequency 20 | } 21 | \description{ 22 | Estimate the allele frequency in population from case/control summary data 23 | } 24 | -------------------------------------------------------------------------------- /man/get_regions_from_ldobjdir.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ld.r 3 | \name{get_regions_from_ldobjdir} 4 | \alias{get_regions_from_ldobjdir} 5 | \title{Determine regions from LD file} 6 | \usage{ 7 | get_regions_from_ldobjdir(ldobjdir) 8 | } 9 | \arguments{ 10 | \item{ldobjdir}{Directory containing output from \code{generate_ldobj}} 11 | } 12 | \value{ 13 | Data frame 14 | } 15 | \description{ 16 | Determine regions from LD file 17 | } 18 | -------------------------------------------------------------------------------- /man/gwas.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/fast_assoc.r 3 | \name{gwas} 4 | \alias{gwas} 5 | \title{Perform association of many SNPs against phenotype} 6 | \usage{ 7 | gwas(y, g, logistic = FALSE) 8 | } 9 | \arguments{ 10 | \item{y}{Vector of phenotypes} 11 | 12 | \item{g}{Matrix of genotypes} 13 | 14 | \item{logistic}{Use logistic regression (much slower)? Default=FALSE} 15 | } 16 | \value{ 17 | Data frame 18 | } 19 | \description{ 20 | Perform association of many SNPs against phenotype 21 | } 22 | -------------------------------------------------------------------------------- /man/gx_to_gp.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/risk.r 3 | \name{gx_to_gp} 4 | \alias{gx_to_gp} 5 | \title{Translate risk from liability to probability scale} 6 | \usage{ 7 | gx_to_gp(gx, h2x, prev) 8 | } 9 | \arguments{ 10 | \item{gx}{score on liability scale} 11 | 12 | \item{h2x}{Disease heritability on liability scale} 13 | 14 | \item{prev}{Prevalence} 15 | } 16 | \value{ 17 | Vector of disease probabilities 18 | } 19 | \description{ 20 | Translate risk from liability to probability scale 21 | } 22 | -------------------------------------------------------------------------------- /man/hap_freqs.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ld.r 3 | \name{hap_freqs} 4 | \alias{hap_freqs} 5 | \title{Estimate haplotype frequencies for two loci} 6 | \usage{ 7 | hap_freqs(r, p1, p2) 8 | } 9 | \arguments{ 10 | \item{r}{Required LD r} 11 | 12 | \item{p1}{Freq 1} 13 | 14 | \item{p2}{Freq 2} 15 | } 16 | \value{ 17 | vector 18 | } 19 | \description{ 20 | Estimate haplotype frequencies for two loci 21 | } 22 | -------------------------------------------------------------------------------- /man/init_parameters.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/mr_system.r 3 | \name{init_parameters} 4 | \alias{init_parameters} 5 | \title{Choose initial parameters for direct effects on X and Y} 6 | \usage{ 7 | init_parameters( 8 | nsnp_x, 9 | var_gx.x, 10 | var_x.y, 11 | var_gx.y = 0, 12 | nsnp_y = 0, 13 | var_gy.y = 0, 14 | mu_gx.y = 0, 15 | var_gy.x = 0, 16 | mu_gy.x = 0, 17 | prop_gy.x = 1, 18 | prop_gx.y = 1 19 | ) 20 | } 21 | \arguments{ 22 | \item{nsnp_x}{nsnp_x} 23 | 24 | \item{var_gx.x}{var_gx.x} 25 | 26 | \item{var_x.y}{var_x.y} 27 | 28 | \item{var_gx.y}{var_gx.y=0} 29 | 30 | \item{nsnp_y}{nsnp_y=0} 31 | 32 | \item{var_gy.y}{var_gy.y=0} 33 | 34 | \item{mu_gx.y}{mu_gx.y=0} 35 | 36 | \item{var_gy.x}{var_gy.x=0} 37 | 38 | \item{mu_gy.x}{mu_gy.x=0} 39 | 40 | \item{prop_gy.x}{prop_gy.x=1} 41 | 42 | \item{prop_gx.y}{prop_gx.y=1} 43 | } 44 | \value{ 45 | List of model parameters 46 | } 47 | \description{ 48 | Choose initial parameters for direct effects on X and Y 49 | } 50 | -------------------------------------------------------------------------------- /man/ldetect.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ldetect.r 3 | \docType{data} 4 | \name{ldetect} 5 | \alias{ldetect} 6 | \title{Data frame of independent LD regions} 7 | \format{ 8 | A data frame with 5731 rows and 4 columns 9 | \describe{ 10 | \item{chr}{chromosome} 11 | \item{start}{start position} 12 | \item{stop}{stop position} 13 | \item{pop}{Population} 14 | } 15 | } 16 | \source{ 17 | \url{https://bitbucket.org/nygcresearch/ldetect-data](https://bitbucket.org/nygcresearch/ldetect-data/src/master/} 18 | } 19 | \usage{ 20 | ldetect 21 | } 22 | \description{ 23 | Taken from Berisa and Pickrell (2016) - \url{https://www.ncbi.nlm.nih.gov/pmc/articles/PMC4731402/} - a list of independent LD regions for Africans, Europeans and Asians. All in build hg19 24 | } 25 | \keyword{datasets} 26 | -------------------------------------------------------------------------------- /man/lor_to_rsq.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/rsq_liability.r 3 | \name{lor_to_rsq} 4 | \alias{lor_to_rsq} 5 | \title{Estimate proportion of variance of liability explained by SNP in general population} 6 | \usage{ 7 | lor_to_rsq(b, af, ncase, ncontrol, prevalence, model = "logit") 8 | } 9 | \arguments{ 10 | \item{b}{Log odds ratio} 11 | 12 | \item{af}{allele frequency} 13 | 14 | \item{ncase}{Number of cases} 15 | 16 | \item{ncontrol}{number of controls} 17 | 18 | \item{prevalence}{prevalence} 19 | 20 | \item{model}{Is the effect size estiamted in "logit" (default) or "probit" model} 21 | } 22 | \value{ 23 | Rsq 24 | } 25 | \description{ 26 | This uses equation 10 in Genetic Epidemiology 36 : 214–224 (2012) 27 | } 28 | -------------------------------------------------------------------------------- /man/make_geno.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/generate_individuals.r 3 | \name{make_geno} 4 | \alias{make_geno} 5 | \title{Create genotype matrix} 6 | \usage{ 7 | make_geno(nid, nsnp, af) 8 | } 9 | \arguments{ 10 | \item{nid}{Number of samples} 11 | 12 | \item{nsnp}{Number of SNPs} 13 | 14 | \item{af}{Allele frequency of all SNPs (all SNPs have the same allele frequency)} 15 | } 16 | \value{ 17 | Matrix of genotypes, rows = individuals, columns = snps 18 | } 19 | \description{ 20 | Create genotype matrix 21 | } 22 | -------------------------------------------------------------------------------- /man/make_mvdat.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/format_mr.r 3 | \name{make_mvdat} 4 | \alias{make_mvdat} 5 | \title{Take several exposures and one outcome and make the data required for multivariable MR} 6 | \usage{ 7 | make_mvdat(exposures, y, g) 8 | } 9 | \arguments{ 10 | \item{exposures}{List of exposure vectors} 11 | 12 | \item{y}{Vector of outcomes} 13 | 14 | \item{g}{Matrix of genotypes} 15 | } 16 | \value{ 17 | mv_harmonise_data output 18 | } 19 | \description{ 20 | Take several exposures and one outcome and make the data required for multivariable MR 21 | } 22 | -------------------------------------------------------------------------------- /man/make_phen.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/generate_individuals.r 3 | \name{make_phen} 4 | \alias{make_phen} 5 | \title{Simulate variable based on the influences of other variables} 6 | \usage{ 7 | make_phen(effs, indep, vy = 1, vx = rep(1, length(effs)), my = 0) 8 | } 9 | \arguments{ 10 | \item{effs}{An array of effect sizes that the variables in indep have on the variable that you are simulating} 11 | 12 | \item{indep}{A matrix of variables, rows = Samples and columns = variables that have an influence on the variable that you are simulating} 13 | 14 | \item{vy}{What variance the output should have. Default = 1, meaning effs relate to the signed rsq of the influence of the indep variables on the outcome} 15 | 16 | \item{vx}{What variance the indep variables should have. Default is to set to 1, meaning that the effects are the signed variance explained} 17 | 18 | \item{my}{mean value of y to be output} 19 | } 20 | \value{ 21 | Vector of y values 22 | } 23 | \description{ 24 | I need a function that takes some variables, and an effect size for each of them, and this creates a new variable where y = Xb + e, where X is the matrix of independent variables, b is their effect sizes, and e is a noise term. By default it's easier if b relates to the variance explained by each vector in X, and e has variance of 1 - sum(b). 25 | } 26 | -------------------------------------------------------------------------------- /man/merge_exp_out.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/format_mr.r 3 | \name{merge_exp_out} 4 | \alias{merge_exp_out} 5 | \title{Organise outputs from \code{gwas} into harmonised dat format} 6 | \usage{ 7 | merge_exp_out(gwasx, gwasy, xname = "X", yname = "Y") 8 | } 9 | \arguments{ 10 | \item{gwasx}{Output from \code{gwas}} 11 | 12 | \item{gwasy}{Output from \code{gwas}} 13 | 14 | \item{xname}{exposure name} 15 | 16 | \item{yname}{outcome name} 17 | } 18 | \value{ 19 | data frame 20 | } 21 | \description{ 22 | Organise outputs from \code{gwas} into harmonised dat format 23 | } 24 | -------------------------------------------------------------------------------- /man/pipe.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils-pipe.R 3 | \name{\%>\%} 4 | \alias{\%>\%} 5 | \title{Pipe operator} 6 | \usage{ 7 | lhs \%>\% rhs 8 | } 9 | \description{ 10 | See \code{magrittr::\link[magrittr:pipe]{\%>\%}} for details. 11 | } 12 | \keyword{internal} 13 | -------------------------------------------------------------------------------- /man/range01.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/risk.r 3 | \name{range01} 4 | \alias{range01} 5 | \title{Scale variable to have range between 0 and 1} 6 | \usage{ 7 | range01(x) 8 | } 9 | \arguments{ 10 | \item{x}{Vector} 11 | } 12 | \value{ 13 | Vector 14 | } 15 | \description{ 16 | Scale variable to have range between 0 and 1 17 | } 18 | -------------------------------------------------------------------------------- /man/read_ldobjdir.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ld.r 3 | \name{read_ldobjdir} 4 | \alias{read_ldobjdir} 5 | \title{Read in LD objects into list} 6 | \usage{ 7 | read_ldobjdir(ldobjdir, nthreads = 1) 8 | } 9 | \arguments{ 10 | \item{ldobjdir}{Directory containing output from \code{generate_ldobj}} 11 | 12 | \item{nthreads}{Number of threads. Default=1} 13 | } 14 | \value{ 15 | List of ldobj 16 | } 17 | \description{ 18 | Read in LD objects into list 19 | } 20 | -------------------------------------------------------------------------------- /man/recode_dat.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/format_mr.r 3 | \name{recode_dat} 4 | \alias{recode_dat} 5 | \title{Recode data to make every effect on x positive} 6 | \usage{ 7 | recode_dat(dat, method = "intercept") 8 | } 9 | \arguments{ 10 | \item{dat}{Output from get_effs} 11 | 12 | \item{method}{Default 'intercept'. Alternatively can specify 'simple'} 13 | } 14 | \value{ 15 | Data frame 16 | } 17 | \description{ 18 | Can use simple method or by pivoting around intercept 19 | } 20 | -------------------------------------------------------------------------------- /man/recode_dat_intercept.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/format_mr.r 3 | \name{recode_dat_intercept} 4 | \alias{recode_dat_intercept} 5 | \title{Intercept recoding to have every effect on x positive} 6 | \usage{ 7 | recode_dat_intercept(dat) 8 | } 9 | \arguments{ 10 | \item{dat}{Output from get_effs} 11 | } 12 | \value{ 13 | Data frame 14 | } 15 | \description{ 16 | Tries to avoid issue of recoding by finding intercept and pivoting negative g-x associations around intercept 17 | } 18 | -------------------------------------------------------------------------------- /man/recode_dat_simple.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/format_mr.r 3 | \name{recode_dat_simple} 4 | \alias{recode_dat_simple} 5 | \title{Simple recoding to have every effect on x positive} 6 | \usage{ 7 | recode_dat_simple(dat) 8 | } 9 | \arguments{ 10 | \item{dat}{Output from get_effs} 11 | } 12 | \value{ 13 | Data frame 14 | } 15 | \description{ 16 | Simple recoding to have every effect on x positive 17 | } 18 | -------------------------------------------------------------------------------- /man/risk_cross_plot.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/risk.r 3 | \name{risk_cross_plot} 4 | \alias{risk_cross_plot} 5 | \title{Plot liability vs probability disease risk} 6 | \usage{ 7 | risk_cross_plot( 8 | x, 9 | o, 10 | xlab = "Values (low to high)", 11 | ylab = "", 12 | title = "", 13 | xname = "GRS", 14 | oname = "Disease" 15 | ) 16 | } 17 | \arguments{ 18 | \item{x}{Disease risk on liability scale} 19 | 20 | \item{o}{Disease risk on probability scale} 21 | 22 | \item{xlab}{default="Values (low to high)"} 23 | 24 | \item{ylab}{default=""} 25 | 26 | \item{title}{default=""} 27 | 28 | \item{xname}{Name of liability. Default="GRS"} 29 | 30 | \item{oname}{Name of disease. Default="Disease"} 31 | } 32 | \value{ 33 | ggplot 34 | } 35 | \description{ 36 | Plot liability vs probability disease risk 37 | } 38 | -------------------------------------------------------------------------------- /man/risk_simulation.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/risk.r 3 | \name{risk_simulation} 4 | \alias{risk_simulation} 5 | \title{Make simulation to compare disease and liability scales} 6 | \usage{ 7 | risk_simulation(G, eff, prevalence, prop_discovered) 8 | } 9 | \arguments{ 10 | \item{G}{Matrix of genotypes} 11 | 12 | \item{eff}{SNP effects on liability scale} 13 | 14 | \item{prevalence}{Disease prevalence} 15 | 16 | \item{prop_discovered}{Proportion of SNPs discovered} 17 | } 18 | \value{ 19 | Data frame 20 | } 21 | \description{ 22 | Compares the liability and probability of disease under two scenarios - where all SNPs are known, and where only some SNPs are known 23 | } 24 | -------------------------------------------------------------------------------- /man/sample_beta.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/theoretical_gwas.R 3 | \name{sample_beta} 4 | \alias{sample_beta} 5 | \title{Sample beta values given standard errors} 6 | \usage{ 7 | sample_beta(beta, se, r = NULL, af = NULL) 8 | } 9 | \arguments{ 10 | \item{beta}{array of beta values - i.e. the true coefficients. If using the correlation matrix r then this should be an LD-aware set of expected beta values.} 11 | 12 | \item{se}{array of se values} 13 | 14 | \item{r}{matrix of LD correlations amongst the SNPs. If NULL (default) then assumes no LD} 15 | 16 | \item{af}{array of allele frequencies. Must be non-null if r is non-null.} 17 | } 18 | \value{ 19 | array of beta hats 20 | } 21 | \description{ 22 | Sample beta values given standard errors 23 | } 24 | -------------------------------------------------------------------------------- /man/sample_system_effects.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/mr_system.r 3 | \name{sample_system_effects} 4 | \alias{sample_system_effects} 5 | \title{Sample the actual effects based on initial parameters} 6 | \usage{ 7 | sample_system_effects(parameters) 8 | } 9 | \arguments{ 10 | \item{parameters}{Output from \code{init_parameters} or \code{add_u}} 11 | } 12 | \value{ 13 | List of effect parameters 14 | } 15 | \description{ 16 | Sample the actual effects based on initial parameters 17 | } 18 | -------------------------------------------------------------------------------- /man/simulateGP-package.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/simulateGP-package.r 3 | \docType{package} 4 | \name{simulateGP-package} 5 | \alias{simulateGP-package} 6 | \alias{simulateGP} 7 | \alias{simulategp} 8 | \title{simulateGP: Functions for Simulating Genotype-Phenotype Relationships} 9 | \description{ 10 | This package is a collection of utilities relating to simulating genotype phenotype maps 11 | The simulations are largely used for Mendelian randomisation, and link up with the TwoSampleMR R package 12 | } 13 | \details{ 14 | \strong{Full documentation available here:} \url{https://explodecomputer.github.io/simulateGP} 15 | } 16 | \seealso{ 17 | Useful links: 18 | \itemize{ 19 | \item \url{https://explodecomputer.github.io/simulateGP/} 20 | \item Report bugs at \url{https://github.com/explodecomputer/simulateGP/issues} 21 | } 22 | 23 | } 24 | \author{ 25 | \strong{Maintainer}: Gibran Hemani \email{explodecomputer@gmail.com} (\href{https://orcid.org/0000-0003-0920-1055}{ORCID}) 26 | 27 | Authors: 28 | \itemize{ 29 | \item John Ferguson \email{john.ferguson@nuigalway.ie} 30 | \item Rita Rasteiro \email{rita.rasteiro@bristol.ac.uk} (\href{https://orcid.org/0000-0002-4217-3060}{ORCID}) 31 | } 32 | 33 | } 34 | -------------------------------------------------------------------------------- /man/simulate_geno.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ld.r 3 | \name{simulate_geno} 4 | \alias{simulate_geno} 5 | \title{Simulate genotypes from haplotypes} 6 | \usage{ 7 | simulate_geno(nid, r, p1, p2) 8 | } 9 | \arguments{ 10 | \item{nid}{Number of samples} 11 | 12 | \item{r}{Desired LD r} 13 | 14 | \item{p1}{Freq 1} 15 | 16 | \item{p2}{Freq 2} 17 | } 18 | \value{ 19 | Matrix 20 | } 21 | \description{ 22 | Simulate genotypes from haplotypes 23 | } 24 | -------------------------------------------------------------------------------- /man/simulate_haplotypes.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ld.r 3 | \name{simulate_haplotypes} 4 | \alias{simulate_haplotypes} 5 | \title{Simulate haplotypes of two loci} 6 | \usage{ 7 | simulate_haplotypes(nid, r, p1, p2) 8 | } 9 | \arguments{ 10 | \item{nid}{Number of samples} 11 | 12 | \item{r}{Desired LD r} 13 | 14 | \item{p1}{Freq 1} 15 | 16 | \item{p2}{Freq 2} 17 | } 18 | \value{ 19 | Matrix 20 | } 21 | \description{ 22 | Simulate haplotypes of two loci 23 | } 24 | -------------------------------------------------------------------------------- /man/simulate_population.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/mr_system.r 3 | \name{simulate_population} 4 | \alias{simulate_population} 5 | \title{Simulate individual level data from initial parameters} 6 | \usage{ 7 | simulate_population(parameters, nid) 8 | } 9 | \arguments{ 10 | \item{parameters}{Output from \code{init_parameters} or \code{add_u}} 11 | 12 | \item{nid}{Sample size to generate} 13 | } 14 | \value{ 15 | List of matrices and vectors that represent individual level data 16 | } 17 | \description{ 18 | Simulate individual level data from initial parameters 19 | } 20 | -------------------------------------------------------------------------------- /man/stuff.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils-pipe.R 3 | \name{stuff} 4 | \alias{stuff} 5 | \title{General funcs} 6 | \description{ 7 | General funcs 8 | } 9 | -------------------------------------------------------------------------------- /man/summary_set.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/summary_set.r 3 | \name{summary_set} 4 | \alias{summary_set} 5 | \title{Wrapper for generating a summary set} 6 | \usage{ 7 | summary_set( 8 | beta_gx, 9 | beta_gy, 10 | af, 11 | n_gx, 12 | n_gy, 13 | n_overlap, 14 | cor_xy, 15 | prev_y = NA, 16 | sigma_x = 1, 17 | sigma_y = 1 18 | ) 19 | } 20 | \arguments{ 21 | \item{beta_gx}{Array of true effects on x} 22 | 23 | \item{beta_gy}{Array of true effects on y} 24 | 25 | \item{af}{Array of effect allele frequencies} 26 | 27 | \item{n_gx}{Sample size of g-x association} 28 | 29 | \item{n_gy}{Sample size of g-y association} 30 | 31 | \item{n_overlap}{Number of overlapping samples} 32 | 33 | \item{cor_xy}{Observational correlation between x and y} 34 | 35 | \item{prev_y}{Disease prevalence of y. Default = NA (in which case treated as continuous)} 36 | 37 | \item{sigma_x}{SD of x. Default=1} 38 | 39 | \item{sigma_y}{SD of y. Default=1} 40 | } 41 | \value{ 42 | Data frame of summary statistics for x and y 43 | } 44 | \description{ 45 | Allows arbitrary sample overlap 46 | } 47 | -------------------------------------------------------------------------------- /man/test_ldobj.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ld.r 3 | \name{test_ldobj} 4 | \alias{test_ldobj} 5 | \title{Create test LD object} 6 | \usage{ 7 | test_ldobj(nsnp, chunksize) 8 | } 9 | \arguments{ 10 | \item{nsnp}{Number of SNPs} 11 | 12 | \item{chunksize}{Chunksize for splitting} 13 | } 14 | \value{ 15 | list of chunks, which each contain map and LD matrix 16 | } 17 | \description{ 18 | Create test LD object 19 | } 20 | -------------------------------------------------------------------------------- /man/test_system.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/mr_system.r 3 | \name{test_system} 4 | \alias{test_system} 5 | \title{Apply MR tests to system} 6 | \usage{ 7 | test_system(ss, id = "test") 8 | } 9 | \arguments{ 10 | \item{ss}{Output from create_syste,} 11 | 12 | \item{id}{string denoting simulation ID} 13 | } 14 | \value{ 15 | List 16 | } 17 | \description{ 18 | Apply MR tests to system 19 | } 20 | -------------------------------------------------------------------------------- /man/y_to_binary.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/generate_individuals.r 3 | \name{y_to_binary} 4 | \alias{y_to_binary} 5 | \title{Convert continuous trait to binary} 6 | \usage{ 7 | y_to_binary(y, prevalence = NULL, threshold = NULL) 8 | } 9 | \arguments{ 10 | \item{y}{Phenotype vector} 11 | 12 | \item{prevalence}{Disease prevalence. Default = NULL} 13 | 14 | \item{threshold}{Disease threshold Default = NULL} 15 | } 16 | \value{ 17 | Vector of binary trait 18 | } 19 | \description{ 20 | Convert continuous trait to binary 21 | } 22 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(simulateGP) 3 | 4 | test_check("simulateGP") 5 | -------------------------------------------------------------------------------- /tests/testthat/test_fastassoc.R: -------------------------------------------------------------------------------- 1 | context("fastassoc") 2 | library(simulateGP) 3 | 4 | test_that("fastassoc", { 5 | set.seed(1234) 6 | n <- 10000 7 | x <- rnorm(n) 8 | y <- x + rnorm(n) 9 | a <- fast_assoc(y, x) 10 | b <- summary(lm(y ~ x)) 11 | expect_equal(a$bhat, b$coefficients[2,1]) 12 | expect_equal(a$se, b$coefficients[2,2]) 13 | expect_equal(a$pval, b$coefficients[2,4]) 14 | }) 15 | 16 | 17 | test_that("gwas", { 18 | set.seed(1234) 19 | nsnp <- 3 20 | nid <- 10000 21 | rsq_gx <- 0.05 22 | u <- rnorm(nid) 23 | g <- make_geno(nid=nid, nsnp=nsnp, af=0.5) 24 | effs <- choose_effects(nsnp=nsnp, totvar=rsq_gx) 25 | x <- make_phen(effs=c(effs, 0.3), indep=cbind(g, u)) 26 | res <- gwas(x, g) 27 | expect_equal(nrow(res), nsnp) 28 | mod <- summary(lm(x ~ g[,1])) 29 | expect_equal(res$bhat[1], mod$coefficients[2,1]) 30 | }) 31 | 32 | 33 | test_that("get_effs", { 34 | 35 | set.seed(1234) 36 | beta_xy <- -0.3 37 | nsnp <- 3 38 | nid <- 10000 39 | rsq_gx <- 0.05 40 | u <- rnorm(nid) 41 | g <- make_geno(nid=nid, nsnp=nsnp, af=0.5) 42 | effs <- choose_effects(nsnp=nsnp, totvar=rsq_gx) 43 | x <- make_phen(effs=c(effs, 0.3), indep=cbind(g, u)) 44 | y <- make_phen(effs=c(beta_xy, 0.3), cbind(x, u)) 45 | res <- gwas(x, g) 46 | expect_equal(nrow(res), nsnp) 47 | mod <- summary(lm(x ~ g[,1])) 48 | expect_equal(res$bhat[1], mod$coefficients[2,1]) 49 | 50 | res <- get_effs(x, y, g) 51 | expect_equal(nrow(res), nsnp) 52 | }) 53 | 54 | 55 | test_that("logistic", { 56 | 57 | set.seed(1234) 58 | beta_xy <- -0.3 59 | nsnp <- 3 60 | nid <- 10000 61 | rsq_gx <- 0.05 62 | u <- rnorm(nid) 63 | g <- make_geno(nid=nid, nsnp=nsnp, af=0.5) 64 | effs <- choose_effects(nsnp=nsnp, totvar=rsq_gx) 65 | x <- make_phen(effs=c(effs, 0.3), indep=cbind(g, u)) 66 | z <- rbinom(nid, 1, plogis(x)) 67 | res <- gwas(z, g, logistic=TRUE) 68 | 69 | expect_equal(nrow(res), nsnp) 70 | mod <- summary(glm(z ~ g[,1], family="binomial")) 71 | expect_equal(res$bhat[1], mod$coefficients[2,1]) 72 | }) 73 | -------------------------------------------------------------------------------- /tests/testthat/test_format_mr.R: -------------------------------------------------------------------------------- 1 | context("format MR") 2 | library(simulateGP) 3 | 4 | 5 | test_that("mvmr", { 6 | 7 | # Simulate 100 genotypes 8 | g <- make_geno(10000, 80, 0.5) 9 | 10 | # Choose effect sizes for instruments for each trait 11 | effs1 <- choose_effects(50, 0.05) 12 | effs2 <- choose_effects(50, 0.05) 13 | 14 | # Create X1 and X2, where they overlap some variants 15 | x1 <- make_phen(effs1, g[,1:50]) 16 | x2 <- make_phen(effs2, g[,31:80]) 17 | 18 | # Create Y - x1 has a -0.3 influence on it and x2 has a +0.3 influence on it 19 | y <- make_phen(c(-0.3, 0.3), cbind(x1, x2)) 20 | 21 | # Perform separate MR on each 22 | dat1 <- get_effs(x1, y, g) 23 | dat2 <- get_effs(x2, y, g) 24 | 25 | # Do multivariable MR 26 | # First get the effects for x1, x2 and y, and put them in mv format 27 | mvdat <- make_mvdat(list(x1, x2), y, g) 28 | 29 | expect_true(is.list(mvdat)) 30 | 31 | }) 32 | 33 | 34 | test_that("merge_exp_out", { 35 | 36 | # Simulate 100 genotypes 37 | g <- make_geno(10000, 80, 0.5) 38 | 39 | # Choose effect sizes for instruments for each trait 40 | effs <- choose_effects(80, 0.05) 41 | 42 | # Create X1 and X2, where they overlap some variants 43 | x <- make_phen(effs, g) 44 | 45 | # Create Y - x1 has a -0.3 influence on it and x2 has a +0.3 influence on it 46 | y <- make_phen(-0.3, x) 47 | 48 | gx <- gwas(x, g) 49 | gy <- gwas(y, g) 50 | 51 | dat <- merge_exp_out(gx, gy) 52 | expect_true(nrow(dat) == 80) 53 | 54 | dat2 <- recode_dat(dat) 55 | expect_true(nrow(dat2) == 80) 56 | }) 57 | 58 | -------------------------------------------------------------------------------- /tests/testthat/test_generate_individuals.R: -------------------------------------------------------------------------------- 1 | context("generate individuals") 2 | library(simulateGP) 3 | 4 | test_that("make_geno", { 5 | 6 | g <- make_geno(10000, 80, 0.5) 7 | 8 | expect_true(nrow(g) == 10000) 9 | expect_true(ncol(g) == 80) 10 | }) 11 | 12 | test_that("make_phen", { 13 | 14 | set.seed(1234) 15 | g <- make_geno(10000, 50, 0.5) 16 | effs <- choose_effects(50, 0.05) 17 | expect_equal(sum(effs^2), 0.05) 18 | 19 | x <- make_phen(effs, g) 20 | prs <- g %*% effs 21 | cor(prs, x)^2 22 | expect_equal(cor(prs, x)[1,1]^2, sum(effs^2), tolerance=0.015) 23 | }) 24 | 25 | 26 | test_that("y_to_binary", { 27 | 28 | set.seed(1234) 29 | g <- make_geno(10000, 50, 0.5) 30 | effs <- choose_effects(50, 0.05) 31 | expect_equal(sum(effs^2), 0.05) 32 | 33 | x <- make_phen(effs, g) 34 | y <- y_to_binary(x, prevalence=0.01) 35 | 36 | expect_equal(sum(y)/length(y), 0.01) 37 | 38 | a <- ascertain_samples(y, 0.5) 39 | expect_equal(sum(y[a])/length(a), 0.5) 40 | }) 41 | -------------------------------------------------------------------------------- /tests/testthat/test_ld.R: -------------------------------------------------------------------------------- 1 | context("LD") 2 | library(simulateGP) 3 | 4 | test_that("get ld matrix", { 5 | 6 | skip("needs gwas files") 7 | chr <- 1 8 | from <- 1892607 9 | to <- 3582736 10 | bfile <- "/Users/gh13047/repo/mr-base-api/app/ld_files/EUR" 11 | plink_bin <- genetics.binaRies::get_plink_binary() 12 | a <- get_ld(chr, from, to, bfile, plink_bin) 13 | expect_true(length(a) == 2) 14 | expect_true(nrow(a[[1]]) == nrow(a[[2]])) 15 | expect_true(nrow(a[[1]]) == ncol(a[[1]])) 16 | }) 17 | 18 | 19 | test_that("test_ldobj", { 20 | ldobj <- test_ldobj(nsnp=1050, chunksize=100) 21 | expect_equal(length(ldobj), ceiling(1050/100)) 22 | }) 23 | 24 | -------------------------------------------------------------------------------- /tests/testthat/test_mr_system.r: -------------------------------------------------------------------------------- 1 | context("mr system") 2 | library(simulateGP) 3 | 4 | test_that("create system", { 5 | 6 | dat <- create_system(nidx=1000, nidy=1000, nidu=0, nu=0, na=0, nb=0, var_x.y=0.1, nsnp_x=100, var_gx.x=0.1, var_gx.y=0, mu_gx.y=0, prop_gx.y=1, nsnp_y=0, var_gy.y=0, var_gy.x=0, mu_gy.x=0, prop_gy.x=1) 7 | expect_true(is.list(dat)) 8 | }) 9 | 10 | test_that("init_parameters", { 11 | 12 | dat <- init_parameters(var_x.y=0.1, nsnp_x=100, var_gx.x=0.1, var_gx.y=0, mu_gx.y=0, prop_gx.y=1, nsnp_y=0, var_gy.y=0, var_gy.x=0, mu_gy.x=0, prop_gy.x=1) 13 | expect_true(is.list(dat)) 14 | 15 | dat <- add_u(dat, nsnp_u=100, var_u.x=0.1, var_u.y=0.1, var_gu.u=0.1) 16 | expect_true(is.list(dat)) 17 | 18 | dat2 <- sample_system_effects(dat) 19 | expect_true(is.list(dat2)) 20 | 21 | dat3 <- simulate_population(dat2, 1000) 22 | expect_true(is.list(dat3)) 23 | 24 | dat4 <- estimate_system_effects(dat3) 25 | expect_true(is.list(dat4)) 26 | }) 27 | 28 | 29 | test_that("test_system", { 30 | 31 | skip("need random forest") 32 | ss <- create_system(nidx=10000, nidy=10000, nidu=0, nu=0, na=0, nb=0, var_x.y=0.1, nsnp_x=10, var_gx.x=0.1, var_gx.y=0, mu_gx.y=0, prop_gx.y=1, nsnp_y=10, var_gy.y=0.1, var_gy.x=0, mu_gy.x=0, prop_gy.x=1) 33 | res <- test_system(ss) 34 | expect_true(is.list(res)) 35 | }) 36 | -------------------------------------------------------------------------------- /tests/testthat/test_summary_set.R: -------------------------------------------------------------------------------- 1 | context("GWAS summary data simulations") 2 | library(simulateGP) 3 | 4 | 5 | test_that("no sample overlap", { 6 | 7 | set.seed(1234) 8 | nsnp <- 100 9 | map <- dplyr::tibble( 10 | af = runif(nsnp, 0.01, 0.99), 11 | snp = 1:nsnp 12 | ) 13 | beta_gx <- generate_gwas_params(map, h2=0.5) 14 | beta_gy <- beta_gx 15 | beta_gy$beta <- beta_gy$beta * 0.3 16 | 17 | dat <- summary_set( 18 | beta_gx = beta_gx$beta, 19 | beta_gy = beta_gy$beta, 20 | af = beta_gx$af, 21 | n_gx = 10000, 22 | n_gy = 10000, 23 | n_overlap = 0, 24 | cor_xy = 0, 25 | prev_y=NA, 26 | sigma_x=1, 27 | sigma_y=1 28 | ) 29 | 30 | res <- dat %>% 31 | dplyr::filter(pval.exposure < 5e-8) %>% 32 | TwoSampleMR::mr(., method_list="mr_ivw") 33 | 34 | expect_equal(0.3, res$b, tolerance=res$se * 1.96) 35 | }) 36 | 37 | 38 | 39 | test_that("complete sample overlap linear linear", { 40 | 41 | set.seed(1234) 42 | nsnp <- 100 43 | map <- dplyr::tibble( 44 | af = runif(nsnp, 0.01, 0.99), 45 | snp = 1:nsnp 46 | ) 47 | beta_gx <- generate_gwas_params(map, h2=0.5) 48 | beta_gy <- beta_gx 49 | beta_gy$beta <- beta_gy$beta * 0.3 50 | 51 | dat <- summary_set( 52 | beta_gx = beta_gx$beta, 53 | beta_gy = beta_gy$beta, 54 | af = beta_gx$af, 55 | n_gx = 10000, 56 | n_gy = 10000, 57 | n_overlap = 10000, 58 | cor_xy = 0.6, 59 | prev_y=NA, 60 | sigma_x=1, 61 | sigma_y=1 62 | ) 63 | 64 | res <- dat %>% 65 | dplyr::filter(pval.exposure < 5e-8) %>% 66 | TwoSampleMR::mr(., method_list="mr_ivw") 67 | 68 | expect_equal(0.3, res$b, tolerance=res$se * 1.96) 69 | }) 70 | 71 | 72 | 73 | test_that("partial sample overlap linear linear", { 74 | 75 | set.seed(123456) 76 | nsnp <- 100 77 | map <- dplyr::tibble( 78 | af = runif(nsnp, 0.01, 0.99), 79 | snp = 1:nsnp 80 | ) 81 | beta_gx <- generate_gwas_params(map, h2=0.7) 82 | beta_gy <- beta_gx 83 | beta_gy$beta <- beta_gy$beta * 0.3 84 | 85 | dat <- summary_set( 86 | beta_gx = beta_gx$beta, 87 | beta_gy = beta_gy$beta, 88 | af = beta_gx$af, 89 | n_gx = 10000, 90 | n_gy = 10000, 91 | n_overlap = 5000, 92 | cor_xy = 0.1, 93 | prev_y=NA, 94 | sigma_x=1, 95 | sigma_y=1 96 | ) 97 | 98 | res <- dat %>% 99 | dplyr::filter(pval.exposure < 5e-8) %>% 100 | TwoSampleMR::mr(., method_list="mr_ivw") 101 | 102 | expect_equal(0.3, res$b, tolerance=res$se * 1.96) 103 | }) 104 | 105 | 106 | test_that("partial sample overlap linear logistic", { 107 | 108 | set.seed(1234567) 109 | nsnp <- 100 110 | map <- dplyr::tibble( 111 | af = runif(nsnp, 0.01, 0.99), 112 | snp = 1:nsnp 113 | ) 114 | beta_gx <- generate_gwas_params(map, h2=0.5) 115 | beta_gy <- beta_gx 116 | beta_gy$beta <- beta_gy$beta * 0.3 117 | 118 | dat <- summary_set( 119 | beta_gx = beta_gx$beta, 120 | beta_gy = beta_gy$beta, 121 | af = beta_gx$af, 122 | n_gx = 10000, 123 | n_gy = 10000, 124 | n_overlap = 5000, 125 | cor_xy = 0.6, 126 | prev_y=0.1, 127 | sigma_x=1, 128 | sigma_y=1 129 | ) 130 | 131 | res <- dat %>% 132 | dplyr::filter(pval.exposure < 5e-8) %>% 133 | TwoSampleMR::mr(., method_list="mr_ivw") 134 | 135 | expect_equal(0.3, res$b, tolerance=res$se * 1.96) 136 | }) 137 | 138 | 139 | -------------------------------------------------------------------------------- /tests/testthat/test_theoreticalgwas.R: -------------------------------------------------------------------------------- 1 | context("Theoretical GWAS") 2 | library(simulateGP) 3 | 4 | test_that("expected se works", { 5 | 6 | set.seed(1) 7 | h2 <- 0.3 8 | nid <- 1000 9 | nsnp <- 1 10 | eff <- rnorm(nsnp) 11 | g <- make_geno(1000, 1, 0.5) 12 | grs <- g %*% eff 13 | vare <- var(g) * (1 - h2) / h2 14 | y <- grs + rnorm(nid, 0, sqrt(vare)) 15 | empirical_se <- summary(lm(y ~ g))$coefficients[2,2] 16 | ese <- expected_se(eff, mean(g)/2, nid, var(y)) 17 | 18 | # 5% error maximum? 19 | expect_true(abs(empirical_se - ese)/ese < 0.05) 20 | 21 | }) 22 | 23 | 24 | test_that("gwas summary data", { 25 | set.seed(1345) 26 | nsnp <- 1000 27 | ldobjlist <- test_ldobj(nsnp, 100) 28 | map <- lapply(ldobjlist, function(x) x$map) %>% 29 | dplyr::bind_rows() 30 | out <- map %>% 31 | generate_gwas_params(h2=0.3, S=0.3, Pi=3/nsnp) %>% 32 | generate_gwas_ss(100000, ldobjlist=ldobjlist) 33 | expect_equal(nrow(out), nsnp) 34 | expect_true(sum(out$pval < 5e-8) > 3) 35 | # ggplot(out, aes(pos, -log10(pval))) + geom_point() + facet_grid(. ~ chr) 36 | 37 | ldobj <- ldobjlist[[1]] 38 | nsnp <- nrow(ldobj$map) 39 | out <- ldobj$map %>% 40 | generate_gwas_params(h2=0.3, S=0.3, Pi=3/nsnp) %>% 41 | generate_gwas_ss(100000, ldobj=ldobj) 42 | expect_equal(nrow(out), nsnp) 43 | expect_true(sum(out$pval < 5e-8) > 3) 44 | 45 | out <- ldobj$map %>% 46 | generate_gwas_params(h2=0.3, S=0.3, Pi=3/nsnp) %>% 47 | generate_gwas_ss(100000, ld=ldobj$ld) 48 | expect_equal(nrow(out), nsnp) 49 | expect_true(sum(out$pval < 5e-8) > 3) 50 | 51 | 52 | }) 53 | 54 | -------------------------------------------------------------------------------- /vignettes/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | *.R 3 | -------------------------------------------------------------------------------- /vignettes/2smr.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/vignettes/2smr.png -------------------------------------------------------------------------------- /vignettes/generate_ldobj.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Generating LD matrices" 3 | output: rmarkdown::html_vignette 4 | vignette: > 5 | %\VignetteIndexEntry{Generating LD matrices} 6 | %\VignetteEngine{knitr::rmarkdown} 7 | %\VignetteEncoding{UTF-8} 8 | --- 9 | 10 | ```{r, include = FALSE} 11 | knitr::opts_chunk$set( 12 | collapse = TRUE, 13 | comment = "#>", 14 | eval=FALSE 15 | ) 16 | ``` 17 | 18 | ```{r setup} 19 | library(simulateGP) 20 | library(jsonlite) 21 | library(data.table) 22 | library(tidyverse) 23 | ``` 24 | 25 | ## Obtain independent LD regions 26 | 27 | Use [https://bitbucket.org/nygcresearch/ldetect-data](https://bitbucket.org/nygcresearch/ldetect-data/src/master/) from [Berisa and Pickrell (2016)](https://www.ncbi.nlm.nih.gov/pmc/articles/PMC4731402/) - a list of independent LD regions for Africans, Europeans and Asians. 28 | 29 | Note: The Africans dataset has a couple of None values that I am interpolating in a simple way to avoid errors. 30 | 31 | ```{r} 32 | a <- data.table::fread("https://bitbucket.org/nygcresearch/ldetect-data/raw/ac125e47bf7ff3e90be31f278a7b6a61daaba0dc/AFR/fourier_ls-all.bed") 33 | midpoint <- round((108823642 + 111048570)/2) 34 | a$stop[a$stop=="None"] <- midpoint 35 | a$start[a$start=="None"] <- midpoint 36 | a$start <- as.numeric(a$start) 37 | a$stop <- as.numeric(a$stop) 38 | a$pop <- "AFR" 39 | 40 | b <- data.table::fread("https://bitbucket.org/nygcresearch/ldetect-data/raw/ac125e47bf7ff3e90be31f278a7b6a61daaba0dc/ASN/fourier_ls-all.bed") 41 | b$pop <- "EAS" 42 | 43 | c <- data.table::fread("https://bitbucket.org/nygcresearch/ldetect-data/raw/ac125e47bf7ff3e90be31f278a7b6a61daaba0dc/EUR/fourier_ls-all.bed") 44 | c$pop <- "EUR" 45 | 46 | ldetect <- dplyr::bind_rows(a,b,c) 47 | 48 | # Avoid overlap between regions 49 | ldetect$stop <- ldetect$stop - 1 50 | ``` 51 | 52 | This `ldetect` object is saved as a data object in this package. 53 | 54 | 55 | ## Generate LD matrix objects 56 | 57 | For each region create an `.rds` object that contains a list of `map` and `ld` 58 | 59 | Create a `generate_ldobj_config.json` file: 60 | 61 | ```json 62 | { 63 | "dl_dir": "/path/to/downloads" 64 | } 65 | ``` 66 | 67 | Setup directories 68 | 69 | ```{r} 70 | conf <- read_json("generate_ldobj_config.json") 71 | dir.create(conf$dl_dir) 72 | dir.create(file.path(conf$dl_dir, "EUR_1kg_hm3")) 73 | dir.create(file.path(conf$dl_dir, "EAS_1kg_hm3")) 74 | dir.create(file.path(conf$dl_dir, "AFR_1kg_hm3")) 75 | setwd(conf$dl_dir) 76 | ``` 77 | 78 | Get the 1000 genomes files 79 | 80 | ```{r, engine="bash", eval=FALSE} 81 | wget -O 1kg.v3.tgz http://fileserve.mrcieu.ac.uk/ld/1kg.v3.tgz 82 | tar xzvf 1kg.v3.tgz 83 | rm 1kg.v3.tgz 84 | wget https://github.com/MRCIEU/gwasglue/raw/master/inst/hapmap3/hapmap3_autosome.snplist.gz 85 | gunzip hapmap3_autosome.snplist.gz 86 | plink --bfile EUR --extract hapmap3_autosome.snplist --make-bed --keep-allele-order --out EUR_1kg_hm3 87 | plink --bfile EAS --extract hapmap3_autosome.snplist --make-bed --keep-allele-order --out EAS_1kg_hm3 88 | plink --bfile AFR --extract hapmap3_autosome.snplist --make-bed --keep-allele-order --out AFR_1kg_hm3 89 | ``` 90 | 91 | Generate matrices for each population 92 | 93 | ```{r} 94 | data(ldetect) 95 | 96 | map_eas <- generate_ldobj( 97 | outdir=file.path(conf$dl_dir, "EAS_1kg_hm3"), 98 | bfile=file.path(conf$dl_dir, "EAS_1kg_hm3"), 99 | regions=subset(ldetect, pop=="EAS"), 100 | nthreads=16 101 | ) 102 | 103 | map_afr <- generate_ldobj( 104 | outdir=file.path(conf$dl_dir, "AFR_1kg_hm3"), 105 | bfile=file.path(conf$dl_dir, "AFR_1kg_hm3"), 106 | regions=subset(ldetect, pop=="AFR"), 107 | nthreads=16 108 | ) 109 | 110 | map_eur <- generate_ldobj( 111 | outdir=file.path(conf$dl_dir, "EUR_1kg_hm3"), 112 | bfile=file.path(conf$dl_dir, "EUR_1kg_hm3"), 113 | regions=subset(ldetect, pop=="EUR"), 114 | nthreads=16 115 | ) 116 | ``` 117 | 118 | Package them up 119 | 120 | ```{r} 121 | cmd <- paste0("cd ", conf$dl_dir, "; tar cvf EUR_1kg_hm3_ldobj.tar EUR_1kg_hm3") 122 | system(cmd) 123 | 124 | cmd <- paste0("cd ", conf$dl_dir, "; tar cvf EAS_1kg_hm3_ldobj.tar EAS_1kg_hm3") 125 | system(cmd) 126 | 127 | cmd <- paste0("cd ", conf$dl_dir, "; tar cvf AFR_1kg_hm3_ldobj.tar AFR_1kg_hm3") 128 | system(cmd) 129 | ``` 130 | 131 | 132 | ## Try it out for generating summary data 133 | 134 | Using just one region with just one causal variant. Read in a regional LD matrix 135 | 136 | ```{r} 137 | set.seed(1234) 138 | fn <- list.files(file.path(conf$dl_dir, "EAS_1kg_hm3"), full.names=TRUE) %>% 139 | grep("ldobj_chr", ., value=TRUE) %>% 140 | {.[7]} 141 | ldobj_eas <- readRDS(fn) 142 | ``` 143 | 144 | Generate the LD-aware effects from a single causal variant 145 | 146 | ```{r} 147 | params <- ldobj_eas$map %>% 148 | generate_gwas_params(h2=0.01, Pi=1/nrow(.)) %>% 149 | add_ld_to_params(ldobj=ldobj_eas) 150 | ``` 151 | 152 | Add some random noise for a sample size of 100000 and plot 153 | 154 | ```{r} 155 | ss <- params %>% 156 | generate_gwas_ss(100000) 157 | 158 | ggplot(ss, aes(x=pos, y=-log10(pval))) + 159 | geom_point() 160 | ``` 161 | 162 | Now try whole genome with 100 causal variants - from files - takes less than 2 minutes for HapMap3 with 1 thread 163 | 164 | ```{r} 165 | # Generate effects 166 | params <- map_eas %>% 167 | generate_gwas_params(h2=0.01, Pi=100/nrow(.)) %>% 168 | add_ld_to_params(ldobjdir = file.path(conf$dl_dir, "EAS_1kg_hm3"), nthreads=16) 169 | 170 | # Generate sample estimates 171 | ss <- params %>% 172 | generate_gwas_ss(10000000) 173 | 174 | # Plot 175 | ggplot(ss, aes(x=pos, y=-log10(pval))) + 176 | geom_point() + 177 | facet_grid(. ~ chr, scale="free_x", space="free_x") 178 | ``` 179 | -------------------------------------------------------------------------------- /vignettes/ld_matrices.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "LD matrices" 3 | output: rmarkdown::html_vignette 4 | vignette: > 5 | %\VignetteIndexEntry{LD matrices} 6 | %\VignetteEngine{knitr::rmarkdown} 7 | %\VignetteEncoding{UTF-8} 8 | --- 9 | 10 | ```{r, include = FALSE} 11 | knitr::opts_chunk$set( 12 | collapse = TRUE, 13 | comment = "#>", 14 | eval=FALSE 15 | ) 16 | ``` 17 | 18 | 19 | Components of GWAS summary data 20 | 21 | - genome wide 22 | - sample overlap 23 | - distribution of genetic effects 24 | - polygenic 25 | - following an evolutionary model 26 | - sparseness 27 | - genetic effects wrt LD patterns 28 | - winner's curse - top hits have winner's curse 29 | - large sample sizes 30 | - population structure 31 | 32 | 33 | ```{r setup} 34 | library(simulateGP) 35 | ``` 36 | 37 | ```{r} 38 | pop <- "EUR" 39 | bfile <- paste0("/Users/gh13047/repo/mr-base-api/app/ld_files/", pop) 40 | 41 | varref <- variant_reference(bfile) 42 | regions <- get_regions(pop) 43 | 44 | t1 <- Sys.time() 45 | generate_ld_matrices(regions[1:2,], varref, bfile) 46 | Sys.time()-t1 47 | 48 | t1 <- Sys.time() 49 | generate_ld_matrices2(regions[1:2,], varref, bfile) 50 | Sys.time()-t1 51 | ``` 52 | 53 | -------------------------------------------------------------------------------- /vignettes/mrdag.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/explodecomputer/simulateGP/94ec3733431a4ebca4287c801df3adf3b20df436/vignettes/mrdag.png -------------------------------------------------------------------------------- /vignettes/sample_overlap.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Sample overlap in GWAS summary datasets" 3 | output: rmarkdown::html_vignette 4 | vignette: > 5 | %\VignetteIndexEntry{Sample overlap in GWAS summary datasets} 6 | %\VignetteEngine{knitr::rmarkdown} 7 | %\VignetteEncoding{UTF-8} 8 | --- 9 | 10 | ```{r, include = FALSE} 11 | knitr::opts_chunk$set( 12 | collapse = TRUE, 13 | comment = "#>" 14 | ) 15 | ``` 16 | 17 | ```{r setup} 18 | library(simulateGP) 19 | library(MASS) 20 | library(tidyverse) 21 | library(ggplot2) 22 | ``` 23 | 24 | Sample overlap 25 | 26 | $$ 27 | \begin{bmatrix} 28 | \hat{\beta}_1\\ 29 | \hat{\beta}_2 30 | \end{bmatrix} = 31 | MVN\left ( 32 | \begin{bmatrix} 33 | \beta_1\\ 34 | \beta_2 35 | \end{bmatrix}, 36 | \boldsymbol{S} 37 | \right ) 38 | $$ 39 | 40 | $$ 41 | \boldsymbol{C} = \boldsymbol{S} 42 | 43 | \begin{bmatrix} 44 | N_1 & \rho_{1,2}\frac{N_O}{\sqrt{N_1 N_2}}\\ 45 | \rho_{1,2}\frac{N_O}{\sqrt{N_1 N_2}} & N_2 46 | \end{bmatrix} 47 | 48 | \boldsymbol{S} 49 | $$ 50 | 51 | 52 | ```{r} 53 | betas <- function(b1, b2, se1, se2, n1, n2, pcor, n_overlap, Nrep=1) 54 | { 55 | mu <- c(b1,b2) 56 | # se1 and se2 are computed as per your formula 57 | ses <- matrix(c(se1,0, 0, se2), 2, 2) 58 | # pcor is the phenotypic correlation between traits, N_0 is the sample overlap, N1 is sample size 1, N2 is sample size 2 59 | r <- pcor * n_overlap / sqrt(n1*n2) 60 | cor = matrix(c(1,r, r, 1), 2, 2) 61 | cov <- ses %*% cor %*% ses 62 | sample <- mvrnorm(Nrep, mu, cov) 63 | sample 64 | } 65 | 66 | maf <- 0.4 67 | vy <- 1 68 | n1 <- 10000 69 | n2 <- 10000 70 | b1 <- 0.1 71 | bxy <- 0 72 | b2 <- b1 * bxy 73 | 74 | se1 <- expected_se(b1, maf, n1, 1) 75 | (b1 / se1)^2 76 | se2 <- expected_se(b2, maf, n2, 1) 77 | 78 | betas(b1, b2, se1, se2, 1000, 1000, 0.5, n_overlap=1000, 10000) %>% colMeans %>% {.[2]/.[1]} 79 | betas(b1, b2, se1, se2, 1000, 1000, 0.5, n_overlap=0, 10000) %>% colMeans %>% {.[2]/.[1]} 80 | 81 | betas(b1, b2, se1, se2, 1000, 1000, 0.5, n_overlap=1000, 10000) %>% cor 82 | betas(b1, b2, se1, se2, 1000, 1000, 0.5, n_overlap=0, 10000) %>% cor 83 | 84 | # rsq = F / (F + n -1) 85 | 86 | # rsq F + rsq(n-1) = F 87 | # rsq F - F = -rsq(n-1) 88 | # F (rsq - 1) = - rsq(n - 1) 89 | # F = (rsq - rsq n) / rsq - 1 90 | 91 | # rsq = 20 / (20 + 1000 - 1) 92 | 93 | 94 | nrep=2000 95 | nsnp=100 96 | n1 <- 1000 97 | n2 <- 1000 98 | maf <- 0.4 99 | pcor <- 0.6 100 | 101 | a <- generate_gwas_params(tibble(snp=1:nsnp, af=maf), 1, S=5) 102 | a <- expand.grid(b1=a$beta, overlap=c(0, 0.5, 1), bxy=c(0, 0.3)) %>% as_tibble 103 | a$se1 <- expected_se(a$b1, maf, n1, 1) 104 | a$fval <- (a$b1/a$se1)^2 105 | hist(a$fval) 106 | 107 | a$b2 <- a$b1 * a$bxy 108 | a$se2 <- expected_se(a$b2, maf, n2, 1) 109 | 110 | l <- list() 111 | for(i in 1:nrow(a)) 112 | { 113 | r <- betas(a$b1[i], a$b2[i], a$se1[i], a$se2[i], n1, n2, pcor, a$overlap[i] * n1, nrep) 114 | d <- a[i,] %>% slice(rep(row_number(), nrep)) 115 | d$bx <- r[,1] 116 | d$by <- r[,2] 117 | l[[i]] <- d 118 | } 119 | dat <- bind_rows(l) 120 | dat$wr <- dat$by/dat$bx 121 | ggplot(subset(dat, wr < 3 & wr > -3), aes(x=fval, y=by/bx)) + 122 | # geom_point(size=0.1, aes(colour=as.factor(overlap))) + 123 | geom_smooth(aes(colour=as.factor(overlap))) + 124 | facet_grid(. ~ bxy) + 125 | scale_colour_brewer(type="qual") 126 | ``` 127 | 128 | 129 | ```{r} 130 | nsim <- 500 131 | dat1 <- tibble(rsq1=runif(nsim, 0.001, 0.01), overlap=1) 132 | dat2 <- tibble(rsq1=dat1$rsq1, overlap=0) 133 | dat3 <- tibble(rsq1=dat1$rsq1, overlap=0.5) 134 | 135 | n1 <- 1000 136 | n2 <- 1000 137 | g1 <- make_geno(n1, 1, 0.4) 138 | g2 <- make_geno(n2, 1, 0.4) 139 | u1 <- rnorm(n1) 140 | u2 <- rnorm(n2) 141 | mid <- round(n2/2) 142 | for(i in 1:nrow(dat1)) 143 | { 144 | b <- choose_effects(1, dat1$rsq1[i]) 145 | x1 <- make_phen(c(b, sqrt(0.5)), cbind(g1, u1)) 146 | x2 <- make_phen(c(b, sqrt(0.5)), cbind(g2, u2)) 147 | y1 <- make_phen(c(0.1, -sqrt(0.5)), cbind(x1, u1)) 148 | y2 <- make_phen(c(0.1, -sqrt(0.5)), cbind(x2, u2)) 149 | e1 <- get_effs(x1, y1, g1) 150 | ex1 <- fast_assoc(x1, g1) 151 | ey1 <- fast_assoc(y1, g1) 152 | ey2 <- fast_assoc(y2, g2) 153 | ey3 <- fast_assoc(c(y1[1:mid], y2[(mid+1):n2]), c(g1[1:mid], g2[(mid+1):n2])) 154 | dat1$fval[i] <- ex1$fval 155 | dat2$fval[i] <- ex1$fval 156 | dat3$fval[i] <- ex1$fval 157 | dat1$bx[i] <- ex1$bhat 158 | dat1$by[i] <- ey1$bhat 159 | dat2$bx[i] <- ex1$bhat 160 | dat2$by[i] <- ey2$bhat 161 | dat3$bx[i] <- ex1$bhat 162 | dat3$by[i] <- ey3$bhat 163 | } 164 | 165 | dat <- bind_rows(dat1, dat2, dat3) 166 | ggplot(dat, aes(x=fval, y=by/bx)) + 167 | geom_point(size=0.1, aes(colour=as.factor(overlap))) + 168 | geom_smooth(aes(colour=as.factor(overlap))) + 169 | xlim(c(0.1, max(dat$fval))) + 170 | ylim(c(-3, 3)) + 171 | scale_colour_brewer(type="qual") 172 | 173 | 174 | dat1 %>% subset(fval > 0.1) %>% {cor(.$bx, .$by)} 175 | dat2 %>% subset(fval > 0.1) %>% {cor(.$bx, .$by)} 176 | dat3 %>% subset(fval > 0.1) %>% {cor(.$bx, .$by)} 177 | 178 | ``` 179 | -------------------------------------------------------------------------------- /vignettes/simplemr.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Simple Mendelian randomisation examples" 3 | output: rmarkdown::html_vignette 4 | vignette: > 5 | %\VignetteIndexEntry{Simple Mendelian randomisation examples} 6 | %\VignetteEngine{knitr::rmarkdown} 7 | %\VignetteEncoding{UTF-8} 8 | --- 9 | 10 | ```{r, include = FALSE} 11 | knitr::opts_chunk$set( 12 | collapse = TRUE, 13 | comment = "#>" 14 | ) 15 | ``` 16 | 17 | ```{r setup} 18 | library(simulateGP) 19 | library(systemfit) 20 | ``` 21 | 22 | The Mendelian randomisation statistical method aims to estimate the causal effect of some exposure $x$ on some outcome $y$ using a genetic instrumental variable for the exposure, $g$. The assumptions of the model are that 23 | 24 | 1. $g$ associates with $x$ 25 | 2. $g$ is independent of any confounders of $x$ and $y$ 26 | 3. $g$ only associates with $y$ via $x$ 27 | 28 | A DAG representing the assumptions is below: 29 | 30 | ![mrdag](mrdag.png) 31 | 32 | We can simulate individual level data according to this DAG 33 | 34 | 1. Simulate some genetic or confounding variables 35 | 2. Simulate exposures that are influenced by (1) 36 | 3. Simulate the outcomes that are influenced by (1) and (2) 37 | 4. Obtain MR estimate using two-stage least squares 38 | 39 | Here is how to do 1-3: 40 | 41 | ```{r} 42 | # Set causal effect of x on y 43 | beta_xy <- -0.3 44 | 45 | # Set number of instruments for x 46 | nsnp <- 3 47 | 48 | # Set number of individuals to simulate 49 | nid <- 10000 50 | 51 | # Set variance explained in x by the instruments 52 | rsq_gx <- 0.05 53 | 54 | # Generate a confounder 55 | u <- rnorm(nid) 56 | 57 | # Generate genotypes with allele frequencies of 0.5 58 | g <- make_geno(nid=nid, nsnp=nsnp, af=0.5) 59 | 60 | # These SNPs instrument some exposure, and together explain 5% of the variance 61 | effs <- choose_effects(nsnp=nsnp, totvar=rsq_gx) 62 | 63 | # Create X - influenced by snps and the confounder 64 | x <- make_phen(effs=c(effs, 0.3), indep=cbind(g, u)) 65 | ``` 66 | 67 | Check that the SNPs explain 5% of the variance in x 68 | 69 | ```{r} 70 | sum(cor(x, g)^2) 71 | ``` 72 | 73 | Create Y, which is negatively influenced by x and positively influenced by the confounder 74 | 75 | ```{r} 76 | y <- make_phen(effs=c(beta_xy, 0.3), cbind(x, u)) 77 | ``` 78 | 79 | We now have an X and Y, and the genotypes. To perform 2-stage least squares MR on this we can use the `systemfit` package. 80 | 81 | ```{r} 82 | summary(systemfit::systemfit(y ~ x, method="2SLS", inst = ~ g)) 83 | ``` 84 | 85 | Compare against confounded observational estimate 86 | 87 | ```{r} 88 | summary(lm(y ~ x)) 89 | ``` 90 | 91 | -------------------------------------------------------------------------------- /vignettes/susie_check.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Comparing SuSIE results with summary level vs individual level simulations" 3 | output: rmarkdown::html_vignette 4 | vignette: > 5 | %\VignetteIndexEntry{Comparing SuSIE results with summary level vs individual level simulations} 6 | %\VignetteEngine{knitr::rmarkdown} 7 | %\VignetteEncoding{UTF-8} 8 | --- 9 | 10 | ```{r, include = FALSE} 11 | knitr::opts_chunk$set( 12 | collapse = TRUE, 13 | eval=FALSE, 14 | comment = "#>" 15 | ) 16 | ``` 17 | 18 | ```{r setup} 19 | library(simulateGP) 20 | library(tidyverse) 21 | library(susieR) 22 | ``` 23 | 24 | ## Compare summary level simulations against individual level simulations 25 | 26 | ```{r} 27 | ldobj <- readRDS("~/data/ld_files/ldmat/EUR_1kg_hm3/ldobj_chr9_30387392_31310382.rds") 28 | set.seed(1234) 29 | nid <- 100000 30 | params <- ldobj$map %>% 31 | generate_gwas_params(h2=0.02, Pi=3/nrow(ldobj$map)) %>% 32 | generate_gwas_ss(nid, ldobj=ldobj) 33 | 34 | X <- MASS::mvrnorm(nid, rep(0, nrow(ldobj$ld)), ldobj$ld) 35 | for(i in 1:ncol(X)) 36 | { 37 | X[,i] <- X[,i] * sqrt(2 * ldobj$map$af[i] * (1-ldobj$map$af[i])) 38 | } 39 | 40 | Xb <- X %*% params$beta 41 | y <- Xb + rnorm(nid, sd=sqrt(1 - var(Xb))) 42 | out <- gwas(y, X) 43 | ``` 44 | 45 | ```{r} 46 | plot(cor(X), ldobj$ld) 47 | ``` 48 | 49 | ```{r} 50 | plot(out$bhat ~ params$bhat) 51 | ``` 52 | 53 | Run SuSIE 54 | 55 | ```{r} 56 | sus <- susieR::susie_rss(params$bhat/params$se, R = ldobj$ld, check_R=FALSE) 57 | susieR::susie_plot(sus, y="PIP", b=params$beta) 58 | sus$sets 59 | 60 | sui <- susieR::susie_rss(out$bhat / out$se, R = ldobj$ld, check_R=FALSE) 61 | susieR::susie_plot(sui, y="PIP", b=params$beta) 62 | sui$sets 63 | ``` 64 | 65 | ## Compare two different populations 66 | 67 | 68 | ```{r} 69 | ldobj1 <- readRDS("~/data/ld_files/ldmat/EUR_1kg_hm3/ldobj_chr22_26791628_27834751.rds") 70 | ldobj2 <- readRDS("~/data/ld_files/ldmat/EAS_1kg_hm3/ldobj_chr22_26524344_28233389.rds") 71 | 72 | snps <- ldobj1$map$snp[ldobj1$map$snp %in% ldobj2$map$snp] 73 | index1 <- which(ldobj1$map$snp %in% snps) 74 | index2 <- which(ldobj2$map$snp %in% snps) 75 | ldobj1$map <- ldobj1$map[index1,] 76 | ldobj1$ld <- ldobj1$ld[index1, index1] 77 | ldobj2$map <- ldobj2$map[index2,] 78 | ldobj2$ld <- ldobj2$ld[index2, index2] 79 | length(snps) 80 | 81 | set.seed(1111) 82 | nid <- 100000 83 | params1 <- ldobj1$map %>% 84 | generate_gwas_params(h2=0.02, Pi=3/nrow(ldobj1$map)) %>% 85 | generate_gwas_ss(nid, ldobj=ldobj1) 86 | 87 | params2 <- ldobj2$map %>% 88 | mutate(beta = params1$beta) %>% 89 | generate_gwas_ss(nid, ldobj=ldobj2) 90 | 91 | bind_rows(params1 %>% mutate(pop="EUR"), params2 %>% mutate(pop="EAS")) %>% 92 | ggplot(., aes(x=pos, y=-log10(pval))) + 93 | geom_point(aes(colour=beta == 0)) + 94 | facet_grid(pop ~ .) 95 | ``` 96 | 97 | Run SuSIE 98 | 99 | ```{r} 100 | su1 <- susieR::susie_rss(params1$bhat/params1$se, R = ldobj1$ld, check_R=FALSE) 101 | susieR::susie_plot(su1, y="PIP", b=params1$beta) 102 | su1$sets 103 | 104 | su2 <- susieR::susie_rss(params2$bhat/params2$se, R = ldobj2$ld, check_R=FALSE) 105 | susieR::susie_plot(su2, y="PIP", b=params2$beta) 106 | su2$sets 107 | ``` 108 | 109 | --------------------------------------------------------------------------------