R/CredibleSetPrune.R

In statwangz/SuSiE: A simple new approach to variable selection in regression, with application to genetic fine-mapping

#' Prune the credible sets through correlation
#'
#' @param cs_list credible sets list
#' @param X genotype matrix
#' @param thr threshold
#' @param p_thr threshold
#'
#' @return
#' @export
CredibleSetPrune <- function(cs_list, X, thr = 0.5, p_thr = 50){
  L <- length(cs_list)
  cs_prune <- list()
  for (l in 1:L) {
    cs_l <- as.vector(cs_list[[l]])
    if(length(cs_l <= p_thr)){
      cor <- abs(cor(X[ , cs_l]))
    }else{
      cor <- abs(cor(X[ , sample(cs_l, p_thr, replace = F)]))
    }
    
    if(min(cor) >= thr){
      cs_prune <- c(cs_prune, list(cs_l))
    }
  }
  return(cs_prune)
}