From df061b728b528964163073f34cbc33529fa0ec4b Mon Sep 17 00:00:00 2001 From: zhanghao-njmu <542370159@qq.com> Date: Mon, 20 Nov 2023 22:07:40 +0800 Subject: [PATCH] Update CellDimPlot function --- NAMESPACE | 2 + R/SCP-app.R | 2 +- R/SCP-plot.R | 101 +++++++++++++++++++++++++++++++++++--------- R/SCP-workflow.R | 29 +++++++++++-- R/Seurat-function.R | 2 +- R/utils.R | 7 +-- man/CellDimPlot.Rd | 42 ++++++++++++++++-- 7 files changed, 153 insertions(+), 32 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 066312d5..b82030d9 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -332,8 +332,10 @@ importFrom(dplyr,summarise) importFrom(dplyr,summarise_at) importFrom(future,nbrOfWorkers) importFrom(future.apply,future_sapply) +importFrom(ggforce,geom_mark_circle) importFrom(ggforce,geom_mark_ellipse) importFrom(ggforce,geom_mark_hull) +importFrom(ggforce,geom_mark_rect) importFrom(ggnewscale,new_scale) importFrom(ggnewscale,new_scale_color) importFrom(ggnewscale,new_scale_fill) diff --git a/R/SCP-app.R b/R/SCP-app.R index af18df30..94900483 100644 --- a/R/SCP-app.R +++ b/R/SCP-app.R @@ -602,7 +602,7 @@ RunSCExplorer <- function(base_dir = "SCExplorer", style_script = require("styler", quietly = TRUE), overwrite = FALSE, return_app = TRUE) { - check_R(c("rhdf5", "HDF5Array", "shiny", "ggplot2", "ragg", "htmlwidgets", "plotly", "bslib", "future", "promises", "BiocParallel")) + check_R(c("rhdf5", "HDF5Array", "shiny@1.6.0", "ggplot2", "ragg", "htmlwidgets", "plotly", "bslib", "future", "promises", "BiocParallel")) DataFile_full <- paste0(base_dir, "/", DataFile) MetaFile_full <- paste0(base_dir, "/", MetaFile) if (!file.exists(DataFile_full) || !file.exists(MetaFile_full)) { diff --git a/R/SCP-plot.R b/R/SCP-plot.R index b0d17972..a0737706 100644 --- a/R/SCP-plot.R +++ b/R/SCP-plot.R @@ -1222,9 +1222,9 @@ BlendRGBList <- function(Clist, mode = "blend", RGB_BackGround = c(1, 1, 1)) { #' CellDimPlot(pancreas_sub, group.by = "SubCellType", reduction = "UMAP", theme_use = ggplot2::theme_classic, theme_args = list(base_size = 16)) #' CellDimPlot(pancreas_sub, group.by = "SubCellType", reduction = "UMAP") %>% panel_fix(height = 2, raster = TRUE, dpi = 30) #' -#' # Label and highlight cell points +#' # Highlight cells #' CellDimPlot(pancreas_sub, -#' group.by = "SubCellType", reduction = "UMAP", label = TRUE, label_insitu = TRUE, +#' group.by = "SubCellType", reduction = "UMAP", #' cells.highlight = colnames(pancreas_sub)[pancreas_sub$SubCellType == "Epsilon"] #' ) #' CellDimPlot(pancreas_sub, @@ -1232,9 +1232,38 @@ BlendRGBList <- function(Clist, mode = "blend", RGB_BackGround = c(1, 1, 1)) { #' cells.highlight = TRUE, theme_use = "theme_blank", legend.position = "none" #' ) #' +#' # Add group labels +#' CellDimPlot(pancreas_sub, group.by = "SubCellType", reduction = "UMAP", label = TRUE) +#' CellDimPlot(pancreas_sub, +#' group.by = "SubCellType", reduction = "UMAP", +#' label = TRUE, label.fg = "orange", label.bg = "red", label.size = 5 +#' ) +#' CellDimPlot(pancreas_sub, +#' group.by = "SubCellType", reduction = "UMAP", +#' label = TRUE, label_insitu = TRUE +#' ) +#' CellDimPlot(pancreas_sub, +#' group.by = "SubCellType", reduction = "UMAP", +#' label = TRUE, label_insitu = TRUE, label_repel = TRUE, label_segment_color = "red" +#' ) +#' +#' # Add various shape of marks +#' CellDimPlot(pancreas_sub, group.by = "SubCellType", reduction = "UMAP", add_mark = TRUE) +#' CellDimPlot(pancreas_sub, group.by = "SubCellType", reduction = "UMAP", add_mark = TRUE, mark_expand = unit(1, "mm")) +#' CellDimPlot(pancreas_sub, group.by = "SubCellType", reduction = "UMAP", add_mark = TRUE, mark_alpha = 0.3) +#' CellDimPlot(pancreas_sub, group.by = "SubCellType", reduction = "UMAP", add_mark = TRUE, mark_linetype = 2) +#' CellDimPlot(pancreas_sub, group.by = "SubCellType", reduction = "UMAP", add_mark = TRUE, mark_type = "ellipse") +#' CellDimPlot(pancreas_sub, group.by = "SubCellType", reduction = "UMAP", add_mark = TRUE, mark_type = "rect") +#' CellDimPlot(pancreas_sub, group.by = "SubCellType", reduction = "UMAP", add_mark = TRUE, mark_type = "circle") +#' #' # Add a density layer -#' CellDimPlot(pancreas_sub, group.by = "SubCellType", reduction = "UMAP", label = TRUE, add_density = TRUE) -#' CellDimPlot(pancreas_sub, group.by = "SubCellType", reduction = "UMAP", label = TRUE, add_density = TRUE, density_filled = TRUE) +#' CellDimPlot(pancreas_sub, group.by = "SubCellType", reduction = "UMAP", add_density = TRUE) +#' CellDimPlot(pancreas_sub, group.by = "SubCellType", reduction = "UMAP", add_density = TRUE, density_filled = TRUE) +#' CellDimPlot(pancreas_sub, +#' group.by = "SubCellType", reduction = "UMAP", +#' add_density = TRUE, density_filled = TRUE, density_filled_palette = "Blues", +#' cells.highlight = TRUE +#' ) #' #' # Add statistical charts #' CellDimPlot(pancreas_sub, group.by = "CellType", reduction = "UMAP", stat.by = "Phase") @@ -1289,6 +1318,7 @@ BlendRGBList <- function(Clist, mode = "blend", RGB_BackGround = c(1, 1, 1)) { #' @importFrom ggrepel geom_text_repel #' @importFrom ggnewscale new_scale_color new_scale_fill new_scale #' @importFrom gtable gtable_add_cols gtable_add_grob +#' @importFrom ggforce geom_mark_hull geom_mark_ellipse geom_mark_circle geom_mark_rect #' @importFrom patchwork wrap_plots #' @importFrom stats median loess aggregate #' @importFrom utils askYesNo @@ -1302,6 +1332,7 @@ CellDimPlot <- function(srt, group.by, reduction = NULL, dims = c(1, 2), split.b label_point_size = 1, label_point_color = "black", label_segment_color = "black", cells.highlight = NULL, cols.highlight = "black", sizes.highlight = 1, alpha.highlight = 1, stroke.highlight = 0.5, add_density = FALSE, density_color = "grey80", density_filled = FALSE, density_filled_palette = "Greys", density_filled_palcolor = NULL, + add_mark = FALSE, mark_type = c("hull", "ellipse", "rect", "circle"), mark_expand = unit(3, "mm"), mark_alpha = 0.1, mark_linetype = 1, lineages = NULL, lineages_trim = c(0.01, 0.99), lineages_span = 0.75, lineages_palette = "Dark2", lineages_palcolor = NULL, lineages_arrow = arrow(length = unit(0.1, "inches")), lineages_linewidth = 1, lineages_line_bg = "white", lineages_line_bg_stroke = 0.5, @@ -1325,6 +1356,7 @@ CellDimPlot <- function(srt, group.by, reduction = NULL, dims = c(1, 2), split.b theme_use = "theme_scp", theme_args = list(), combine = TRUE, nrow = NULL, ncol = NULL, byrow = TRUE, force = FALSE, seed = 11) { set.seed(seed) + mark_type <- match.arg(mark_type) if (is.null(split.by)) { split.by <- "All.groups" @@ -1528,25 +1560,32 @@ CellDimPlot <- function(srt, group.by, reduction = NULL, dims = c(1, 2), split.b } else { subtitle_use <- subtitle } - if (isTRUE(add_density)) { - if (isTRUE(density_filled)) { - filled_color <- palette_scp(palette = density_filled_palette, palcolor = density_filled_palcolor) - density <- list( - stat_density_2d( - geom = "raster", aes(x = .data[["x"]], y = .data[["y"]], fill = after_stat(density)), - contour = FALSE, inherit.aes = FALSE, show.legend = FALSE + + if (isTRUE(add_mark)) { + mark_fun <- switch(mark_type, + "ellipse" = "geom_mark_ellipse", + "hull" = "geom_mark_hull", + "rect" = "geom_mark_rect", + "circle" = "geom_mark_circle" + ) + mark <- list( + do.call( + mark_fun, + list( + data = dat[!is.na(dat[["group.by"]]), , drop = FALSE], + mapping = aes(x = .data[["x"]], y = .data[["y"]], color = .data[["group.by"]], fill = .data[["group.by"]]), + expand = mark_expand, alpha = mark_alpha, linetype = mark_linetype, show.legend = FALSE, inherit.aes = FALSE ), - scale_fill_gradientn(name = "Density", colours = filled_color), - new_scale_fill() - ) - } else { - density <- geom_density_2d(aes(x = .data[["x"]], y = .data[["y"]]), - color = density_color, inherit.aes = FALSE, show.legend = FALSE - ) - } + ), + scale_fill_manual(values = colors[names(labels_tb)]), + scale_color_manual(values = colors[names(labels_tb)]), + new_scale_fill(), + new_scale_color() + ) } else { - density <- NULL + mark <- NULL } + if (!is.null(graph)) { net_mat <- as_matrix(graph)[rownames(dat), rownames(dat)] net_mat[net_mat == 0] <- NA @@ -1570,7 +1609,28 @@ CellDimPlot <- function(srt, group.by, reduction = NULL, dims = c(1, 2), split.b net <- NULL } + if (isTRUE(add_density)) { + if (isTRUE(density_filled)) { + filled_color <- palette_scp(palette = density_filled_palette, palcolor = density_filled_palcolor) + density <- list( + stat_density_2d( + geom = "raster", aes(x = .data[["x"]], y = .data[["y"]], fill = after_stat(density)), + contour = FALSE, inherit.aes = FALSE, show.legend = FALSE + ), + scale_fill_gradientn(name = "Density", colours = filled_color), + new_scale_fill() + ) + } else { + density <- geom_density_2d(aes(x = .data[["x"]], y = .data[["y"]]), + color = density_color, inherit.aes = FALSE, show.legend = FALSE + ) + } + } else { + density <- NULL + } + p <- ggplot(dat) + + mark + net + density + labs(title = title, subtitle = subtitle_use, x = xlab, y = ylab) + @@ -1615,6 +1675,7 @@ CellDimPlot <- function(srt, group.by, reduction = NULL, dims = c(1, 2), split.b size = pt.size, alpha = pt.alpha ) } + if (!is.null(cells.highlight_use) && !isTRUE(hex)) { cell_df <- subset(p$data, rownames(p$data) %in% cells.highlight_use) if (nrow(cell_df) > 0) { diff --git a/R/SCP-workflow.R b/R/SCP-workflow.R index abfc8e5e..b83042a8 100644 --- a/R/SCP-workflow.R +++ b/R/SCP-workflow.R @@ -1361,6 +1361,14 @@ Seurat_integrate <- function(srtMerge = NULL, batch = NULL, append = TRUE, srtLi type <- checked[["type"]] } + if (min(sapply(srtList, ncol)) < 50) { + warning("The cell count in some batches is lower than 50, which may not be suitable for the current integration method.", immediate. = TRUE) + answer <- askYesNo("Are you sure to continue?", default = FALSE) + if (!isTRUE(answer)) { + return(srtMerge) + } + } + if (normalization_method == "TFIDF") { cat(paste0("[", Sys.time(), "]", " normalization_method is 'TFIDF'. Use 'rlsi' integration workflow...\n")) do_scaling <- FALSE @@ -1420,7 +1428,6 @@ Seurat_integrate <- function(srtMerge = NULL, batch = NULL, append = TRUE, srtLi object.list = srtList, normalization.method = normalization_method, anchor.features = HVF, - dims = seq_len(min(min(sapply(srtList, ncol)) - 1, 30)), verbose = FALSE ) for (nm in names(FindIntegrationAnchors_params)) { @@ -1434,7 +1441,6 @@ Seurat_integrate <- function(srtMerge = NULL, batch = NULL, append = TRUE, srtLi new.assay.name = "Seuratcorrected", normalization.method = normalization_method, features.to.integrate = HVF, - dims = seq_len(min(min(sapply(srtList, ncol)), 30)), verbose = FALSE ) for (nm in names(IntegrateData_params)) { @@ -2170,7 +2176,7 @@ Harmony_integrate <- function(srtMerge = NULL, batch = NULL, append = TRUE, srtL "leiden" = 4 ) - check_R("harmony") + check_R("harmony@1.1.0") set.seed(seed) if (is.null(srtList) && is.null(srtMerge)) { @@ -3036,6 +3042,14 @@ LIGER_integrate <- function(srtMerge = NULL, batch = NULL, append = TRUE, srtLis type <- checked[["type"]] } + if (min(sapply(srtList, ncol)) < 30) { + warning("The cell count in some batches is lower than 30, which may not be suitable for the current integration method.", immediate. = TRUE) + answer <- askYesNo("Are you sure to continue?", default = FALSE) + if (!isTRUE(answer)) { + return(srtMerge) + } + } + scale.data <- list() for (i in seq_along(srtList)) { srt <- srtList[[i]] @@ -3253,6 +3267,15 @@ Conos_integrate <- function(srtMerge = NULL, batch = NULL, append = TRUE, srtLis assay <- checked[["assay"]] type <- checked[["type"]] } + + if (min(sapply(srtList, ncol)) < 30) { + warning("The cell count in some batches is lower than 30, which may not be suitable for the current integration method.", immediate. = TRUE) + answer <- askYesNo("Are you sure to continue?", default = FALSE) + if (!isTRUE(answer)) { + return(srtMerge) + } + } + srtIntegrated <- srtMerge srtMerge <- NULL diff --git a/R/Seurat-function.R b/R/Seurat-function.R index b984d1f9..be5f448d 100644 --- a/R/Seurat-function.R +++ b/R/Seurat-function.R @@ -1799,7 +1799,7 @@ RunHarmony2.Seurat <- function(object, group.by.vars, project.dim = TRUE, reduction.name = "Harmony", reduction.key = "Harmony_", verbose = TRUE, seed.use = 11L, ...) { - check_R("immunogenomics/harmony") + check_R("harmony@1.1.0") if (!is.null(x = seed.use)) { set.seed(seed = seed.use) } diff --git a/R/utils.R b/R/utils.R index f0c043f2..a9878b03 100644 --- a/R/utils.R +++ b/R/utils.R @@ -568,6 +568,7 @@ check_R <- function(packages, install_methods = c("BiocManager::install", "insta version <- strsplit(pkg, split = "@|==", perl = TRUE)[[1]][[2]] } } + dest <- gsub("@.*|==.*|>=.*", "", pkg) if (is.null(version)) { force_update <- isTRUE(force) } else { @@ -583,7 +584,7 @@ check_R <- function(packages, install_methods = c("BiocManager::install", "insta if (!requireNamespace("BiocManager", quietly = TRUE)) { install.packages("BiocManager", lib = lib) } - eval(str2lang(paste0(install_methods[i], "(\"", pkg, "\", lib=\"", lib, "\", update = FALSE, upgrade = \"never\", ask = FALSE, force = TRUE)"))) + eval(str2lang(paste0(install_methods[i], "(\"", dest, "\", lib=\"", lib, "\", update = FALSE, upgrade = \"never\", ask = FALSE, force = TRUE)"))) } else if (grepl("devtools", install_methods[i])) { if (!requireNamespace("devtools", quietly = TRUE)) { install.packages("devtools", lib = lib) @@ -591,9 +592,9 @@ check_R <- function(packages, install_methods = c("BiocManager::install", "insta if (!requireNamespace("withr", quietly = TRUE)) { install.packages("withr", lib = lib) } - eval(str2lang(paste0("withr::with_libpaths(new = \"", lib, "\", ", install_methods[i], "(\"", pkg, "\", upgrade = \"never\", force = TRUE))"))) + eval(str2lang(paste0("withr::with_libpaths(new = \"", lib, "\", ", install_methods[i], "(\"", dest, "\", upgrade = \"never\", force = TRUE))"))) } else { - eval(str2lang(paste0(install_methods[i], "(\"", pkg, "\", lib=\"", lib, "\", force = TRUE)"))) + eval(str2lang(paste0(install_methods[i], "(\"", dest, "\", lib=\"", lib, "\", force = TRUE)"))) } }, error = function(e) { status_list[[pkg]] <- FALSE diff --git a/man/CellDimPlot.Rd b/man/CellDimPlot.Rd index 26b98083..341b7640 100644 --- a/man/CellDimPlot.Rd +++ b/man/CellDimPlot.Rd @@ -39,6 +39,11 @@ CellDimPlot( density_filled = FALSE, density_filled_palette = "Greys", density_filled_palcolor = NULL, + add_mark = FALSE, + mark_type = c("hull", "ellipse", "rect", "circle"), + mark_expand = unit(3, "mm"), + mark_alpha = 0.1, + mark_linetype = 1, lineages = NULL, lineages_trim = c(0.01, 0.99), lineages_span = 0.75, @@ -363,9 +368,9 @@ CellDimPlot(pancreas_sub, group.by = "SubCellType", reduction = "UMAP", theme_us CellDimPlot(pancreas_sub, group.by = "SubCellType", reduction = "UMAP", theme_use = ggplot2::theme_classic, theme_args = list(base_size = 16)) CellDimPlot(pancreas_sub, group.by = "SubCellType", reduction = "UMAP") \%>\% panel_fix(height = 2, raster = TRUE, dpi = 30) -# Label and highlight cell points +# Highlight cells CellDimPlot(pancreas_sub, - group.by = "SubCellType", reduction = "UMAP", label = TRUE, label_insitu = TRUE, + group.by = "SubCellType", reduction = "UMAP", cells.highlight = colnames(pancreas_sub)[pancreas_sub$SubCellType == "Epsilon"] ) CellDimPlot(pancreas_sub, @@ -373,9 +378,38 @@ CellDimPlot(pancreas_sub, cells.highlight = TRUE, theme_use = "theme_blank", legend.position = "none" ) +# Add group labels +CellDimPlot(pancreas_sub, group.by = "SubCellType", reduction = "UMAP", label = TRUE) +CellDimPlot(pancreas_sub, + group.by = "SubCellType", reduction = "UMAP", + label = TRUE, label.fg = "orange", label.bg = "red", label.size = 5 +) +CellDimPlot(pancreas_sub, + group.by = "SubCellType", reduction = "UMAP", + label = TRUE, label_insitu = TRUE +) +CellDimPlot(pancreas_sub, + group.by = "SubCellType", reduction = "UMAP", + label = TRUE, label_insitu = TRUE, label_repel = TRUE, label_segment_color = "red" +) + +# Add various shape of marks +CellDimPlot(pancreas_sub, group.by = "SubCellType", reduction = "UMAP", add_mark = TRUE) +CellDimPlot(pancreas_sub, group.by = "SubCellType", reduction = "UMAP", add_mark = TRUE, mark_expand = unit(1, "mm")) +CellDimPlot(pancreas_sub, group.by = "SubCellType", reduction = "UMAP", add_mark = TRUE, mark_alpha = 0.3) +CellDimPlot(pancreas_sub, group.by = "SubCellType", reduction = "UMAP", add_mark = TRUE, mark_linetype = 2) +CellDimPlot(pancreas_sub, group.by = "SubCellType", reduction = "UMAP", add_mark = TRUE, mark_type = "ellipse") +CellDimPlot(pancreas_sub, group.by = "SubCellType", reduction = "UMAP", add_mark = TRUE, mark_type = "rect") +CellDimPlot(pancreas_sub, group.by = "SubCellType", reduction = "UMAP", add_mark = TRUE, mark_type = "circle") + # Add a density layer -CellDimPlot(pancreas_sub, group.by = "SubCellType", reduction = "UMAP", label = TRUE, add_density = TRUE) -CellDimPlot(pancreas_sub, group.by = "SubCellType", reduction = "UMAP", label = TRUE, add_density = TRUE, density_filled = TRUE) +CellDimPlot(pancreas_sub, group.by = "SubCellType", reduction = "UMAP", add_density = TRUE) +CellDimPlot(pancreas_sub, group.by = "SubCellType", reduction = "UMAP", add_density = TRUE, density_filled = TRUE) +CellDimPlot(pancreas_sub, + group.by = "SubCellType", reduction = "UMAP", + add_density = TRUE, density_filled = TRUE, density_filled_palette = "Blues", + cells.highlight = TRUE +) # Add statistical charts CellDimPlot(pancreas_sub, group.by = "CellType", reduction = "UMAP", stat.by = "Phase")