#' spatialPerCellQC
#' @name spatialPerCellQC
#' @rdname spatialPerCellQC
#' @description
#' Computes quality‐control metrics for each cell and adds them to `colData`.
#'
#' @param spe A `SpatialExperiment` object containing spatial omics data.
#' @param micronConvFact Numeric factor to convert pixels to microns. Default
#' is 0.12.
#' @param rmZeros logical for removing zero total counts (protein intensities) 
#' cells (default is TRUE).
#' @param negProbList Character vector of patterns to identify negative probes.
#' Defaults include:
#'   Nanostring CosMx: `"NegPrb"`, `"Negative"`, `"SystemControl"`
#'   Xenium: `"NegControlProbe"`, `"NegControlCodeword"`, `"UnassignedCodeword"`
#'   MERFISH: `"Blank"`
#' @param use_altexps logical for `use_altexps` in `scuttle` package.
#' If TRUE uses the altexps for computing some metrics on it.
#' Useful for interoperability with `SpatialExperimentIO`.
#' (See \link[scuttle]{addPerCellQC} for additional details).
#'
#' @return A `SpatialExperiment` object with added QC metrics in `colData`.
#'
#' @details
#' The function computes and appends per‑cell QC metrics to `colData(spe)` and
#' may subset the returned SpatialExperiment.
#'
#' Key behaviours and expectations:
#' - Feature detection: negative‑probe patterns supplied in `negProbList` are
#' passed to `scater::addPerCellQC()` (via `use_altexps` when requested). 
#' `addPerCellQC()` must be able to find matching control feature names 
#' (`rownames` of spe) and will create `subsets_*_sum` and `subsets_*_detected` 
#' columns used below for each of control feature types.
#' 
#' The function appends `sum`, `detected` and `total` to the SPE colData by
#' calling internally `addPerCellQC()`; these are used to compute `control_sum`, 
#' `control_detected`, `target_sum` and `target_detected.`
#' 
#' - Control metrics: `control_sum` and `control_detected` are computed by
#' summing matching `subsets_*` columns; `target_*` metrics are computed as
#' sum(detected) - control_sum(_detected).
#' 
#' - Ratios and logs: `ctrl_total_ratio` (`control_sum`/`sum`) and its stabilized
#' log2-transformed `log2Ctrl_total_ratio` are added.
#' 
#' - Coordinate and area handling:
#' - For CosMx technologies (Nanostring_CosMx and Nanostring_CosMx_Protein)
#' spatial coordinates are converted from pixels to microns using
#' `micronConvFact` and appended to `colData` (column names have px -> um).
#' 
#' - For CosMx, `Area_um` is derived from an existing Area column scaled by
#' micronConvFact^2 and `.computeBorderDistanceCosMx()` is invoked to
#' compute `dist_border`.
#' 
#' - For Nanostring_CosMx_Protein, a legacy `Area.um2` column (if present)
#' is renamed to `Area_um` to standardize naming.
#' 
#' - For Xenium (10X_Xenium), if `Area_um` is missing the function will
#' attempt to use `cell_area` as a fallback and issue a warning.
#' 
#' - Aspect ratio: if `AspectRatio` exists it is logged (`log2AspectRatio`); if
#' missing a warning is emitted.
#' 
#' - Signal density: `SignalDensity` is computed as `sum` / `Area_um` for most
#' technologies; for Nanostring_CosMx_Protein it coincides with `total`. A
#' log2-transformed `log2SignalDensity` is also added.
#' 
#' - Zero‑count (protein intensity) removal: when `rmZeros = TRUE` cells with 
#' `sum == 0` are removed from the returned SpatialExperiment (message printed).
#' 
#' - Side effects: the function modifies `colData(spe)` (adds multiple new
#' columns). It may add spatial coordinates into `colData` if missing, and may
#' subset the SPE to remove zero‑count cells. It issues warnings when expected
#' inputs (e.g. area, aspect ratio, polygon‑derived fields) are missing or
#' when fallbacks are used.
#'
#' Use this information to ensure the input SpatialExperiment contains the
#' necessary assays and fields (feature names, `sum`/`detected`/`total`,
#' `Area`/`cell_area`, log2AspectRatio, dist_border when available) so 
#' metrics are computed and assigned correctly.
#'
#' @importFrom SummarizedExperiment colData
#' @importFrom scater addPerCellQC
#' @importFrom S4Vectors cbind.DataFrame
#' @export
#' @examples
#' example(readCosmxSPE)
#' spe <- spatialPerCellQC(spe)
spatialPerCellQC <- function(spe, micronConvFact=0.12, rmZeros=TRUE,
    negProbList=c("NegPrb", "Negative", "SystemControl", "Ms IgG1", "Rb IgG",
    "BLANK_", "NegControlProbe", "NegControlCodeword", "UnassignedCodeword",
    "Blank"),
    use_altexps=NULL) {
    stopifnot(is(object=spe, "SpatialExperiment"))
    idxlist <- lapply(negProbList, function(ng) {
        grep(paste0("^", ng), rownames(spe))
    })
    names(idxlist) <- negProbList
    idxlist <- idxlist[which(lengths(idxlist)!=0)]
    spe <- addPerCellQC(spe, subsets=idxlist, use_altexps=use_altexps)
    idx <- grep("^subsets_.*_sum$", colnames(colData(spe)))
    npc <- npd <- 0
    if ( length(idx) !=0 ) {
        npc <- rowSums(as.matrix(colData(spe)[ , idx, drop=FALSE]))
        # TODO: not robust at all! the +1 is not a really good choice
        npd <- rowSums(as.matrix(colData(spe)[ , idx+1, drop=FALSE]))
    }
    spe$control_sum <- npc
    spe$control_detected <- npd
    spe$target_sum <- spe$sum - npc
    spe$target_detected <- spe$detected - npd
    if(!all(spatialCoordsNames(spe) %in% names(colData(spe)))) {
        # TODO: CHANGE SPE constructor WITH COORDINATES IN COLDATA
        colData(spe) <- cbind.DataFrame(colData(spe), spatialCoords(spe))
    }

    spe$ctrl_total_ratio <- spe$control_sum/spe$total
    spe$ctrl_total_ratio[which(is.na(spe$ctrl_total_ratio))] <- 0
    # using eps avoids NaNs and 0 in further computations
    eps <- 0.0001
    spe$log2Ctrl_total_ratio <- log2(spe$ctrl_total_ratio+eps)
    if(metadata(spe)$technology == "Nanostring_CosMx_Protein") {
        # Only for proteins will be included in QScore
        idx <- which(names(colData(spe)) == "Area.um2")
        if(length(idx)!=0) { names(colData(spe))[idx] <- "Area_um" }
    }

    if(any(metadata(spe)$technology %in%
            c("Nanostring_CosMx", "Nanostring_CosMx_Protein"))) {
        spnc <- spatialCoords(spe) * micronConvFact
        colnames(spnc) <- gsub("px", "um", spatialCoordsNames(spe))
        colData(spe) <- cbind.DataFrame(colData(spe), spnc)
        spe$Area_um <- spe$Area * (micronConvFact^2)
        spe <- .computeBorderDistanceCosMx(spe)
    }

    if (metadata(spe)$technology == "10X_Xenium") {
        if(!"Area_um" %in% colnames(colData(spe))) {
            warning("Missing Area_um in colData for Xenium data.\n",
                "Computing from cell_area column.")
            spe$Area_um <- spe$cell_area # standardized across other techs
        }
    }
    if ("AspectRatio" %in% colnames(colData(spe))) {
        spe$log2AspectRatio <- log2(spe$AspectRatio) # not cosmx
    } else { warning("Missing aspect ratio in colData") }

    spe$SignalDensity <- spe$sum/spe$Area_um

    if (metadata(spe)$technology == "Nanostring_CosMx_Protein") {
        spe$SignalDensity <- spe$total
    }

    spe$log2SignalDensity <- log2(spe$SignalDensity)
    if (rmZeros) {
        if (sum(spe$sum==0) > 0) {
            message("Removing ", dim(spe[,spe$sum==0])[2],
                    " cells with 0 counts!")
            spe <- spe[,!spe$sum==0]
        }
    }
    return(spe)
}

