Skip to content

Commit

Permalink
Update CellDimPlot function
Browse files Browse the repository at this point in the history
  • Loading branch information
@zhanghao-njmu
zhanghao-njmu committed Nov 20, 2023
1 parent 048e784 commit df061b7
Show file tree
Hide file tree
Showing 7 changed files with 153 additions and 32 deletions.
2 changes: 2 additions & 0 deletions NAMESPACE
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
2 changes: 1 addition & 1 deletion R/SCP-app.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)) {
Expand Down
101 changes: 81 additions & 20 deletions R/SCP-plot.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1222,19 +1222,48 @@ 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,
#' group.by = "SubCellType", split.by = "Phase", reduction = "UMAP",
#' 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")
Expand Down Expand Up @@ -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
Expand All @@ -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,
Expand All @@ -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"
Expand Down Expand Up @@ -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
Expand All @@ -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) +
Expand Down Expand Up @@ -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) {
Expand Down
29 changes: 26 additions & 3 deletions R/SCP-workflow.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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)) {
Expand All @@ -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)) {
Expand Down Expand Up @@ -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)) {
Expand Down Expand Up @@ -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]]
Expand Down Expand Up @@ -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

Expand Down
2 changes: 1 addition & 1 deletion R/Seurat-function.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)
}
Expand Down
7 changes: 4 additions & 3 deletions R/utils.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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 {
Expand All @@ -583,17 +584,17 @@ 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)
}
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
Expand Down
42 changes: 38 additions & 4 deletions man/CellDimPlot.Rd
View file

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

0 comments on commit df061b7

Please sign in to comment.