add function z_to_beta_se

R/RcppExports.R

@@ -2,21 +2,22 @@
 # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
 
 dentist_iterative_impute <- function(LD_mat, nSample, zScore, pValueThreshold, propSVD, gcControl, nIter, gPvalueThreshold, ncpus, seed, correct_chen_et_al_bug, verbose = FALSE) {
- .Call("_pecotmr_dentist_iterative_impute", PACKAGE = "pecotmr", LD_mat, nSample, zScore, pValueThreshold, propSVD, gcControl, nIter, gPvalueThreshold, ncpus, seed, correct_chen_et_al_bug, verbose)
+  .Call('_pecotmr_dentist_iterative_impute', PACKAGE = 'pecotmr', LD_mat, nSample, zScore, pValueThreshold, propSVD, gcControl, nIter, gPvalueThreshold, ncpus, seed, correct_chen_et_al_bug, verbose)
 }
 
 rcpp_mr_ash_rss <- function(bhat, shat, z, R, var_y, n, sigma2_e, s0, w0, mu1_init, tol = 1e-8, max_iter = 1e5L, update_w0 = TRUE, update_sigma = TRUE, compute_ELBO = TRUE, standardize = FALSE, ncpus = 1L) {
- .Call("_pecotmr_rcpp_mr_ash_rss", PACKAGE = "pecotmr", bhat, shat, z, R, var_y, n, sigma2_e, s0, w0, mu1_init, tol, max_iter, update_w0, update_sigma, compute_ELBO, standardize, ncpus)
+  .Call('_pecotmr_rcpp_mr_ash_rss', PACKAGE = 'pecotmr', bhat, shat, z, R, var_y, n, sigma2_e, s0, w0, mu1_init, tol, max_iter, update_w0, update_sigma, compute_ELBO, standardize, ncpus)
 }
 
 prs_cs_rcpp <- function(a, b, phi, bhat, maf, n, ld_blk, n_iter, n_burnin, thin, verbose, seed) {
- .Call("_pecotmr_prs_cs_rcpp", PACKAGE = "pecotmr", a, b, phi, bhat, maf, n, ld_blk, n_iter, n_burnin, thin, verbose, seed)
+  .Call('_pecotmr_prs_cs_rcpp', PACKAGE = 'pecotmr', a, b, phi, bhat, maf, n, ld_blk, n_iter, n_burnin, thin, verbose, seed)
 }
 
 qtl_enrichment_rcpp <- function(r_gwas_pip, r_qtl_susie_fit, pi_gwas = 0, pi_qtl = 0, ImpN = 25L, shrinkage_lambda = 1.0, num_threads = 1L) {
- .Call("_pecotmr_qtl_enrichment_rcpp", PACKAGE = "pecotmr", r_gwas_pip, r_qtl_susie_fit, pi_gwas, pi_qtl, ImpN, shrinkage_lambda, num_threads)
+  .Call('_pecotmr_qtl_enrichment_rcpp', PACKAGE = 'pecotmr', r_gwas_pip, r_qtl_susie_fit, pi_gwas, pi_qtl, ImpN, shrinkage_lambda, num_threads)
 }
 
 sdpr_rcpp <- function(bhat, LD, n, per_variant_sample_size = NULL, array = NULL, a = 0.1, c = 1.0, M = 1000L, a0k = 0.5, b0k = 0.5, iter = 1000L, burn = 200L, thin = 5L, n_threads = 1L, opt_llk = 1L, verbose = TRUE) {
- .Call("_pecotmr_sdpr_rcpp", PACKAGE = "pecotmr", bhat, LD, n, per_variant_sample_size, array, a, c, M, a0k, b0k, iter, burn, thin, n_threads, opt_llk, verbose)
+  .Call('_pecotmr_sdpr_rcpp', PACKAGE = 'pecotmr', bhat, LD, n, per_variant_sample_size, array, a, c, M, a0k, b0k, iter, burn, thin, n_threads, opt_llk, verbose)
 }
+

R/misc.R

@@ -519,3 +519,53 @@ find_duplicate_variants <- function(z, LD, rThreshold) {
 
  return(list(filteredZ = filteredZ, filteredLD = filteredLD, dupBearer = dupBearer, corABS = corABS, sign = sign, minValue = minValue))
 }
+
+#' Convert Z-scores to Beta and Standard Error
+#'
+#' This function estimates the effect sizes (beta) and standard errors (SE) from
+#' given z-scores, minor allele frequencies (MAF), and a sample size (n) in genetic studies.
+#' It supports vector inputs for z-scores and MAFs to process multiple variants simultaneously.
+#'
+#' @param z Numeric vector. The z-scores of the genetic variants.
+#' @param maf Numeric vector. The minor allele frequencies of the genetic variants (0 < maf <= 0.5).
+#' @param n Integer. The sample size of the study (assumed to be the same for all variants).
+#'
+#' @return A data frame containing three columns:
+#' \describe{
+#' \item{beta}{The estimated effect sizes.}
+#' \item{se}{The estimated standard errors.}
+#' \item{maf}{The input minor allele frequencies (possibly adjusted if > 0.5).}
+#' }
+#'
+#' @details
+#' The function uses the following formulas to estimate beta and SE:
+#' Beta = z / sqrt(2p(1-p)(n + z^2))
+#' SE = 1 / sqrt(2p(1-p)(n + z^2))
+#' Where p is the minor allele frequency.
+#'
+#' @examples
+#' z <- c(2.5, -1.8, 3.2, 0.7)
+#' maf <- c(0.3, 0.1, 0.4, 0.05)
+#' n <- 10000
+#' result <- z_to_beta_se(z, maf, n)
+#' print(result)
+#' test_data_with_results <- cbind(test_data, results)
+#' print(test_data_with_results)
+#' 
+#' @note
+#' This function assumes that the input z-scores are normally distributed and
+#' that the genetic model is additive. It may not be accurate for rare variants
+#' or in cases of imperfect imputation. The function automatically adjusts MAF > 0.5
+#' to ensure it's always working with the minor allele.
+
+z_to_beta_se <- function(z, maf, n) {
+ if (length(z) != length(maf)) {
+ stop("z and maf must be vectors of the same length")
+ }
+ # Ensure MAF is the minor allele frequency
+ p <- pmin(maf, 1 - maf)
+ denominator <- sqrt(2 * p * (1 - p) * (n + z^2))
+ beta <- z / denominator
+ se <- 1 / denominator
+ return(data.frame(beta = beta, se = se, maf = p))
+}