#' .computeBorderDistanceCosMx
#' @name .computeBorderDistanceCosMx
#' @rdname dot-computeBorderDistanceCosMx
#' @description
#' Calculates the minimum distance of each cell to the Field‐Of‐View (FOV) 
#' border and adds it to `colData`.
#'
#' @param spe A `SpatialExperiment` object with CosMx data.
#' @param xwindim Width of FOV along x axis (default from `metadata(spe)$fov_dim`).
#' @param ywindim Height of FOV along y axis (default from `metadata(spe)$fov_dim`).
#'
#' @return A `SpatialExperiment` object with `dist_border` column in
#' `colData`.
#'
#' @importFrom dplyr left_join
#' @importFrom SummarizedExperiment colData
#' @importFrom S4Vectors metadata
#' @keywords internal
.computeBorderDistanceCosMx <- function(spe,
                                    xwindim=metadata(spe)$fov_dim[["xdim"]],
                                    ywindim=metadata(spe)$fov_dim[["ydim"]]) {
    stopifnot(is(spe, "SpatialExperiment"))
    cd <- colData(spe)
    cdf <- left_join(as.data.frame(cd), metadata(spe)$fov_positions, by="fov")
    spcn <- spatialCoordsNames(spe)
    fovpn <- colnames(metadata(spe)$fov_positions)[colnames(
        metadata(spe)$fov_positions) %in% c("x_global_px", "y_global_px")]
    cd$dist_border_x <- pmin(cdf[,spcn[1]] - cdf[,fovpn[1]],
                            (cdf[,fovpn[1]] + xwindim) - cdf[,spcn[1]])
    cd$dist_border_y <- pmin(cdf[,spcn[2]] - cdf[,fovpn[2]],
                            (cdf[,fovpn[2]] + ywindim) - cdf[,spcn[2]])
    cd$dist_border <- pmin(cd$dist_border_x, cd$dist_border_y)
    colData(spe) <- cd
    return(spe)
}

#' computeSpatialOutlier
#' @name computeSpatialOutlier
#' @rdname computeSpatialOutlier
#' @description
#' Computes outliers for quantitative cell metadata based on a statistical test:
#' medcouple (`mc` method argument) or the Median Absolute Deviation (MAD, `scuttle` 
#' method argument), when the metric distribution is respectively asymmetric or symmetric.
#'
#' @details
#' The medcouple method is a measure for the skeweness of univariate
#' distribution as described in Hubert M. et al. (2008).
#' In particular, the computed medcouple value must be in a range between -0.6
#' and 0.6 to compute adjusted boxplots and perform the outlier detection.
#' For MAD method we just wrap the isOutlier function in the scuttle package. 
#' Please see McCarthy DJ et al (2017) for further details.
#'
#' @param spe a SpatialExperiment object with quantitative cell metrics in the `colData`.
#' @param computeBy character indicating a `colData` column name to compute the outliers on.
#' @param method one of `mc`, `scuttle`, `both`.
#' Use `mc` for medcouple, `scuttle` for MAD as computed in `scuttle`, `both` 
#' for computing both of them.
#' @param mcDoScale logical indicating if the metric values should be scaled 
#' to compute medcouple (default is FALSE, as suggested by the original medcouple 
#' authors). See \link[robustbase]{mc} for further readings.
#' @param scuttleType One of `"both"`, `"lower"`, `"higher"` for scuttle method.
#'
#' @return a SpatialExperiment object with additional column(s) (named as
#' the column name indicated in `computeBy` followed by the outlier_sc/mc).
#' Resulting columns are `outlier.filter` logical class objects, allowing to store 
#' the thresholds as attributes of the columns.
#' Use attr(,"thresholds") to retrieve them.
#'
#' @export
#' @importFrom robustbase mc adjbox
#' @importFrom e1071 skewness
#' @importFrom scuttle isOutlier outlier.filter
#'
#' @examples
#' example(spatialPerCellQC)
#' spe <- computeSpatialOutlier(spe, computeBy="log2SignalDensity", method="both")
#' table(spe$log2SignalDensity_outlier_mc)
#' table(spe$log2SignalDensity_outlier_sc)
computeSpatialOutlier <- function(spe, computeBy=NULL,
    method=c("mc", "scuttle", "both"), mcDoScale=FALSE,
    scuttleType=c("both", "lower", "higher")) {
    stopifnot(all(is(spe, "SpatialExperiment"), !is.null(computeBy)))
    stopifnot(computeBy %in% names(colData(spe)))
    options(mc_doScale_quiet=TRUE)
    method <- match.arg(method)
    scuttleType <- match.arg(scuttleType)
    cd <- colData(spe)
    cdcol <- cd[[computeBy]]
    mcfl <- scuttlefl <- FALSE
    switch(method, both={ mcfl <- scuttlefl <- TRUE },
            mc={ mcfl <- TRUE }, scuttle={ scuttlefl <- TRUE },
            {stop("Method is not one of allowed methods")} )
    if (mcfl) {
        skw <- e1071::skewness(cdcol, na.rm = TRUE) # NAs arise problems
        if (skw >- 1 & skw < 1) warning("Distribution is symmetric: ",
                "mc is for asymmetric distributions. Use scuttle instead.")
        mcval <- robustbase::mc(cdcol, doScale=mcDoScale, na.rm=TRUE)
        if ( any( (mcval <= -0.6), (mcval >= 0.6) ) )
            stop("mc is: ",round(mcval, digits=4),"outliers reqs not satisfied")
        names(cdcol) <- colnames(spe)
        outl <- robustbase::adjbox(cdcol, plot=FALSE)
        outsmc <- rep("NO", dim(cd)[1])
        outsmc[rownames(cd) %in% names(outl$out)] <-
            ifelse(outl$out <= outl$fence[1], "LOW", "HIGH")
        outlier_mc <- scuttle::outlier.filter(outsmc) #using scuttle class
        thrs <- as.numeric(outl$fence)
        names(thrs) <- c("lower", "higher")
        attr(outlier_mc, "thresholds") <- thrs
        cd$outlier_mc <- outlier_mc
        names(cd)[names(cd) =="outlier_mc"] <- paste0(computeBy, "_outlier_mc")
        # TODO: compute distributions in the adjusted boxplots to store in cd
    }
    if (scuttlefl) {
        outssc <- scuttle::isOutlier(cdcol, type=scuttleType)
        sctri <- rep("NO", dim(cd)[1])
        sctri <- ifelse(outssc == TRUE & cdcol <= attr(outssc, "thresholds")[1],
                        "LOW", sctri)
        outlier_sc <- ifelse(outssc == TRUE &
                            cdcol >= attr(outssc, "thresholds")[2],
                            "HIGH", sctri)
        outlier_sc <- scuttle::outlier.filter(outlier_sc)
        attr(outlier_sc, "thresholds") <- attr(outssc, "thresholds")
        cd$outlier_sc <- outlier_sc
        names(cd)[names(cd)=="outlier_sc"] <- paste0(computeBy, "_outlier_sc")
    }
    colData(spe) <- cd
    return(spe)
}

#' computeThresholdFlags
#' @name computeThresholdFlags
#' @rdname computeThresholdFlags
#' @description
#' Computes flagged cells using fixed thresholds for SpatialExperiment.
#'
#' This function calculates flagged cells only for total counts (protein intensities) 
#' and control-to-total probe counts ratio using fixed thresholds for a `SpatialExperiment`
#' object.
#'
#' @param spe A `SpatialExperiment` object with spatial omics data.
#' @param totalThreshold A numeric value for the threshold of total counts to
#' identify cells with low counts. Default is `0`.
#' @param ctrlTotRatioThreshold A numeric value for the threshold of
#' control-to-total ratio to flag cells over a certain threshold. Default is
#' `0.1`.
#'
#' @return The `SpatialExperiment` object with added flagged cells as TRUE/FALSE
#'  in `colData`.
#'
#' @details The function flags cells basing on zero counts and control-to-total
#' ratio to identify junk cells.
#' It also combines these two flags into a single flag metric named `threshold_flags`.
#'
#' @importFrom SummarizedExperiment colData
#' @export
#' @examples
#' example(readCosmxSPE)
#' spe <- spatialPerCellQC(spe)
#' spe <- computeThresholdFlags(spe)
#' table(spe$threshold_flags)
computeThresholdFlags <- function(spe, totalThreshold=0,
                            ctrlTotRatioThreshold=0.1)
{
    stopifnot(is(spe, "SpatialExperiment"))
    stopifnot("total" %in% names(colData(spe)))
    stopifnot("ctrl_total_ratio" %in% names(colData(spe)))

    spe$is_zero_counts <- ifelse(spe$total == totalThreshold, TRUE, FALSE)
    #flagging cells with probe counts on total counts ratio > 0.1
    spe$is_ctrl_tot_outlier <- ifelse(spe$ctrl_total_ratio >
                                        ctrlTotRatioThreshold, TRUE, FALSE)

    spe$threshold_flags <- (spe$is_ctrl_tot_outlier &
                                spe$is_zero_counts)
    return(spe)
}


#' computeLambda
#' @description
#' Computes optimal ridge regularization parameter \eqn{\lambda} via
#' k-fold cross-validation.
#'
#' \code{computeLambda} performs ridge (L2) logistic regression with
#' k-fold cross-validation to identify the optimal regularization parameter
#' \eqn{\lambda} for Quality Score (QS) model training.
#'
#' @param trainDF  `data.frame`
#'   A data frame for QS model training that must include:
#'     Predictor columns: All columns referenced in the formula returned by `getModelFormula()`.
#'     `QScore_train` or historical `qcscore_train`, containing the binary
#'     (0/1) response to be modeled.
#' @param modelFormula A one-sided formula or character string describing the
#'   supported predictor terms.
#'
#' @return
#' `numeric`
#'   The value of \eqn{\lambda} (i.e., `lambda.min`) from
#'   `cv.glmnet` that minimizes the cross-validation error.
#'
#' @details
#' Complete cases for the formula variables and response are retained. The
#' function constructs a model matrix and passes it to an internal
#' matrix-based implementation that runs ridge logistic-regression
#' cross-validation using `cv.glmnet` with `alpha = 0`.
#'
#' @examples
#' example(computeTrainDF)
#' modform <- getModelFormula(names(metadata(spe)$formula_variables))
#' best_lambda <- computeLambda(df_train, modform)
#' print(best_lambda)
#'
#'
#' @export

