diff --git a/.Rbuildignore b/.Rbuildignore new file mode 100644 index 0000000..39e4ed9 --- /dev/null +++ b/.Rbuildignore @@ -0,0 +1,7 @@ +^renv$ +^renv\.lock$ +^_pkgdown\.yml$ +^docs$ +^pkgdown$ +^LICENSE\.md$ +^.Rprofile$ \ No newline at end of file diff --git a/.Rprofile b/.Rprofile new file mode 100644 index 0000000..81b960f --- /dev/null +++ b/.Rprofile @@ -0,0 +1 @@ +source("renv/activate.R") diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..e69de29 diff --git a/DESCRIPTION b/DESCRIPTION index 5ad09a8..fe0b753 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -10,18 +10,27 @@ URL: https://github.com/jean997/simGWAS BugReports: https://github.com/jean997/simGWAS/issues Encoding: UTF-8 LazyData: true +LazyDataCompression: gzip RoxygenNote: 7.2.3 Depends: R (>= 2.10) -IMPORTS: - dplyr - purrr - tidyr +Imports: + dplyr, + purrr, + tidyr, + MASS, + Matrix, + reshape2, + utils, + stats, + magrittr VignetteBuilder: knitr Suggests: - knitr, - rmarkdown, - hapsim, - testthat (>= 3.0.0) + knitr, + rmarkdown, + testthat (>= 3.0.0), + DiagrammeR, + ggplot2, + hapsim Config/testthat/edition: 3 diff --git a/NAMESPACE b/NAMESPACE index 603d060..f30e985 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,7 @@ # Generated by roxygen2: do not edit by hand +S3method(print,sim_mv) +export("%>%") export(compute_h2) export(fast_lm) export(fixed_to_scale_fam) @@ -22,3 +24,11 @@ export(xyz_to_G) import(dplyr) import(purrr) import(tidyr) +importFrom(magrittr,"%>%") +importFrom(stats,cov2cor) +importFrom(stats,pnorm) +importFrom(stats,qnorm) +importFrom(stats,rbinom) +importFrom(stats,rnorm) +importFrom(stats,runif) +importFrom(utils,str) diff --git a/R/checks.R b/R/checks.R index 3e0466b..cb94d9b 100644 --- a/R/checks.R +++ b/R/checks.R @@ -1,11 +1,11 @@ check_scalar_or_numeric <- function(x, string, n){ if(is.null(x)) return(x) - if("matrix" %in% class(x) | "data.frame" %in% class(x)){ + if(inherits(x, "matrix") | inherits(x, "data.frame")){ if(ncol(x) > 1) stop(paste0(string, " must be a numeric vector or one column array.")) x <- as.numeric(x[,1]) - }else if(length(x) == 1 & ("numeric" %in% class(x) | all(is.na(x)))){ + }else if(length(x) == 1 & (inherits(x, "numeric") | all(is.na(x)))){ x <- rep(x, n) - }else if(! "numeric" %in% class(x)){ + }else if(! inherits(x, "numeric")){ stop(paste0(string, " must be a numeric vector or one column array.")) } if(length(x) != n) stop(paste0("Expected ", string, " to have length ", n, ", found ", length(x), "\n")) @@ -15,13 +15,13 @@ check_scalar_or_numeric <- function(x, string, n){ check_matrix <- function(x, string, n, p){ if(is.null(x)) return(x) - if("data.frame" %in% class(x)){ + if(inherits(x, "data.frame")){ cat("Coercing ", string, " to matrix.\n") x <- as.matrix(x) colnames(x) <- NULL - }else if("numeric" %in% class(x)){ + }else if(inherits(x, "numeric")){ x <- as.matrix(x, ncol = 1) - }else if(!"matrix" %in% class(x)){ + }else if(!inherits(x, "matrix")){ stop(paste0(string, " must be a numeric vector, matrix, or data.frame.")) } if(!missing(n)){ @@ -35,7 +35,7 @@ check_matrix <- function(x, string, n, p){ check_pi <- function(pi, n, p){ - if("matrix" %in% class(pi)){ + if(inherits(pi, "matrix")){ pi <- check_matrix(pi, "pi", n, p) }else{ pi <- check_scalar_or_numeric(pi, "pi", p) @@ -45,17 +45,17 @@ check_pi <- function(pi, n, p){ } check_N <- function(N, n, allow_mat = TRUE){ - if("sample_size" %in% class(N)){ + if(inherits(N, "sample_size")){ if(length(N$N) == n) return(N) stop(paste0("Expected information for ", n, " traits but found ", length(N$N), "\n")) } if(any(is.na(N))){ stop("N cannot contain missing (NA) values. Use sample size 0 instead.\n") } - if("matrix" %in% class(N) | "data.frame" %in% class(N)){ + if(inherits(N, "matrix") | inherits(N, "data.frame")){ if(ncol(N) == 1){ type <- "vector" - }else if("data.frame" %in% class(N) & "trait_1" %in% names(N)){ + }else if(inherits(N, "data.frame") & "trait_1" %in% names(N)){ type <- "df" }else{ if(!allow_mat){ @@ -108,7 +108,7 @@ make_Ndf_indep <- function(N){ } check_Ndf <- function(N, M){ - if(!"data.frame" %in% class(N)){ + if(!inherits(N, "data.frame")){ stop("class(N) does not include data.frame\n") } if(missing(M)){ @@ -163,7 +163,7 @@ check_Ndf <- function(N, M){ } subset_N_nonzero <- function(N){ - stopifnot("sample_size" %in% class(N)) + stopifnot(inherits(N, "sample_size")) i <- which(N$N > 0) newN <- N newN$N <- N$N[i] @@ -188,8 +188,8 @@ check_psd <- function(M, string){ check_G <- function(G, h2){ - if(! "matrix" %in% class(G)){ - if(!(class(G) == "numeric" | class(G) == "integer" )){ + if(! inherits(G, "matrix")){ + if(!(inherits(G, "numeric") | inherits(G, "integer") )){ stop(paste0("G should have class matrix, numeric, or integer, found ", class(G), "\n")) } if(!(G >= 0 & G == round(G))){ @@ -248,13 +248,13 @@ direct_to_total <- function(G_dir){ check_R_LD <- function(R_LD, return = c("eigen", "matrix", "sqrt", "l")){ return <- match.arg(return, return) - if(class(R_LD) != "list"){ + if(!inherits(R_LD, "list")){ stop(paste0("R_LD should be of class list, found ", class(R_LD), "\n")) } cl <- sapply(R_LD, function(x){ - case_when("matrix" %in% class(x) ~ "matrix", - class(x) == "dsCMatrix" ~ "matrix", - class(x) == "eigen" ~ "eigen", + dplyr::case_when(inherits(x, "matrix") ~ "matrix", + inherits(x, "dsCMatrix") ~ "matrix", + inherits(x, "eigen") ~ "eigen", TRUE ~ "not_allowed") }) if(any(cl == "not_allowed")){ @@ -321,7 +321,7 @@ check_R_LD <- function(R_LD, return = c("eigen", "matrix", "sqrt", "l")){ check_snpinfo <- function(snp_info, J){ - if(!"data.frame" %in% class(snp_info)){ + if(!inherits(snp_info, "data.frame")){ stop("snp_info should have class containing data.frame.\n") } if(nrow(snp_info) != J){ @@ -336,7 +336,7 @@ check_snpinfo <- function(snp_info, J){ check_af <- function(af, n, function_ok = TRUE){ if(is.null(af)){ return(NULL) - }else if(class(af) == "function"){ + }else if(inherits(af, "function")){ if(!function_ok) stop("af cannot be a function.\n") myaf <- af(n) af <- myaf @@ -347,7 +347,7 @@ check_af <- function(af, n, function_ok = TRUE){ } check_effect_function_list <- function(snp_effect_function, M, snp_info = NULL){ - if(!class(snp_effect_function) == "list"){ + if(!inherits(snp_effect_function, "list")){ f <- check_snp_effect_function(snp_effect_function, snp_info) fl <- list() for(i in 1:M) fl[[i]] <- f @@ -364,10 +364,10 @@ check_effect_function_list <- function(snp_effect_function, M, snp_info = NULL){ check_snp_effect_function <- function(snp_effect_function, snp_info = NULL){ - if(!(class(snp_effect_function) == "character" | class(snp_effect_function) == "function") ){ + if(!(inherits(snp_effect_function, "character") | inherits(snp_effect_function, "function")) ){ stop("snp_effect_function should either be 'normal', a function, or a vector.") } - if(class(snp_effect_function) == "function"){ + if(inherits(snp_effect_function, "function")){ if(!is.null(snp_info)){ test_snp_info <- snp_info[1:3,] }else{ diff --git a/R/compute_h2.R b/R/compute_h2.R index c3c3927..95cd6a3 100644 --- a/R/compute_h2.R +++ b/R/compute_h2.R @@ -1,5 +1,7 @@ #'@title Compute hertiability from standardized or non-standardized effects -#'@param b_joint_std,b_joint matrix of standardized or non-standardized effects. Provide only one of these options. +#'@param b_joint matrix of standardized or non-standardized effects. Provide only one of these options. +#'@param geno_scale effects should be per allele or sd +#'@param pheno_sd phenotype standard deviation #'@param R_LD LD pattern (optional). See \code{?sim_mv} for more details. #'@param af Allele frequencies (optional, allowed only if \code{R_LD} is missing). See \code{?sim_mv} for more details. #'@param full_mat If TRUE, return the full genetic variance-covariance matrix diff --git a/R/gen_bhat_from_b.R b/R/gen_bhat_from_b.R index c94c650..ccb8cd0 100644 --- a/R/gen_bhat_from_b.R +++ b/R/gen_bhat_from_b.R @@ -198,7 +198,7 @@ gen_bhat_from_b <- function(b_joint, } } } - ret <- list(beta_hat =beta_hat, + ret <- list(beta_hat = beta_hat, se_beta_hat = se_beta_hat, sx = sx, R=R, diff --git a/R/generate_F.R b/R/generate_F.R index 755c670..a30fecf 100644 --- a/R/generate_F.R +++ b/R/generate_F.R @@ -1,3 +1,7 @@ +#' Generate F (simple) +#' +#' @param nblocks nblocks +#' @param type type #'@export generate_F_simple <- function(nblocks, type=c("nested", "difference", "checkers1", "checkers2")){ @@ -21,6 +25,8 @@ generate_F_simple <- function(nblocks, type=c("nested", "difference", } #'@title Generate random F +#'@param K K +#'@param M M #'@param g_F Function from which non-zero elements of F are generated #'@param nz_factor Number of non-zero elements of each factor if F is to be generated. #'@param omega Proportion of trait heritability explained by factors @@ -45,7 +51,7 @@ generate_random_F <- function(K, M, g_F= function(n){runif(n, -1, 1)}, omega <- check_01(omega, "omega") h2_trait <- check_01(h2_trait, "h2_trait") srs <- omega*h2_trait - F_mat <- sumstatFactors:::generate_F2(non_zero_by_factor = nz_factor, + F_mat <- generate_F2(non_zero_by_factor = nz_factor, square_row_sums = srs, rfunc = g_F) if(any(rowSums(F_mat^2) == 0 & srs != 0) & pad){ @@ -57,6 +63,11 @@ generate_random_F <- function(K, M, g_F= function(n){runif(n, -1, 1)}, return(F_mat) } +#' Generate F (2) +#' +#' @param non_zero_by_factor non_zero_by_factor +#' @param square_row_sums square_row_sums +#' @param rfunc rfunc #'@export generate_F2 <- function(non_zero_by_factor, square_row_sums, diff --git a/R/hapsim_simple.R b/R/hapsim_simple.R index c39cf61..9b560c1 100644 --- a/R/hapsim_simple.R +++ b/R/hapsim_simple.R @@ -31,9 +31,9 @@ R_LD_to_haplodat <- function(R_LD, af){ as.double(P), as.double(Q), rlt = as.double(null.mat), PACKAGE = "hapsim")$rlt V <- matrix(vmat, nrow = nloci, ncol = nloci) - if (!hapsim:::checkpd(V)){ + if (!hapsim::checkpd(V)){ warning("Coercing LD matrix to feasible values.\n") - V <- hapsim:::makepd(V) + V <- hapsim::makepd(V) } eV <- eigen(V) return(list(freqs = P, cor = C, cov = V, eCov = eV)) diff --git a/R/mixnorm_to_scalefam.R b/R/mixnorm_to_scalefam.R index 79cbca0..a91a9ba 100644 --- a/R/mixnorm_to_scalefam.R +++ b/R/mixnorm_to_scalefam.R @@ -1,3 +1,7 @@ +#' mixnorm_to_scale_fam +#' +#' @param sigma sigma +#' @param pi pi #'@export mixnorm_to_scale_fam <- function(sigma, pi){ K <- length(sigma) @@ -27,9 +31,9 @@ mixnorm_to_scale_fam <- function(sigma, pi){ #'@title Simulate from a normal mixture distribution #'@param n Number of points to simulate -#'@param sigma Standard deviations -#'@param mu Means +#'@param sd Standard deviations #'@param pi Mixture proportions +#'@param mu Means #'@param return.Z if TRUE, also return a vector of indicators indicating which of the K classes each sample belongs to #'@return If return.Z=TRUE, returns a list with elements beta (samples) and Z (indicators). Otherwise returns a length n vector of samples. #'@export @@ -55,8 +59,10 @@ rnormalmix <- function(n, sd, pi, mu =0, return.Z=FALSE){ return(beta) } - -#'@export +#' fixed_to_scale_fam +#' +#' @param b vector +#' @export fixed_to_scale_fam <- function(b){ f <- function(n, sd, ...){ newb <- b[ ((0:(n-1)) %% length(b)) + 1] diff --git a/R/parse_g.R b/R/parse_g.R new file mode 100644 index 0000000..6443f2b --- /dev/null +++ b/R/parse_g.R @@ -0,0 +1,85 @@ +#' Generate G matrix from text input +#' +#' Convenience function for parsing a multi-line text string into the G matrix, where each line +#' specifies one causal relationship between traits. Each line must be formatted with four +#' space-separated tokens as: +#' +#' +#' +#' The function tries to parse the effect from numeric expressions or global variables. +#' +#' @param text A multi line text string that specifies the causal relationships between traits +#' +#' @export +#' @return A square matrix with dimension number of traits +#' +#' @examples +#' +#' # Simple specification +#' text <- "X <- Y 0.25 +#' A <- X 0.1 +#' A <- Y sqrt(0.34)" +#' G_from_text(text) +#' +#' # Another example +#' a <- 0.25 +#' b <- -0.34 +#' text <- "X -> Y a +#' A -> X b +#' Y <- A sqrt(0.34)" +#' G_from_text(text) +G_from_text <- function(text) { + f5f731c87529 <- strsplit(text, "\n")[[1]] + f5f75f83f047 <- lapply(f5f731c87529, \(x) strsplit(trimws(x), " +")[[1]]) + if(!all(sapply(f5f75f83f047, length) == 4)) { + stop("Expect there to be four tokens, space separated, for each line e.g. 'A <- B 0.25") + } + lapply(f5f75f83f047, \(x) { + if(x[2] == "<-") { + dplyr::tibble(eff = eval(parse(text=x[4])), i = x[3], j = x[1]) + } else if(x[2] == "->") { + dplyr::tibble(eff = eval(parse(text=x[4])), i = x[1], j = x[3]) + } else { + stop("Nodes must be linked by either '<-' or '->'. See Vignette for examples.") + } + }) %>% + dplyr::bind_rows() %>% + G_from_df() %>% + return() +} + +#' Generate G matrix from data frame +#' +#' Specify G matrix as a data frame in long format, one row represents one causal +#' relationship of trait `i` on trait `j` with effect `eff`. +#' +#' @param df A data frame with required columns i (the causal trait name), j (the +#' response trait name) and eff (the effect of i on j) +#' +#' @export +#' @return A square matrix with dimension number of traits +#' +#' @examples +#' +#' # Simple example +#' df <- dplyr::tribble(~i, ~j, ~eff, +#' "Y", "X", 0.25, +#' "X", "A", 0.24, +#' "Y", "A", 0.34) +#' +#' G_from_df(df) +#' +G_from_df <- function(df) { + stopifnot(inherits(df, "data.frame")) + stopifnot(nrow(df) >0) + stopifnot(all(c("i", "j", "eff") %in% names(df))) + nodes <- unique(c(df$i, df$j)) + message(nrow(df), " causal relationships specified amongst ", length(nodes), " traits") + G <- matrix(0, length(nodes), length(nodes)) + rownames(G) <- nodes + colnames(G) <- nodes + for(x in 1:nrow(df)) { + G[df$i[x], df$j[x]] <- df$eff[x] + } + return(G) +} diff --git a/R/resample_inddata.R b/R/resample_inddata.R index 2d627ee..3cbafa1 100644 --- a/R/resample_inddata.R +++ b/R/resample_inddata.R @@ -8,6 +8,7 @@ #'@param J Optional number of variants. \code{J} is only required if \code{dat} is missing. #'@param R_LD LD pattern (optional). See \code{?sim_mv} for more details. #'@param af Allele frequencies. \code{af} is required unless unless \code{genos} is supplied. +#'@param sim_func Function for generating genotype data. Default = gen_genos_mvn #'@param new_env_var Optional. The environmental variance in the new population. #'If missing the function will assume the environmental variance is the same as in the old population. #'@param new_h2 Optional. The heritability in the new population. Provide at most one of \code{new_env_var} and \code{new_h2}. @@ -60,6 +61,7 @@ #' R_LD = list(simple_ld), #' af = rep(0.3, 5)) #'@export +#' @importFrom stats rnorm resample_inddata <- function(N, dat = NULL, genos = NULL, @@ -82,7 +84,7 @@ resample_inddata <- function(N, # Option 3: Generate phenotypes for existing genotypes. Provide genos, and dat. omit J if(is.null(dat)){ - if(!require(hapsim)){ + if(!requireNamespace("hapsim", quietly=TRUE)){ stop("Please install the hapsim library.") } message("Generating genotype matrix only.") @@ -273,7 +275,13 @@ resample_inddata <- function(N, } -#'@export +#' Fast implementation of linear model +#' +#' @param X X vector or matrix +#' @param Y Y vector or matrix +#' @param check X and Y inputs +#' +#' @export fast_lm <- function(X, Y, check = TRUE){ if(check){ X <- check_matrix(X, "X") @@ -304,6 +312,16 @@ fast_lm <- function(X, Y, check = TRUE){ } +#' Generate genotypes from multivariate normal +#' +#' @param n Sample size to generate +#' @param J Number of variants to generate +#' @param R_LD Optional list of LD blocks. R_LD should have class \code{list}. +#'Each element of R_LD can be either a) a matrix, b) a sparse matrix (class \code{dsCMatrix}) or c) an eigen decomposition (class \code{eigen}). +#'All elements should be correlation matrices, meaning that they have 1 on the diagonal and are positive definite. See Details and vignettes. +#' @param af Optional vector of allele frequencies. If R_LD is not supplied, af can be a scalar, vector or function. +#'If af is a function it should take a single argument (n) and return a vector of n allele frequencies (See Examples). +#'If R_LD is supplied, af must be a vector with length equal to the size of the supplied LD pattern (See Examples). #'@export gen_genos_mvn <- function(n, J, R_LD, af){ diff --git a/R/simGWAS-package.R b/R/simGWAS-package.R new file mode 100644 index 0000000..812a491 --- /dev/null +++ b/R/simGWAS-package.R @@ -0,0 +1,47 @@ +#' simGWAS: Simulate GWAS summary statistics from specified DAG or factor structure. +#' +#' @importFrom stats cov2cor pnorm qnorm rbinom rnorm runif cov2cor +#' @importFrom utils str +#' @docType package +#' @name simGWAS +NULL + +#' SNP data for examples +#' +#' The package contains a built-in data set containing the LD pattern from Chromosome 19 +#' in HapMap3 broken into 39 blocks. This LD pattern was estimated from the HapMap3 European +#' subset using LDShrink. This data set can also be downloaded +#' [here](https://zenodo.org/record/6761943#.Yrno2njMIUE). The LD pattern must be accompanied +#' by a vector of allele frequencies with length equal to the total size of the LDpattern +#' (i.e. the sum of the size of each block in the list). +#' +#' @format ## `snpdata` +#' A tibble with 19490 rows and 14 columns: +#' \describe{ +#' \item{AF}{AF} +#' \item{SNP}{SNP} +#' \item{allele}{allele} +#' \item{chr}{chr} +#' \item{ld_snp_id}{ld_snp_id} +#' \item{map}{map} +#' \item{pos}{pos} +#' \item{region_id}{region_id} +#' \item{snp_id}{snp_id} +#' \item{in_hapmap}{in_hapmap} +#' \item{ldscore_1kg}{ldscore_1kg} +#' \item{ldscore_hm3}{ldscore_hm3} +#' \item{keep_ld_prune_0}{keep_ld_prune_0} +#' \item{keep_ld_prune_0}{keep_ld_prune_0} +#' } +#' @source +"snpdata" + +#' Allele frequencies for SNP data +#' +#' Allele frequency column from `snpdata` object +"AF" + +#' Block LD matrices for SNP data +"ld_mat_list" + +utils::globalVariables(c(".", "Ndf", "Var1", "Var2", "block", "ix_in_block", "ix_in_dat", "pval")) \ No newline at end of file diff --git a/R/sim_lf.R b/R/sim_lf.R index 8377ed5..1e9e7b1 100644 --- a/R/sim_lf.R +++ b/R/sim_lf.R @@ -73,8 +73,9 @@ #'myF <- diag(2) #'N <- matrix(c(10000, 8000, 8000, 10000), nrow = 2) #'R_E <- matrix(c(1, 0.6, 0.6, 1), nrow = 2) -#'dat <- sim_lf(F_mat = myF, N = N, J = 20000, h2_trait = rep(0.6, 2), omega = rep(1, 2), h2_factor = rep(1, 2), -#' pi_L = 0.1, pi_theta = 0.1, R_E = R_E) +#'dat <- sim_lf(F_mat = myF, N = N, J = 20000, h2_trait = rep(0.6, 2), +#' omega = rep(1, 2), h2_factor = rep(1, 2), +#' pi_L = 0.1, pi_theta = 0.1, R_E = R_E) #'dat$R #'cor(dat$beta_hat[,1]-dat$beta_joint[,1], dat$beta_hat[,2]-dat$beta_joint[,2]) #'@export diff --git a/R/sim_mv.R b/R/sim_mv.R index a2fb08e..85e6152 100644 --- a/R/sim_mv.R +++ b/R/sim_mv.R @@ -31,7 +31,6 @@ #'@param sporadic_pleiotropy Allow sporadic pleiotropy between traits. Defaults to TRUE. #'@param pi_exact If TRUE, the number of direct effect SNPs for each trait will be exactly equal to `round(pi*J)`. #'@param h2_exact If TRUE, the heritability of each trait will be exactly `h2`. -#'@param return_dat Useful development option, not recommend for general users. #' #'@return A list with the following elements: #' @@ -212,3 +211,11 @@ sim_mv <- function(N, } +#' Print sim_mv +#' +#' @param x A sim_mv object +#' @param ... Arguments to be passed to str +#' @export +print.sim_mv <- function(x, ...) { + str(x, ...) +} diff --git a/R/sim_mv_determined.R b/R/sim_mv_determined.R index 9dadaf7..2217abb 100644 --- a/R/sim_mv_determined.R +++ b/R/sim_mv_determined.R @@ -27,7 +27,7 @@ #'@details A wrapper for \code{sim_mv}. See \code{?sim_mv} and the "Providing an Exact Set of Direct Effects" section of the Effect Size vignette. #' #'@examples -#' G <- matrix(c(0, 0.5, 0, 0), nrow = 2, byrow =T) +#' G <- matrix(c(0, 0.5, 0, 0), nrow = 2, byrow = TRUE) #' my_effects <- matrix(0, nrow = 10, ncol = 2) #' my_effects[c(1, 5),1] <- c(-0.008, 0.01) #' my_effects[c(3, 6, 9), 2] <- c(-0.02, 0.06, 0.009) diff --git a/R/utils-pipe.R b/R/utils-pipe.R new file mode 100644 index 0000000..fd0b1d1 --- /dev/null +++ b/R/utils-pipe.R @@ -0,0 +1,14 @@ +#' Pipe operator +#' +#' See \code{magrittr::\link[magrittr:pipe]{\%>\%}} for details. +#' +#' @name %>% +#' @rdname pipe +#' @keywords internal +#' @export +#' @importFrom magrittr %>% +#' @usage lhs \%>\% rhs +#' @param lhs A value or the magrittr placeholder. +#' @param rhs A function call using the magrittr semantics. +#' @return The result of calling `rhs(lhs)`. +NULL diff --git a/R/xyz_to_G.R b/R/xyz_to_G.R index 784bdfe..3e0308b 100644 --- a/R/xyz_to_G.R +++ b/R/xyz_to_G.R @@ -1,5 +1,5 @@ #'@title Generate G from XYZ Specification -#'@param taux_xz,tau_yz Effect size between Z and X or Y as signed percent variance explained (see details) +#'@param tau_xz,tau_yz Effect size between Z and X or Y as signed percent variance explained (see details) #'@param dir_xz,dir_yz Effect direction between Z and X or Y (see details) #'@param gamma Signed variance of Y explained by X, see details #'@details diff --git a/README.md b/README.md index bbc1061..eb51f49 100644 --- a/README.md +++ b/README.md @@ -4,7 +4,7 @@ The `simGWAS` package simulates GWAS summary statistics. The main function in th Briefly, `simGWAS` can simulate data with the following features. -- Data an be produced for continuous traits with user supplied linear causal relationships. +- Data can be produced for continuous traits with user supplied linear causal relationships. - GWAS for multiple traits may have overlapping samples. - Data can be generated with or without LD. One realistic LD pattern is supplied as built-in data. - GWAS for the same trait can be replicated with different sample sizes, LD patterns, and allele frequencies (see the "Resampling and Re-Scaling.." vignette) diff --git a/data/AF.rda b/data/AF.rda index 022071e..09e859b 100644 Binary files a/data/AF.rda and b/data/AF.rda differ diff --git a/data/ld_mat_list.rda b/data/ld_mat_list.rda index bc23eb9..8bfcf02 100644 Binary files a/data/ld_mat_list.rda and b/data/ld_mat_list.rda differ diff --git a/data/snpdata.rda b/data/snpdata.rda index 7cbc6a9..aa32e2c 100644 Binary files a/data/snpdata.rda and b/data/snpdata.rda differ diff --git a/man/AF.Rd b/man/AF.Rd new file mode 100644 index 0000000..b2b0e32 --- /dev/null +++ b/man/AF.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/simGWAS-package.R +\docType{data} +\name{AF} +\alias{AF} +\title{Allele frequencies for SNP data} +\format{ +An object of class \code{numeric} of length 19490. +} +\usage{ +AF +} +\description{ +Allele frequency column from `snpdata` object +} +\keyword{datasets} diff --git a/man/G_from_df.Rd b/man/G_from_df.Rd new file mode 100644 index 0000000..8214115 --- /dev/null +++ b/man/G_from_df.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/parse_g.R +\name{G_from_df} +\alias{G_from_df} +\title{Generate G matrix from data frame} +\usage{ +G_from_df(df) +} +\arguments{ +\item{df}{A data frame with required columns i (the causal trait name), j (the +response trait name) and eff (the effect of i on j)} +} +\value{ +A square matrix with dimension number of traits +} +\description{ +Specify G matrix as a data frame in long format, one row represents one causal +relationship of trait `i` on trait `j` with effect `eff`. +} +\examples{ + +# Simple example +df <- dplyr::tribble(~i, ~j, ~eff, + "Y", "X", 0.25, + "X", "A", 0.24, + "Y", "A", 0.34) + +G_from_df(df) + +} diff --git a/man/G_from_text.Rd b/man/G_from_text.Rd new file mode 100644 index 0000000..8600b01 --- /dev/null +++ b/man/G_from_text.Rd @@ -0,0 +1,40 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/parse_g.R +\name{G_from_text} +\alias{G_from_text} +\title{Generate G matrix from text input} +\usage{ +G_from_text(text) +} +\arguments{ +\item{text}{A multi line text string that specifies the causal relationships between traits} +} +\value{ +A square matrix with dimension number of traits +} +\description{ +Convenience function for parsing a multi-line text string into the G matrix, where each line +specifies one causal relationship between traits. Each line must be formatted with four +space-separated tokens as: +} +\details{ + + +The function tries to parse the effect from numeric expressions or global variables. +} +\examples{ + +# Simple specification +text <- "X <- Y 0.25 + A <- X 0.1 + A <- Y sqrt(0.34)" +G_from_text(text) + +# Another example +a <- 0.25 +b <- -0.34 +text <- "X -> Y a + A -> X b + Y <- A sqrt(0.34)" +G_from_text(text) +} diff --git a/man/compute_h2.Rd b/man/compute_h2.Rd index 63c4f1d..c517542 100644 --- a/man/compute_h2.Rd +++ b/man/compute_h2.Rd @@ -14,13 +14,17 @@ compute_h2( ) } \arguments{ +\item{b_joint}{matrix of standardized or non-standardized effects. Provide only one of these options.} + +\item{geno_scale}{effects should be per allele or sd} + +\item{pheno_sd}{phenotype standard deviation} + \item{R_LD}{LD pattern (optional). See \code{?sim_mv} for more details.} \item{af}{Allele frequencies (optional, allowed only if \code{R_LD} is missing). See \code{?sim_mv} for more details.} \item{full_mat}{If TRUE, return the full genetic variance-covariance matrix} - -\item{b_joint_std, b_joint}{matrix of standardized or non-standardized effects. Provide only one of these options.} } \description{ Compute hertiability from standardized or non-standardized effects diff --git a/man/fast_lm.Rd b/man/fast_lm.Rd new file mode 100644 index 0000000..574335d --- /dev/null +++ b/man/fast_lm.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/resample_inddata.R +\name{fast_lm} +\alias{fast_lm} +\title{Fast implementation of linear model} +\usage{ +fast_lm(X, Y, check = TRUE) +} +\arguments{ +\item{X}{X vector or matrix} + +\item{Y}{Y vector or matrix} + +\item{check}{X and Y inputs} +} +\description{ +Fast implementation of linear model +} diff --git a/man/fixed_to_scale_fam.Rd b/man/fixed_to_scale_fam.Rd new file mode 100644 index 0000000..850744d --- /dev/null +++ b/man/fixed_to_scale_fam.Rd @@ -0,0 +1,14 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mixnorm_to_scalefam.R +\name{fixed_to_scale_fam} +\alias{fixed_to_scale_fam} +\title{fixed_to_scale_fam} +\usage{ +fixed_to_scale_fam(b) +} +\arguments{ +\item{b}{vector} +} +\description{ +fixed_to_scale_fam +} diff --git a/man/gen_genos_mvn.Rd b/man/gen_genos_mvn.Rd new file mode 100644 index 0000000..1065428 --- /dev/null +++ b/man/gen_genos_mvn.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/resample_inddata.R +\name{gen_genos_mvn} +\alias{gen_genos_mvn} +\title{Generate genotypes from multivariate normal} +\usage{ +gen_genos_mvn(n, J, R_LD, af) +} +\arguments{ +\item{n}{Sample size to generate} + +\item{J}{Number of variants to generate} + +\item{R_LD}{Optional list of LD blocks. R_LD should have class \code{list}. +Each element of R_LD can be either a) a matrix, b) a sparse matrix (class \code{dsCMatrix}) or c) an eigen decomposition (class \code{eigen}). +All elements should be correlation matrices, meaning that they have 1 on the diagonal and are positive definite. See Details and vignettes.} + +\item{af}{Optional vector of allele frequencies. If R_LD is not supplied, af can be a scalar, vector or function. +If af is a function it should take a single argument (n) and return a vector of n allele frequencies (See Examples). +If R_LD is supplied, af must be a vector with length equal to the size of the supplied LD pattern (See Examples).} +} +\description{ +Generate genotypes from multivariate normal +} diff --git a/man/generate_F2.Rd b/man/generate_F2.Rd new file mode 100644 index 0000000..ebc73c5 --- /dev/null +++ b/man/generate_F2.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/generate_F.R +\name{generate_F2} +\alias{generate_F2} +\title{Generate F (2)} +\usage{ +generate_F2( + non_zero_by_factor, + square_row_sums, + rfunc = function(n) { + runif(n, -1, 1) + } +) +} +\arguments{ +\item{non_zero_by_factor}{non_zero_by_factor} + +\item{square_row_sums}{square_row_sums} + +\item{rfunc}{rfunc} +} +\description{ +Generate F (2) +} diff --git a/man/generate_F_simple.Rd b/man/generate_F_simple.Rd new file mode 100644 index 0000000..b7c0e86 --- /dev/null +++ b/man/generate_F_simple.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/generate_F.R +\name{generate_F_simple} +\alias{generate_F_simple} +\title{Generate F (simple)} +\usage{ +generate_F_simple( + nblocks, + type = c("nested", "difference", "checkers1", "checkers2") +) +} +\arguments{ +\item{nblocks}{nblocks} + +\item{type}{type} +} +\description{ +Generate F (simple) +} diff --git a/man/generate_random_F.Rd b/man/generate_random_F.Rd index c38fbb4..6c2da50 100644 --- a/man/generate_random_F.Rd +++ b/man/generate_random_F.Rd @@ -17,6 +17,10 @@ generate_random_F( ) } \arguments{ +\item{K}{K} + +\item{M}{M} + \item{g_F}{Function from which non-zero elements of F are generated} \item{nz_factor}{Number of non-zero elements of each factor if F is to be generated.} diff --git a/man/ld_mat_list.Rd b/man/ld_mat_list.Rd new file mode 100644 index 0000000..584edcd --- /dev/null +++ b/man/ld_mat_list.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/simGWAS-package.R +\docType{data} +\name{ld_mat_list} +\alias{ld_mat_list} +\title{Block LD matrices for SNP data} +\format{ +An object of class \code{list} of length 39. +} +\usage{ +ld_mat_list +} +\description{ +Block LD matrices for SNP data +} +\keyword{datasets} diff --git a/man/mixnorm_to_scale_fam.Rd b/man/mixnorm_to_scale_fam.Rd new file mode 100644 index 0000000..18478b2 --- /dev/null +++ b/man/mixnorm_to_scale_fam.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mixnorm_to_scalefam.R +\name{mixnorm_to_scale_fam} +\alias{mixnorm_to_scale_fam} +\title{mixnorm_to_scale_fam} +\usage{ +mixnorm_to_scale_fam(sigma, pi) +} +\arguments{ +\item{sigma}{sigma} + +\item{pi}{pi} +} +\description{ +mixnorm_to_scale_fam +} diff --git a/man/pipe.Rd b/man/pipe.Rd new file mode 100644 index 0000000..1f8f237 --- /dev/null +++ b/man/pipe.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils-pipe.R +\name{\%>\%} +\alias{\%>\%} +\title{Pipe operator} +\usage{ +lhs \%>\% rhs +} +\arguments{ +\item{lhs}{A value or the magrittr placeholder.} + +\item{rhs}{A function call using the magrittr semantics.} +} +\value{ +The result of calling `rhs(lhs)`. +} +\description{ +See \code{magrittr::\link[magrittr:pipe]{\%>\%}} for details. +} +\keyword{internal} diff --git a/man/print.sim_mv.Rd b/man/print.sim_mv.Rd new file mode 100644 index 0000000..86fd843 --- /dev/null +++ b/man/print.sim_mv.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/sim_mv.R +\name{print.sim_mv} +\alias{print.sim_mv} +\title{Print sim_mv} +\usage{ +\method{print}{sim_mv}(x, ...) +} +\arguments{ +\item{x}{A sim_mv object} + +\item{...}{Arguments to be passed to str} +} +\description{ +Print sim_mv +} diff --git a/man/resample_inddata.Rd b/man/resample_inddata.Rd index b8784a4..f0d4f4b 100644 --- a/man/resample_inddata.Rd +++ b/man/resample_inddata.Rd @@ -34,6 +34,8 @@ in `dat` will also be included.} \item{af}{Allele frequencies. \code{af} is required unless unless \code{genos} is supplied.} +\item{sim_func}{Function for generating genotype data. Default = gen_genos_mvn} + \item{new_env_var}{Optional. The environmental variance in the new population. If missing the function will assume the environmental variance is the same as in the old population.} diff --git a/man/rnormalmix.Rd b/man/rnormalmix.Rd index 1c534a9..1a92477 100644 --- a/man/rnormalmix.Rd +++ b/man/rnormalmix.Rd @@ -9,13 +9,13 @@ rnormalmix(n, sd, pi, mu = 0, return.Z = FALSE) \arguments{ \item{n}{Number of points to simulate} +\item{sd}{Standard deviations} + \item{pi}{Mixture proportions} \item{mu}{Means} \item{return.Z}{if TRUE, also return a vector of indicators indicating which of the K classes each sample belongs to} - -\item{sigma}{Standard deviations} } \value{ If return.Z=TRUE, returns a list with elements beta (samples) and Z (indicators). Otherwise returns a length n vector of samples. diff --git a/man/simGWAS.Rd b/man/simGWAS.Rd index bb9c7f3..537b5a5 100644 --- a/man/simGWAS.Rd +++ b/man/simGWAS.Rd @@ -1,9 +1,14 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/package.R +% Please edit documentation in R/package.R, R/simGWAS-package.R \docType{package} \name{simGWAS} \alias{simGWAS} \title{simGWAS} +\description{ +simGWAS + +simGWAS: Simulate GWAS summary statistics from specified DAG or factor structure. +} \author{ Jean Morrison } diff --git a/man/sim_lf.Rd b/man/sim_lf.Rd index 154ffe9..893aeb2 100644 --- a/man/sim_lf.Rd +++ b/man/sim_lf.Rd @@ -118,8 +118,9 @@ dat <- sim_lf(myF, N = 10000, J = 20000, h2_trait = rep(0.6, 10), myF <- diag(2) N <- matrix(c(10000, 8000, 8000, 10000), nrow = 2) R_E <- matrix(c(1, 0.6, 0.6, 1), nrow = 2) -dat <- sim_lf(F_mat = myF, N = N, J = 20000, h2_trait = rep(0.6, 2), omega = rep(1, 2), h2_factor = rep(1, 2), - pi_L = 0.1, pi_theta = 0.1, R_E = R_E) +dat <- sim_lf(F_mat = myF, N = N, J = 20000, h2_trait = rep(0.6, 2), + omega = rep(1, 2), h2_factor = rep(1, 2), + pi_L = 0.1, pi_theta = 0.1, R_E = R_E) dat$R cor(dat$beta_hat[,1]-dat$beta_joint[,1], dat$beta_hat[,2]-dat$beta_joint[,2]) } diff --git a/man/sim_mv.Rd b/man/sim_mv.Rd index b663218..66b3282 100644 --- a/man/sim_mv.Rd +++ b/man/sim_mv.Rd @@ -69,8 +69,6 @@ should have \code{J} rows.} \item{pi_exact}{If TRUE, the number of direct effect SNPs for each trait will be exactly equal to `round(pi*J)`.} \item{h2_exact}{If TRUE, the heritability of each trait will be exactly `h2`.} - -\item{return_dat}{Useful development option, not recommend for general users.} } \value{ A list with the following elements: diff --git a/man/sim_mv_determined.Rd b/man/sim_mv_determined.Rd index 48504b0..6448522 100644 --- a/man/sim_mv_determined.Rd +++ b/man/sim_mv_determined.Rd @@ -61,7 +61,7 @@ Simulate multivariate GWAS Data with Specified Direct Effects A wrapper for \code{sim_mv}. See \code{?sim_mv} and the "Providing an Exact Set of Direct Effects" section of the Effect Size vignette. } \examples{ -G <- matrix(c(0, 0.5, 0, 0), nrow = 2, byrow =T) +G <- matrix(c(0, 0.5, 0, 0), nrow = 2, byrow = TRUE) my_effects <- matrix(0, nrow = 10, ncol = 2) my_effects[c(1, 5),1] <- c(-0.008, 0.01) my_effects[c(3, 6, 9), 2] <- c(-0.02, 0.06, 0.009) diff --git a/man/snpdata.Rd b/man/snpdata.Rd new file mode 100644 index 0000000..a6df608 --- /dev/null +++ b/man/snpdata.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/simGWAS-package.R +\docType{data} +\name{snpdata} +\alias{snpdata} +\title{SNP data for examples} +\format{ +## `snpdata` +A tibble with 19490 rows and 14 columns: +\describe{ + \item{AF}{AF} + \item{SNP}{SNP} + \item{allele}{allele} + \item{chr}{chr} + \item{ld_snp_id}{ld_snp_id} + \item{map}{map} + \item{pos}{pos} + \item{region_id}{region_id} + \item{snp_id}{snp_id} + \item{in_hapmap}{in_hapmap} + \item{ldscore_1kg}{ldscore_1kg} + \item{ldscore_hm3}{ldscore_hm3} + \item{keep_ld_prune_0}{keep_ld_prune_0} + \item{keep_ld_prune_0}{keep_ld_prune_0} +} +} +\source{ + +} +\usage{ +snpdata +} +\description{ +The package contains a built-in data set containing the LD pattern from Chromosome 19 +in HapMap3 broken into 39 blocks. This LD pattern was estimated from the HapMap3 European +subset using LDShrink. This data set can also be downloaded +[here](https://zenodo.org/record/6761943#.Yrno2njMIUE). The LD pattern must be accompanied +by a vector of allele frequencies with length equal to the total size of the LDpattern +(i.e. the sum of the size of each block in the list). +} +\keyword{datasets} diff --git a/man/xyz_to_G.Rd b/man/xyz_to_G.Rd index a17376b..efc54e8 100644 --- a/man/xyz_to_G.Rd +++ b/man/xyz_to_G.Rd @@ -7,11 +7,11 @@ xyz_to_G(tau_xz, tau_yz, dir_xz, dir_yz, gamma) } \arguments{ +\item{tau_xz, tau_yz}{Effect size between Z and X or Y as signed percent variance explained (see details)} + \item{dir_xz, dir_yz}{Effect direction between Z and X or Y (see details)} \item{gamma}{Signed variance of Y explained by X, see details} - -\item{taux_xz, tau_yz}{Effect size between Z and X or Y as signed percent variance explained (see details)} } \value{ A matrix of direct effects corresponding to variables in the order (Y, X, Z_1, ..., Z_K) diff --git a/renv.lock b/renv.lock new file mode 100644 index 0000000..60c185b --- /dev/null +++ b/renv.lock @@ -0,0 +1,1297 @@ +{ + "R": { + "Version": "4.3.0", + "Repositories": [ + { + "Name": "CRAN", + "URL": "https://www.stats.bris.ac.uk/R" + } + ] + }, + "Packages": { + "DiagrammeR": { + "Package": "DiagrammeR", + "Version": "1.0.10", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "RColorBrewer", + "downloader", + "dplyr", + "glue", + "htmltools", + "htmlwidgets", + "igraph", + "magrittr", + "purrr", + "readr", + "rlang", + "rstudioapi", + "scales", + "stringr", + "tibble", + "tidyr", + "viridis", + "visNetwork" + ], + "Hash": "f3de4a4878163a4629a528bbcc6e655d" + }, + "MASS": { + "Package": "MASS", + "Version": "7.3-60", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "grDevices", + "graphics", + "methods", + "stats", + "utils" + ], + "Hash": "a56a6365b3fa73293ea8d084be0d9bb0" + }, + "Matrix": { + "Package": "Matrix", + "Version": "1.6-0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "grDevices", + "graphics", + "grid", + "lattice", + "methods", + "stats", + "utils" + ], + "Hash": "31262fd18481fab05c5e7258dac163ca" + }, + "R6": { + "Package": "R6", + "Version": "2.5.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "470851b6d5d0ac559e9d01bb352b4021" + }, + "RColorBrewer": { + "Package": "RColorBrewer", + "Version": "1.1-3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "45f0398006e83a5b10b72a90663d8d8c" + }, + "Rcpp": { + "Package": "Rcpp", + "Version": "1.0.10", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "methods", + "utils" + ], + "Hash": "e749cae40fa9ef469b6050959517453c" + }, + "askpass": { + "Package": "askpass", + "Version": "1.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "sys" + ], + "Hash": "e8a22846fff485f0be3770c2da758713" + }, + "base64enc": { + "Package": "base64enc", + "Version": "0.1-3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "543776ae6848fde2f48ff3816d0628bc" + }, + "brio": { + "Package": "brio", + "Version": "1.1.3", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "976cf154dfb043c012d87cddd8bca363" + }, + "bslib": { + "Package": "bslib", + "Version": "0.5.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "base64enc", + "cachem", + "grDevices", + "htmltools", + "jquerylib", + "jsonlite", + "memoise", + "mime", + "rlang", + "sass" + ], + "Hash": "1b117970533deb6d4e992c1b34e9d905" + }, + "cachem": { + "Package": "cachem", + "Version": "1.0.8", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "fastmap", + "rlang" + ], + "Hash": "c35768291560ce302c0a6589f92e837d" + }, + "callr": { + "Package": "callr", + "Version": "3.7.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R6", + "processx", + "utils" + ], + "Hash": "9b2191ede20fa29828139b9900922e51" + }, + "cli": { + "Package": "cli", + "Version": "3.6.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "utils" + ], + "Hash": "89e6d8219950eac806ae0c489052048a" + }, + "colorspace": { + "Package": "colorspace", + "Version": "2.1-0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "grDevices", + "graphics", + "methods", + "stats" + ], + "Hash": "f20c47fd52fae58b4e377c37bb8c335b" + }, + "cpp11": { + "Package": "cpp11", + "Version": "0.4.5", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "f07821e9b0aada6c999d4692e22a2ea7" + }, + "crayon": { + "Package": "crayon", + "Version": "1.5.2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "grDevices", + "methods", + "utils" + ], + "Hash": "e8a1e41acf02548751f45c718d55aa6a" + }, + "curl": { + "Package": "curl", + "Version": "5.0.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "e4f97056611e8e6b8b852d13b7400cf1" + }, + "desc": { + "Package": "desc", + "Version": "1.4.2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R6", + "cli", + "rprojroot", + "utils" + ], + "Hash": "6b9602c7ebbe87101a9c8edb6e8b6d21" + }, + "diffobj": { + "Package": "diffobj", + "Version": "0.3.5", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "crayon", + "methods", + "stats", + "tools", + "utils" + ], + "Hash": "bcaa8b95f8d7d01a5dedfd959ce88ab8" + }, + "digest": { + "Package": "digest", + "Version": "0.6.33", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "utils" + ], + "Hash": "b18a9cf3c003977b0cc49d5e76ebe48d" + }, + "downlit": { + "Package": "downlit", + "Version": "0.4.2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "brio", + "desc", + "digest", + "evaluate", + "fansi", + "memoise", + "rlang", + "vctrs", + "withr", + "yaml" + ], + "Hash": "79bf3f66590752ffbba20f8d2da94c7c" + }, + "downloader": { + "Package": "downloader", + "Version": "0.4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "digest", + "utils" + ], + "Hash": "f4f2a915e0dedbdf016a83b63477349f" + }, + "dplyr": { + "Package": "dplyr", + "Version": "1.1.2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R6", + "cli", + "generics", + "glue", + "lifecycle", + "magrittr", + "methods", + "pillar", + "rlang", + "tibble", + "tidyselect", + "utils", + "vctrs" + ], + "Hash": "dea6970ff715ca541c387de363ff405e" + }, + "ellipsis": { + "Package": "ellipsis", + "Version": "0.3.2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "rlang" + ], + "Hash": "bb0eec2fe32e88d9e2836c2f73ea2077" + }, + "evaluate": { + "Package": "evaluate", + "Version": "0.21", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "methods" + ], + "Hash": "d59f3b464e8da1aef82dc04b588b8dfb" + }, + "fansi": { + "Package": "fansi", + "Version": "1.0.4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "grDevices", + "utils" + ], + "Hash": "1d9e7ad3c8312a192dea7d3db0274fde" + }, + "farver": { + "Package": "farver", + "Version": "2.1.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "8106d78941f34855c440ddb946b8f7a5" + }, + "fastmap": { + "Package": "fastmap", + "Version": "1.1.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "f7736a18de97dea803bde0a2daaafb27" + }, + "fontawesome": { + "Package": "fontawesome", + "Version": "0.5.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "htmltools", + "rlang" + ], + "Hash": "1e22b8cabbad1eae951a75e9f8b52378" + }, + "fs": { + "Package": "fs", + "Version": "1.6.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "methods" + ], + "Hash": "47b5f30c720c23999b913a1a635cf0bb" + }, + "generics": { + "Package": "generics", + "Version": "0.1.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "methods" + ], + "Hash": "15e9634c0fcd294799e9b2e929ed1b86" + }, + "ggplot2": { + "Package": "ggplot2", + "Version": "3.4.2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "MASS", + "R", + "cli", + "glue", + "grDevices", + "grid", + "gtable", + "isoband", + "lifecycle", + "mgcv", + "rlang", + "scales", + "stats", + "tibble", + "vctrs", + "withr" + ], + "Hash": "3a147ee02e85a8941aad9909f1b43b7b" + }, + "glue": { + "Package": "glue", + "Version": "1.6.2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "methods" + ], + "Hash": "4f2596dfb05dac67b9dc558e5c6fba2e" + }, + "gtable": { + "Package": "gtable", + "Version": "0.3.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cli", + "glue", + "grid", + "lifecycle", + "rlang" + ], + "Hash": "b44addadb528a0d227794121c00572a0" + }, + "hapsim": { + "Package": "hapsim", + "Version": "0.31", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "MASS" + ], + "Hash": "d799e1d5880c647ed7aa6f4cc81ee3d4" + }, + "highr": { + "Package": "highr", + "Version": "0.10", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "xfun" + ], + "Hash": "06230136b2d2b9ba5805e1963fa6e890" + }, + "htmltools": { + "Package": "htmltools", + "Version": "0.5.5", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "base64enc", + "digest", + "ellipsis", + "fastmap", + "grDevices", + "rlang", + "utils" + ], + "Hash": "ba0240784ad50a62165058a27459304a" + }, + "httr": { + "Package": "httr", + "Version": "1.4.6", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R6", + "curl", + "jsonlite", + "mime", + "openssl" + ], + "Hash": "7e5e3cbd2a7bc07880c94e22348fb661" + }, + "igraph": { + "Package": "igraph", + "Version": "1.5.0.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "Matrix", + "R", + "cli", + "cpp11", + "grDevices", + "graphics", + "magrittr", + "methods", + "pkgconfig", + "rlang", + "stats", + "utils" + ], + "Hash": "08352b502db2eae1e46364de6e6421f4" + }, + "isoband": { + "Package": "isoband", + "Version": "0.2.7", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "grid", + "utils" + ], + "Hash": "0080607b4a1a7b28979aecef976d8bc2" + }, + "jquerylib": { + "Package": "jquerylib", + "Version": "0.1.4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "htmltools" + ], + "Hash": "5aab57a3bd297eee1c1d862735972182" + }, + "jsonlite": { + "Package": "jsonlite", + "Version": "1.8.7", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "methods" + ], + "Hash": "266a20443ca13c65688b2116d5220f76" + }, + "knitr": { + "Package": "knitr", + "Version": "1.43", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "evaluate", + "highr", + "methods", + "tools", + "xfun", + "yaml" + ], + "Hash": "9775eb076713f627c07ce41d8199d8f6" + }, + "labeling": { + "Package": "labeling", + "Version": "0.4.2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "graphics", + "stats" + ], + "Hash": "3d5108641f47470611a32d0bdf357a72" + }, + "lattice": { + "Package": "lattice", + "Version": "0.21-8", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "grDevices", + "graphics", + "grid", + "stats", + "utils" + ], + "Hash": "0b8a6d63c8770f02a8b5635f3c431e6b" + }, + "lifecycle": { + "Package": "lifecycle", + "Version": "1.0.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cli", + "glue", + "rlang" + ], + "Hash": "001cecbeac1cff9301bdc3775ee46a86" + }, + "magrittr": { + "Package": "magrittr", + "Version": "2.0.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "7ce2733a9826b3aeb1775d56fd305472" + }, + "memoise": { + "Package": "memoise", + "Version": "2.0.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "cachem", + "rlang" + ], + "Hash": "e2817ccf4a065c5d9d7f2cfbe7c1d78c" + }, + "mgcv": { + "Package": "mgcv", + "Version": "1.9-0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "Matrix", + "R", + "graphics", + "methods", + "nlme", + "splines", + "stats", + "utils" + ], + "Hash": "086028ca0460d0c368028d3bda58f31b" + }, + "mime": { + "Package": "mime", + "Version": "0.12", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "tools" + ], + "Hash": "18e9c28c1d3ca1560ce30658b22ce104" + }, + "munsell": { + "Package": "munsell", + "Version": "0.5.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "colorspace", + "methods" + ], + "Hash": "6dfe8bf774944bd5595785e3229d8771" + }, + "nlme": { + "Package": "nlme", + "Version": "3.1-162", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "graphics", + "lattice", + "stats", + "utils" + ], + "Hash": "0984ce8da8da9ead8643c5cbbb60f83e" + }, + "openssl": { + "Package": "openssl", + "Version": "2.0.6", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "askpass" + ], + "Hash": "0f7cd2962e3044bb940cca4f4b5cecbe" + }, + "pillar": { + "Package": "pillar", + "Version": "1.9.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "cli", + "fansi", + "glue", + "lifecycle", + "rlang", + "utf8", + "utils", + "vctrs" + ], + "Hash": "15da5a8412f317beeee6175fbc76f4bb" + }, + "pkgconfig": { + "Package": "pkgconfig", + "Version": "2.0.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "utils" + ], + "Hash": "01f28d4278f15c76cddbea05899c5d6f" + }, + "pkgdown": { + "Package": "pkgdown", + "Version": "2.0.7", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "bslib", + "callr", + "cli", + "desc", + "digest", + "downlit", + "fs", + "httr", + "jsonlite", + "magrittr", + "memoise", + "purrr", + "ragg", + "rlang", + "rmarkdown", + "tibble", + "whisker", + "withr", + "xml2", + "yaml" + ], + "Hash": "16fa15449c930bf3a7761d3c68f8abf9" + }, + "pkgload": { + "Package": "pkgload", + "Version": "1.3.2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cli", + "crayon", + "desc", + "fs", + "glue", + "methods", + "rlang", + "rprojroot", + "utils", + "withr" + ], + "Hash": "6b0c222c5071efe0f3baf3dae9aa40e2" + }, + "plyr": { + "Package": "plyr", + "Version": "1.8.8", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "Rcpp" + ], + "Hash": "d744387aef9047b0b48be2933d78e862" + }, + "praise": { + "Package": "praise", + "Version": "1.0.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "a555924add98c99d2f411e37e7d25e9f" + }, + "processx": { + "Package": "processx", + "Version": "3.8.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R6", + "ps", + "utils" + ], + "Hash": "d75b4059d781336efba24021915902b4" + }, + "ps": { + "Package": "ps", + "Version": "1.7.5", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "utils" + ], + "Hash": "709d852d33178db54b17c722e5b1e594" + }, + "purrr": { + "Package": "purrr", + "Version": "1.0.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cli", + "lifecycle", + "magrittr", + "rlang", + "vctrs" + ], + "Hash": "d71c815267c640f17ddbf7f16144b4bb" + }, + "ragg": { + "Package": "ragg", + "Version": "1.2.5", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "systemfonts", + "textshaping" + ], + "Hash": "690bc058ea2b1b8a407d3cfe3dce3ef9" + }, + "rappdirs": { + "Package": "rappdirs", + "Version": "0.3.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "5e3c5dc0b071b21fa128676560dbe94d" + }, + "readr": { + "Package": "readr", + "Version": "2.1.4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R6", + "cli", + "clipr", + "cpp11", + "crayon", + "hms", + "lifecycle", + "methods", + "rlang", + "tibble", + "tzdb", + "utils", + "vroom" + ], + "Hash": "b5047343b3825f37ad9d3b5d89aa1078" + }, + "rematch2": { + "Package": "rematch2", + "Version": "2.1.2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "tibble" + ], + "Hash": "76c9e04c712a05848ae7a23d2f170a40" + }, + "renv": { + "Package": "renv", + "Version": "0.17.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "utils" + ], + "Hash": "4543b8cd233ae25c6aba8548be9e747e" + }, + "reshape2": { + "Package": "reshape2", + "Version": "1.4.4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "Rcpp", + "plyr", + "stringr" + ], + "Hash": "bb5996d0bd962d214a11140d77589917" + }, + "rlang": { + "Package": "rlang", + "Version": "1.1.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "utils" + ], + "Hash": "a85c767b55f0bf9b7ad16c6d7baee5bb" + }, + "rmarkdown": { + "Package": "rmarkdown", + "Version": "2.23", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "bslib", + "evaluate", + "fontawesome", + "htmltools", + "jquerylib", + "jsonlite", + "knitr", + "methods", + "stringr", + "tinytex", + "tools", + "utils", + "xfun", + "yaml" + ], + "Hash": "79f14e53725f28900d936f692bfdd69f" + }, + "rprojroot": { + "Package": "rprojroot", + "Version": "2.0.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "1de7ab598047a87bba48434ba35d497d" + }, + "rstudioapi": { + "Package": "rstudioapi", + "Version": "0.15.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "5564500e25cffad9e22244ced1379887" + }, + "sass": { + "Package": "sass", + "Version": "0.4.7", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R6", + "fs", + "htmltools", + "rappdirs", + "rlang" + ], + "Hash": "6bd4d33b50ff927191ec9acbf52fd056" + }, + "scales": { + "Package": "scales", + "Version": "1.2.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R6", + "RColorBrewer", + "farver", + "labeling", + "lifecycle", + "munsell", + "rlang", + "viridisLite" + ], + "Hash": "906cb23d2f1c5680b8ce439b44c6fa63" + }, + "stringi": { + "Package": "stringi", + "Version": "1.7.12", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "stats", + "tools", + "utils" + ], + "Hash": "ca8bd84263c77310739d2cf64d84d7c9" + }, + "stringr": { + "Package": "stringr", + "Version": "1.5.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cli", + "glue", + "lifecycle", + "magrittr", + "rlang", + "stringi", + "vctrs" + ], + "Hash": "671a4d384ae9d32fc47a14e98bfa3dc8" + }, + "sys": { + "Package": "sys", + "Version": "3.4.2", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "3a1be13d68d47a8cd0bfd74739ca1555" + }, + "systemfonts": { + "Package": "systemfonts", + "Version": "1.0.4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cpp11" + ], + "Hash": "90b28393209827327de889f49935140a" + }, + "testthat": { + "Package": "testthat", + "Version": "3.1.8", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R6", + "brio", + "callr", + "cli", + "desc", + "digest", + "ellipsis", + "evaluate", + "jsonlite", + "lifecycle", + "magrittr", + "methods", + "pkgload", + "praise", + "processx", + "ps", + "rlang", + "utils", + "waldo", + "withr" + ], + "Hash": "e0eded5dd915510f8e0d6e6277506203" + }, + "textshaping": { + "Package": "textshaping", + "Version": "0.3.6", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cpp11", + "systemfonts" + ], + "Hash": "1ab6223d3670fac7143202cb6a2d43d5" + }, + "tibble": { + "Package": "tibble", + "Version": "3.2.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "fansi", + "lifecycle", + "magrittr", + "methods", + "pillar", + "pkgconfig", + "rlang", + "utils", + "vctrs" + ], + "Hash": "a84e2cc86d07289b3b6f5069df7a004c" + }, + "tidyselect": { + "Package": "tidyselect", + "Version": "1.2.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cli", + "glue", + "lifecycle", + "rlang", + "vctrs", + "withr" + ], + "Hash": "79540e5fcd9e0435af547d885f184fd5" + }, + "tinytex": { + "Package": "tinytex", + "Version": "0.45", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "xfun" + ], + "Hash": "e4e357f28c2edff493936b6cb30c3d65" + }, + "tzdb": { + "Package": "tzdb", + "Version": "0.4.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cpp11" + ], + "Hash": "f561504ec2897f4d46f0c7657e488ae1" + }, + "utf8": { + "Package": "utf8", + "Version": "1.2.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "1fe17157424bb09c48a8b3b550c753bc" + }, + "vctrs": { + "Package": "vctrs", + "Version": "0.6.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cli", + "glue", + "lifecycle", + "rlang" + ], + "Hash": "d0ef2856b83dc33ea6e255caf6229ee2" + }, + "viridis": { + "Package": "viridis", + "Version": "0.6.4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "ggplot2", + "gridExtra", + "viridisLite" + ], + "Hash": "80cd127bc8c9d3d9f0904ead9a9102f1" + }, + "viridisLite": { + "Package": "viridisLite", + "Version": "0.4.2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "c826c7c4241b6fc89ff55aaea3fa7491" + }, + "visNetwork": { + "Package": "visNetwork", + "Version": "2.1.2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "grDevices", + "htmltools", + "htmlwidgets", + "jsonlite", + "magrittr", + "methods", + "stats", + "utils" + ], + "Hash": "3e48b097e8d9a91ecced2ed4817a678d" + }, + "vroom": { + "Package": "vroom", + "Version": "1.6.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "bit64", + "cli", + "cpp11", + "crayon", + "glue", + "hms", + "lifecycle", + "methods", + "progress", + "rlang", + "stats", + "tibble", + "tidyselect", + "tzdb", + "vctrs", + "withr" + ], + "Hash": "8318e64ffb3a70e652494017ec455561" + }, + "waldo": { + "Package": "waldo", + "Version": "0.5.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "cli", + "diffobj", + "fansi", + "glue", + "methods", + "rematch2", + "rlang", + "tibble" + ], + "Hash": "2c993415154cdb94649d99ae138ff5e5" + }, + "whisker": { + "Package": "whisker", + "Version": "0.4.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "c6abfa47a46d281a7d5159d0a8891e88" + }, + "withr": { + "Package": "withr", + "Version": "2.5.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "grDevices", + "graphics", + "stats" + ], + "Hash": "c0e49a9760983e81e55cdd9be92e7182" + }, + "xfun": { + "Package": "xfun", + "Version": "0.39", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "stats", + "tools" + ], + "Hash": "8f56e9acb54fb525e66464d57ab58bcb" + }, + "xml2": { + "Package": "xml2", + "Version": "1.3.4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "methods" + ], + "Hash": "7dc765ac9b909487326a7d471fdd3821" + }, + "yaml": { + "Package": "yaml", + "Version": "2.3.7", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "0d0056cc5383fbc240ccd0cb584bf436" + } + } +} diff --git a/renv/.gitignore b/renv/.gitignore new file mode 100644 index 0000000..0ec0cbb --- /dev/null +++ b/renv/.gitignore @@ -0,0 +1,7 @@ +library/ +local/ +cellar/ +lock/ +python/ +sandbox/ +staging/ diff --git a/renv/activate.R b/renv/activate.R new file mode 100644 index 0000000..a8fdc32 --- /dev/null +++ b/renv/activate.R @@ -0,0 +1,1032 @@ + +local({ + + # the requested version of renv + version <- "0.17.3" + + # the project directory + project <- getwd() + + # figure out whether the autoloader is enabled + enabled <- local({ + + # first, check config option + override <- getOption("renv.config.autoloader.enabled") + if (!is.null(override)) + return(override) + + # next, check environment variables + # TODO: prefer using the configuration one in the future + envvars <- c( + "RENV_CONFIG_AUTOLOADER_ENABLED", + "RENV_AUTOLOADER_ENABLED", + "RENV_ACTIVATE_PROJECT" + ) + + for (envvar in envvars) { + envval <- Sys.getenv(envvar, unset = NA) + if (!is.na(envval)) + return(tolower(envval) %in% c("true", "t", "1")) + } + + # enable by default + TRUE + + }) + + if (!enabled) + return(FALSE) + + # avoid recursion + if (identical(getOption("renv.autoloader.running"), TRUE)) { + warning("ignoring recursive attempt to run renv autoloader") + return(invisible(TRUE)) + } + + # signal that we're loading renv during R startup + options(renv.autoloader.running = TRUE) + on.exit(options(renv.autoloader.running = NULL), add = TRUE) + + # signal that we've consented to use renv + options(renv.consent = TRUE) + + # load the 'utils' package eagerly -- this ensures that renv shims, which + # mask 'utils' packages, will come first on the search path + library(utils, lib.loc = .Library) + + # unload renv if it's already been loaded + if ("renv" %in% loadedNamespaces()) + unloadNamespace("renv") + + # load bootstrap tools + `%||%` <- function(x, y) { + if (is.environment(x) || length(x)) x else y + } + + `%??%` <- function(x, y) { + if (is.null(x)) y else x + } + + bootstrap <- function(version, library) { + + # attempt to download renv + tarball <- tryCatch(renv_bootstrap_download(version), error = identity) + if (inherits(tarball, "error")) + stop("failed to download renv ", version) + + # now attempt to install + status <- tryCatch(renv_bootstrap_install(version, tarball, library), error = identity) + if (inherits(status, "error")) + stop("failed to install renv ", version) + + } + + renv_bootstrap_tests_running <- function() { + getOption("renv.tests.running", default = FALSE) + } + + renv_bootstrap_repos <- function() { + + # get CRAN repository + cran <- getOption("renv.repos.cran", "https://cloud.r-project.org") + + # check for repos override + repos <- Sys.getenv("RENV_CONFIG_REPOS_OVERRIDE", unset = NA) + if (!is.na(repos)) { + + # check for RSPM; if set, use a fallback repository for renv + rspm <- Sys.getenv("RSPM", unset = NA) + if (identical(rspm, repos)) + repos <- c(RSPM = rspm, CRAN = cran) + + return(repos) + + } + + # check for lockfile repositories + repos <- tryCatch(renv_bootstrap_repos_lockfile(), error = identity) + if (!inherits(repos, "error") && length(repos)) + return(repos) + + # if we're testing, re-use the test repositories + if (renv_bootstrap_tests_running()) { + repos <- getOption("renv.tests.repos") + if (!is.null(repos)) + return(repos) + } + + # retrieve current repos + repos <- getOption("repos") + + # ensure @CRAN@ entries are resolved + repos[repos == "@CRAN@"] <- cran + + # add in renv.bootstrap.repos if set + default <- c(FALLBACK = "https://cloud.r-project.org") + extra <- getOption("renv.bootstrap.repos", default = default) + repos <- c(repos, extra) + + # remove duplicates that might've snuck in + dupes <- duplicated(repos) | duplicated(names(repos)) + repos[!dupes] + + } + + renv_bootstrap_repos_lockfile <- function() { + + lockpath <- Sys.getenv("RENV_PATHS_LOCKFILE", unset = "renv.lock") + if (!file.exists(lockpath)) + return(NULL) + + lockfile <- tryCatch(renv_json_read(lockpath), error = identity) + if (inherits(lockfile, "error")) { + warning(lockfile) + return(NULL) + } + + repos <- lockfile$R$Repositories + if (length(repos) == 0) + return(NULL) + + keys <- vapply(repos, `[[`, "Name", FUN.VALUE = character(1)) + vals <- vapply(repos, `[[`, "URL", FUN.VALUE = character(1)) + names(vals) <- keys + + return(vals) + + } + + renv_bootstrap_download <- function(version) { + + # if the renv version number has 4 components, assume it must + # be retrieved via github + nv <- numeric_version(version) + components <- unclass(nv)[[1]] + + # if this appears to be a development version of 'renv', we'll + # try to restore from github + dev <- length(components) == 4L + + # begin collecting different methods for finding renv + methods <- c( + renv_bootstrap_download_tarball, + if (dev) + renv_bootstrap_download_github + else c( + renv_bootstrap_download_cran_latest, + renv_bootstrap_download_cran_archive + ) + ) + + for (method in methods) { + path <- tryCatch(method(version), error = identity) + if (is.character(path) && file.exists(path)) + return(path) + } + + stop("failed to download renv ", version) + + } + + renv_bootstrap_download_impl <- function(url, destfile) { + + mode <- "wb" + + # https://bugs.r-project.org/bugzilla/show_bug.cgi?id=17715 + fixup <- + Sys.info()[["sysname"]] == "Windows" && + substring(url, 1L, 5L) == "file:" + + if (fixup) + mode <- "w+b" + + args <- list( + url = url, + destfile = destfile, + mode = mode, + quiet = TRUE + ) + + if ("headers" %in% names(formals(utils::download.file))) + args$headers <- renv_bootstrap_download_custom_headers(url) + + do.call(utils::download.file, args) + + } + + renv_bootstrap_download_custom_headers <- function(url) { + + headers <- getOption("renv.download.headers") + if (is.null(headers)) + return(character()) + + if (!is.function(headers)) + stopf("'renv.download.headers' is not a function") + + headers <- headers(url) + if (length(headers) == 0L) + return(character()) + + if (is.list(headers)) + headers <- unlist(headers, recursive = FALSE, use.names = TRUE) + + ok <- + is.character(headers) && + is.character(names(headers)) && + all(nzchar(names(headers))) + + if (!ok) + stop("invocation of 'renv.download.headers' did not return a named character vector") + + headers + + } + + renv_bootstrap_download_cran_latest <- function(version) { + + spec <- renv_bootstrap_download_cran_latest_find(version) + type <- spec$type + repos <- spec$repos + + message("* Downloading renv ", version, " ... ", appendLF = FALSE) + + baseurl <- utils::contrib.url(repos = repos, type = type) + ext <- if (identical(type, "source")) + ".tar.gz" + else if (Sys.info()[["sysname"]] == "Windows") + ".zip" + else + ".tgz" + name <- sprintf("renv_%s%s", version, ext) + url <- paste(baseurl, name, sep = "/") + + destfile <- file.path(tempdir(), name) + status <- tryCatch( + renv_bootstrap_download_impl(url, destfile), + condition = identity + ) + + if (inherits(status, "condition")) { + message("FAILED") + return(FALSE) + } + + # report success and return + message("OK (downloaded ", type, ")") + destfile + + } + + renv_bootstrap_download_cran_latest_find <- function(version) { + + # check whether binaries are supported on this system + binary <- + getOption("renv.bootstrap.binary", default = TRUE) && + !identical(.Platform$pkgType, "source") && + !identical(getOption("pkgType"), "source") && + Sys.info()[["sysname"]] %in% c("Darwin", "Windows") + + types <- c(if (binary) "binary", "source") + + # iterate over types + repositories + for (type in types) { + for (repos in renv_bootstrap_repos()) { + + # retrieve package database + db <- tryCatch( + as.data.frame( + utils::available.packages(type = type, repos = repos), + stringsAsFactors = FALSE + ), + error = identity + ) + + if (inherits(db, "error")) + next + + # check for compatible entry + entry <- db[db$Package %in% "renv" & db$Version %in% version, ] + if (nrow(entry) == 0) + next + + # found it; return spec to caller + spec <- list(entry = entry, type = type, repos = repos) + return(spec) + + } + } + + # if we got here, we failed to find renv + fmt <- "renv %s is not available from your declared package repositories" + stop(sprintf(fmt, version)) + + } + + renv_bootstrap_download_cran_archive <- function(version) { + + name <- sprintf("renv_%s.tar.gz", version) + repos <- renv_bootstrap_repos() + urls <- file.path(repos, "src/contrib/Archive/renv", name) + destfile <- file.path(tempdir(), name) + + message("* Downloading renv ", version, " ... ", appendLF = FALSE) + + for (url in urls) { + + status <- tryCatch( + renv_bootstrap_download_impl(url, destfile), + condition = identity + ) + + if (identical(status, 0L)) { + message("OK") + return(destfile) + } + + } + + message("FAILED") + return(FALSE) + + } + + renv_bootstrap_download_tarball <- function(version) { + + # if the user has provided the path to a tarball via + # an environment variable, then use it + tarball <- Sys.getenv("RENV_BOOTSTRAP_TARBALL", unset = NA) + if (is.na(tarball)) + return() + + # allow directories + if (dir.exists(tarball)) { + name <- sprintf("renv_%s.tar.gz", version) + tarball <- file.path(tarball, name) + } + + # bail if it doesn't exist + if (!file.exists(tarball)) { + + # let the user know we weren't able to honour their request + fmt <- "* RENV_BOOTSTRAP_TARBALL is set (%s) but does not exist." + msg <- sprintf(fmt, tarball) + warning(msg) + + # bail + return() + + } + + fmt <- "* Bootstrapping with tarball at path '%s'." + msg <- sprintf(fmt, tarball) + message(msg) + + tarball + + } + + renv_bootstrap_download_github <- function(version) { + + enabled <- Sys.getenv("RENV_BOOTSTRAP_FROM_GITHUB", unset = "TRUE") + if (!identical(enabled, "TRUE")) + return(FALSE) + + # prepare download options + pat <- Sys.getenv("GITHUB_PAT") + if (nzchar(Sys.which("curl")) && nzchar(pat)) { + fmt <- "--location --fail --header \"Authorization: token %s\"" + extra <- sprintf(fmt, pat) + saved <- options("download.file.method", "download.file.extra") + options(download.file.method = "curl", download.file.extra = extra) + on.exit(do.call(base::options, saved), add = TRUE) + } else if (nzchar(Sys.which("wget")) && nzchar(pat)) { + fmt <- "--header=\"Authorization: token %s\"" + extra <- sprintf(fmt, pat) + saved <- options("download.file.method", "download.file.extra") + options(download.file.method = "wget", download.file.extra = extra) + on.exit(do.call(base::options, saved), add = TRUE) + } + + message("* Downloading renv ", version, " from GitHub ... ", appendLF = FALSE) + + url <- file.path("https://api.github.com/repos/rstudio/renv/tarball", version) + name <- sprintf("renv_%s.tar.gz", version) + destfile <- file.path(tempdir(), name) + + status <- tryCatch( + renv_bootstrap_download_impl(url, destfile), + condition = identity + ) + + if (!identical(status, 0L)) { + message("FAILED") + return(FALSE) + } + + message("OK") + return(destfile) + + } + + renv_bootstrap_install <- function(version, tarball, library) { + + # attempt to install it into project library + message("* Installing renv ", version, " ... ", appendLF = FALSE) + dir.create(library, showWarnings = FALSE, recursive = TRUE) + + # invoke using system2 so we can capture and report output + bin <- R.home("bin") + exe <- if (Sys.info()[["sysname"]] == "Windows") "R.exe" else "R" + r <- file.path(bin, exe) + + args <- c( + "--vanilla", "CMD", "INSTALL", "--no-multiarch", + "-l", shQuote(path.expand(library)), + shQuote(path.expand(tarball)) + ) + + output <- system2(r, args, stdout = TRUE, stderr = TRUE) + message("Done!") + + # check for successful install + status <- attr(output, "status") + if (is.numeric(status) && !identical(status, 0L)) { + header <- "Error installing renv:" + lines <- paste(rep.int("=", nchar(header)), collapse = "") + text <- c(header, lines, output) + writeLines(text, con = stderr()) + } + + status + + } + + renv_bootstrap_platform_prefix <- function() { + + # construct version prefix + version <- paste(R.version$major, R.version$minor, sep = ".") + prefix <- paste("R", numeric_version(version)[1, 1:2], sep = "-") + + # include SVN revision for development versions of R + # (to avoid sharing platform-specific artefacts with released versions of R) + devel <- + identical(R.version[["status"]], "Under development (unstable)") || + identical(R.version[["nickname"]], "Unsuffered Consequences") + + if (devel) + prefix <- paste(prefix, R.version[["svn rev"]], sep = "-r") + + # build list of path components + components <- c(prefix, R.version$platform) + + # include prefix if provided by user + prefix <- renv_bootstrap_platform_prefix_impl() + if (!is.na(prefix) && nzchar(prefix)) + components <- c(prefix, components) + + # build prefix + paste(components, collapse = "/") + + } + + renv_bootstrap_platform_prefix_impl <- function() { + + # if an explicit prefix has been supplied, use it + prefix <- Sys.getenv("RENV_PATHS_PREFIX", unset = NA) + if (!is.na(prefix)) + return(prefix) + + # if the user has requested an automatic prefix, generate it + auto <- Sys.getenv("RENV_PATHS_PREFIX_AUTO", unset = NA) + if (auto %in% c("TRUE", "True", "true", "1")) + return(renv_bootstrap_platform_prefix_auto()) + + # empty string on failure + "" + + } + + renv_bootstrap_platform_prefix_auto <- function() { + + prefix <- tryCatch(renv_bootstrap_platform_os(), error = identity) + if (inherits(prefix, "error") || prefix %in% "unknown") { + + msg <- paste( + "failed to infer current operating system", + "please file a bug report at https://github.com/rstudio/renv/issues", + sep = "; " + ) + + warning(msg) + + } + + prefix + + } + + renv_bootstrap_platform_os <- function() { + + sysinfo <- Sys.info() + sysname <- sysinfo[["sysname"]] + + # handle Windows + macOS up front + if (sysname == "Windows") + return("windows") + else if (sysname == "Darwin") + return("macos") + + # check for os-release files + for (file in c("/etc/os-release", "/usr/lib/os-release")) + if (file.exists(file)) + return(renv_bootstrap_platform_os_via_os_release(file, sysinfo)) + + # check for redhat-release files + if (file.exists("/etc/redhat-release")) + return(renv_bootstrap_platform_os_via_redhat_release()) + + "unknown" + + } + + renv_bootstrap_platform_os_via_os_release <- function(file, sysinfo) { + + # read /etc/os-release + release <- utils::read.table( + file = file, + sep = "=", + quote = c("\"", "'"), + col.names = c("Key", "Value"), + comment.char = "#", + stringsAsFactors = FALSE + ) + + vars <- as.list(release$Value) + names(vars) <- release$Key + + # get os name + os <- tolower(sysinfo[["sysname"]]) + + # read id + id <- "unknown" + for (field in c("ID", "ID_LIKE")) { + if (field %in% names(vars) && nzchar(vars[[field]])) { + id <- vars[[field]] + break + } + } + + # read version + version <- "unknown" + for (field in c("UBUNTU_CODENAME", "VERSION_CODENAME", "VERSION_ID", "BUILD_ID")) { + if (field %in% names(vars) && nzchar(vars[[field]])) { + version <- vars[[field]] + break + } + } + + # join together + paste(c(os, id, version), collapse = "-") + + } + + renv_bootstrap_platform_os_via_redhat_release <- function() { + + # read /etc/redhat-release + contents <- readLines("/etc/redhat-release", warn = FALSE) + + # infer id + id <- if (grepl("centos", contents, ignore.case = TRUE)) + "centos" + else if (grepl("redhat", contents, ignore.case = TRUE)) + "redhat" + else + "unknown" + + # try to find a version component (very hacky) + version <- "unknown" + + parts <- strsplit(contents, "[[:space:]]")[[1L]] + for (part in parts) { + + nv <- tryCatch(numeric_version(part), error = identity) + if (inherits(nv, "error")) + next + + version <- nv[1, 1] + break + + } + + paste(c("linux", id, version), collapse = "-") + + } + + renv_bootstrap_library_root_name <- function(project) { + + # use project name as-is if requested + asis <- Sys.getenv("RENV_PATHS_LIBRARY_ROOT_ASIS", unset = "FALSE") + if (asis) + return(basename(project)) + + # otherwise, disambiguate based on project's path + id <- substring(renv_bootstrap_hash_text(project), 1L, 8L) + paste(basename(project), id, sep = "-") + + } + + renv_bootstrap_library_root <- function(project) { + + prefix <- renv_bootstrap_profile_prefix() + + path <- Sys.getenv("RENV_PATHS_LIBRARY", unset = NA) + if (!is.na(path)) + return(paste(c(path, prefix), collapse = "/")) + + path <- renv_bootstrap_library_root_impl(project) + if (!is.null(path)) { + name <- renv_bootstrap_library_root_name(project) + return(paste(c(path, prefix, name), collapse = "/")) + } + + renv_bootstrap_paths_renv("library", project = project) + + } + + renv_bootstrap_library_root_impl <- function(project) { + + root <- Sys.getenv("RENV_PATHS_LIBRARY_ROOT", unset = NA) + if (!is.na(root)) + return(root) + + type <- renv_bootstrap_project_type(project) + if (identical(type, "package")) { + userdir <- renv_bootstrap_user_dir() + return(file.path(userdir, "library")) + } + + } + + renv_bootstrap_validate_version <- function(version) { + + loadedversion <- utils::packageDescription("renv", fields = "Version") + if (version == loadedversion) + return(TRUE) + + # assume four-component versions are from GitHub; + # three-component versions are from CRAN + components <- strsplit(loadedversion, "[.-]")[[1]] + remote <- if (length(components) == 4L) + paste("rstudio/renv", loadedversion, sep = "@") + else + paste("renv", loadedversion, sep = "@") + + fmt <- paste( + "renv %1$s was loaded from project library, but this project is configured to use renv %2$s.", + "Use `renv::record(\"%3$s\")` to record renv %1$s in the lockfile.", + "Use `renv::restore(packages = \"renv\")` to install renv %2$s into the project library.", + sep = "\n" + ) + + msg <- sprintf(fmt, loadedversion, version, remote) + warning(msg, call. = FALSE) + + FALSE + + } + + renv_bootstrap_hash_text <- function(text) { + + hashfile <- tempfile("renv-hash-") + on.exit(unlink(hashfile), add = TRUE) + + writeLines(text, con = hashfile) + tools::md5sum(hashfile) + + } + + renv_bootstrap_load <- function(project, libpath, version) { + + # try to load renv from the project library + if (!requireNamespace("renv", lib.loc = libpath, quietly = TRUE)) + return(FALSE) + + # warn if the version of renv loaded does not match + renv_bootstrap_validate_version(version) + + # execute renv load hooks, if any + hooks <- getHook("renv::autoload") + for (hook in hooks) + if (is.function(hook)) + tryCatch(hook(), error = warning) + + # load the project + renv::load(project) + + TRUE + + } + + renv_bootstrap_profile_load <- function(project) { + + # if RENV_PROFILE is already set, just use that + profile <- Sys.getenv("RENV_PROFILE", unset = NA) + if (!is.na(profile) && nzchar(profile)) + return(profile) + + # check for a profile file (nothing to do if it doesn't exist) + path <- renv_bootstrap_paths_renv("profile", profile = FALSE, project = project) + if (!file.exists(path)) + return(NULL) + + # read the profile, and set it if it exists + contents <- readLines(path, warn = FALSE) + if (length(contents) == 0L) + return(NULL) + + # set RENV_PROFILE + profile <- contents[[1L]] + if (!profile %in% c("", "default")) + Sys.setenv(RENV_PROFILE = profile) + + profile + + } + + renv_bootstrap_profile_prefix <- function() { + profile <- renv_bootstrap_profile_get() + if (!is.null(profile)) + return(file.path("profiles", profile, "renv")) + } + + renv_bootstrap_profile_get <- function() { + profile <- Sys.getenv("RENV_PROFILE", unset = "") + renv_bootstrap_profile_normalize(profile) + } + + renv_bootstrap_profile_set <- function(profile) { + profile <- renv_bootstrap_profile_normalize(profile) + if (is.null(profile)) + Sys.unsetenv("RENV_PROFILE") + else + Sys.setenv(RENV_PROFILE = profile) + } + + renv_bootstrap_profile_normalize <- function(profile) { + + if (is.null(profile) || profile %in% c("", "default")) + return(NULL) + + profile + + } + + renv_bootstrap_path_absolute <- function(path) { + + substr(path, 1L, 1L) %in% c("~", "/", "\\") || ( + substr(path, 1L, 1L) %in% c(letters, LETTERS) && + substr(path, 2L, 3L) %in% c(":/", ":\\") + ) + + } + + renv_bootstrap_paths_renv <- function(..., profile = TRUE, project = NULL) { + renv <- Sys.getenv("RENV_PATHS_RENV", unset = "renv") + root <- if (renv_bootstrap_path_absolute(renv)) NULL else project + prefix <- if (profile) renv_bootstrap_profile_prefix() + components <- c(root, renv, prefix, ...) + paste(components, collapse = "/") + } + + renv_bootstrap_project_type <- function(path) { + + descpath <- file.path(path, "DESCRIPTION") + if (!file.exists(descpath)) + return("unknown") + + desc <- tryCatch( + read.dcf(descpath, all = TRUE), + error = identity + ) + + if (inherits(desc, "error")) + return("unknown") + + type <- desc$Type + if (!is.null(type)) + return(tolower(type)) + + package <- desc$Package + if (!is.null(package)) + return("package") + + "unknown" + + } + + renv_bootstrap_user_dir <- function() { + dir <- renv_bootstrap_user_dir_impl() + path.expand(chartr("\\", "/", dir)) + } + + renv_bootstrap_user_dir_impl <- function() { + + # use local override if set + override <- getOption("renv.userdir.override") + if (!is.null(override)) + return(override) + + # use R_user_dir if available + tools <- asNamespace("tools") + if (is.function(tools$R_user_dir)) + return(tools$R_user_dir("renv", "cache")) + + # try using our own backfill for older versions of R + envvars <- c("R_USER_CACHE_DIR", "XDG_CACHE_HOME") + for (envvar in envvars) { + root <- Sys.getenv(envvar, unset = NA) + if (!is.na(root)) + return(file.path(root, "R/renv")) + } + + # use platform-specific default fallbacks + if (Sys.info()[["sysname"]] == "Windows") + file.path(Sys.getenv("LOCALAPPDATA"), "R/cache/R/renv") + else if (Sys.info()[["sysname"]] == "Darwin") + "~/Library/Caches/org.R-project.R/R/renv" + else + "~/.cache/R/renv" + + } + + + renv_json_read <- function(file = NULL, text = NULL) { + + jlerr <- NULL + + # if jsonlite is loaded, use that instead + if ("jsonlite" %in% loadedNamespaces()) { + + json <- catch(renv_json_read_jsonlite(file, text)) + if (!inherits(json, "error")) + return(json) + + jlerr <- json + + } + + # otherwise, fall back to the default JSON reader + json <- catch(renv_json_read_default(file, text)) + if (!inherits(json, "error")) + return(json) + + # report an error + if (!is.null(jlerr)) + stop(jlerr) + else + stop(json) + + } + + renv_json_read_jsonlite <- function(file = NULL, text = NULL) { + text <- paste(text %||% read(file), collapse = "\n") + jsonlite::fromJSON(txt = text, simplifyVector = FALSE) + } + + renv_json_read_default <- function(file = NULL, text = NULL) { + + # find strings in the JSON + text <- paste(text %||% read(file), collapse = "\n") + pattern <- '["](?:(?:\\\\.)|(?:[^"\\\\]))*?["]' + locs <- gregexpr(pattern, text, perl = TRUE)[[1]] + + # if any are found, replace them with placeholders + replaced <- text + strings <- character() + replacements <- character() + + if (!identical(c(locs), -1L)) { + + # get the string values + starts <- locs + ends <- locs + attr(locs, "match.length") - 1L + strings <- substring(text, starts, ends) + + # only keep those requiring escaping + strings <- grep("[[\\]{}:]", strings, perl = TRUE, value = TRUE) + + # compute replacements + replacements <- sprintf('"\032%i\032"', seq_along(strings)) + + # replace the strings + mapply(function(string, replacement) { + replaced <<- sub(string, replacement, replaced, fixed = TRUE) + }, strings, replacements) + + } + + # transform the JSON into something the R parser understands + transformed <- replaced + transformed <- gsub("{}", "`names<-`(list(), character())", transformed, fixed = TRUE) + transformed <- gsub("[[{]", "list(", transformed, perl = TRUE) + transformed <- gsub("[]}]", ")", transformed, perl = TRUE) + transformed <- gsub(":", "=", transformed, fixed = TRUE) + text <- paste(transformed, collapse = "\n") + + # parse it + json <- parse(text = text, keep.source = FALSE, srcfile = NULL)[[1L]] + + # construct map between source strings, replaced strings + map <- as.character(parse(text = strings)) + names(map) <- as.character(parse(text = replacements)) + + # convert to list + map <- as.list(map) + + # remap strings in object + remapped <- renv_json_remap(json, map) + + # evaluate + eval(remapped, envir = baseenv()) + + } + + renv_json_remap <- function(json, map) { + + # fix names + if (!is.null(names(json))) { + lhs <- match(names(json), names(map), nomatch = 0L) + rhs <- match(names(map), names(json), nomatch = 0L) + names(json)[rhs] <- map[lhs] + } + + # fix values + if (is.character(json)) + return(map[[json]] %||% json) + + # handle true, false, null + if (is.name(json)) { + text <- as.character(json) + if (text == "true") + return(TRUE) + else if (text == "false") + return(FALSE) + else if (text == "null") + return(NULL) + } + + # recurse + if (is.recursive(json)) { + for (i in seq_along(json)) { + json[i] <- list(renv_json_remap(json[[i]], map)) + } + } + + json + + } + + # load the renv profile, if any + renv_bootstrap_profile_load(project) + + # construct path to library root + root <- renv_bootstrap_library_root(project) + + # construct library prefix for platform + prefix <- renv_bootstrap_platform_prefix() + + # construct full libpath + libpath <- file.path(root, prefix) + + # attempt to load + if (renv_bootstrap_load(project, libpath, version)) + return(TRUE) + + # load failed; inform user we're about to bootstrap + prefix <- paste("# Bootstrapping renv", version) + postfix <- paste(rep.int("-", 77L - nchar(prefix)), collapse = "") + header <- paste(prefix, postfix) + message(header) + + # perform bootstrap + bootstrap(version, libpath) + + # exit early if we're just testing bootstrap + if (!is.na(Sys.getenv("RENV_BOOTSTRAP_INSTALL_ONLY", unset = NA))) + return(TRUE) + + # try again to load + if (requireNamespace("renv", lib.loc = libpath, quietly = TRUE)) { + message("* Successfully installed and loaded renv ", version, ".") + return(renv::load()) + } + + # failed to download or load renv; warn the user + msg <- c( + "Failed to find an renv installation: the project will not be loaded.", + "Use `renv::activate()` to re-initialize the project." + ) + + warning(paste(msg, collapse = "\n"), call. = FALSE) + +}) diff --git a/renv/settings.json b/renv/settings.json new file mode 100644 index 0000000..1a06760 --- /dev/null +++ b/renv/settings.json @@ -0,0 +1,17 @@ +{ + "bioconductor.version": null, + "external.libraries": [], + "ignored.packages": [], + "package.dependency.fields": [ + "Imports", + "Depends", + "LinkingTo" + ], + "r.version": null, + "snapshot.type": "implicit", + "use.cache": true, + "vcs.ignore.cellar": true, + "vcs.ignore.library": true, + "vcs.ignore.local": true, + "vcs.manage.ignores": true +} diff --git a/tests/testthat/test-parse_g.R b/tests/testthat/test-parse_g.R new file mode 100644 index 0000000..72692ca --- /dev/null +++ b/tests/testthat/test-parse_g.R @@ -0,0 +1,62 @@ +# Define the tests for the G_from_text function +test_that("G_from_text parses text input correctly", { + # Define some example text input + text <- "X <- Y 0.25 + A <- X 0.1 + A <- Y sqrt(0.34)" + + # Call the G_from_text function + G_matrix <- G_from_text(text) + + # Define the expected output G matrix (you may need to adjust this based on your function's logic) + expected_G_matrix <- matrix(c(0, 0.25, sqrt(0.34), 0, 0, 0.1, 0, 0, 0), nrow = 3, ncol = 3, + dimnames = list(c("Y", "X", "A"), c("Y", "X", "A")), byrow=T) + + # Check if the generated G matrix matches the expected G matrix + expect_equal(G_matrix, expected_G_matrix) +}) + +test_that("G_from_text handles invalid input gracefully", { + # Define some invalid input + invalid_text <- "X -> Y 0.25\nInvalidLine\nA <- Z 0.1" + + # Check if the function throws an error when given invalid input + expect_error(G_from_text(invalid_text), "Expect there to be four tokens, space separated") +}) + + + +test_that("G_from_df generates G matrix from a valid data frame", { + # Define a sample data frame + df <- data.frame( + i = c("Y", "X", "X", "A", "Y", "A"), + j = c("X", "A", "Y", "X", "A", "Y"), + eff = c(0.25, 0.24, 0.34, 0.2, 0.15, 0.3) + ) + + # Call the G_from_df function + G_matrix <- G_from_df(df) + + # Define the expected output G matrix (you may need to adjust this based on your function's logic) + expected_G_matrix <- matrix(c(0, 0.25, 0.15, 0.34, 0, 0.24, 0.3, 0.2, 0), nrow = 3, ncol = 3, + dimnames = list(c("Y", "X", "A"), c("Y", "X", "A")), byrow=T) + + # Check if the generated G matrix matches the expected G matrix + expect_equal(G_matrix, expected_G_matrix) +}) + +test_that("G_from_df handles invalid input gracefully", { + # Define an empty data frame + empty_df <- data.frame() + + # Check if the function throws an error when given an empty data frame + expect_error(G_from_df(empty_df), "nrow") + + # Define a data frame with missing columns + missing_cols_df <- data.frame(i = c("Y", "X"), eff = c(0.25, 0.24)) + + # Check if the function throws an error when given a data frame with missing columns + expect_error(G_from_df(missing_cols_df), "all") +}) + + diff --git a/tests/testthat/test-sim_mv.R b/tests/testthat/test-sim_mv.R new file mode 100644 index 0000000..38b19d0 --- /dev/null +++ b/tests/testthat/test-sim_mv.R @@ -0,0 +1,16 @@ +test_that("sim_mv", { + G <- matrix(c(0, sqrt(0.25), 0, sqrt(0.15), + 0, 0, 0, sqrt(0.1), + sqrt(0.2), 0, 0, -sqrt(0.3), + 0, 0, 0, 0), nrow = 4, byrow = TRUE) + colnames(G) <- row.names(G) <- c("X", "Y", "Z", "W") + + x <- sim_mv(G = G, + J = 50000, + N = 60000, + h2 = c(0.3, 0.3, 0.5, 0.4), + pi = 1000/50000) %>% suppressWarnings() + + expect_true(all(!is.na(x$beta_hat))) + expect_true(sum(x$beta_hat == 0) / length(x$beta_hat) < 0.01) +}) diff --git a/tests/testthat/test-sim_mv_executes.R b/tests/testthat/test-sim_mv_executes.R index cb3ddef..f51e1d0 100644 --- a/tests/testthat/test-sim_mv_executes.R +++ b/tests/testthat/test-sim_mv_executes.R @@ -99,5 +99,5 @@ test_that("sim_mv executes", { expect_equal(dat7$direct_SNP_effects_marg, S %*% L %*% solve(S) %*% dat7$direct_SNP_effects_joint) expect_equal(dat7$beta_joint, dat7$direct_SNP_effects_joint) expect_equal(dat7$beta_marg, dat7$direct_SNP_effects_marg) - expect_equal(dat7$beta_hat[1,1], 0.14509329) # this just tells me if gen_bhat_from_b has changed + expect_equal(dat7$beta_hat[1,1], 0.1460432, tolerance=1e-6) # this just tells me if gen_bhat_from_b has changed }) diff --git a/vignettes/effect_distribution.Rmd b/vignettes/effect_distribution.Rmd index 8a86d66..e6d94a6 100644 --- a/vignettes/effect_distribution.Rmd +++ b/vignettes/effect_distribution.Rmd @@ -323,7 +323,7 @@ hist(std_effects2[!std_effects2 == 0], breaks = 30, freq = F, main = "Standardiz ### Example Using Fixed Effects -Below is some code that combines some of the effect size specification options we have seent to simulate GWAS data for one LD block and two traits. The first trait will have two effect variants that have equal standardized effect size. The second trait has two effect variants with different effect sizes. One pair of variants co-localizes across traits. Simulations of this type could be used to test co-localization methods. Since we are looking at only one block, we will set the heritability of the block to be a reasonable amount of heritability provided by two variants, 6e-4 for one trait and 1e-3 for the other. +Below is some code that combines some of the effect size specification options we have seen to simulate GWAS data for one LD block and two traits. The first trait will have two effect variants that have equal standardized effect size. The second trait has two effect variants with different effect sizes. One pair of variants co-localizes across traits. Simulations of this type could be used to test co-localization methods. Since we are looking at only one block, we will set the heritability of the block to be a reasonable amount of heritability provided by two variants, 6e-4 for one trait and 1e-3 for the other. ```{r} data("ld_mat_list") diff --git a/vignettes/simulating_data.Rmd b/vignettes/simulating_data.Rmd index a3a96ca..39a23d2 100644 --- a/vignettes/simulating_data.Rmd +++ b/vignettes/simulating_data.Rmd @@ -54,14 +54,14 @@ The `sim_mv` function has five required arguments: There are additional optional arguments: -+ `R_E` and `R_obs`: Alternative ways to specify environmental correlation (see "Sample Overlap" section below for more details). -+ `R_LD`: A list of LD blocks (see "Simulating Data with LD"). -+ `af`: Vector of allele frequencies (required if `R_LD` is specified). If `R_LD` is not specified, `af` can be a scalar, vector of length `J` or a function (more details below). If `R_LD` is specified, `af` must be a vector with length corresponding to the size of the LD pattern (see "Simulating Data with LD") -+ `sporadic_pleiotropy`: Allow a single variant to have direct effects on multiple traits at random. Defaults to `TRUE`. -+ `pi_exact`: If `TRUE`, the number of direct effect SNPs for each trait will be exactly equal to `round(pi*J)`. Defaults to `FALSE`. -+ `h2_exact`: If `TRUE`, the heritability of each trait will be exactly `h2`. Defaults to `FALSE`. -+ `est_s`: If `TRUE`, return estimates of `se(beta_hat)`. Defaults to `FALSE` but we generally recommend setting `est_s` to `TRUE` if you will be making use of standard errors. -+ `snp_effect_function` and `snp_info` are parameters useful for specifying non-default distributions of effect sizes. This is not covered in this vignette but is covered in the Effect Size Distributions vignette. ++ `R_E` and `R_obs`: Alternative ways to specify the correlation of environmental trait components of each trait (see "Sample Overlap" section below for more details). ++ `R_LD`: A list of LD blocks (See "Simulating Data with LD"). ++ `af`: Optional vector of allele frequencies (required if `R_LD` is specified). ++ `sporadic_pleiotropy`: Allow a single variant to have direct effects on multiple traits at random. Defaults to TRUE. ++ `pi_exact`: If TRUE, the number of direct effect SNPs for each trait will be exactly equal to `round(pi*J)`. Defaults to FALSE. ++ `h2_exact`: If TRUE, the heritability of each trait will be exactly `h2`. Defaults to FALSE. ++ `est_s`: If TRUE, return estimates of se(beta_hat). Currently defaults to FALSE but this is probably generally a good option to use. ++ `return_dat`: A developer option, return some extra data that is useful for debugging and testing. ### Output @@ -102,46 +102,7 @@ Some other pieces of information useful in more complicated scenarios: + `snp_info`: A data frame of variant information including allele frequency and possibly other information (see the Effect Distribution vignette). + `geno_scale`: Equal to `allele` if effect sizes are per allele or `sd` if effect sizes are per genotype SD (i.e. standardized). -The order of the columns of all results corresponds -to the order of traits in `G`. - -## Simplest Usage - -The simplest thing to do with `sim_mv` is to generate summary statistics for $M$ traits with no causal relationship with no LD between variants. In the code below, we generate data for 3 traits and 100,000 variants. Since the sample size is specified as a scalar, all three GWAS have the same sample size but there are no overlapping samples. For some variety, we give each trait a different heritability and a different proportion of causal variants. - -```{r} -dat_simple <- sim_mv(G = 3, # using the shortcut for specifying unrelated traits. - # equivalent to G = matrix(0, nrow = 3, ncol = 3) - N = 50000, # sample size, same for all three traits - J = 100000, # number of variants - h2 = c(0.1, 0.25, 0.4), # heritability - pi = c(0.01, 0.005, 0.02), # proportion of causal variants - est_s = TRUE # generate standard error estimates. - ) -``` - - -The `sim_mv` function always assumes that traits have been scaled to have variance equal to 1, so effect sizes are interpretable as the expected change in the trait in units of SD per either alternate allele (if `geno_scale = allele`) or per genotype SD (if `geno_scale = sd`). In our case, `dat_simple$geno_scale` is equal to `sd` because no allele frequencies were provided. The realized genetic and environmental variance matrices are in `Sigma_G` and `Sigma_E`. - -```{r} -dat_simple$Sigma_G -dat_simple$Sigma_E -``` - - -The diagonal of `dat_simple$Sigma_G` is equal to the trait heritability (also stored in `dat_simple$h2`). We can see that these numbers are close to but not exactly equal to the values input to the `h2` parameter. This is because `h2` provides the expected heritability. If we want to force the realized heritability to be exactly equal to the input `h2`, we can use `h2_exact = TRUE`. The genetic covariance (the non-diagonal elements of `Sigma_G`) is slightly non-zero because the traits share a small number of causal variants by chance. If we want to prevent this, we can use `sporadic_pleiotropy=FALSE`. However, in some cases, it is not possible to satisfy `sporadic_pleiotropy = FALSE` and that option will generate an error. - - -The simulated summary effect estimates are in `dat_simple$beta_hat` and simulated standard error estimates are in `dat_simple$s_estimate`. In our case, these will both be 100,000 by 3 matrices. -```{r} -head(dat_simple$beta_hat) -head(dat_simple$s_estimate) -``` -In actual GWAS data, these two matrices are the only information we get to observe. Everything else stored in `dat_simple` is information that is unobservable in "real" data but useful for benchmarking analysis methods. -The effect estimates in `dat_simple$beta_hat` are always estimates of the true marginal effects in in `dat_simple$beta_marg`. Since there is no LD in this data, marginal and joint effects are the same, so you will find that `dat_simple$beta_marg` and `dat_simple$beta_joint` are identical. We can identify causal variants as variants with non-zero values of `beta_joint`. For example, `which(dat_simple$beta_joint[,1] != 0)` would give the indices of variants causal for trait 1. -The estimates in `dat_simple$s_estimate` are estimates of the standard error of `dat_simple$beta_hat`. The true standard errors are stored in `dat_simple$se_beta_hat`. -If we had left `est_s` at its default value of `FALSE`, `dat_simple` would not contain the `s_estimate` matrix. - +The order of the columns of all results corresponds to the order of variables in `G`. ## Specifying Causal Relationships Between Traits @@ -153,6 +114,7 @@ equal to 1, so `G[i,j]^2` is the proportion of trait $j$ variance explained by the direct effect of trait $i$. For example, the matrix + ```{r} G <- matrix(c(0, sqrt(0.25), 0, sqrt(0.15), 0, 0, 0, sqrt(0.1), @@ -212,7 +174,125 @@ sim_dat1$trait_corr ``` By default, `sim_mv` assumes that direct environmental components of each trait are independent, meaning that the DAG explains all of the correlation between traits. This is modifiable using the `R_E` and `R_obs` arguments, discussed a bit later in this vignette. -Relationships between traits are described by two matrices, `direct_trait_effects` which is equal to the input `G` matrix and `total_trait_effects` which gives the total effect of each trait on each other trait. Here we can notice that the direct effect of $Z$ on $W$ is -0.548 as specified but the total effect includes the effects mediated by $X$ and $Y$ as well, $-0.548 + 0.447\cdot 0.387 + 0.447\cdot 0.5 \cdot 0.316 = -0.304$. +By default, we allow variants to +have direct effects on multiple traits, a phenomenon we refer to as sporadic pleiotropy. +In this case, the majority of variants have direct effects on only one trait but +`r sum(rowSums(sim_dat1$direct_SNP_effects_joint != 0) > 1)` variants directly affect more than one +trait. +```{r} +A <- data.frame(sim_dat1$direct_SNP_effects_joint != 0) +names(A) <- paste0("Direct ", c("X", "Y", "Z", "W"), " effect") +group_by_all(A) %>% + summarize(n = n()) %>% + arrange(-n) +``` + +These features can be controlled using the `pi_exact`, `h2_exact`, and `sporadic_pleiotropy` options. +Using `pi_exact = TRUE` forces the number of direct effect variants to be exactly equal to `round(pi*J)` (in our case 1000 for each trait). +`h2_exact = TRUE` forces the realized heritability to be +(nearly) exactly equal to the input `h2` and `sporadic_pleiotropy = FALSE` prevents +sporadic pleiotropy. +If `sporadic_pleiotropy = TRUE` (the default value), `h2_exact` will result in +trait heritabilities very close, but not exactly equal to `h2`. +Note that some scenarios with either many traits or large values of `pi` +are inconsistent with `sporadic_pleiotropy = FALSE` because +there are not enough variants to exclude overlap between traits. In these cases +using `sporadic_pleiotropy = FALSE` will result in an error. + +Below, we demonstrate these three options. We can see that the diagonal of `Sigma_G` is now exactly equal to the input heritability, exactly 1000 variants have direct effects on each trait, and there are no variants that directly affect multiple traits. + +```{r} +sim_dat2 <- sim_mv(G = G, + J = 50000, + N = 60000, + h2 = c(0.3, 0.3, 0.5, 0.4), + pi = 1000/50000, + pi_exact = TRUE, + h2_exact = TRUE, + sporadic_pleiotropy = FALSE) + +sim_dat2$Sigma_G +A <- data.frame(sim_dat2$direct_SNP_effects_joint != 0) +names(A) <- paste0("Direct ", c("X", "Y", "Z", "W"), " effect") +group_by_all(A) %>% + summarize(n = n()) %>% + arrange(-n) +``` + + + + +### Generating $G$ from "XYZ" mode. + +The function `xyz_to_G` will generate a matrix, $G$, corresponding to a specific "XYZ" DAG form. +In the "XYZ" DAG, there is an exposure ($X$), an outcome ($Y$), and $M-2$ other variables, $Z_1, \dots, Z_{M-2}$. +The XYZ DAG format is an older input format used in early versions of this package. We expect that +most new users will prefer the default method of directly specifying $G$, +but have retained the XYZ format for earlier users and users that find it helpful. + +In XYZ format, we specify a (possibly 0) effect of $X$ on $Y$, given by the `gamma` argument. +Variables $Z_1, \dots, Z_{M-2}$ can have effects either on or from $X$ and on or from $Y$, +but there are no effects $Z_1, \dots, Z_{M-2}$ on each other. +Effects between each $Z_m$ and $X$ and $Y$ respectively are given in the `tau_xz` and `tau_yz` arguments. +The direction of these effects is given in the `dir_xz` and `dir_yz` arguments. All four of +these arguments should have length $M-2$. + +The direction parameters `dir_xz` and `dir_yz` are vectors of 1 or -1 with 1 indicating an effect on $X$ or $Y$ and -1 indicating an effect from $X$ or $Y$. +Effect size arguments `gamma`, `tau_xz`, and `tau_yz` are given as the signed proportion of variance explained. +So if `gamma = -0.3`, The direct effect of $X$ explains 30\% of the variance of $Y$ and the +effect of $X$ on $Y$ is negative. + + +For example, the code + +```{r} +myG <- xyz_to_G(tau_xz = c(0.1, -0.15, 0.2, 0.3), + tau_yz = c(0, 0.2, -0.25, 0.15), + dir_xz = c(1, 1, -1, -1), + dir_yz = c(1, 1, -1, 1), + gamma = 0.3) +``` + +generates the matrix corresponding to the graph below: + + +```{r, echo=FALSE, fig.align='center', fig.width = 5} + +myd <- melt(myG) %>% + filter(value !=0) %>% + rename(from = Var1, to = Var2) + +n <- create_node_df(n = 6, label = c("Y", "X", "Z1", "Z2", "Z3", "Z4"), + fontname = "Helvetica", + fontsize = 10, + width = 0.3, + fillcolor = "white", + fontcolor = "black", + color = "black", + x = c(2, 0, -0.5, 1, 1, 1), + y = c(0, 0, 1, 1, -0.5, -1)) +e <- create_edge_df(from = myd$from, to = myd$to, minlen = 1, color = "black", + label = round(d$value, digits = 3)) +g <- create_graph(nodes_df = n, edges_df = e) + +render_graph(g) +``` + + +The weights in the graph give the effect size. Note that this is the square root of the value provided in `tau_xz` and `tau_yz` which specifies the percent variance explained. For example, the effect of $Z_1$ on $X$ is $0.316 = \sqrt{0.1}$ and the effect of $Z_2$ on $X$ is $-0.387 = - \sqrt{0.15}$. The matrix created by `xyz_to_G` can be used in the `G` parameter of `sim_mv`. + +## A Closer Look at the Output + +We can now take a look at the output from running `sim_mv`. Summary statistics are contained in the `beta_hat`, `se_beta_hat`, and if `est_s = TRUE` was used, `s_estimate`. These all have dimension $J\times M$ where $M$ is the number of traits. + +```{r} +names(sim_dat1) +dim(sim_dat1$beta_hat) +head(sim_dat1$beta_hat) +head(sim_dat1$se_beta_hat) +``` + +The `direct_trait_effects` object is a matrix giving the input `G` while `total_trait_effects` gives the total effect of each trait on each other trait. ```{r} sim_dat1$direct_trait_effects sim_dat1$total_trait_effects