Project: s41467-024-47280-x | Function: computeEnrichment_custom (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:** Custom function for computing chromatin accessibility peak enrichment analysis using base-pair level calculations instead of peak counts. Analyzes differential peaks between cell states by computing enrichment scores based on genomic intersection analysis.

**KEY TERMS:** {
  "positions": "annotation coordinates",
  "compare": "differential peaks",
  "background": "background peaks",
  "enrichment": "enrichment ratio"
}

**CONTEXT CODE:** 
### A FAIRE SUR SERVEURS LINUX avec source /home/amelie/miniconda2/etc/profile.d/conda.sh et conda activate r_env_4.1

library(dplyr)
library(tidyr)
library(ArchR)
library(pheatmap)

addArchRGenome("hg38") # load the genome for each R session
# addArchRThreads(threads = 16) # takes automatically half of the threads available

geco.load <- function (filename) # File to be loaded
{
  if (file.exists(filename)) 
    return(eval(parse(text = load(filename))))
  cat(paste("error - function geco.load : file ", filename, 
            " not found"))
  NULL
}


#####################
##### FUNCTIONS #####
#####################

computeEnrichment_custom <- function(positions = NULL, compare = NULL, background = NULL, r2, r3) {
    stop("Function implementation has been masked")
}

So each element of enrichList corresponds to a column of seMarker (each comparison). Then, when they do lapply(seq_len(ncol(enrichList[[1]])), function(x) { ... enrichList[[y]][names(positions), x, drop = FALSE] ... }), that implies that each computeEnrichment_custom output has columns. But what would those columns be?


peakAnnoEnrichment_custom <- function (seMarker = NULL, ArchRProj = NULL, positions = NULL,
          cutOff = "FDR <= 0.1 & Log2FC >= 0.5", background = "all",
          logFile = createLogFile("peakAnnoEnrichment"))
{
  if (metadata(seMarker)$Params$useMatrix != "PeakMatrix") {
    stop("Only markers identified from PeakMatrix can be used!")
  }
  
  # object for whole peak set
  r2 <- getPeakSet(ArchRProj)
  pr2 <- paste(seqnames(r2), start(r2), end(r2), sep = "_")
  mcols(r2) <- NULL
  # object for seMarker = peaks to study
  r3 <- GRanges(rowData(seMarker)$seqnames, IRanges(rowData(seMarker)$start,
                                                    rowData(seMarker)$end))
  pr3 <- paste(seqnames(r3), start(r3), end(r3), sep = "_")
  mcols(r3) <- NULL
  
  if (length(which(pr2 %ni% pr3)) != 0) {
    stop("Peaks from seMarker do not match peakSet in ArchRProj!")
  }
  assayNames <- names(SummarizedExperiment::assays(seMarker)) # colnames of seMarker
  for (an in assayNames) {
    eval(parse(text = paste0(an, " <- ", "SummarizedExperiment::assays(seMarker)[['",
                             an, "']]")))
  }
  passMat <- eval(parse(text = cutOff)) # restrict to peaks with the wanted thresholds
  passMat[is.na(passMat)] <- FALSE
  for (an in assayNames) {
    eval(parse(text = paste0("rm(", an, ")")))
  }
  background = seq_len(length(r2))
  enrichList <- lapply(seq_len(ncol(seMarker)), function(x) {
    idx <- which(passMat[, x])
    computeEnrichment_custom(positions = positions, compare = idx, background = background, r2=r2, r3=r3)
  }) %>% SimpleList # takes ~20 min
  print("test2")
  names(enrichList) <- colnames(seMarker)
  assays <- lapply(seq_len(ncol(enrichList[[1]])), function(x) {
    d <- lapply(seq_along(enrichList), function(y) {
      enrichList[[y]][names(positions), x, drop = FALSE]
    }) %>% Reduce("cbind", .)
    colnames(d) <- names(enrichList)
    d
  }) %>% SimpleList
  names(assays) <- names(enrichList[[1]])
  assays <- rev(assays)
  return(assays)
}

plot_motif_enrich <- function(df, labels){ggplot(df, aes(rank, enrichment, color = enrichment)) + 
    geom_point(size = 1) +
    ggrepel::geom_label_repel(
      max.overlaps=Inf,
      data = df[match(labels, df$TF), ], aes(x = rank, y = enrichment, label = TF), 
      size = 6,
      nudge_x = 2,
      color = "black"
    ) + theme_ArchR() + 
    ylab("Enrichment") + 
    xlab("Rank Sorted features Enriched") +
    scale_color_gradientn(colors = paletteContinuous(set = "comet"))+
    theme(axis.text=element_text(size=13), axis.title=element_text(size=15))}


######################
##### PARAMETERS #####
######################

archrdir = "/mnt/MD1200_5/Workdir_amelie/snRNAseq_ATACseq_multiome/2.Analyses/2.snATACseq/Final_analyses/All_samples_merged/"
datadir = "/mnt/MD1200_5/Workdir_amelie/snRNAseq_ATACseq_multiome/2.Analyses/2.snATACseq/Final_analyses/All_samples_merged/Differential_peaks/1.Tables"
resdir = file.path("/mnt/MD1200_5/Workdir_amelie/snRNAseq_ATACseq_multiome/2.Analyses/2.snATACseq/Final_analyses/All_samples_merged/Motif_TF")
cisbp_dir = "/mnt/MD1200_5/Workdir_amelie/snRNAseq_ATACseq_multiome/2.Analyses/2.snATACseq/0.Public_annotation/Cisbp_database/" # folder containing cisbp v2.00 results from MEME software

# choose one comparison to study 
comp = c("NT_vs_T", "H_vs_LP", "H_HLP_LP_vs_M")[2] 

# define thresholds for differential peaks study 
threshold_loose_logFC = log2(1.5)
threshold_loose_FDR = 0.01

threshold_medium_logFC = log2(2)
threshold_medium_FDR = 1e-3

threshold_strict_logFC = log2(3)
threshold_strict_FDR = 1e-12


###########################
##### 0. DATA LOADING #####
###########################

# Load ArchR project


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