computeLambda <- function(trainDF, modelFormula) {
    stopifnot(is.data.frame(trainDF))
    model_formula <- stats::as.formula(modelFormula)
    response <- .getQScoreResponse(trainDF)
    train_ok <- .filterCompleteModelCases(
        df=trainDF,
        modelFormula=model_formula,
        response=response,
        context="training cells for lambda selection"
    )
    train_df <- trainDF[train_ok, , drop=FALSE]
    response <- response[train_ok]
    model_matrix <- stats::model.matrix(
        model_formula,
        data=train_df
    )
    .computeLambda(modelMatrix=model_matrix, response=response)
}

.computeLambda <- function(modelMatrix, response) {
    ridge_cv <- glmnet::cv.glmnet(
        modelMatrix,
        response,
        family="binomial",
        alpha=0,
        lambda=NULL
    )
    ridge_cv$lambda.min
}

#' computeQScore
#' @name computeQScore
#' @rdname computeQScore
#' @description
#' Computes Quality Score (QS) and automatically define weights of the QS model
#' terms through glm training. This function computes QS with a formula
#' defined on the metrics "log2SignalDensity", "Area_um",
#' "log2AspectRatio", "log2Ctrl_total_ratio", as computed from
#' the `spatialPerCellQC` function.
#' It automatically computes the number of outliers for each available
#' metric, which are needed for the glm training.
#' See Details for further information.
#'
#' @details For all the technologies, the QS formula can contain
#' only the following terms at most:
#'
#' Quality Score ~ signal density - size - border effect - background signal 
#'
#' Where signal density is the total counts/protein intensities-to-size ratio, 
#' border effect is represented by the aspect ratio (i.e. width/height of the cell) 
#' and is considered only for cells with a distance from the FOV border less than 
#' 50 px and only for CosMx datasets. Background signal is represented by the ratio 
#' of control probe counts to total counts (protein intensities) and cell size is 
#' the area for CosMx and Xenium, while it is the volume for Merfish.
#' For each couple of variables interaction terms are computed.
#'
#' Note that the function is responsible for automatically including/excluding
#' metrics in the formula based on their availability in the `colData` of the
#' `SpatialExperiment` object.
#'
#' For the default formula, inclusion of metrics also depends on the number of
#' available outliers. If the number of outliers for a metric is less than
#' 0.1\% of the dataset, that metric is excluded from the default QS formula.
#'
#' - Model fitting: ridge (L2) logistic regression is fitted (via `glmnet`) on
#' the balanced training set. The function uses `trainModel()` for fitting
#' and `computeLambda()` to select lambda unless `bestLambda` is supplied.
#'
#' - Lambda details: because of the randomness in the training set selection,
#' results may vary. The easiest way to ensure reproducibility is to let lambda 
#' be computed internally, just set a seed with `set.seed()` before running 
#' `computeQScore`. Otherwise, a fixed value of lambda previously computed with 
#' `computeLambda` preceeded by `computeTrainDF` and `getModelFormula` can be set.
#' 
#' - Model formula details: the most complete default formula is:
#' `~(log2SignalDensity + Area_um + I(abs(log2AspectRatio) * as.numeric(dist_border < 50)) + log2Ctrl_total_ratio)^2`.
#' A user-supplied formula is fitted as supplied: additive structures, selected
#' interactions, `:` and `*` are preserved. The formula must include
#' `log2SignalDensity` and may use any subset of the other supported predictors:
#' `Area_um`,
#' `log2AspectRatio`, and `log2Ctrl_total_ratio`. Arbitrary predictors and
#' transformations are rejected. The supported CosMx-only border expression is
#' `I(abs(log2AspectRatio) * as.numeric(dist_border < 50))`.
#'
#' When a custom `modelFormula` is supplied, the supported base QC metrics in
#' that formula are also used to compute outliers, define good and bad training
#' cells, and construct `QScore_train`. Interactions do not create additional
#' training metrics. In the supported border expression, `dist_border` is an
#' auxiliary variable and `log2AspectRatio` is the corresponding training QC
#' metric. Supported metrics omitted from the custom formula do not contribute
#' to training-label construction. When `modelFormula=NULL`, the established
#' default metric-selection and training-label workflow is unchanged.
#'
#' The computed model output is stored in `metadata(spe)$QScore_model`.
#' For inspection and model coefficient transfer between datasets
#' see also \code{\link{applyQScoreModel}}. However, transferring models between
#' datasets is not recommended. As described in the paper, QS model training is
#' dataset-specific and does not generalize well across datasets. Moreover,
#' this step is computationally efficient. Please, refer to the paper for  
#' details on scalability and coefficient transfer.
#'
#' @param spe A `SpatialExperiment` object with spatial omics data.
#' @param verbose logical for having a verbose output. Default is FALSE.
#' @param bestLambda the best lambda typically computed using `computeLambda`.
#' @param modelFormula A one-sided formula or character string. If `NULL`, the
#'   default formula is generated from available supported metrics and their
#'   outliers. If supplied, its supported terms and interactions are fitted
#'   without rewriting. See Details.
#' @return The `SpatialExperiment` object with added Quality Score in `colData`.
#' @export
#' @importFrom dplyr case_when filter mutate distinct pull
#' @importFrom glmnet glmnet cv.glmnet
#' @importFrom stats as.formula model.matrix quantile predict coef terms
#' @examples
#' example(spatialPerCellQC)
#' set.seed(1998)
#' spe <- computeQScore(spe)
#' summary(spe$QScore)
computeQScore <- function(spe, bestLambda=NULL, modelFormula=NULL, verbose=FALSE) {
    stopifnot(is(spe, "SpatialExperiment"))
    if (dim(spe[,spe$total == 0])[2] != 0) {
        warning(paste0(dim(spe[,spe$total == 0])[2],
            " cells with 0 counts were found. These cells will be removed."))
        spe <- spe[,spe$total > 0]
    }
    formula_info <- NULL
    if (is.null(modelFormula)) {
        metric_list <- intersect(
            .qscoreSupportedPredictors(),
            names(colData(spe))
        )
    } else {
        formula_info <- .validateQScoreFormula(
            modelFormula=modelFormula,
            dataNames=names(colData(spe)),
            technology=metadata(spe)$technology
        )
        metric_list <- formula_info$training_metrics
    }

    if (!"log2SignalDensity" %in% metric_list) {
        stop(
            "'log2SignalDensity' is required to construct Quality Score ",
            "training labels."
        )
    }

    ctx <- .prepQCContext(spe, metric_list, verbose)
    df <- ctx$df; out_var <- ctx$out_var; tech <- ctx$tech

    if (is.null(modelFormula)) {
        model_formula <- getModelFormula(names(out_var))
        model_formula_object <- stats::as.formula(model_formula)
    } else {
        model_formula <- formula_info$text
        model_formula_object <- formula_info$formula
    }

    if (verbose) {
        message("Using final model formula:")
        message(model_formula)
    }

    train_df <- computeTrainDF(df, out_var, tech, verbose)

    train_ok <- .filterCompleteModelCases(
        df=train_df,
        modelFormula=model_formula_object,
        response=train_df$QScore_train,
        context="training cells"
    )

    train_df <- train_df[train_ok, , drop=FALSE]

    model_matrix <- stats::model.matrix(
        model_formula_object,
        data=train_df
    )
    model <- trainModel(model_matrix, train_df)
    
    if(is.null(bestLambda)) {
        bestLambda <- .computeLambda(
            modelMatrix=model_matrix,
            response=train_df$QScore_train
        )
    }

    coefs <- coef(model, s=bestLambda)

    if (verbose) {
        message("Model coefficients for every term used in the formula:")
        message( paste( rownames(coefs), round(as.numeric(coefs), 2), sep="=",
            collapse=" "))
    }

    full_ok <- .filterCompleteModelCases(
        df=df,
        modelFormula=model_formula_object,
        context="cells")

    full_matrix <- stats::model.matrix(
        model_formula_object,
        data=df[full_ok, , drop=FALSE]
    )

    ## NAs may come from model variables used in `model_formula`, e.g. cells with
    ## missing `log2AspectRatio` when aspect ratio cannot be computed from polygons.
    ## Predict only complete cases; incomplete cells keep QScore = NA.
    qscore <- rep(NA_real_, nrow(df))
    qscore[full_ok] <- as.vector(
        predict(model, s=bestLambda, newx=full_matrix, type="response")
    )

    spe$QScore <- qscore

    metadata(spe)$QScore_model <- list(
        model=model,
        bestLambda=bestLambda,
        model_formula=model_formula,
        formula_variables=out_var,
        model_matrix_colnames=colnames(model_matrix),
        coefficients=coefs,
        coefficients_table=data.frame(
            term=rownames(coefs),
            coefficient=as.numeric(coefs),
            row.names=NULL
        )
    )
    return(spe)
}

