HiDDEN entrypoint w/ grouping and automatic hyper-parameter tuning
Usage
# method for SingleCellExperiment
HiDDENgt(sce, cond_col, control_val, group_by, tuner, algo, which_grouped, grp_specific_args, ...)
# method for Seurat
HiDDENgt(so, cond_col, control_val, group_by, tuner, algo, which_grouped, grp_specific_args, ...)
## S7 method for class <new("classRepresentation", slots = list(int_elementMetadata = structure("DataFrame", package = "S4Vectors"), int_colData = structure("DataFrame", package = "S4Vectors"), int_metadata = structure("list", package = "methods"), rowRanges = structure("GenomicRanges_OR_GRangesList", package = "GenomicRanges"), colData = structure("DataFrame", package = "S4Vectors"), assays = structure("Assays_OR_NULL", package = "SummarizedExperiment"), NAMES = structure("character_OR_NULL", package = "S4Vectors"), elementMetadata = structure("DataFrame", package = "S4Vectors"), metadata = structure("list", package = "methods")), contains = list( RangedSummarizedExperiment = new("SClassExtension", subClass = structure("SingleCellExperiment", package = "SingleCellExperiment"), superClass = structure("RangedSummarizedExperiment", package = "SummarizedExperiment"), package = "SingleCellExperiment", coerce = function (from, strict = TRUE) { value <- methods::new("RangedSummarizedExperiment") for (what in c("rowRanges", "colData", "assays", "NAMES", "elementMetadata", "metadata")) methods::slot(value, what) <- methods::slot(from, what) value }, test = function (object) TRUE, replace = function (from, to, value) { for (what in c("rowRanges", "colData", "assays", "NAMES", "elementMetadata", "metadata")) methods::slot(from, what) <- methods::slot(value, what) from }, simple = TRUE, by = character(0), dataPart = FALSE, distance = 1), SummarizedExperiment = new("SClassExtension", subClass = structure("SingleCellExperiment", package = "SingleCellExperiment"), superClass = structure("SummarizedExperiment", package = "SummarizedExperiment"), package = "SingleCellExperiment", coerce = function (from, strict = TRUE) { from <- { value <- methods::new("RangedSummarizedExperiment") for (what in c("rowRanges", "colData", "assays", "NAMES", "elementMetadata", "metadata")) methods::slot(value, what) <- methods::slot(from, what) value } { value <- methods::new("SummarizedExperiment") for (what in c("colData", "assays", "NAMES", "elementMetadata", "metadata")) methods::slot(value, what) <- methods::slot(from, what) value } }, test = function (object) TRUE, replace = function (from, to, value) { .value <- methods::as(from, "RangedSummarizedExperiment", TRUE) methods::as(.value, "SummarizedExperiment") <- value value <- .value { for (what in c("rowRanges", "colData", "assays", "NAMES", "elementMetadata", "metadata")) methods::slot(from, what) <- methods::slot(value, what) from } }, simple = TRUE, by = structure("RangedSummarizedExperiment", package = "SummarizedExperiment"), dataPart = FALSE, distance = 2), RectangularData = new("SClassExtension", subClass = structure("SingleCellExperiment", package = "SingleCellExperiment"), superClass = structure("RectangularData", package = "S4Vectors"), package = "SingleCellExperiment", coerce = function (from, strict = TRUE) { from <- { value <- methods::new("RangedSummarizedExperiment") for (what in c("rowRanges", "colData", "assays", "NAMES", "elementMetadata", "metadata")) methods::slot(value, what) <- methods::slot(from, what) value } { from <- { value <- methods::new("SummarizedExperiment") for (what in c("colData", "assays", "NAMES", "elementMetadata", "metadata")) methods::slot(value, what) <- methods::slot(from, what) value } from } }, test = function (object) TRUE, replace = function (from, to, value) { .value <- methods::as(from, "RangedSummarizedExperiment", TRUE) methods::as(.value, "RectangularData") <- value value <- .value { for (what in c("rowRanges", "colData", "assays", "NAMES", "elementMetadata", "metadata")) methods::slot(from, what) <- methods::slot(value, what) from } }, simple = TRUE, by = structure("RangedSummarizedExperiment", package = "SummarizedExperiment"), dataPart = FALSE, distance = 3), Vector = new("SClassExtension", subClass = structure("SingleCellExperiment", package = "SingleCellExperiment"), superClass = structure("Vector", package = "S4Vectors"), package = "SingleCellExperiment", coerce = function (from, strict = TRUE) { from <- { value <- methods::new("RangedSummarizedExperiment") for (what in c("rowRanges", "colData", "assays", "NAMES", "elementMetadata", "metadata")) methods::slot(value, what) <- methods::slot(from, what) value } { from <- { value <- methods::new("SummarizedExperiment") for (what in c("colData", "assays", "NAMES", "elementMetadata", "metadata")) methods::slot(value, what) <- methods::slot(from, what) value } from } }, test = function (object) TRUE, replace = function (from, to, value) { .value <- methods::as(from, "RangedSummarizedExperiment", TRUE) methods::as(.value, "Vector") <- value value <- .value { for (what in c("rowRanges", "colData", "assays", "NAMES", "elementMetadata", "metadata")) methods::slot(from, what) <- methods::slot(value, what) from } }, simple = TRUE, by = structure("RangedSummarizedExperiment", package = "SummarizedExperiment"), dataPart = FALSE, distance = 3), Annotated = new("SClassExtension", subClass = structure("SingleCellExperiment", package = "SingleCellExperiment"), superClass = structure("Annotated", package = "S4Vectors"), package = "SingleCellExperiment", coerce = function (from, strict = TRUE) { from <- { value <- methods::new("RangedSummarizedExperiment") for (what in c("rowRanges", "colData", "assays", "NAMES", "elementMetadata", "metadata")) methods::slot(value, what) <- methods::slot(from, what) value } { from <- { value <- methods::new("SummarizedExperiment") for (what in c("colData", "assays", "NAMES", "elementMetadata", "metadata")) methods::slot(value, what) <- methods::slot(from, what) value } from } }, test = function (object) TRUE, replace = function (from, to, value) { .value <- methods::as(from, "RangedSummarizedExperiment", TRUE) methods::as(.value, "Annotated") <- value value <- .value { for (what in c("rowRanges", "colData", "assays", "NAMES", "elementMetadata", "metadata")) methods::slot(from, what) <- methods::slot(value, what) from } }, simple = TRUE, by = structure("RangedSummarizedExperiment", package = "SummarizedExperiment"), dataPart = FALSE, distance = 4), vector_OR_Vector = new("SClassExtension", subClass = structure("SingleCellExperiment", package = "SingleCellExperiment"), superClass = structure("vector_OR_Vector", package = "S4Vectors"), package = "SingleCellExperiment", coerce = function (from, strict = TRUE) { from <- { value <- methods::new("RangedSummarizedExperiment") for (what in c("rowRanges", "colData", "assays", "NAMES", "elementMetadata", "metadata")) methods::slot(value, what) <- methods::slot(from, what) value } { from <- { value <- methods::new("SummarizedExperiment") for (what in c("colData", "assays", "NAMES", "elementMetadata", "metadata")) methods::slot(value, what) <- methods::slot(from, what) value } from } }, test = function (object) TRUE, replace = function (from, to, value) { .value <- methods::as(from, "RangedSummarizedExperiment", TRUE) methods::as(.value, "vector_OR_Vector") <- value value <- .value { for (what in c("rowRanges", "colData", "assays", "NAMES", "elementMetadata", "metadata")) methods::slot(from, what) <- methods::slot(value, what) from } }, simple = TRUE, by = structure("RangedSummarizedExperiment", package = "SummarizedExperiment"), dataPart = FALSE, distance = 4)), virtual = FALSE, prototype = <S4 object of class NULL>, validity = function (object) { if (disableValidity()) return(TRUE) if (debugValidity()) { whoami <- paste("validity method for", Class, "object") cat("[debugValidity] Entering ", whoami, "\n", sep = "") on.exit(cat("[debugValidity] Leaving ", whoami, "\n", sep = "")) } desc_strings <- method(object) if (isTRUE(desc_strings) || length(desc_strings) == 0L) return(TRUE) vapply(desc_strings, wmsg2, character(1), USE.NAMES = FALSE) }, access = list(), className = structure("SingleCellExperiment", package = "SingleCellExperiment"), package = "SingleCellExperiment", subclasses = list(), versionKey = <pointer: (nil)>, sealed = FALSE)>
HiDDENgt(x, cond_col, control_val, group_by, ...)
## S7 method for class <new("classRepresentation", slots = list(assays = structure("list", package = "methods"), meta.data = structure("data.frame", package = "methods"), active.assay = structure("character", package = "methods"), active.ident = structure("factor", package = "methods"), graphs = structure("list", package = "methods"), neighbors = structure("list", package = "methods"), reductions = structure("list", package = "methods"), images = structure("list", package = "methods"), project.name = structure("character", package = "methods"), misc = structure("list", package = "methods"), version = structure("package_version", package = "SeuratObject"), commands = structure("list", package = "methods"), tools = structure("list", package = "methods")), contains = list(), virtual = FALSE, prototype = <S4 object of class NULL>, validity = function (object) { if (.GetSeuratCompat() < "5.0.0") { return(TRUE) } if (isFALSE(x = getOption(x = "Seurat.object.validate", default = TRUE))) { warn(message = paste("Not validating", class(x = object)[1L], "objects"), class = "validationWarning") return(TRUE) } valid <- NULL md <- slot(object = object, name = "meta.data") if (!.IsDataFrame(x = md)) { valid <- c(valid, "'meta.data' must be a base-R data.frame") } if (ncol(x = md)) { if (is.null(x = names(x = md)) || any(!nzchar(x = names(x = md)))) { valid <- c(valid, "all columns in 'meta.data' must be named") } } ocells <- colnames(x = object) if (anyDuplicated(x = ocells)) { valid <- c(valid, "cell names may not be duplicated") } if (!IsNamedList(x = slot(object = object, name = "assays"))) { valid <- c(valid, "'assays' must be a named list") } else { for (assay in Assays(object = object)) { if (!inherits(x = object[[assay]], what = c("Assay", "StdAssay"))) { valid <- c(valid, "'assays' must be a list of 'Assay' objects") break } acells <- colnames(x = object[[assay]]) if (!all(acells %in% ocells)) { valid <- c(valid, "all cells in assays must be present in the Seurat object") } else if (is.unsorted(x = MatchCells(new = acells, orig = ocells, ordered = TRUE))) { valid <- c(valid, "all cells in assays must be in the same order as the Seurat object") } if (!isTRUE(x = nzchar(x = Key(object = object[[assay]])))) { valid <- c(valid, "all assays must have a key") } } } if (!IsNamedList(x = slot(object = object, name = "reductions"), pass.zero = TRUE)) { valid <- c(valid, "'reductions' must be a named list") } else { for (reduc in Reductions(object = object)) { rcells <- Cells(x = object[[reduc]]) if (!all(rcells %in% ocells)) { valid <- c(valid, "All cells in reductions must be present in the Seurat object") } else if (is.unsorted(x = MatchCells(new = rcells, orig = ocells, ordered = TRUE))) { valid <- c(valid, "all cells in reductions must be in the same order as the Seurat object") } } } if (!IsNamedList(x = slot(object = object, name = "graphs"), pass.zero = TRUE)) { valid <- c(valid, "'graphs' must be a named list") } else { for (graph in Graphs(object = object)) { gnames <- Cells(x = object[[graph]], margin = NA_integer_) if (!all(gnames %in% colnames(x = object))) { valid <- c(valid, "all cells in graphs must be present in the Seurat object") } else if (is.unsorted(x = MatchCells(new = gnames, orig = ocells, ordered = TRUE))) { valid <- c(valid, paste0("all cells in graphs must be in the same order as the Seurat object (offending: ", graph, ")")) } } } if (!IsNamedList(x = slot(object = object, name = "neighbors"), pass.zero = TRUE)) { valid <- c(valid, "'neighbors' must be a named list") } else { for (nn in Neighbors(object = object)) { ncells <- Cells(x = object[[nn]]) if (!all(ncells %in% ocells)) { valid <- c(valid, "All cells in neighbor objects must be present in the Seurat object") } else if (is.unsorted(x = MatchCells(new = ncells, orig = ocells, ordered = TRUE))) { valid <- c(valid, "All cells in neighbor objects must be in the same order as the Seurat object") } } } if (!IsNamedList(x = slot(object = object, name = "images"), pass.zero = TRUE)) { valid <- c(valid, "'images' must be a named list") } else { for (img in Images(object = object)) { icells <- Cells(x = object[[img]]) if (!all(icells %in% ocells)) { valid <- c(valid, "All cells in images must be present in the Seurat object") } } } proj <- Project(object = object) if (length(x = proj) != 1L) { valid <- c(valid, "'project' must be a 1-length character vector") } else if (is.na(x = proj)) { valid <- c(valid, "'project' cannot be NA") } else if (!nzchar(x = proj)) { valid <- c(valid, "'project' cannot be an empty character") } idents <- Idents(object = object) if (length(x = idents) != ncol(x = object)) { valid <- c(valid, "'active.idents' must be as long as the number of cells present") } else if (!all(names(x = idents) == colnames(x = object))) { valid <- c(valid, "'active.idents' must be named with cell names") } if (length(x = slot(object = object, name = "version")) > 1) { valid <- c(valid, "Only one version is allowed") } return(valid %||% TRUE) }, access = list(), className = structure("Seurat", package = "SeuratObject"), package = "SeuratObject", subclasses = list(), versionKey = <pointer: (nil)>, sealed = FALSE)>
HiDDENgt(x, cond_col, control_val, group_by, ...)Arguments
- x
input object
- ...
extra arguments passed into pipeline
- cond_col
character character indicating per-cell metadata column for condition labels
- control_val
value in per-cell condition labels representing control condition
- group_by
character character indicating per-cell metadata column for grouping labels
- tuner
Tuner
- algo
Pipeline
- which_grouped
character vector of argument names from the pipeline need to be grouped (by default will be determined automatically by checking which ones support indexing)
- grp_specific_args
list any arguments that need to be provided on a group-specific basis (list w/ names being groups, values being lists w/ names being arguments names, values being associated value) (by default will be determined automatically by checking which ones support indexing)
Value
HiDDENgt output - list of three (3) elements w/ names:
chosen: mapping from each group to selected hyper-parameter for that groupby_param: accessor function which given a mapping of groups to hyper-parameters (and an optional default hyper-parameter for unspecified groups), returns a list of three (3) elements w/ names:p_hat: 1-d array of prediction outputs by model, ordered by their original order within the providedlabs: model adjusted labelsscore: mapping of group to score value given provided configuration
by_grp: accessor function which given a specific group, returns HiDDENt-style output for just that group
Examples
if (FALSE) { # requireNamespace("irlba", quietly = TRUE) && requireNamespace("Seurat", quietly = TRUE) && requireNamespace("SeuratObject", quietly = TRUE) && requireNamespace("SeuratData", quietly = TRUE) && ("ifnb" %in% SeuratData::InstalledData()[["Dataset"]])
so <- SeuratData::LoadData("ifnb") |>
Seurat::SCTransform(verbose = FALSE) |>
suppressWarnings() |>
suppressMessages()
sct_pca <- function(so, k) {
irlba::prcomp_irlba(
t(SeuratObject::LayerData(so, assay = "SCT", layer = "scale.data")),
n = k
)$x
}
algo <- adapters$Pipeline(to_step(sct_pca), methods$reg_logit, methods$bin_kmeans)
tuner <- tune$FixPointTuner(5, 8, 0.04)
out <- HiDDENgt(so, "stim", "CTRL", "seurat_annotations", tuner, algo, so = so)
names(out)
names(out[["by_param"]](out[["chosen"]]))
names(out[["by_grp"]](names(out[["chosen"]])[[1]]))
}