R/main.R

In NCBI-Hackathons/clustifyR: Classifier for Single-cell RNA-seq Using Cell Clusters

#' Compare scRNA-seq data to reference data.
#'
#' @export
clustify <- function(input, ...) {
  UseMethod("clustify", input)
}

#' @rdname clustify
#' @param input single-cell expression matrix or Seurat object
#' @param metadata cell cluster assignments,
#'   supplied as a vector or data.frame.
#'   If data.frame is supplied then `cluster_col` needs to be set.
#'   Not required if running correlation per cell.
#' @param ref_mat reference expression matrix
#' @param cluster_col column in metadata that contains cluster ids per cell.
#'   Will default to first column of metadata if not supplied.
#'   Not required if running correlation per cell.
#' @param query_genes A vector of genes of interest to compare. If NULL, then
#'   common genes between the expr_mat and ref_mat
#'   will be used for comparision.
#' @param n_genes number of genes limit for Seurat variable genes, by default 1000,
#'   set to 0 to use all variable genes (generally not recommended)
#' @param per_cell if true run per cell, otherwise per cluster.
#' @param n_perm number of permutations, set to 0 by default
#' @param compute_method method(s) for computing similarity scores
#' @param pseudobulk_method method used for summarizing clusters, options are mean (default), median, truncate (10% truncated mean), or trimean, max, min
#' @param use_var_genes if providing a seurat object, use the variable genes
#'   (stored in seurat_object@var.genes) as the query_genes.
#' @param dr stored dimension reduction
#' @param seurat_out output cor matrix or called seurat object
#'  (deprecated, use obj_out instead)
#' @param verbose whether to report certain variables chosen and steps
#' @param lookuptable if not supplied, will look in built-in table
#'  for object parsing
#' @param rm0 consider 0 as missing data, recommended for per_cell
#' @param obj_out whether to output object instead of cor matrix
#' @param vec_out only output a result vector in the same order as metadata
#' @param rename_prefix prefix to add to type and r column names
#' @param threshold identity calling minimum correlation score threshold,
#'  only used when obj_out = TRUE
#' @param low_threshold_cell option to remove clusters with too few cells
#' @param exclude_genes a vector of gene names to throw out of query
#' @param if_log input data is natural log,
#' averaging will be done on unlogged data
#' @param organism for GO term analysis, organism name: human - 'hsapiens', mouse - 'mmusculus'
#' @param plot_name name for saved pdf, if NULL then no file is written (default)
#' @param rds_name name for saved rds of rank_diff, if NULL then no file is written (default)
#' @param expand_unassigned test all ref clusters for unassigned results
#' @param ... additional arguments to pass to compute_method function
#'
#' @return single cell object with identity assigned in metadata,
#'   or matrix of correlation values, clusters from input as row names, cell
#'   types from ref_mat as column names
#'
#' @examples
#' # Annotate a matrix and metadata
#' clustify(
#'     input = pbmc_matrix_small,
#'     metadata = pbmc_meta,
#'     ref_mat = cbmc_ref,
#'     query_genes = pbmc_vargenes,
#'     cluster_col = "RNA_snn_res.0.5",
#'     verbose = TRUE
#' )
#'
#' # Annotate using a different method
#' clustify(
#'     input = pbmc_matrix_small,
#'     metadata = pbmc_meta,
#'     ref_mat = cbmc_ref,
#'     query_genes = pbmc_vargenes,
#'     cluster_col = "RNA_snn_res.0.5",
#'     compute_method = "cosine"
#' )
#'
#' # Annotate a SingleCellExperiment object
#' sce <- sce_pbmc()
#' clustify(
#'     sce,
#'     cbmc_ref,
#'     cluster_col = "clusters",
#'     obj_out = TRUE,
#'     per_cell = FALSE,
#'     dr = "umap"
#' )
#'
#' # Annotate a Seurat object
#' so <- so_pbmc()
#' clustify(
#'     so,
#'     cbmc_ref,
#'     cluster_col = "seurat_clusters",
#'     obj_out = TRUE,
#'     per_cell = FALSE,
#'     dr = "umap"
#' )
#'
#' # Annotate (and return) a Seurat object per-cell
#' clustify(
#'     input = so,
#'     ref_mat = cbmc_ref,
#'     cluster_col = "seurat_clusters",
#'     obj_out = TRUE,
#'     per_cell = TRUE,
#'     dr = "umap"
#' )
#' @export
clustify.default <- function(
  input,
  ref_mat,
  metadata = NULL,
  cluster_col = NULL,
  query_genes = NULL,
  n_genes = 1000,
  per_cell = FALSE,
  n_perm = 0,
  compute_method = "spearman",
  pseudobulk_method = "mean",
  verbose = TRUE,
  lookuptable = NULL,
  rm0 = FALSE,
  obj_out = TRUE,
  seurat_out = obj_out,
  vec_out = FALSE,
  rename_prefix = NULL,
  threshold = "auto",
  low_threshold_cell = 0,
  exclude_genes = c(),
  if_log = TRUE,
  organism = "hsapiens",
  plot_name = NULL,
  rds_name = NULL,
  expand_unassigned = FALSE,
  ...
) {
  if (!compute_method %in% clustifyr_methods) {
    stop(compute_method, " correlation method not implemented", call. = FALSE)
  }

  input_original <- input
  if (!inherits(input_original, c("matrix", "Matrix", "data.frame"))) {
    temp <- parse_loc_object(
      input,
      type = class(input),
      expr_loc = NULL,
      meta_loc = NULL,
      var_loc = NULL,
      cluster_col = cluster_col,
      lookuptable = lookuptable
    )

    if (!(is.null(temp[["expr"]]))) {
      message("recognized object type - ", class(input))
    }

    input <- temp[["expr"]]
    metadata <- temp[["meta"]]
    if (is.null(query_genes)) {
      query_genes <- temp[["var"]]
    }

    if (is.null(cluster_col)) {
      cluster_col <- temp[["col"]]
    }
  }

  if (is.null(metadata) && !per_cell) {
    stop("`metadata` needed for per cluster analysis", call. = FALSE)
  }

  if (
    !is.null(cluster_col) &&
      !cluster_col %in% colnames(metadata)
  ) {
    stop("given `cluster_col` is not a column in `metadata`", call. = FALSE)
  }

  if (is.null(query_genes) || length(query_genes) == 0) {
    message(
      "Variable features not available, using all genes instead\n",
      "consider supplying variable features to `query_genes` argument."
    )
    query_genes <- NULL
  }

  expr_mat <- input

  # select gene subsets
  gene_constraints <- get_common_elements(
    rownames(expr_mat),
    rownames(ref_mat),
    query_genes
  )

  if (length(exclude_genes) > 0) {
    gene_constraints <- setdiff(gene_constraints, exclude_genes)
  }

  if (verbose) {
    message("using # of genes: ", length(gene_constraints))
    if (length(gene_constraints) >= 2000) {
      message(
        "using a high number (>=2000) genes to calculate correlation ",
        "please consider feature selection to improve performance"
      )
    }
  }

  expr_mat <- expr_mat[gene_constraints, , drop = FALSE]
  ref_mat <- ref_mat[gene_constraints, , drop = FALSE]

  if (!per_cell) {
    if (is.vector(metadata)) {
      cluster_ids <- metadata
    } else if (is.factor(metadata)) {
      cluster_ids <- as.character(metadata)
    } else if (is.data.frame(metadata) & !is.null(cluster_col)) {
      cluster_ids <- metadata[[cluster_col]]
    } else {
      stop(
        "metadata not formatted correctly,
           supply either a character vector or a dataframe",
        call. = FALSE
      )
    }
    if (is.factor(cluster_ids)) {
      cluster_ids <- as.character(cluster_ids)
    }
    cluster_ids[is.na(cluster_ids)] <- "orig.NA"
  }

  if (per_cell) {
    cluster_ids <- colnames(expr_mat)
  }

  if (n_perm == 0) {
    res <- get_similarity(
      expr_mat,
      ref_mat,
      cluster_ids = cluster_ids,
      per_cell = per_cell,
      compute_method = compute_method,
      pseudobulk_method = pseudobulk_method,
      rm0 = rm0,
      if_log = if_log,
      low_threshold = low_threshold_cell,
      ...
    )
  } else {
    # run permutation
    res <- permute_similarity(
      expr_mat,
      ref_mat,
      cluster_ids = cluster_ids,
      n_perm = n_perm,
      per_cell = per_cell,
      compute_method = compute_method,
      pseudobulk_method = pseudobulk_method,
      rm0 = rm0,
      ...
    )
  }

  if (verbose) {
    message(
      "similarity computation completed, matrix of ",
      dim(res)[1],
      " x ",
      dim(res)[2],
      ", preparing output"
    )
  }

  obj_out <- seurat_out
  if (
    obj_out &&
      !inherits(
        input_original,
        c(
          "matrix",
          "Matrix",
          "data.frame"
        )
      ) ||
      (vec_out &&
        inherits(
          input_original,
          c(
            "matrix",
            "Matrix",
            "data.frame"
          )
        ))
  ) {
    df_temp <- cor_to_call(
      res,
      metadata = metadata,
      cluster_col = cluster_col,
      threshold = threshold
    )

    df_temp_full <- call_to_metadata(
      df_temp,
      metadata = metadata,
      cluster_col = cluster_col,
      per_cell = per_cell,
      rename_prefix = rename_prefix
    )

    if (vec_out) {
      if (is.null(rename_prefix)) {
        return(df_temp_full[["type"]])
      } else {
        return(df_temp_full[[paste0(rename_prefix, "_type")]])
      }
    }

    out <- insert_meta_object(
      input_original,
      df_temp_full,
      lookuptable = lookuptable
    )

    if (!is.null(plot_name)) {
      message("saving rank diff plot")
      avg_mat <- average_clusters(
        expr_mat,
        cluster_ids
      )
      assess_rank_bias(
        avg_mat = avg_mat,
        ref_mat = ref_mat,
        query_genes = query_genes,
        res = df_temp,
        organism = organism,
        plot_name = plot_name,
        rds_name = rds_name,
        expand_unassigned = expand_unassigned
      )
    }
    return(out)
  } else {
    return(res)
  }
}