#' trainModel
#' @name trainModel
#' @rdname trainModel
#' @description
#' Fits a ridge logistic regression model.
#'
#' \code{trainModel} fits an L2-regularized (ridge) logistic regression
#' using \pkg{glmnet}, given a design matrix and a training data frame.
#'
#' @param trainDF `data.frame`
#'   A data frame containing `QScore_train` or historical `qcscore_train`,
#'   coded as 0/1. If both are present, they must agree.
#' @param modelMatrix a matrix describing the model variables, tipically created
#' with `getModelFormula` and `model.matrix` functions.
#'
#' @return
#' A \code{\link[glmnet]{glmnet}} model object fitted with
#' \code{family="binomial"}, \code{alpha=0} (ridge), and a sequence of
#' \eqn{\lambda} values.
#'
#' @export
#' @examples
#' example(computeTrainDF)
#' model_formula <- getModelFormula(metadata(spe)$formula_variables)
#' model_matrix <- model.matrix(as.formula(model_formula), data=df_train)
#' fit <- trainModel(model_matrix, df_train)
#' coef(fit, s = 0.01)
trainModel <- function(modelMatrix, trainDF)
{
    response <- .getQScoreResponse(trainDF)
    model <- glmnet(x=modelMatrix, y=response,
                    family="binomial", lambda=NULL, alpha=0)
    return(model)
}

#' computeTrainDF
#'
#' @rdname computeTrainDF
#'
#' @description
#' Builds a balanced training data frame from a SpatialExperiment.
#'
#' \code{computeTrainDF} takes a \code{SpatialExperiment} object
#' and assembles a balanced training set of “good” vs “bad” cells for
#' subsequent model fitting.
#' @param colData A per-cell metadata table. Typically
#'   `as.data.frame(colData(spe))`. Must include at least:
#'   `cell_id`, raw metric columns named as in `formulaVars` (e.g.
#'   `log2SignalDensity`, `Area_um`, `log2Ctrl_total_ratio`,
#'   optionally `log2AspectRatio` and `dist_border`), and the corresponding outlier-label
#'   columns referenced by `formulaVars`.
#' @param formulaVars A named character vector mapping variable name to
#'   its outlier label column name, e.g.
#'   `c(log2SignalDensity="log2SignalDensity_outlier_train", ...)`.
#' @param tech Character string with the acquisition technology. Used to
#'   enable CosMx-specific inclusion of border effect. Expected
#'   values include `"Nanostring_CosMx"` or `"Nanostring_CosMx_Protein"`.
#' @param verbose Logical; print progress messages.
#'
#' @param verbose `logical(1)` (default \code{FALSE})
#'   If \code{TRUE}, prints the number of “bad” and “good” cells selected.
#'
#' @return
#' A \code{data.frame} with one row per cell, including:
#'   \code{QScore_train} and its compatibility alias
#'   \code{qcscore_train} (0/1) indicating “bad” vs “good”,
#'   relevant \code{colData} columns used for modeling.
#'   Deduplicates and down-samples “good” cells to match the number of “bad” cells.
#'
#' @details The function builds a training set using the variables specified
#' in the `metadata` of the `SpatialExperiment` object.
#'
#' @importFrom SummarizedExperiment colData
#' @importFrom dplyr filter mutate distinct pull
#' @importFrom glmnet glmnet cv.glmnet
#' @importFrom stats as.formula model.matrix quantile predict
#'
#' @examples
#' example(spatialPerCellQC)
#' spe <- computeOutliersQScore(spe)
#' spe <- checkOutliers(spe)
#' df_train <- computeTrainDF(colData(spe), metadata(spe)$formula_variables,
#'     metadata(spe)$technology)
#' table(df_train$QScore_train)
#'
#' @export
computeTrainDF <- function(colData, formulaVars, tech, verbose=FALSE) {
    out_var <- formulaVars
    df <- as.data.frame(colData)
    train_bad_var <- character()
    train_good_var <- character()

    stopifnot("log2SignalDensity is not included in the Quality Score formula.\nQuality Score cannot be computed"="log2SignalDensity" %in% names(out_var))

    cfg <- list(
        log2SignalDensity=list(bad="LOW", good=c(0.90,0.99)),
        Area_um=list(bad="HIGH", good=c(0.25,0.75)),
        log2Ctrl_total_ratio=list(bad="HIGH", good=NULL)
    )

    vars <- intersect(names(cfg), names(out_var))

    for (v in vars) {
        r <- cfg[[v]]
        out_col <- out_var[names(out_var) == v]
        if (length(out_col) == 0L) next

        # BAD ids
        bad_ids <- df |>
            dplyr::filter(.data[[out_col]] == r$bad) |>
            dplyr::pull(cell_id)
        train_bad_var <- unique(c(train_bad_var, bad_ids))

        # GOOD ids (if a band is defined)
        if (!is.null(r$good)) {
            qs <- stats::quantile(df[[v]], probs=r$good)
            good_ids <- df |>
                dplyr::filter(.data[[v]] > qs[1] & .data[[v]] < qs[2]) |>
                dplyr::pull(cell_id)
            train_good_var <- unique(c(train_good_var, good_ids))
        }
    }

    # CosMx-specific handling for log2AspectRatio
    is_cosmx <- tech %in% c("Nanostring_CosMx", "Nanostring_CosMx_Protein")

    if (is_cosmx && "log2AspectRatio" %in% names(out_var)) {

        if (!("dist_border" %in% colnames(df))) {
            stop("dist_border column is required for CosMx handling")
        }

        out_col <- out_var[names(out_var) == "log2AspectRatio"]

        bad_ids <- df |>
            dplyr::filter(.data[[out_col]] %in% c("HIGH","LOW") &
                            dist_border < 50) |>
            dplyr::pull(cell_id)
        train_bad_var <- unique(c(train_bad_var, bad_ids))

        qs <- stats::quantile(df$log2AspectRatio, probs=c(0.25,0.75))
        good_ids <- df |>
            dplyr::filter(log2AspectRatio > qs[1] &
                            log2AspectRatio < qs[2] &
                            dist_border > 50) |>
            dplyr::pull(cell_id)
        train_good_var <- unique(c(train_good_var, good_ids))

        idx <- grep(pattern="log2AspectRatio_outlier", x=out_var)
        if (length(idx)) {
            names(out_var)[idx] <-
                "I(abs(log2AspectRatio) * as.numeric(dist_border < 50))"
        }
    }

    train_bad <- df |>
        dplyr::filter(cell_id %in% train_bad_var) |>
        dplyr::mutate(QScore_train=0)

    train_good <- df |>
        dplyr::filter(cell_id %in% train_good_var) |>
        dplyr::mutate(
            QScore_train=1,
            is_a_bad_boy=cell_id %in% train_bad$cell_id
        )

    train_bad <- train_bad |>
        dplyr::distinct(cell_id, .keep_all=TRUE)

    if (verbose) message(paste0("Chosen low qual examples: ", nrow(train_bad)))

    # good example duplicates removal without any warning to the user
    train_good <- train_good |>
        dplyr::distinct(cell_id, .keep_all=TRUE)

    train_good <- train_good[!train_good$is_a_bad_boy, ]

    n_bad <- nrow(train_bad)
    stopifnot("Not enough good examples to match bad examples"=
                nrow(train_good) > n_bad)
    idx <- sample(seq_len(nrow(train_good)), n_bad, replace=FALSE)
    train_good <- train_good[idx, ]

    if (verbose) {
        message(paste0(
            "Chosen good quality examples (should match bad): ",
            nrow(train_good)
        ))
    }

    train_good$is_a_bad_boy <- NULL
    train_df <- rbind(train_bad, train_good)
    train_df <- train_df |>
        dplyr::distinct(cell_id, .keep_all=TRUE)
    ## `qcscore_train` remains available because `computeTrainDF()` is a
    ## published API. Canonical internals use `QScore_train`.
    train_df$qcscore_train <- train_df$QScore_train
    return(train_df)
}

