clean up unused functions 2

NAMESPACE

@@ -53,7 +53,6 @@ export(pos_neg_marker)
 export(pos_neg_select)
 export(ref_feature_select)
 export(ref_marker_select)
-export(remove_background)
 export(reverse_marker_matrix)
 export(run_gsea)
 export(seurat_meta)

R/common_dplyr.R

@@ -0,0 +1,384 @@
+#' get best calls for each cluster
+#'
+#' @param cor_mat input similarity matrix
+#' @param metadata input metadata with tsne or umap coordinates and cluster ids
+#' @param cluster_col metadata column, can be cluster or cellid
+#' @param collapse_to_cluster if a column name is provided, takes the most
+#' frequent call of entire cluster to color in plot
+#' @param threshold minimum correlation coefficent cutoff for calling clusters
+#' @param rename_prefix prefix to add to type and r column names
+#' @param carry_r whether to include threshold in unassigned names
+#' @return dataframe of cluster, new ident, and r info
+#' @examples
+#' res <- clustify(
+#'     input = pbmc_matrix_small,
+#'     metadata = pbmc_meta,
+#'     cluster_col = "classified",
+#'     ref_mat = cbmc_ref
+#' )
+#'
+#' cor_to_call(res)
+#' @export
+cor_to_call <- function(cor_mat,
+                        metadata = NULL,
+                        cluster_col = "cluster",
+                        collapse_to_cluster = FALSE,
+                        threshold = 0,
+                        rename_prefix = NULL,
+                        carry_r = FALSE) {
+    correlation_matrix <- cor_mat
+    if (threshold == "auto") {
+        threshold <- round(0.75 * max(correlation_matrix), 2)
+        message(paste0("using threshold of ", threshold))
+    }
+    correlation_matrix[is.na(correlation_matrix)] <- 0
+    df_temp <-
+        tibble::as_tibble(correlation_matrix, rownames = cluster_col)
+    df_temp <- tidyr::gather(
+        df_temp,
+        key = !!dplyr::sym("type"),
+        value = !!dplyr::sym("r"), -!!cluster_col
+    )
+
+    if (carry_r) {
+        df_temp[["type"]][df_temp$r < threshold] <-
+            paste0("r<", threshold, ", unassigned")
+    } else {
+        df_temp[["type"]][df_temp$r < threshold] <- "unassigned"
+    }
+
+    df_temp <-
+        dplyr::top_n(dplyr::group_by_at(df_temp, 1), 1, !!dplyr::sym("r"))
+    if (nrow(df_temp) != nrow(correlation_matrix)) {
+        clash <- dplyr::summarize(dplyr::group_by_at(df_temp, 1), n = n())
+        clash <- dplyr::filter(clash, n > 1)
+        clash <- dplyr::pull(clash, 1)
+        df_temp[lapply(
+            df_temp[, 1],
+            FUN = function(x) {
+                x %in% clash
+            }
+        )[[1]], 2] <-
+            paste0(df_temp[["type"]][lapply(
+                df_temp[, 1],
+                FUN = function(x) {
+                    x %in% clash
+                }
+            )[[1]]], "-CLASH!")
+        df_temp2 <- df_temp
+        df_temp_full <-
+            dplyr::distinct_at(df_temp,
+                               vars(-!!dplyr::sym("type")),
+                               .keep_all = TRUE)
+    } else {
+        df_temp_full <- df_temp
+    }
+
+    if (collapse_to_cluster != FALSE) {
+        if (!(cluster_col %in% colnames(metadata))) {
+            metadata <- tibble::as_tibble(metadata, rownames = "rn")
+        }
+        df_temp_full <-
+            collapse_to_cluster(
+                df_temp_full,
+                metadata = metadata,
+                cluster_col = cluster_col,
+                threshold = threshold
+            )
+    }
+
+    if (!is.null(rename_prefix)) {
+        if (collapse_to_cluster) {
+            eval(parse(
+                text = paste0(
+                    "df_temp_full <- dplyr::rename(df_temp_full, ",
+                    paste0(rename_prefix, "_type"),
+                    " = type, ",
+                    paste0(rename_prefix, "_sum"),
+                    " = sum, ",
+                    paste0(rename_prefix, "_n"),
+                    " = n)"
+                )
+            ))
+        } else {
+            eval(parse(
+                text = paste0(
+                    "df_temp_full <- dplyr::rename(df_temp_full, ",
+                    paste0(rename_prefix, "_type"),
+                    " = type, ",
+                    paste0(rename_prefix, "_r"),
+                    " = r)"
+                )
+            ))
+        }
+    }
+    df_temp_full
+}
+
+#' Insert called ident results into metadata
+#'
+#' @param res dataframe of idents, such as output of cor_to_call
+#' @param metadata input metadata with tsne or umap coordinates and cluster ids
+#' @param cluster_col metadata column, can be cluster or cellid
+#' @param per_cell whether the res dataframe is listed per cell
+#' @param rename_prefix prefix to add to type and r column names
+#' @return new metadata with added columns
+#' @examples
+#' \donttest{
+#' res <- clustify(
+#'     input = pbmc_matrix_small,
+#'     metadata = pbmc_meta,
+#'     cluster_col = "classified",
+#'     ref_mat = cbmc_ref
+#' )
+#'
+#' res2 <- cor_to_call(res, cluster_col = "classified")
+#'
+#' call_to_metadata(
+#'     res = res2,
+#'     metadata = pbmc_meta,
+#'     cluster_col = "classified",
+#'     rename_prefix = "assigned"
+#' )
+#' }
+#' @export
+call_to_metadata <- function(res,
+                             metadata,
+                             cluster_col,
+                             per_cell = FALSE,
+                             rename_prefix = NULL) {
+    temp_col_id <- get_unique_column(metadata, "rn")
+
+    df_temp <- res
+    if (!is.null(rename_prefix)) {
+        eval(parse(
+            text = paste0(
+                "df_temp <- dplyr::rename(df_temp, ",
+                paste0(rename_prefix, "_type"),
+                " = type, ",
+                paste0(rename_prefix, "_r"),
+                " = r)"
+            )
+        ))
+    }
+
+    if (per_cell == FALSE) {
+        if (!(cluster_col %in% colnames(metadata))) {
+            stop("cluster_col is not a column of metadata",
+                 call. = FALSE)
+        }
+
+        if (!(cluster_col %in% colnames(res))) {
+            stop("cluster_col is not a column ",
+                 "of called cell type dataframe",
+                call. = FALSE
+            )
+        }
+
+        if (!(all(unique(df_temp[[cluster_col]]) %in%
+                  unique(metadata[[cluster_col]])))) {
+            stop("cluster_col from clustify step and",
+                "joining to metadata step are not the same",
+                call. = FALSE
+            )
+        }
+
+        df_temp_full <-
+            suppressWarnings(
+                dplyr::left_join(
+                    tibble::rownames_to_column(
+                        metadata,
+                        temp_col_id
+                    ),
+                    df_temp,
+                    by = cluster_col,
+                    suffix = c("", ".clustify")
+                )
+            )
+
+        df_temp_full <- tibble::column_to_rownames(
+            df_temp_full,
+            temp_col_id
+        )
+    } else {
+        colnames(df_temp)[1] <- cluster_col
+        names(cluster_col) <- temp_col_id
+
+        df_temp_full <-
+            suppressWarnings(
+                dplyr::left_join(
+                    tibble::rownames_to_column(
+                        metadata,
+                        temp_col_id
+                    ),
+                    df_temp,
+                    by = cluster_col,
+                    suffix = c("", ".clustify")
+                )
+            )
+
+        df_temp_full <-
+            tibble::column_to_rownames(df_temp_full,
+                                       temp_col_id)
+    }
+    df_temp_full
+}
+
+#' From per-cell calls, take highest freq call in each cluster
+#'
+#' @param res dataframe of idents, such as output of cor_to_call
+#' @param metadata input metadata with tsne or umap coordinates and cluster ids
+#' @param cluster_col metadata column for cluster
+#' @param threshold minimum correlation coefficent cutoff for calling clusters
+#' @return new metadata with added columns
+#' @examples
+#' res <- clustify(
+#'     input = pbmc_matrix_small,
+#'     metadata = pbmc_meta,
+#'     cluster_col = "classified",
+#'     ref_mat = cbmc_ref,
+#'     per_cell = TRUE
+#' )
+#'
+#' res2 <- cor_to_call(res)
+#'
+#' collapse_to_cluster(
+#'     res2,
+#'     metadata = pbmc_meta,
+#'     cluster_col = "classified",
+#'     threshold = 0
+#' )
+#' @export
+collapse_to_cluster <- function(res,
+                                metadata,
+                                cluster_col,
+                                threshold = 0) {
+    res_temp <- res
+    colnames(res_temp)[1] <- "rn"
+    df_temp_full <- as.data.frame(res_temp)
+    df_temp_full <-
+        dplyr::mutate(df_temp_full,
+                      cluster = metadata[[cluster_col]])
+    df_temp_full2 <-
+        dplyr::group_by(df_temp_full,
+                        !!dplyr::sym("type"),
+                        !!dplyr::sym("cluster"))
+    df_temp_full2 <-
+        dplyr::summarize(df_temp_full2,
+            sum = sum(!!dplyr::sym("r")),
+            n = n()
+        )
+    df_temp_full2 <-
+        dplyr::group_by(df_temp_full2,
+                        !!dplyr::sym("cluster"))
+    df_temp_full2 <-
+        dplyr::arrange(df_temp_full2,
+                       desc(n),
+                       desc(sum))
+    df_temp_full2 <-
+        dplyr::filter(df_temp_full2,
+                      !!dplyr::sym("type") != paste0("r<",
+                                                     threshold,
+                                                     ", unassigned"))
+    df_temp_full2 <- dplyr::slice(df_temp_full2, 1)
+    df_temp_full2 <-
+        dplyr::rename(df_temp_full2,
+                      !!cluster_col := cluster)
+    dplyr::select(df_temp_full2, 2, 1,
+                  tidyr::everything())
+}
+
+#' get ranked calls for each cluster
+#'
+#' @param cor_mat input similarity matrix
+#' @param metadata input metadata with tsne or umap coordinates
+#' and cluster ids
+#' @param cluster_col metadata column, can be cluster or cellid
+#' @param collapse_to_cluster if a column name is provided, takes the most
+#' frequent call of entire cluster to color in plot
+#' @param threshold minimum correlation coefficent cutoff for calling clusters
+#' @param rename_prefix prefix to add to type and r column names
+#' @param top_n the number of ranks to keep, the rest will be set to 100
+#' @return dataframe of cluster, new ident, and r info
+#' @examples
+#' res <- clustify(
+#'     input = pbmc_matrix_small,
+#'     metadata = pbmc_meta,
+#'     cluster_col = "classified",
+#'     ref_mat = cbmc_ref
+#' )
+#'
+#' cor_to_call_rank(res, threshold = "auto")
+#' @export
+cor_to_call_rank <- function(cor_mat,
+                             metadata = NULL,
+                             cluster_col = "cluster",
+                             collapse_to_cluster = FALSE,
+                             threshold = 0,
+                             rename_prefix = NULL,
+                             top_n = NULL) {
+    correlation_matrix <- cor_mat
+    if (threshold == "auto") {
+        threshold <- round(0.75 * max(correlation_matrix), 2)
+        message(paste0("using threshold of ", threshold))
+    }
+    df_temp <- tibble::as_tibble(correlation_matrix,
+        rownames = cluster_col
+    )
+    df_temp <-
+        tidyr::gather(
+            df_temp,
+            key = !!dplyr::sym("type"),
+            value = !!dplyr::sym("r"), -!!cluster_col
+        )
+    df_temp <-
+        dplyr::mutate(dplyr::group_by_at(df_temp, 1),
+                      rank = dplyr::dense_rank(desc(!!dplyr::sym("r"))))
+    df_temp[["rank"]][df_temp$r < threshold] <- 100
+    if (!(is.null(top_n))) {
+        df_temp <- dplyr::filter(df_temp, rank <= top_n)
+    }
+    df_temp_full <- df_temp
+    if (!is.null(rename_prefix)) {
+        eval(parse(
+            text = paste0(
+                "df_temp_full <- dplyr::rename(df_temp_full, ",
+                paste0(rename_prefix, "_type"),
+                " = type, ",
+                paste0(rename_prefix, "_r"),
+                " = r)"
+            )
+        ))
+    }
+    df_temp_full
+}
+
+#' get concensus calls for a list of cor calls
+#'
+#' @param list_of_res list of call dataframes from cor_to_call_rank
+#' @return dataframe of cluster, new ident, and mean rank
+#' @examples
+#' res <- clustify(
+#'     input = pbmc_matrix_small,
+#'     metadata = pbmc_meta,
+#'     cluster_col = "classified",
+#'     ref_mat = cbmc_ref
+#' )
+#'
+#' res2 <- cor_to_call_rank(res, threshold = "auto")
+#' res3 <- cor_to_call_rank(res)
+#' call_consensus(list(res2, res3))
+#' @export
+call_consensus <- function(list_of_res) {
+
+    res <- do.call("rbind", list_of_res)
+    df_temp <- dplyr::group_by_at(res, c(1, 2))
+    df_temp <- dplyr::summarize_at(df_temp, 2, mean)
+    df_temp <- dplyr::top_n(df_temp, -1)
+    df_temp <- dplyr::group_by_at(df_temp, c(1, 3))
+    df_temp <-
+        dplyr::summarize_at(df_temp, 1, function(x) {
+            stringr::str_c(x, collapse = "__")
+        })
+    df_temp <- dplyr::select(df_temp, c(1, 3, 2))
+}