#' @rdname clustify
#' @export
clustify.Seurat <- function(
  input,
  ref_mat,
  cluster_col = NULL,
  query_genes = NULL,
  n_genes = 1000,
  per_cell = FALSE,
  n_perm = 0,
  compute_method = "spearman",
  pseudobulk_method = "mean",
  use_var_genes = TRUE,
  dr = "umap",
  obj_out = TRUE,
  seurat_out = obj_out,
  vec_out = FALSE,
  threshold = "auto",
  verbose = TRUE,
  rm0 = FALSE,
  rename_prefix = NULL,
  exclude_genes = c(),
  metadata = NULL,
  organism = "hsapiens",
  plot_name = NULL,
  rds_name = NULL,
  expand_unassigned = FALSE,
  ...
) {
  s_object <- input
  # for seurat 3.0 +
  expr_mat <- object_data(s_object, "data")
  vec <- FALSE
  if (!is.null(metadata)) {
    if (is.vector(metadata)) {
      vec <- TRUE
    } else if (is.factor(metadata)) {
      vec <- TRUE
      metadata <- as.character(metadata)
    }
  } else {
    metadata <- seurat_meta(s_object, dr = dr)
  }

  if (use_var_genes && is.null(query_genes)) {
    query_genes <- object_data(s_object, "var.genes", n_genes)
  }

  if (verbose) {
    message("object data retrieval complete, moving to similarity computation")
  }

  res <- clustify(
    expr_mat,
    ref_mat,
    metadata,
    query_genes,
    per_cell = per_cell,
    n_perm = n_perm,
    cluster_col = cluster_col,
    compute_method = compute_method,
    pseudobulk_method = pseudobulk_method,
    verbose = verbose,
    rm0 = rm0,
    exclude_genes = exclude_genes,
    ...
  )

  if (n_perm != 0) {
    res <- -log(res$p_val + .01, 10)
  }
  obj_out <- seurat_out
  if (!obj_out && !vec_out || vec) {
    res
  } else {
    df_temp <- cor_to_call(
      res,
      metadata = metadata,
      cluster_col = cluster_col,
      threshold = threshold
    )

    df_temp_full <- call_to_metadata(
      df_temp,
      metadata = metadata,
      cluster_col = cluster_col,
      per_cell = per_cell,
      rename_prefix = rename_prefix
    )

    if (!is.null(plot_name)) {
      message("saving rank diff plot")
      avg_mat <- average_clusters(
        expr_mat,
        metadata,
        cluster_col
      )
      assess_rank_bias(
        avg_mat = avg_mat,
        ref_mat = ref_mat,
        query_genes = query_genes,
        res = df_temp,
        organism = organism,
        plot_name = plot_name,
        rds_name = rds_name,
        expand_unassigned = expand_unassigned
      )
    }

    if (vec_out) {
      if (is.null(rename_prefix)) {
        return(df_temp_full[["type"]])
      } else {
        return(df_temp_full[[paste0(rename_prefix, "_type")]])
      }
    }

    if ("SeuratObject" %in% loadedNamespaces()) {
      s_object <- write_meta(s_object, df_temp_full)
      return(s_object)
    } else {
      message("seurat not loaded, returning cor_mat instead")
      return(res)
    }
    s_object
  }
}