#' getModelFormula
#' @name getModelFormula
#' @rdname getModelFormula
#' @description
#' Returns the right‐hand side of a model formula string based on a vector of
#' metric names.
#' @param formulaVars A named character vector mapping metric names to outlier
#'   columns, as historically stored in
#'   `metadata(spe)$formula_variables`. An unnamed character vector of metric
#'   names is also accepted.
#' @param verbose Logical. If `TRUE`, prints the generated formula.
#' @param ... May contain the named replacement `metricList`. If both
#'   `formulaVars` and `metricList` are supplied, `metricList` takes precedence
#'   with a warning.
#' @return `character`
#'   A one‐sided formula as a string (e.g. "~ log2SignalDensity + ...").
#' @export
#' @examples
#' example(checkOutliers)
#' getModelFormula(metadata(spe)$formula_variables)
getModelFormula <- function(formulaVars, verbose=FALSE, ...)
{
    has_formula_vars <- !missing(formulaVars)
    dots <- list(...)
    unknown_dots <- setdiff(names(dots), "metricList")
    if (length(unknown_dots) > 0L) {
        stop(
            "Unused argument(s): ",
            paste(unknown_dots, collapse=", "),
            "."
        )
    }
    has_metric_list <- "metricList" %in% names(dots)
    if (!has_formula_vars && !has_metric_list) {
        stop("'formulaVars' or 'metricList' must be supplied.")
    }
    if (has_formula_vars && has_metric_list) {
        warning(
            "Both 'formulaVars' and 'metricList' were supplied; ",
            "using 'metricList'."
        )
    }
    out_var <- if (has_metric_list) dots$metricList else formulaVars
    if (!is.character(out_var)) {
        stop("Model formula variables must be supplied as a character vector.")
    }
    if (!is.null(names(out_var)) && all(nzchar(names(out_var)))) {
        out_var <- names(out_var)
    }
    if ("log2AspectRatio" %in% out_var) {
        out_var[grep("log2AspectRatio", out_var)] <-
            "I(abs(log2AspectRatio) * as.numeric(dist_border < 50))"
    }
    model_formula <- paste0("~(", paste(out_var, collapse = " + "),
                        ")^2", sep = "")

    if (verbose) {
        message("Final formula used for Quality Score computation:")
        message(model_formula)
    }

    return(model_formula)
}

.qscoreSupportedPredictors <- function() {
    c(
        "log2SignalDensity",
        "Area_um",
        "log2AspectRatio",
        "log2Ctrl_total_ratio"
    )
}

.qscoreBorderTerm <- function() {
    paste0(
        "I(abs(log2AspectRatio)*",
        "as.numeric(dist_border<50))"
    )
}

.validateQScoreFormula <- function(modelFormula, dataNames, technology) {
    model_formula <- tryCatch(
        stats::as.formula(modelFormula),
        error=function(e) {
            stop("Unable to parse 'modelFormula': ", conditionMessage(e))
        }
    )
    if (length(model_formula) != 2L) {
        stop("'modelFormula' must be a one-sided formula.")
    }

    required_variables <- base::all.vars(model_formula)
    supported <- .qscoreSupportedPredictors()
    allowed_variables <- c(supported, "dist_border")
    unsupported_variables <- setdiff(
        required_variables,
        allowed_variables
    )
    if (length(unsupported_variables) > 0L) {
        stop(
            "Unsupported Quality Score predictor(s): ",
            paste(unsupported_variables, collapse=", "),
            ". Formula structure may be customised, but predictors and ",
            "transformations are restricted to: ",
            paste(supported, collapse=", "),
            "."
        )
    }

    term_labels <- attr(stats::terms(model_formula), "term.labels")
    if (length(term_labels) == 0L) {
        stop("'modelFormula' must contain at least one supported predictor.")
    }
    normalise <- function(x) gsub("[[:space:]]+", "", x)
    border_term <- .qscoreBorderTerm()
    unsupported_terms <- character()
    for (term_label in term_labels) {
        components <- strsplit(
            normalise(term_label),
            ":",
            fixed=TRUE
        )[[1]]
        valid_components <- components %in% supported |
            components == border_term
        if (!all(valid_components)) {
            unsupported_terms <- c(unsupported_terms, term_label)
        }
    }
    unsupported_terms <- unique(unsupported_terms)
    if (length(unsupported_terms) > 0L) {
        stop(
            "Unsupported Quality Score formula term(s) or transformation(s): ",
            paste(unsupported_terms, collapse=", "),
            ". Formula structure and interactions may be customised, but ",
            "predictors and transformations may not be extended. Supported ",
            "predictors are: ",
            paste(supported, collapse=", "),
            "; the supported border-effect expression is ",
            "'I(abs(log2AspectRatio) * as.numeric(dist_border < 50))'."
        )
    }

    missing_variables <- setdiff(required_variables, dataNames)
    if (length(missing_variables) > 0L) {
        stop(
            "Missing variables required by 'modelFormula': ",
            paste(missing_variables, collapse=", "),
            ". Run 'spatialPerCellQC()' before computing Quality Score."
        )
    }

    is_cosmx <- technology %in%
        c("Nanostring_CosMx", "Nanostring_CosMx_Protein")
    uses_border_predictor <- any(
        c("log2AspectRatio", "dist_border") %in% required_variables
    )
    if (uses_border_predictor && !is_cosmx) {
        stop(
            "'log2AspectRatio' and the border-effect expression are ",
            "supported only for Nanostring CosMx datasets; detected ",
            "technology: '", technology, "'."
        )
    }

    formula_text <- if (is.character(modelFormula)) {
        paste(modelFormula, collapse=" ")
    } else {
        paste(deparse(model_formula, width.cutoff=500L), collapse=" ")
    }
    training_metrics <- required_variables[
        required_variables %in% supported
    ]
    list(
        formula=model_formula,
        text=formula_text,
        variables=required_variables,
        terms=term_labels,
        training_metrics=training_metrics
    )
}

#' .computeXenMerTrainSet
#' @name dot-computeXenMerTrainSet
#' @rdname dot-computeXenMerTrainSet
#' @description
#' Internal: builds Training Set for Xenium & MERFISH.
#' Splits a SpatialExperiment into “bad” vs “good” cells based on
#' pre-computed outlier labels on log2SignalDensity.
#' @param spe \code{SpatialExperiment}
#' @return
#' A list with elements \code{bad} and \code{good}, each a data.frame
#' with \code{qscore_train} and (for “good”) an \code{is_a_bad_boy} flag.
#' @keywords internal
.computeXenMerTrainSet <- function(spe)
{
    train_bad <- data.frame(colData(spe)) |>
        filter(log2SignalDensity_outlier_train=="LOW") |> mutate(qscore_train=0)
    train_good <- data.frame(colData(spe)) |>
        filter((log2SignalDensity > quantile(log2SignalDensity, probs = 0.90) &
                    log2SignalDensity < quantile(log2SignalDensity, probs = 0.99))) |>
        mutate(qscore_train=1, is_a_bad_boy=cell_id %in% train_bad$cell_id)
    return(list(bad=train_bad, good=train_good))
}

#' .computeCosmxTrainSet
#' @name dot-computeCosmxTrainSet
#' @rdname dot-computeCosmxTrainSet
#' @description
#' Internal: builds Training Set for CosMx.
#' Splits a SpatialExperiment into “bad” vs “good” cells based on
#' outliers in aspect ratio near FOV border or low signal density.
#' @param spe \code{SpatialExperiment}
#' @return
#' A list with elements \code{bad} and \code{good}, each a data.frame
#' with \code{qscore_train} and (for “good”) an \code{is_a_bad_boy} flag.
#' @keywords internal
.computeCosmxTrainSet <- function(spe)
{
    spe <- computeSpatialOutlier(spe, "log2AspectRatio", "scuttle")
    train_bad <- data.frame(colData(spe)) |>
        filter((log2AspectRatio_outlier_sc == "HIGH" & dist_border < 50) |
                (log2AspectRatio_outlier_sc == "LOW" & dist_border < 50) |
                log2SignalDensity_outlier_train == "LOW") |>
        mutate(qscore_train = 0)

    train_good <- data.frame(colData(spe)) |>
        filter((log2AspectRatio > quantile(log2AspectRatio, probs = 0.25) &
                    log2AspectRatio < quantile(log2AspectRatio, probs = 0.75) &
                    dist_border > 50) |
                    (log2SignalDensity > quantile(log2SignalDensity, probs = 0.90) &
                    log2SignalDensity < quantile(log2SignalDensity, probs = 0.99))) |>
        mutate(qscore_train=1, is_a_bad_boy=cell_id %in% train_bad$cell_id)
    return(list(bad=train_bad, good=train_good))
}

#' .computeCosmxProteinTrainSet
#' @name dot-computeCosmxProteinTrainSet
#' @rdname dot-computeCosmxProteinTrainSet
#' @description
#' Internal: builds Training Set for CosMx-Protein.
#' Splits a SpatialExperiment into “bad” vs “good” cells based on
#' outliers in aspect ratio near FOV border or low signal density.
#' @param spe \code{SpatialExperiment}
#' @return
#' A list with elements \code{bad} and \code{good}, each a data.frame
#' with \code{qscore_train} and (for “good”) an \code{is_a_bad_boy} flag.
#' @keywords internal
.computeCosmxProteinTrainSet <- function(spe)
{
    spe <- computeSpatialOutlier(spe, "log2AspectRatio", method="both")
    spe <- computeSpatialOutlier(spe, "log2Ctrl_total_ratio", method="both")
    train_bad <- data.frame(colData(spe)) |>
        filter((log2AspectRatio_outlier_mc == "HIGH" & dist_border < 50) |
                (log2AspectRatio_outlier_mc == "LOW" & dist_border < 50) |
                log2SignalDensity_outlier_train == "LOW" |
                log2Ctrl_total_ratio_outlier_sc == "HIGH") |>
        mutate(qscore_train = 0)

    train_good <- data.frame(colData(spe)) |>
        filter((log2AspectRatio > quantile(log2AspectRatio, probs = 0.25) &
                log2AspectRatio < quantile(log2AspectRatio, probs = 0.75) &
                dist_border > 50) |
                (log2SignalDensity > quantile(log2SignalDensity, probs = 0.90) &
                log2SignalDensity < quantile(log2SignalDensity, probs = 0.99))) |>
        mutate(qscore_train=1, is_a_bad_boy=cell_id %in% train_bad$cell_id)
    return(list(bad=train_bad, good=train_good))
}


