# given a list of DNA sequences, scramble the entire sequence
.scrambleSeqs <- function(seqs) {
    scrambled <- lapply(
        seqs,
        function(x) stringi::stri_rand_shuffle(x)
    ) |> unlist()
    return(scrambled)
}


# perform a binomial test on sem scores versus a scores from a background for a
# single sem
.binomSEMEnrich <- function(xs, bg, semName) {
    xs_sem <- xs[xs$SEM == semName, ]
    bg_sem <- bg[bg$SEM == semName, ]

    successes <- sum(xs_sem$scoreNorm > 0)
    sample_size <- nrow(xs_sem)
    prob_success <- (sum(bg_sem$scoreNorm > 0) + 1) / nrow(bg_sem)

    if (prob_success > 1) {
        prob_success <- 1
    }

    binom_test_res <- stats::binom.test(
        x = successes,
        n = sample_size,
        p = prob_success,
        alternative = "greater"
    )

    n_bound_bg <- sum(bg$scoreNorm[bg$SEM == semName] > 0)
    result <- data.table::data.table(
        SEM = semName,
        pvalue = binom_test_res$p.value,
        n_bound = successes,
        n_bound_bg = n_bound_bg
    )
    return(result)
}


# define the background set if not provided
.defineBackground <- function(x, sem, background, seqs, nFlank, 
                              genome, rc) {
    if (is.null(background)) {
        rlang::inform(paste0(
            "Building background set (this may take several ",
            "minutes) ..."
        ))

        if (is(x, "SEMScores")) {
            seqs <- getRanges(x)$sequence
        }

        scramb <- .scrambleSeqs(seqs)
        bg <- scoreBinding(
            x = scramb, sem = sem,
            genome = genome, rc = rc
        )
    } else {
        bg <- scoreBinding(
            x = background, sem = sem,
            genome = genome, rc = rc
        ) |>
            scores()
    }
    return(bg)
}


#' Calculates binding enrichment for motif(s)
#'
#' Perform a binomial test to determine if SNP Effect Matrices are bound more
#' often than expected.
#'
#' @param x The scoring table produced by `scoreBinding`
#' @param sem A `SNPEffectMatrix` or `SNPEffectMatrixCollection` object
#' @param background A `GRanges` object or a list of DNA sequences to use as a
#' background set for the binomial test. The length of each sequence must match
#' the length of sequences in `x`. By default, will scramble the provided
#' sequences.
#' @param seqs The sequences scored in `scoreBinding`
#' @param nFlank Number of flanking nucleotides added to the sequences. Defaults
#' to the length of the longest motif. If no flanks were added (ie, sequences
#' were scored rather than a `GRanges`), use `nFlank = 0`.
#' @param genome A `BSGenome` object. Requried if background isn't specified.
#'
#' @return a `list` of matrices
#'
#' @examples
#'
#' # load SEMs
#'
#' # note that this is a small example for demonstration purposes
#' # in actual enrichment analyses sets of 100+ ranges are recommended
#'
#' # create a GRanges object
#' gr <- GenomicRanges::GRanges(
#'     seqnames = "chr12",
#'     ranges = 94136009
#' )
#'
#' # calculate binding propensity
#' sb <- scoreBinding(gr, SEMC, BSgenome.Hsapiens.UCSC.hg19::Hsapiens)
#'
#' enrichSEMs(sb, SEMC)
#'
#' @export
enrichSEMs <- function(x, sem,
                       background = NULL,
                       seqs = NULL,
                       nFlank = 0,
                       genome = NULL) {
    sem_names <- getSEMs(sem) |> names()

    if (is(x, "data.table") &
        all(c(
            "seqId", "SEM", "score",
            "scoreNorm", "index", "seq"
        ) %in% colnames(x))) {
        x_scores <- x
    } else if (is(x, "SEMScores")) {
        x_scores <- scores(x)
    } else {
        rlang::abort(paste0(
            "x must be the score table resulting from ",
            "scoreBinding or a SEMScores object"
        ))
    }
    rc <- ifelse(any(x_scores[, "rc"] == "rev"), TRUE, FALSE)

    bg <- .defineBackground(
        x = x,
        sem = sem,
        background = background,
        seqs = seqs,
        nFlank = nFlank,
        genome = genome,
        rc = rc
    )

    result <- lapply(
        seq_along(sem_names),
        function(i) {
            .binomSEMEnrich(
                xs = x_scores,
                bg = bg,
                semName = sem_names[i]
            )
        }
    ) |>
        data.table::rbindlist()

    result$padj <- stats::p.adjust(result$pvalue, method = "BH")
    return(result[, c("SEM", "pvalue", "padj", "n_bound", "n_bound_bg")])
}