#' @rdname clustify
#' @export
clustify.SingleCellExperiment <- function(
  input,
  ref_mat,
  cluster_col = NULL,
  query_genes = NULL,
  per_cell = FALSE,
  n_perm = 0,
  compute_method = "spearman",
  pseudobulk_method = "mean",
  use_var_genes = TRUE,
  dr = "umap",
  obj_out = TRUE,
  seurat_out = obj_out,
  vec_out = FALSE,
  threshold = "auto",
  verbose = TRUE,
  rm0 = FALSE,
  rename_prefix = NULL,
  exclude_genes = c(),
  metadata = NULL,
  organism = "hsapiens",
  plot_name = NULL,
  rds_name = NULL,
  expand_unassigned = FALSE,
  ...
) {
  s_object <- input
  expr_mat <- object_data(s_object, "data")
  vec <- FALSE
  if (!is.null(metadata)) {
    if (is.vector(metadata)) {
      vec <- TRUE
    } else if (is.factor(metadata)) {
      vec <- TRUE
      metadata <- as.character(metadata)
    }
  } else {
    metadata <- object_data(s_object, "meta.data")
  }

  if (verbose) {
    message("object data retrieval complete, moving to similarity computation")
  }

  res <- clustify(
    expr_mat,
    ref_mat,
    metadata,
    query_genes,
    per_cell = per_cell,
    n_perm = n_perm,
    cluster_col = cluster_col,
    compute_method = compute_method,
    pseudobulk_method = pseudobulk_method,
    verbose = verbose,
    rm0 = rm0,
    exclude_genes = exclude_genes,
    ...
  )

  if (n_perm != 0) {
    res <- -log(res$p_val + .01, 10)
  }
  obj_out <- seurat_out
  if (!obj_out && !vec_out) {
    res
  } else {
    df_temp <- cor_to_call(
      res,
      metadata = metadata,
      cluster_col = cluster_col,
      threshold = threshold
    )

    df_temp_full <- call_to_metadata(
      df_temp,
      metadata = metadata,
      cluster_col = cluster_col,
      per_cell = per_cell,
      rename_prefix = rename_prefix
    )

    if (!is.null(plot_name)) {
      message("saving rank diff plot")
      avg_mat <- average_clusters(
        expr_mat,
        metadata,
        cluster_col
      )
      assess_rank_bias(
        avg_mat = avg_mat,
        ref_mat = ref_mat,
        query_genes = query_genes,
        res = df_temp,
        organism = organism,
        plot_name = plot_name,
        rds_name = rds_name,
        expand_unassigned = expand_unassigned
      )
    }

    if (vec_out) {
      if (is.null(rename_prefix)) {
        return(df_temp_full[["type"]])
      } else {
        return(df_temp_full[[paste0(rename_prefix, "_type")]])
      }
    }

    if ("SingleCellExperiment" %in% loadedNamespaces()) {
      if (!(is.null(rename_prefix))) {
        col_type <- stringr::str_c(rename_prefix, "_type")
        col_r <- stringr::str_c(rename_prefix, "_r")
      } else {
        col_type <- "type"
        col_r <- "r"
      }
      colDatatemp <- metadata
      colDatatemp[[col_type]] <- df_temp_full[[col_type]]
      colDatatemp[[col_r]] <- df_temp_full[[col_r]]
      s_object <- write_meta(s_object, colDatatemp)
      return(s_object)
    } else {
      message("SingleCellExperiment not loaded, returning cor_mat instead")
      return(res)
    }
    s_object
  }
}