#' computeQScoreFlags
#' @name computeQScoreFlags
#' @rdname computeQScoreFlags
#' @description
#' Computes flagged cells based on a manually chosen threshold on Quality Score (QS).
#'
#' This function computes flagged cells based on a manually chosen threshold on
#' QS stored in `SpatialExperiment` object.
#'
#' @param spe A `SpatialExperiment` object with spatial omics data.
#' @param qsThreshold Numeric threshold or quantile for QS. Default is `0.5`.
#' @param useQSQuantiles Logical; if `TRUE`, treat `qsThreshold` as a percentile.
#'
#' @return The `SpatialExperiment` object with added low-quality flagged cells as
#' TRUE/FALSE in `colData`.
#'
#' @importFrom SummarizedExperiment colData
#' @export
#' @examples
#' example(computeQScore)
#' spe <- computeQScoreFlags(spe)
#' table(spe$low_QScore)
#' # if fixed filters are defined we have an additional column
#' spe <- computeThresholdFlags(spe)
#' spe <- computeQScoreFlags(spe)
#' table(spe$low_threshold_QScore)
computeQScoreFlags <- function(spe, qsThreshold=0.5, useQSQuantiles=FALSE) {
    stopifnot(is(spe, "SpatialExperiment"))
    stopifnot("QScore" %in% names(colData(spe)))

    if(useQSQuantiles) {
        spe$low_QScore <- ifelse(
            spe$QScore < quantile(spe$QScore, probs=qsThreshold),
            TRUE, FALSE)
    } else {
        spe$low_QScore <- spe$QScore < qsThreshold
    }

    if("threshold_flags" %in% names(colData(spe))) {
        spe$low_threshold_QScore <- (spe$low_QScore &
                                        spe$threshold_flags)
    }
    return(spe)
}

#' .checkSkw
#' @name dot-checkSkw
#' @rdname dot-checkSkw
#' @description
#' Internal: checks skewness of metrics to choose outlier detection method.
#'
#' @param cd colData of `SpatialExperiment` object.
#' @param metricList A character vector specifying the metrics to include in
#' the Quality Score formula. Defaults are "log2SignalDensity", "Area_um",
#' "log2AspectRatio", "log2Ctrl_total_ratio".
#'
#' @return
#' A vector containing the list of chosen outlier detection method for each
#' metric.
#' @importFrom e1071 skewness
#' @keywords internal
.checkSkw <- function(cd, metricList=c("log2SignalDensity", "Area_um",
    "log2AspectRatio", "log2Ctrl_total_ratio")) {
    stopifnot(is(cd, "DataFrame"))
    stopifnot(all(metricList %in% names(cd)))
    method <- c()
    for (i in metricList) {
        skw <- e1071::skewness(cd[[i]], na.rm = TRUE)
        method[i] <- ifelse((skw>-1 & skw<1), "sc", "mc")
    }
    for (submeth in c("log2SignalDensity", "log2Ctrl_total_ratio"))
    {
        if (!submeth %in% names(method)) next
        idx <- switch(submeth,
                    "log2SignalDensity"        = cd[["total"]] > 0,
                    "log2Ctrl_total_ratio" = cd[["ctrl_total_ratio"]] != 0,
                    rep(TRUE, nrow(cd))
        )
        if (!any(idx, na.rm = TRUE)) next
        skw <- e1071::skewness(cd[[submeth]][idx], na.rm=TRUE)
        newm <- ifelse((skw>-1 & skw<1), "sc", "mc")
        if (!is.na(newm)) method[[submeth]] <- newm
    }
    return(method)
}

#' computeOutliersQScore
#' @name computeOutliersQScore
#' @rdname computeOutliersQScore
#' @description
#' Computes outlier cells for each metric that can be used in Quality Score formula
#' for SpatialExperiment.
#'
#' This function calculates outlier cells for each variable specified
#' in `metricList` for a `SpatialExperiment`. log2SignalDensity must be present in
#' the `colData` of the `SpatialExperiment` object as a minimum requirement.
#' The user can choose which metrics to include among the following: Area_um,
#' log2Ctrl_total_ratio, log2AspectRatio. For Xenium and Merfish datasets,
#' even if outliers for log2AspectRatio are detected, neither the metric will be 
#' included in the Quality Score formula nor nor the outliers will be used for
#' training.
#' 
#' @param spe A `SpatialExperiment` object with spatial omics data.
#' @param metricList A character vector specifying the metrics to include in
#' the Quality Score formula. Default is `c("log2SignalDensity", "Area_um",
#' "log2AspectRatio", "log2Ctrl_total_ratio")`.
#'
#' @return The `SpatialExperiment` object with added outlier variables in
#' `colData` and the temporary metrics considered for Quality Score computation
#' stored in the object `metadata`.
#'
#' @details The function computes outliers for each specified metric after
#' automatically choosing the appropriate method according to the skewness of
#' the distribution.
#' Internally the function:
#' \enumerate{
#'    \item Calls \code{.checkSkw()} to choose the proper outlier detection
#'     method according to the variable skewness;
#'    \item Calls \code{computeSpatialOutlier()} on each included metric to get
#'    fences;
#'    \item Labels cells as “LOW”/“HIGH” outliers or “NO”.
#' }
#'
#' @importFrom SummarizedExperiment colData
#' @importFrom dplyr case_when
#' @importFrom scuttle outlier.filter
#' @importFrom stats quantile
#' @export
#' @examples
#' example(readCosmxSPE)
#' spe <- spatialPerCellQC(spe)
#' spe <- computeOutliersQScore(spe)
#' table(spe$log2SignalDensity_outlier_train)
computeOutliersQScore <- function(spe, metricList=c("log2SignalDensity","Area_um",
    "log2AspectRatio", "log2Ctrl_total_ratio")) {

    stopifnot(is(spe, "SpatialExperiment"))
    unsupported_metrics <- setdiff(
        metricList,
        .qscoreSupportedPredictors()
    )
    if (length(unsupported_metrics) > 0L) {
        stop(
            "Unsupported Quality Score metric(s): ",
            paste(unsupported_metrics, collapse=", "),
            ". Supported metrics are: ",
            paste(.qscoreSupportedPredictors(), collapse=", "),
            "."
        )
    }

    cd <- colData(spe)
    method <- .checkSkw(cd, metricList)

    spec <- list(
        log2SignalDensity = list(
            idx  = spe$total > 0,
            zero = spe$total == 0,
            tweak_lower = TRUE
        ),
        log2Ctrl_total_ratio = list(
            idx  = spe$ctrl_total_ratio != 0,
            zero = spe$ctrl_total_ratio == 0,
            tweak_lower = FALSE
        )
    )
    if(any(is.na(method)))
    {
        idx <- which(is.na(method))
        for (i in idx) {
            message("Metric ", names(method)[i], " produced NA skewness values.",
                "It will be removed from the Quality Score formula.")
            method <- method[-i]
        }
    }
    for (var in intersect(names(method), names(spec))) {
        s <- spec[[var]]
        spe_temp <- computeSpatialOutlier(spe[, s$idx], computeBy=var,
                                        method=method[[var]])
        out_var <- paste0(var, "_outlier_", method[[var]])
        low_thr  <- getFencesOutlier(spe_temp, out_var, "lower")
        high_thr <- getFencesOutlier(spe_temp, out_var, "higher")
        if (isTRUE(s$tweak_lower)) {
            if (low_thr < min(spe_temp[[var]], na.rm = TRUE)) {
                low_thr <- stats::quantile(spe[[var]], probs=0.01)
            }
        }
        tgt <- paste0(var, "_outlier_train")
        spe[[tgt]] <- dplyr::case_when(
            s$zero ~ "NO",
            spe[[var]] < low_thr  ~ "LOW",
            spe[[var]] > high_thr ~ "HIGH",
            TRUE ~ "NO"
        )
        spe[[tgt]] <- scuttle::outlier.filter(spe[[tgt]])#is this really needed?
        thr <- getFencesOutlier(spe_temp, out_var)
        if (isTRUE(s$tweak_lower)) thr[1] <- low_thr
        attr(spe[[tgt]], "thresholds") <- thr
    }

    submethod <- method[!names(method) %in%
        c("log2SignalDensity", "log2Ctrl_total_ratio")]

    for(j in names(submethod)){
        spe <- computeSpatialOutlier(spe, computeBy=j, method=submethod[j])
    }

    out_var <- paste0(names(method), "_outlier_", method)
    names(out_var) <- names(method)
    # gives warning if one of the variables is missing, but still works!
    # out_var[names(out_var) %in% c("log2SignalDensity", "log2Ctrl_total_ratio")] <-
    #     c("log2SignalDensity_outlier_train", "log2Ctrl_total_ratio_outlier_train")
    mapping <- c(
        log2SignalDensity = "log2SignalDensity_outlier_train",
        log2Ctrl_total_ratio = "log2Ctrl_total_ratio_outlier_train"
    )
    present <- intersect(names(out_var), names(mapping))
    if (length(present) > 0L) {
        for (nm in present) out_var[nm] <- mapping[nm]
    }
    metadata(spe)$formula_variables <- out_var
    return(spe)
}


