Project: s41467-024-44709-1 | Function: CredibleSetFunction (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:** Calculates credible sets for fine-mapping using Wakefield's approximate Bayes factors. Computes prior standard deviation from data quantiles, calculates Bayes factors for each variant, and determines posterior probabilities to identify the most likely causal variants.

**KEY TERMS:** {
  "abf.Wakefield": "Wakefield's approximate Bayes factor",
  "PostProb": "posterior probability",
  "SumProb": "cumulative sum of posterior probabilities",
  "prior": "prior standard deviation",
  "beta": "effect size",
  "se": "standard error"
}

**CONTEXT CODE:** #' # Introduction ####
#' ***
#' 
#' 
#' # Initialize ####
#' ***
#' Update server & set working directory
rm(list=ls())
time0 = Sys.time()

source("../SourceFile_aman.R")

setwd(projectpath_main)

#' # Preparations ####
#' ***
#' ##  ####
#' 
#' ## Load information about independent SNPs 
toDo = fread("../results/05_b_Cojo_Select_Results.txt")

#add flag for SNPs which have to use conditional statistics
toDo[, setting := paste0(phenotype, "_", region)]
toDo[, useCondStats := FALSE]
toDo[is.element(setting, toDo[duplicated(setting), setting]), useCondStats := TRUE]
toDo


#' ## Load data of phenotypes for SNPs which can be done with unconditional statistics
eGFR_all = fread("../data/CKDGen_ChrX_sumStat_eGFR_ALL.gz")
eGFR_all = eGFR_all[invalid_assoc == F, ]
eGFR_male = fread("../data/CKDGen_ChrX_sumStat_eGFR_MALE.gz")
eGFR_male = eGFR_male[invalid_assoc == F, ]
eGFR_female = fread("../data/CKDGen_ChrX_sumStat_eGFR_FEMALE.gz")
eGFR_female = eGFR_female[invalid_assoc == F, ]
UA_all = fread("../data/CKDGen_ChrX_sumStat_UA_ALL.gz")
UA_all = UA_all[invalid_assoc == F, ]
UA_male = fread("../data/CKDGen_ChrX_sumStat_UA_MALE.gz")
UA_male = UA_male[invalid_assoc == F, ]

#' ## Load loci information
loci = fread("../results/01_Locus_Definitions.txt")

#' # Definition of credible set function
#' ***
library(tidyverse)

#' @param data Data frame containing SNP genotypic information.
#' @param filenm Output file name.
#' @return Data frame with credible sets, posterior probabilities, etc.
CredibleSetFunction <- function(data, filenm) {
  stop("Function implementation has been masked")
}

#' # Prepare input data and calculate credible set (unconditional statistics) ####
#' ***
neededCol = c("Chr", "SNP", "bp", "refA", "freq", "beta", "beta_se", "p", "n")  
 
uncond = foreach(s = toDo[useCondStats == FALSE, setting]) %do% {
  #get variables needed for data preparation
  line = which(toDo[, setting] == s)  
  pheno = toDo[line, phenotype]
  myRegion = toDo[line, region]
  region.start = loci[region == myRegion, region_start]
  region.stop = loci[region == myRegion, region_end]
  
  locusData = get(pheno)
  locusData = locusData[chromosome == 23 & position >= region.start & position <= region.stop, ]
  setnames(locusData, c("chromosome", "rsID", "position", "effect_allele", "EAF", "beta", "SE", "P", "N"), neededCol)
  colsOut = setdiff(colnames(locusData), neededCol)
  locusData[, get("colsOut") := NULL]
  
  snp = toDo[line, rsID]
  result = CredibleSetFunction(locusData, paste0(s, "_", gsub(":", "_", snp)))
  
  report = list(phenotype = pheno, region = myRegion, SNP = snp, CredSet.95 = nrow(result[SumProb <= 0.95, ])+1, CredSet.99 = nrow(result[SumProb <= 0.99, ])+1, prior = unique(result[, prior]))
  report
}
uncond = rbindlist(uncond)


#' # Prepare input data and calculate credible set (conditional statistics) ####
#' ***
cond = foreach(s = toDo[useCondStats == TRUE, SNP]) %do% {
  #get variables needed for data preparation
  line = which(toDo[, SNP] == s)
  if (length(line) > 1) {
    pos = which(toDo[line, useCondStats] == T)
    line = line[pos]
  }
  pheno = toDo[line, phenotype]
  myRegion = toDo[line, region]
  setting = toDo[line, setting]
  
  #load data of conditional statistics
  inFile = paste0("../temp/05_c_Cojo_cond_results/CojoCond_",pheno, "_Region_", myRegion, "_",gsub(":", "_", s),".cma.cojo")
  locusData = fread(inFile)
  setnames(locusData, c("bC", "bC_se"), c("beta", "beta_se"))
  colsOut = setdiff(colnames(locusData), neededCol)
  locusData[, get("colsOut") := NULL]
  
  #change SNP ID from UKBB to match IDs of reference or pipeline objects
  dat = get(pheno)
  matched = match(locusData[, SNP], dat[, ID_UKBB])
  locusData[, SNP := dat[matched, rsID]]
  
  snp = toDo[line, rsID]
  result = CredibleSetFunction(locusData, paste0(setting, "_", gsub(":", "_", snp)))
  
  report = list(phenotype = pheno, region = myRegion, SNP = snp, CredSet.95 = nrow(result[SumProb <= 0.95, ])+1, CredSet.99 = nrow(result[SumProb <= 0.99, ])+1, prior = unique(result[, prior]))
  report
}
cond = rbindlist(cond)


#' Save results in file
overview = rbindlist(list(uncond, cond))
myOrder = order(overview[, phenotype], overview[, region])
overview = overview[myOrder, ]

#get summary of prior used
summary(overview[, prior])

write.table(overview, file = "../results/06_SNP_numbers_Credible_Sets.txt", col.names = T, row.names = F)

#' # Generate files for annotation with GWAS Pipeline ####
#' ***
colsNeeded = c("SNP", "CredSet", "PostProb", "SumProb")
phenotypes = unique(overview[, phenotype])

lists = foreach(p = phenotypes) %do% {
  myFiles = list.files(path = "../temp/06_Credible_Sets/", pattern = p)    
  
  dat = foreach(f = myFiles) %do% {
    myFile = fread(paste0("../temp/06_Credible_Sets/",f))
    pos = min(which(myFile[,SumProb]>0.99))
    myFile = myFile[c(1:pos), ]
    dummy = unlist(strsplit(f, split = "_"))
    if (grepl("eGFR_all_9", f) | grepl("UA_all_21", f) | grepl("UA_all_22", f)) { 
      myFile[, CredSet := paste0("Region", dummy[3], "_", dummy[4])] 
    } else {
      myFile[, CredSet := paste0("Region", dummy[3])]  
    }
    
    colsOut = setdiff(colnames(myFile), colsNeeded)
    myFile[, get("colsOut"):=NULL]
    setnames(myFile, "SNP", "snp")
    setcolorder(myFile, c("snp", "CredSet", "PostProb", "SumProb"))
    myFile
  }


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