#' Correlation functions available in clustifyr
#' @examples
#' clustifyr_methods
#' @export
clustifyr_methods <- c(
  "pearson",
  "spearman",
  "cosine",
  "kl_divergence",
  "kendall"
)

#' Main function to compare scRNA-seq data to gene lists.
#'
#' @export
clustify_lists <- function(input, ...) {
  UseMethod("clustify_lists", input)
}

#' @rdname clustify_lists
#' @param input single-cell expression matrix, Seurat object, or SingleCellExperiment
#' @param marker matrix or dataframe of candidate genes for each cluster
#' @param marker_inmatrix whether markers genes are already in preprocessed
#'   matrix form
#' @param metadata cell cluster assignments,
#'   supplied as a vector or data.frame.
#'   If data.frame is supplied then `cluster_col` needs to be set.
#'   Not required if running correlation per cell.
#' @param cluster_col column in metadata with cluster number
#' @param if_log input data is natural log, averaging will be done on
#'   unlogged data
#' @param per_cell compare per cell or per cluster
#' @param topn number of top expressing genes to keep from input matrix
#' @param cut expression cut off from input matrix
#' @param genome_n number of genes in the genome
#' @param metric adjusted p-value for hypergeometric test, or jaccard index
#' @param output_high if true (by default to fit with rest of package),
#' -log10 transform p-value
#' @param lookuptable if not supplied, will look in built-in table
#'  for object parsing
#' @param obj_out whether to output object instead of cor matrix
#' @param vec_out only output a result vector in the same order as metadata
#' @param rename_prefix prefix to add to type and r column names
#' @param threshold identity calling minimum correlation score threshold,
#' only used when obj_out = T
#' @param low_threshold_cell option to remove clusters with too few cells
#' @param dr stored dimension reduction
#' @param seurat_out output cor matrix or called seurat object
#'   (deprecated, use obj_out instead)
#' @param verbose whether to report certain variables chosen and steps
#' @param input_markers whether input is marker data.frame of 0 and 1s (output of pos_neg_marker), and uses alternate enrichment mode
#' @param details_out whether to also output shared gene list from jaccard
#' @param ... passed to matrixize_markers
#' @examples
#' # Annotate a matrix and metadata
# clustify_lists(
#     input = pbmc_matrix_small,
#     marker = cbmc_m,
#     metadata = pbmc_meta,
#     cluster_col = "classified",
#     verbose = TRUE
# )
#'
#' # Annotate using a different method
#' clustify_lists(
#'     input = pbmc_matrix_small,
#'     marker = cbmc_m,
#'     metadata = pbmc_meta,
#'     cluster_col = "classified",
#'     verbose = TRUE,
#'     metric = "jaccard"
#' )
#' @return matrix of numeric values, clusters from input as row names,
#' cell types from marker_mat as column names