#' checkOutliers
#' @name checkOutliers
#' @rdname checkOutliers
#' @description
#' Checks if computed outliers meet the minimum numerical requirement, being
#' at least 0.1\% of total cells for each metric to be used in Quality Score formula.
#' If the requirement is not met, the variable is removed from the formula.
#'
#' @param spe A `SpatialExperiment` object with spatial omics data.
#' @param verbose Logical. If `TRUE`, prints how many outliers were found for
#' each metric.
#'
#' @return The `SpatialExperiment` object with added metric variables that
#' will be used for Quality Score computation stored in the object` metadata`.
#'
#' @details The function checks if computed outliers for each metric meet
#' the minimum number to get the metric included in the Quality Score formula.
#' If verbose is TRUE, it also prints how many outliers were found for each
#' metric.
#'
#' @importFrom SummarizedExperiment colData
#' @export
#' @examples
#' example(computeOutliersQScore)
#' spe <- checkOutliers(spe, verbose = TRUE)
#' metadata(spe)$formula_variables
checkOutliers <- function(spe, verbose=FALSE) {
    warnstopmsg <- function(var, warnstop=c("w","s")) {
        warnstop <- match.arg(warnstop)
        m1 <- paste0("Not enough outlier cells for ", var, ".\n")
        m2 <- switch(warnstop,
                s="In this version of SpaceTrooper, presence of outliers
                for log2SignalDensity is required to compute Quality Score.",
                w="This variable will not be used in the final formula")
        return(paste0(m1, m2))
    }
    out_var <- metadata(spe)$formula_variables
    cd <- colData(spe)
    if (verbose) {
        for (i in names(out_var)) {
            message("Outliers found for ", i, ":")
            outlier_counts <- table(cd[[out_var[i]]])
            for (k in seq_along(outlier_counts)) {
                message(names(outlier_counts)[k], ": ", outlier_counts[k])
            }
        }
    }
    stopifnot(
        "log2SignalDensity is not included in the Quality Score formula.\n
        Quality Score cannot be computed"=
            "log2SignalDensity" %in% names(out_var)
    )
    cfg <- list(
        log2SignalDensity=list(pattern="log2SignalDensity_outlier",
            remove="log2SignalDensity_outlier_train", label="LOW", act=stop,
            code="s"),
        Area_um=list(pattern="Area_um_outlier", remove="Area_um_outlier",
            label="HIGH", act=warning, code="w"),
        log2Ctrl_total_ratio=list(pattern="log2Ctrl_total_ratio_outlier",
            remove="log2Ctrl_total_ratio_outlier_train", label="HIGH",
            act=warning, code="w")
    )
    for (v in intersect(names(cfg), names(out_var))) {
        r <- cfg[[v]]
        gi <- grep(r$pattern, out_var)
        if (length(gi)==0L) next
        col <- out_var[gi]
        labs <- factor(cd[[col]], levels=c("LOW","HIGH","NO"))
        tab <- table(labs)
        cnt <- tab[r$label]
        if (is.null(cnt) || is.na(cnt)) cnt <- 0L
        if (cnt < ncol(spe)*0.001) {
            r$act(warnstopmsg(v, r$code))
            out_var <- out_var[-grep(r$remove, out_var)]
        }
    }
    var <- "log2AspectRatio"
    pat <- paste0(var, "_outlier")
    is_cosmx <- metadata(spe)$technology %in%
                c("Nanostring_CosMx", "Nanostring_CosMx_Protein")
    idx <- grep(pat, out_var)            
    if (is_cosmx && (var %in% names(out_var))) {
        if (length(idx)) {
            col <- out_var[idx]
            labs <- factor(cd[[col]], levels=c("LOW","HIGH","NO"))
            tab <- table(labs)
            nmin <- ncol(spe) * 0.001

            low  <- tab[["LOW"]];  if (is.na(low))  low  <- 0L
            high <- tab[["HIGH"]]; if (is.na(high)) high <- 0L

            if (low < nmin && high < nmin) {
                warning(warnstopmsg(var, "w"))
                out_var <- out_var[-idx]
            }
        }
    } else {
        if (length(idx)) {
            out_var <- out_var[-idx]
        }
    }
    metadata(spe)$formula_variables <- out_var
    return(spe)
}


.prepQCContext <- function(spe, metricList=c("log2SignalDensity", "Area_um",
    "log2AspectRatio", "log2Ctrl_total_ratio"), verbose=FALSE) {

    stopifnot(is(spe,"SpatialExperiment"))

    # remove zero-count cells once
    zerocells <- spe$total==0
    if (sum(zerocells) > 0) {
        warning(sum(zerocells),
            " cells with 0 counts were found. These cells will be removed.")
        spe <- spe[, !zerocells]
    }
    if("log2CountArea" %in% names(colData(spe)))
    {
        stop("log2CountArea found in colData.\n",
        "Please updated the object with the latest version of spatialPerCellQC.")
    }
    spe1 <- computeOutliersQScore(spe, metricList)
    spe1 <- checkOutliers(spe1, verbose)

    out_var <- metadata(spe1)$formula_variables
    df <- as.data.frame(colData(spe1))
    tech <- metadata(spe1)$technology

    return(list(df=df, out_var=out_var, tech=tech))
}

#' applyQScoreModel
#' @name applyQScoreModel
#' @rdname applyQScoreModel
#' 
#' @description
#' Applies a previously trained Quality Score model to a new SpatialExperiment
#' object.
#' See details for important considerations when applying a model to a
#' different dataset.
#' @details
#' The authors do not recommend applying a Quality Score (QS) model trained on one
#' dataset to a different dataset, but this could be useful in some cases,
#' for example to transfer a model trained on a dataset sourced from a tissue 
#' slide sample and then applied to other slides from the same experiment.
#' When transferring the model from a reference dataset of the same technology
#' of the query dataset, there is no need to set a common formula. However,
#' when transferring from a different technology, reference QS computation 
#' should be performed providing a formula that excludes untransferable or unwanted 
#' variables (e.g. computing QS on a reference CosMx dataset omitting the border 
#' effect term to transfer the QS model to a Xenium query dataset. This is done by
#' providing a custom formula in computeQScore, see link computeQScore). The function will check 
#' for the presence of required model variables in the new dataset and will handle 
#' missing or extra variables accordingly.
#'
#' @param spe A `SpatialExperiment` object with QC metrics already computed.
#' @param qsModel A Quality Score model object, usually stored in
#'   `metadata(spe)$QScore_model`.
#' @param scoreName Name of the output column in `colData`.
#'
#' @return A `SpatialExperiment` object with added Quality Score in `colData`.
#'
#' @export
#' @examples
#'
#' example(readCosmxSPE)
#'
#' ## Compute per-cell quality control metrics
#' spe <- spatialPerCellQC(spe)
#'
#' ## Split the object only for example purposes
#' set.seed(1998)
#' idx <- sample(seq_len(ncol(spe)), floor(ncol(spe) / 2))
#' spe_train <- spe[, idx]
#' spe_test <- spe[, -idx]
#'
#' ## Train the Quality Control (QC) score model on one dataset
#' spe_train <- computeQScore(spe_train)
#' qs_model <- metadata(spe_train)$QScore_model
#'
#' ## Apply the trained model to another dataset
#' spe_test <- applyQScoreModel(
#'     spe=spe_test,
#'     qsModel=qs_model,
#'     scoreName="QScore_transferred"
#' )
#'
#' summary(spe_test$QScore_transferred)
applyQScoreModel <- function(spe, qsModel, scoreName="QScore") {
    .applyQScoreModel(spe=spe, qsModel=qsModel, scoreName=scoreName)
}

