Project: s41467-024-51075-5 | Function: fast_asset (r)

system: You are an expert R programmer implementing algorithms from scientific papers.
Complete the masked function based on the algorithm description.
Follow R best practices and maintain consistent code style.
Return **only** the complete R function code.

user: Complete this R function:

**DESCRIPTION:** Core implementation of fast ASSET (Association analysis based on SubSETs) method for multi-trait GWAS meta-analysis. Includes pre-screening, orthogonalization, and subset search for identifying pleiotropic effects.

**KEY TERMS:** {
  "beta.hat": "effect size estimates",
  "sigma.hat": "standard errors",
  "Neff": "effective sample sizes",
  "cor": "trait correlation matrix",
  "scr_pthr": "pre-screening p-value threshold"
}

**CONTEXT CODE:**         for (j in 1:length(traits_i_block)){
            scr = scr_transform_in_block(SNP, traits_i_block[[j]], beta.hat = betahat[traits_i_block[[j]]],
                                          sigma.hat = SE[traits_i_block[[j]]], n.eff = Neff[traits_i_block[[j]]],
                                          cor = cor[traits_i_block[[j]],traits_i_block[[j]]], p.bound = scr_pthr)
            betahat_orth = c(betahat_orth, scr$beta.scr)
            sigma_orth = c(sigma_orth, scr$sigma.scr)
        }
    }

    betahat = betahat[!(names(betahat)%in%unlist(traits_i_block))]
    SE = SE[!(names(SE)%in%unlist(traits_i_block))]

    # two-sided correction
    scr = (2*pnorm(abs(betahat/SE),lower.tail=FALSE))<scr_pthr
    betahat = betahat[scr]
    SE = SE[scr]
    pp1 = pmin(2*pnorm(abs(betahat/SE),lower.tail=FALSE)/scr_pthr, 0.9999999)
    betahat_orth = c(betahat_orth, SE*sign(betahat)*abs(qnorm(pp1/2,lower.tail=FALSE)))
    sigma_orth = c(sigma_orth, SE)

    traits_i=names(betahat_orth)

    return(list(betahat_orth = betahat_orth, sigma_orth = sigma_orth))
}

#' Fast ASSET using pre-screening
#' @description This function implements a fast version of ASSET for analysis of a large number of traits. It accelerates the computation by restricting subset search among the traits with suggestive level of associations. The traits are selected by a liberal p-value threshold. The input is GWAS summary statistics for one SNP. See details for more information.
#' @param snp A character string giving the SNP name to be analyzed. No default.
#' @param traits.lab A character vector giving the names/identifiers of the k studies/traits being analyzed. The order of this vector must match the columns of beta.hat and sigma.hat No default.
#' @param beta.hat A numeric vector of length k giving the coefficients obtained from the analysis of that SNP across the k studies/traits. No default.
#' @param sigma.hat A vector of same dimension as beta.hat, giving the corresponding standard errors. No default.
#' @param Neff A numeric vector of same dimension as beta.hat, giving the effective sample size of each study. For continuous traits, the effective sample size is the total sample size; for binary traits, the effective sample size is Ncase*Ncontrol/(Ncase+Ncontrol).
#' @param cor A matrix of dimension k by k storing the correlation of z-statistics under the null hypothesis. It can be estimated using LD score regression (https://github.com/bulik/ldsc). For example, element \code{(j,k)} is the LD score regression intercept between traits \code{j} and {k}. Diagonal elements are equal to 1. Set to identity matrix if different studies do not have overlapping samples.
#' @param block A list of character vectors. Each element is a vector of study/trait names that fall into the same correlation block based on \code{cor}. Studies from different blocks are treated as independent. Studies that are not in \code{block} are treated as independent from other studies.
#' @param scr_pthr P-value threshold for pre-screening. Only traits with p-value < scr_pthr are retained. Default to 0.05.
#' @param max_numtraits_per_side Maximum number of traits per side for subset search. Default to be 16. The program reports an error if \code{>max_numtraits_per_side} pass pre-screening and the adjusted z-statistics have the same sign. Such SNPs take significant computational time. Increasing this number allows the program to include some of those SNPs.
#'
#' @details The standard ASSET (\code{h.traits}) which searches through all subsets can be computationally intractable for analyzing a large number of traits. \code{fast_asset} reduces the computational burden by the following procedure: (1) De-correlate the z-statistics associated with different traits using the correlation matrix (\code{cor}); (2) select the set of traits using a liberal threshold (p<0.05 by default) of the de-correlated z-statistics; (3) adjust the de-correlated z-statistics for the pre-selection independently across different traits; (4) re-introduce the correlation using the matrix \code{cor} and supply the adjusted statistics to standard ASSET.
#'
#' @return A list of the same format as the output of \code{h.traits}.
#'
#' @references Guanghao Qi, Surya Chhetri, Elizaveta Naydanova, Debashree Ray, Diptavo Dutta, Alexis Battle, Samsiddhi Bhattacharjee and Nilanjan Chatterjee. "Genome-wide Multi-trait Analysis Across 116 Studies Identifies Complex Patterns of Pleiotropy and Unique Trait-Specific Loci". In preparation (2021).
#'
#' @examples
#' data("example_rs6678982", package="fastASSET")
#' block <- create_blocks(ldscintmat)
#' test <- fast_asset(snp=SNP, traits.lab=traits, beta.hat=betahat, sigma.hat=SE,
#' Neff=Neff, cor=ldscintmat, block=block, scr_pthr=0.05)
#' @import ASSET
#' @export
fast_asset <- function(snp, traits.lab, beta.hat, sigma.hat, Neff, cor, block,
                       scr_pthr=0.05, max_numtraits_per_side=16){
    stop("Function implementation has been masked")
}

#' Create blocks from correlation matrix
#' @description Partition the set of traits into blocks of correlated traits using hierarchical clustering.
#' @param cormat A named k by k correlation matrix of z-statistics with row and column names being the names of studies/traits.
#' @param cor_thr Threshold of correlation to divide the set of traits into blocks. Z-statistics with correlation less than \code{cor_thr} are treated as uncorrelated.
#' @return A list of character vectors. Each element is a vector of study/trait names that fall into the same correlation block based on \code{cormat}. Studies from different blocks are treated as independent. Studies that are not in the list are treated as independent from other studies.
#' @examples
#' data("example_rs6678982", package="fastASSET")
#' block <- create_blocks(ldscintmat)
#' @export
create_blocks <- function(cormat, cor_thr=0.2){
    # Hierarchical clustering
    corrdist <- as.dist(1-abs(cormat))
    hc <- hclust(corrdist)
    htree <- cutree(hc, h=1-cor_thr) # Criterion: corr>0.2
    block <- as.integer(names(table(htree))[table(htree)>=2])
    block <- lapply(block, function(x) names(htree)[htree==x])

    return(block)
}




Complete the function implementation replacing "stop("Not implemented")".