#' @export
clustify_lists.default <- function(
  input,
  marker,
  marker_inmatrix = TRUE,
  metadata = NULL,
  cluster_col = NULL,
  if_log = TRUE,
  per_cell = FALSE,
  topn = 800,
  cut = 0,
  genome_n = 30000,
  metric = "hyper",
  output_high = TRUE,
  lookuptable = NULL,
  obj_out = TRUE,
  seurat_out = obj_out,
  vec_out = FALSE,
  rename_prefix = NULL,
  threshold = 0,
  low_threshold_cell = 0,
  verbose = TRUE,
  input_markers = FALSE,
  details_out = FALSE,
  ...
) {
  input_original <- input
  if (!inherits(input, c("matrix", "Matrix", "data.frame"))) {
    temp <- parse_loc_object(
      input,
      type = class(input),
      expr_loc = NULL,
      meta_loc = NULL,
      var_loc = NULL,
      cluster_col = cluster_col,
      lookuptable = lookuptable
    )
    input <- temp[["expr"]]
    metadata <- temp[["meta"]]
    cluster_info <- metadata
    if (is.null(cluster_col)) {
      cluster_col <- temp[["col"]]
    }
  } else {
    cluster_info <- metadata
  }

  if (metric %in% c("posneg", "pct")) {
    per_cell <- TRUE
  }
  if (input_markers) {
    per_cell <- TRUE
  }
  if (!(per_cell)) {
    input <- average_clusters(
      input,
      cluster_info,
      if_log = if_log,
      cluster_col = cluster_col,
      low_threshold = low_threshold_cell
    )
  }

  if (!input_markers) {
    bin_input <- binarize_expr(input, n = topn, cut = cut)
  } else {
    bin_input <- as.matrix(input_original)
  }

  if (marker_inmatrix != TRUE & metric != "posneg") {
    marker <- matrixize_markers(
      marker,
      ...
    )
    if (verbose) {
      message("number of total markers: ", nrow(marker))
    }
  }

  if (metric == "consensus") {
    results <- lapply(
      c("hyper", "jaccard", "pct", "posneg"),
      function(x) {
        clustify_lists(
          input_original,
          marker,
          metadata = cluster_info,
          cluster_col = cluster_col,
          metric = x
        )
      }
    )
    call_list <- lapply(
      results,
      cor_to_call_rank
    )
    res <- call_consensus(call_list)
  } else if (metric == "pct") {
    res <- gene_pct_markerm(
      input,
      marker,
      cluster_info,
      cluster_col = cluster_col
    )
  } else if (metric == "gsea") {
    res <- compare_lists(
      input,
      marker_mat = marker,
      n = genome_n,
      metric = "gsea",
      output_high = output_high
    )
  } else if (metric != "posneg") {
    res <- compare_lists(
      bin_input,
      marker_mat = marker,
      n = genome_n,
      metric = metric,
      output_high = output_high,
      details_out = details_out
    )
  } else {
    if (is.data.frame(marker)) {
      marker <- as.matrix(marker)
    }
    if (!is.numeric(marker)) {
      marker <- pos_neg_marker(marker)
    }
    res <- pos_neg_select(
      input,
      marker,
      cluster_info,
      cluster_col = cluster_col,
      cutoff_score = NULL
    )
  }

  if (verbose) {
    message(
      "similarity computation completed, matrix of ",
      dim(res)[1],
      " x ",
      dim(res)[2],
      ", preparing output"
    )
  }
  obj_out <- seurat_out
  if (
    (!inherits(input_original, c("matrix", "Matrix", "data.frame")) &&
      obj_out) ||
      (vec_out &&
        inherits(
          input_original,
          c(
            "matrix",
            "Matrix",
            "data.frame"
          )
        ))
  ) {
    if (metric != "consensus") {
      df_temp <- cor_to_call(
        res,
        metadata = metadata,
        cluster_col = cluster_col,
        threshold = threshold
      )

      df_temp_full <- call_to_metadata(
        df_temp,
        metadata = metadata,
        cluster_col = cluster_col,
        per_cell = per_cell,
        rename_prefix = rename_prefix
      )
    } else {
      df_temp_full <- res
    }

    if (vec_out) {
      if (is.null(rename_prefix)) {
        return(df_temp_full[["type"]])
      } else {
        return(df_temp_full[[paste0(rename_prefix, "_type")]])
      }
    }

    out <- insert_meta_object(
      input_original,
      df_temp_full,
      lookuptable = lookuptable
    )

    return(out)
  } else {
    return(res)
  }
}