.applyQScoreModel <- function(spe, qsModel, scoreName="QScore") {
    stopifnot(is(spe, "SpatialExperiment"))

    required <- c(
        "model",
        "bestLambda",
        "model_formula",
        "model_matrix_colnames"
    )

    stopifnot(
        "qsModel is missing required fields" =
            all(required %in% names(qsModel))
    )

    df <- as.data.frame(colData(spe))
    .validateQScoreFormula(
        modelFormula=qsModel$model_formula,
        dataNames=colnames(df),
        technology=metadata(spe)$technology
    )

    ok <- .filterCompleteModelCases(
        df=df,
        modelFormula=qsModel$model_formula,
        context="cells"
    )

    new_matrix <- model.matrix(
        as.formula(qsModel$model_formula),
        data=df[ok, , drop=FALSE]
    )

    missing_cols <- setdiff(
        qsModel$model_matrix_colnames,
        colnames(new_matrix)
    )

    if (length(missing_cols) > 0L) {
        zero_matrix <- matrix(
            0,
            nrow=nrow(new_matrix),
            ncol=length(missing_cols),
            dimnames=list(rownames(new_matrix), missing_cols)
        )

        new_matrix <- cbind(new_matrix, zero_matrix)
    }

    extra_cols <- setdiff(
        colnames(new_matrix),
        qsModel$model_matrix_colnames
    )

    if (length(extra_cols) > 0L) {
        warning(
            "New model matrix contains columns not present in the ",
            "training matrix. These columns will be ignored: ",
            paste(extra_cols, collapse=", ")
        )
    }

    new_matrix <- new_matrix[, qsModel$model_matrix_colnames, drop=FALSE]

    score <- rep(NA_real_, nrow(df))

    score[ok] <- as.vector(
        predict(
            qsModel$model,
            s=qsModel$bestLambda,
            newx=new_matrix,
            type="response"
        )
    )

    cd <- colData(spe)
    cd[[scoreName]] <- score
    colData(spe) <- cd

    metadata(spe)$QScore_model_applied <- qsModel

    return(spe)
}

.dropModelIntercept <- function(modelMatrix) {
    if ("(Intercept)" %in% colnames(modelMatrix)) {
        modelMatrix <- modelMatrix[, colnames(modelMatrix)!="(Intercept)",
            drop=FALSE]
    }

    return(modelMatrix)
}

.getQScoreResponse <- function(trainDF) {
    has_canonical <- "QScore_train" %in% colnames(trainDF)
    has_legacy <- "qcscore_train" %in% colnames(trainDF)
    if (!has_canonical && !has_legacy) {
        stop(
            "Training data must contain 'QScore_train' or ",
            "'qcscore_train'."
        )
    }
    if (has_canonical && has_legacy) {
        canonical <- trainDF$QScore_train
        legacy <- trainDF$qcscore_train
        same <- (is.na(canonical) & is.na(legacy)) |
            (!is.na(canonical) & !is.na(legacy) & canonical == legacy)
        if (any(!same)) {
            stop(
                "'QScore_train' and 'qcscore_train' are both present ",
                "but contain different values."
            )
        }
    }
    if (has_canonical) trainDF$QScore_train else trainDF$qcscore_train
}

#' @importFrom stats complete.cases
.filterCompleteModelCases <- function(df, modelFormula, response=NULL,
    context="cells") {

    vars <- base::all.vars(stats::as.formula(modelFormula))

    missing_vars <- setdiff(vars, colnames(df))

    if (length(missing_vars) > 0L) {
        stop(
            "Missing variables required by model formula: ",
            paste(missing_vars, collapse=", ")
        )
    }
    ## Missing values may come from variables used in `modelFormula`, for
    ## example `log2AspectRatio` when aspect ratio cannot be computed from
    ## polygons.
    ok <- complete.cases(df[, vars, drop=FALSE])

    if (!is.null(response)) {
        ok <- ok & !is.na(response)
    }

    if (!all(ok)) {
        warning(
            sum(!ok),
            " ", context,
            " contain missing model variables."
        )
    }

    return(ok)
}

## ---- Deprecated functions -----------------------------------------------

#' Deprecated functions in SpaceTrooper
#'
#' @name SpaceTrooper-deprecated
#' @description
#' These functions are retained for compatibility with published SpaceTrooper
#' APIs. They issue a deprecation warning and direct users to the canonical
#' Quality Score functions.
#'
#' @details
#' \itemize{
#'   \item `computeQCScore()` replaces canonical `QScore` and
#'     `metadata(spe)$QScore_model` with historical `QC_score` and
#'     `metadata(spe)$QCScore_model`.
#'   \item `computeQCScoreFlags()` consumes `QC_score` and creates
#'     `low_qcscore` and, when applicable, `low_threshold_qcscore`.
#'   \item `computeOutliersQCScore()` is the historical name for
#'     `computeOutliersQScore()`.
#'   \item `applyQCScoreModel()` retains the `qcModel` argument, the default
#'     `QC_score` output, and `metadata(spe)$QCScore_model_applied`.
#' }
#'
#' Use `computeQScore()`, `computeQScoreFlags()`,
#' `computeOutliersQScore()`, and `applyQScoreModel()` for canonical names.
NULL

#' computeQCScore (deprecated)
#' @rdname SpaceTrooper-deprecated
#'
#' @param spe A `SpatialExperiment` object.
#' @param bestLambda Passed to \code{\link{computeQScore}}.
#' @param modelFormula Passed to \code{\link{computeQScore}}.
#' @param verbose Passed to \code{\link{computeQScore}}.
#' @return A `SpatialExperiment` object; see \code{\link{computeQScore}}.
#' @export
computeQCScore <- function(spe, bestLambda=NULL, modelFormula=NULL,
                           verbose=FALSE) {
    .Deprecated(
        new="computeQScore",
        package="SpaceTrooper",
        msg=paste0(
            "'computeQCScore' is deprecated.\n",
            "Use 'computeQScore' instead.\n",
            "See help('computeQScore') for details."
        )
    )
    spe <- computeQScore(
        spe,
        bestLambda=bestLambda,
        modelFormula=modelFormula,
        verbose=verbose
    )
    spe$QC_score <- spe$QScore
    spe$QScore <- NULL
    metadata(spe)$QCScore_model <- metadata(spe)$QScore_model
    metadata(spe)$QScore_model <- NULL
    return(spe)
}

#' computeQCScoreFlags (deprecated)
#' @rdname SpaceTrooper-deprecated
#'
#' @param spe A `SpatialExperiment` object.
#' @param qsThreshold Passed to \code{\link{computeQScoreFlags}}.
#' @param useQSQuantiles Passed to \code{\link{computeQScoreFlags}}.
#' @return A `SpatialExperiment` object; see \code{\link{computeQScoreFlags}}.
#' @export
computeQCScoreFlags <- function(spe, qsThreshold=0.5, useQSQuantiles=FALSE) {
    .Deprecated(
        new="computeQScoreFlags",
        package="SpaceTrooper",
        msg=paste0(
            "'computeQCScoreFlags' is deprecated.\n",
            "Use 'computeQScoreFlags' instead.\n",
            "See help('computeQScoreFlags') for details."
        )
    )
    stopifnot(is(spe, "SpatialExperiment"))
    stopifnot("QC_score" %in% names(colData(spe)))

    if (useQSQuantiles) {
        spe$low_qcscore <- spe$QC_score <
            quantile(spe$QC_score, probs=qsThreshold, na.rm=TRUE)
    } else {
        spe$low_qcscore <- spe$QC_score < qsThreshold
    }

    if ("threshold_flags" %in% names(colData(spe))) {
        spe$low_threshold_qcscore <- spe$low_qcscore &
            spe$threshold_flags
    }
    return(spe)
}

#' computeOutliersQCScore (deprecated)
#' @rdname SpaceTrooper-deprecated
#'
#' @param spe A `SpatialExperiment` object.
#' @param metricList Passed to \code{\link{computeOutliersQScore}}.
#' @return A `SpatialExperiment` object; see
#'   \code{\link{computeOutliersQScore}}.
#' @export
computeOutliersQCScore <- function(spe, metricList=c(
    "log2SignalDensity", "Area_um", "log2AspectRatio",
    "log2Ctrl_total_ratio"
)) {
    .Deprecated(
        new="computeOutliersQScore",
        package="SpaceTrooper"
    )
    computeOutliersQScore(spe=spe, metricList=metricList)
}

#' applyQCScoreModel (deprecated)
#' @rdname SpaceTrooper-deprecated
#'
#' @param spe A `SpatialExperiment` object with QC metrics already computed.
#' @param qcModel A historical QC score model object, usually stored in
#'   `metadata(spe)$QCScore_model`.
#' @param scoreName Name of the legacy output column in `colData`.
#' @return A `SpatialExperiment` object with the applied score in `colData`
#'   and the model in `metadata(spe)$QCScore_model_applied`.
#' @export
applyQCScoreModel <- function(spe, qcModel, scoreName="QC_score") {
    .Deprecated(
        new="applyQScoreModel",
        package="SpaceTrooper"
    )
    spe <- .applyQScoreModel(
        spe=spe,
        qsModel=qcModel,
        scoreName=scoreName
    )
    metadata(spe)$QCScore_model_applied <-
        metadata(spe)$QScore_model_applied
    metadata(spe)$QScore_model_applied <- NULL
    return(spe)
}