#' @rdname clustify_lists
#' @export
clustify_lists.Seurat <- function(
  input,
  metadata = NULL,
  cluster_col = NULL,
  if_log = TRUE,
  per_cell = FALSE,
  topn = 800,
  cut = 0,
  marker,
  marker_inmatrix = TRUE,
  genome_n = 30000,
  metric = "hyper",
  output_high = TRUE,
  dr = "umap",
  obj_out = TRUE,
  seurat_out = obj_out,
  vec_out = FALSE,
  threshold = 0,
  rename_prefix = NULL,
  verbose = TRUE,
  details_out = FALSE,
  ...
) {
  s_object <- input
  # for seurat 3.0 +
  input <- object_data(s_object, "data")
  vec <- FALSE
  if (!is.null(metadata)) {
    if (is.vector(metadata)) {
      vec <- TRUE
    } else if (is.factor(metadata)) {
      vec <- TRUE
      metadata <- as.character(metadata)
    }
  } else {
    metadata <- object_data(s_object, "meta.data")
  }
  cluster_info <- metadata

  if (verbose) {
    message("object data retrieval complete, moving to similarity computation")
  }

  res <- clustify_lists(
    input,
    per_cell = per_cell,
    metadata = cluster_info,
    if_log = if_log,
    cluster_col = cluster_col,
    topn = topn,
    cut = cut,
    marker,
    marker_inmatrix = marker_inmatrix,
    genome_n = genome_n,
    metric = metric,
    output_high = output_high,
    verbose = verbose,
    details_out = details_out,
    ...
  )
  obj_out <- seurat_out
  if (!obj_out && !vec_out || vec) {
    res
  } else {
    if (metric != "consensus") {
      df_temp <- cor_to_call(
        res,
        metadata = metadata,
        cluster_col = cluster_col,
        threshold = threshold
      )
    } else {
      df_temp <- res
      colnames(df_temp)[1] <- cluster_col
    }

    df_temp_full <- call_to_metadata(
      df_temp,
      metadata = metadata,
      cluster_col = cluster_col,
      per_cell = per_cell,
      rename_prefix = rename_prefix
    )

    if (vec_out) {
      if (is.null(rename_prefix)) {
        return(df_temp_full[["type"]])
      } else {
        return(df_temp_full[[paste0(rename_prefix, "_type")]])
      }
    }

    if ("SeuratObject" %in% loadedNamespaces()) {
      s_object <- write_meta(s_object, df_temp_full)
      return(s_object)
    } else {
      message("seurat not loaded, returning cor_mat instead")
      return(res)
    }
    s_object
  }
}

#' @rdname clustify_lists
#' @export
clustify_lists.SingleCellExperiment <- function(
  input,
  metadata = NULL,
  cluster_col = NULL,
  if_log = TRUE,
  per_cell = FALSE,
  topn = 800,
  cut = 0,
  marker,
  marker_inmatrix = TRUE,
  genome_n = 30000,
  metric = "hyper",
  output_high = TRUE,
  dr = "umap",
  obj_out = TRUE,
  seurat_out = obj_out,
  vec_out = FALSE,
  threshold = 0,
  rename_prefix = NULL,
  verbose = TRUE,
  details_out = FALSE,
  ...
) {
  s_object <- input
  expr_mat <- object_data(s_object, "data")
  vec <- FALSE
  if (!is.null(metadata)) {
    if (is.vector(metadata)) {
      vec <- TRUE
    } else if (is.factor(metadata)) {
      vec <- TRUE
      metadata <- as.character(metadata)
    }
  } else {
    metadata <- object_data(s_object, "meta.data")
  }

  if (verbose) {
    message("object data retrieval complete, moving to similarity computation")
  }

  res <- clustify_lists(
    expr_mat,
    per_cell = per_cell,
    metadata = metadata,
    if_log = if_log,
    cluster_col = cluster_col,
    topn = topn,
    cut = cut,
    marker,
    marker_inmatrix = marker_inmatrix,
    genome_n = genome_n,
    metric = metric,
    output_high = output_high,
    details_out = details_out,
    ...
  )

  if (!obj_out && !vec_out || vec) {
    res
  } else {
    df_temp <- cor_to_call(
      res,
      metadata = metadata,
      cluster_col = cluster_col,
      threshold = threshold
    )

    df_temp_full <- call_to_metadata(
      df_temp,
      metadata = metadata,
      cluster_col = cluster_col,
      per_cell = per_cell,
      rename_prefix = rename_prefix
    )

    if (vec_out) {
      if (is.null(rename_prefix)) {
        return(df_temp_full[["type"]])
      } else {
        return(df_temp_full[[paste0(rename_prefix, "_type")]])
      }
    }

    if ("SingleCellExperiment" %in% loadedNamespaces()) {
      if (!(is.null(rename_prefix))) {
        col_type <- stringr::str_c(rename_prefix, "_type")
        col_r <- stringr::str_c(rename_prefix, "_r")
      } else {
        col_type <- "type"
        col_r <- "r"
      }
      colDatatemp <- metadata
      colDatatemp[[col_type]] <- df_temp_full[[col_type]]
      colDatatemp[[col_r]] <- df_temp_full[[col_r]]
      s_object <- write_meta(s_object, colDatatemp)
      return(s_object)
    } else {
      message("SingleCellExperiment not loaded, returning cor_mat instead")
      return(res)
    }
    s_object
  }
}