Skip to content

Commit

Permalink
fix bugs
Browse files Browse the repository at this point in the history
  • Loading branch information
@zhanghao-njmu
zhanghao-njmu committed Jan 3, 2024
1 parent b0e49c8 commit 5c4023f
Show file tree
Hide file tree
Showing 5 changed files with 109 additions and 60 deletions.
4 changes: 4 additions & 0 deletions R/SCP-analysis.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3996,6 +3996,8 @@ RunEnrichment <- function(srt = NULL, group_by = NULL, test.use = "wilcox", DE_t
results <- results[!sapply(results, is.null)]
results <- results[intersect(c(nm, paste0(nm, "_sim")), names(results))]
enrichment <- do.call(rbind, lapply(results, function(x) x@result))
enrichment[["Groups"]] <- factor(enrichment[["Groups"]], levels = levels(geneID_groups))
enrichment[["Database"]] <- factor(enrichment[["Database"]], levels = unique(enrichment[["Database"]]))
rownames(enrichment) <- NULL

time_end <- Sys.time()
Expand Down Expand Up @@ -4293,6 +4295,8 @@ RunGSEA <- function(srt = NULL, group_by = NULL, test.use = "wilcox", DE_thresho
results <- results[!sapply(results, is.null)]
results <- results[intersect(c(nm, paste0(nm, "_sim")), names(results))]
enrichment <- do.call(rbind, lapply(results, function(x) x@result))
enrichment[["Groups"]] <- factor(enrichment[["Groups"]], levels = levels(geneID_groups))
enrichment[["Database"]] <- factor(enrichment[["Database"]], levels = unique(enrichment[["Database"]]))
rownames(enrichment) <- NULL

time_end <- Sys.time()
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 @@ -595,7 +595,7 @@ RunSCExplorer <- function(base_dir = "SCExplorer",
initial_raster = NULL,
session_workers = 2,
plotting_workers = 8,
create_script = FALSE,
create_script = TRUE,
style_script = require("styler", quietly = TRUE),
overwrite = FALSE) {
check_R(c("rhdf5", "HDF5Array", "[email protected]", "ggplot2", "ragg", "htmlwidgets", "plotly", "bslib", "future", "promises", "BiocParallel"))
Expand Down
129 changes: 70 additions & 59 deletions R/SCP-plot.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1433,6 +1433,7 @@ CellDimPlot <- function(srt, group.by, reduction = NULL, dims = c(1, 2), split.b
colnames(dat_dim) <- paste0(reduction_key, seq_len(ncol(dat_dim)))
rownames(dat_dim) <- rownames(dat_dim) %||% colnames(srt@assays[[1]])
dat_use <- cbind(dat_dim, dat_meta[row.names(dat_dim), , drop = FALSE])
dat_use[["cell"]] <- rownames(dat_use)
if (!is.null(cells)) {
dat_use <- dat_use[intersect(rownames(dat_use), cells), , drop = FALSE]
}
Expand All @@ -1453,7 +1454,7 @@ CellDimPlot <- function(srt, group.by, reduction = NULL, dims = c(1, 2), split.b
cells = cells,
stat.by = stat.by, group.by = group.by, split.by = split.by,
stat_type = stat_type, plot_type = stat_plot_type, position = stat_plot_position,
palette = stat_plot_palette, palcolor = stat_palcolor, alpha = stat_plot_alpha,
palette = stat_plot_palette, palcolor = stat_palcolor, alpha = stat_plot_alpha, bg_palcolor = "transparent",
label = stat_plot_label, label.size = stat_plot_label_size,
legend.position = "bottom", legend.direction = legend.direction,
theme_use = theme_use, theme_args = theme_args,
Expand Down Expand Up @@ -1680,10 +1681,10 @@ CellDimPlot <- function(srt, group.by, reduction = NULL, dims = c(1, 2), split.b
)
}
} else {
p <- p + geom_point(
mapping = aes(x = .data[["x"]], y = .data[["y"]], color = .data[["group.by"]]),
p <- p + suppressWarnings(geom_point(
mapping = aes(x = .data[["x"]], y = .data[["y"]], color = .data[["group.by"]], cell = .data[["cell"]]),
size = pt.size, alpha = pt.alpha
)
))
}

if (!is.null(cells.highlight_use) && !isTRUE(hex)) {
Expand All @@ -1703,10 +1704,10 @@ CellDimPlot <- function(srt, group.by, reduction = NULL, dims = c(1, 2), split.b
data = cell_df, aes(x = .data[["x"]], y = .data[["y"]]), color = cols.highlight,
size = sizes.highlight + stroke.highlight, alpha = alpha.highlight
) +
geom_point(
data = cell_df, aes(x = .data[["x"]], y = .data[["y"]], color = .data[["group.by"]]),
suppressWarnings(geom_point(
data = cell_df, aes(x = .data[["x"]], y = .data[["y"]], color = .data[["group.by"]], cell = .data[["cell"]]),
size = sizes.highlight, alpha = alpha.highlight
)
))
}
}
}
Expand Down Expand Up @@ -2223,6 +2224,7 @@ FeatureDimPlot <- function(srt, features, reduction = NULL, dims = c(1, 2), spli
rownames(dat_dim) <- rownames(dat_dim) %||% colnames(srt@assays[[1]])
dat_sp <- [email protected][, split.by, drop = FALSE]
dat_use <- cbind(dat_dim, dat_sp[row.names(dat_dim), , drop = FALSE])
dat_use[["cell"]] <- rownames(dat_use)
if (!is.null(cells)) {
dat_use <- dat_use[intersect(rownames(dat_use), cells), , drop = FALSE]
}
Expand Down Expand Up @@ -2404,10 +2406,10 @@ FeatureDimPlot <- function(srt, features, reduction = NULL, dims = c(1, 2), spli
scale_color_identity() +
new_scale_color()
} else {
p <- p + geom_point(
p <- p + suppressWarnings(geom_point(
mapping = aes(x = .data[["x"]], y = .data[["y"]], color = .data[["color_blend"]]),
size = pt.size, alpha = pt.alpha
) +
)) +
scale_color_identity() +
new_scale_color()
}
Expand All @@ -2432,10 +2434,10 @@ FeatureDimPlot <- function(srt, features, reduction = NULL, dims = c(1, 2), spli
data = cell_df, aes(x = .data[["x"]], y = .data[["y"]]), color = cols.highlight,
size = sizes.highlight + stroke.highlight, alpha = alpha.highlight
) +
geom_point(
suppressWarnings(geom_point(
data = cell_df, aes(x = .data[["x"]], y = .data[["y"]], color = .data[["color_blend"]]),
size = sizes.highlight, alpha = alpha.highlight
) +
)) +
scale_color_identity() +
new_scale_color()
}
Expand Down Expand Up @@ -2703,10 +2705,10 @@ FeatureDimPlot <- function(srt, features, reduction = NULL, dims = c(1, 2), spli
p <- p + new_scale_fill()
}
} else {
p <- p + geom_point(
mapping = aes(x = .data[["x"]], y = .data[["y"]], color = .data[["value"]]),
p <- p + suppressWarnings(geom_point(
mapping = aes(x = .data[["x"]], y = .data[["y"]], color = .data[["value"]], cell = .data[["cell"]]),
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)
Expand All @@ -2726,10 +2728,10 @@ FeatureDimPlot <- function(srt, features, reduction = NULL, dims = c(1, 2), spli
data = cell_df, aes(x = .data[["x"]], y = .data[["y"]]), color = cols.highlight,
size = sizes.highlight + stroke.highlight, alpha = alpha.highlight
) +
geom_point(
data = cell_df, aes(x = .data[["x"]], y = .data[["y"]], color = .data[["value"]]),
suppressWarnings(geom_point(
data = cell_df, aes(x = .data[["x"]], y = .data[["y"]], color = .data[["value"]], cell = .data[["cell"]]),
size = sizes.highlight, alpha = alpha.highlight
)
))
}
}
}
Expand Down Expand Up @@ -3547,9 +3549,9 @@ FeatureStatPlot <- function(srt, stat.by, group.by = NULL, split.by = NULL, bg.b
calculate_coexp = FALSE, range = c(-Inf, Inf),
same.y.lims = FALSE, y.min = NULL, y.max = NULL, y.trans = "identity", y.nbreaks = 5,
sort = FALSE, stack = FALSE, flip = FALSE,
comparisons = NULL, ref_group = NULL, pairwise_method = "wilcox.test",
multiplegroup_comparisons = FALSE, multiple_method = "kruskal.test",
sig_label = c("p.signif", "p.format"), sig_labelsize = 3.5,
comparisons = NULL, ref_group = NULL, pairwise_method = "wilcox.test", pairwise_method_args = list(),
multiplegroup_comparisons = FALSE, multiple_method = "kruskal.test", multiple_method_args = list(),
sig_label = c("p.signif", "p.format"), sig_labelsize = 3.5, sig_stepincrease = 0.15,
aspect.ratio = NULL, title = NULL, subtitle = NULL, xlab = NULL, ylab = "Expression",
legend.position = "right", legend.direction = "vertical",
theme_use = "theme_scp", theme_args = list(),
Expand Down Expand Up @@ -3601,9 +3603,9 @@ FeatureStatPlot <- function(srt, stat.by, group.by = NULL, split.by = NULL, bg.b
calculate_coexp = calculate_coexp, range = range,
same.y.lims = same.y.lims, y.min = y.min, y.max = y.max, y.trans = y.trans, y.nbreaks = y.nbreaks,
sort = sort, stack = stack, flip = flip,
comparisons = comparisons, ref_group = ref_group, pairwise_method = pairwise_method,
multiplegroup_comparisons = multiplegroup_comparisons, multiple_method = multiple_method,
sig_label = sig_label, sig_labelsize = sig_labelsize,
comparisons = comparisons, ref_group = ref_group, pairwise_method = pairwise_method, pairwise_method_args = pairwise_method_args,
multiplegroup_comparisons = multiplegroup_comparisons, multiple_method = multiple_method, multiple_method_args = multiple_method_args,
sig_label = sig_label, sig_labelsize = sig_labelsize, sig_stepincrease = sig_stepincrease,
aspect.ratio = aspect.ratio, title = title, subtitle = subtitle, xlab = xlab, ylab = ylab,
legend.position = legend.position, legend.direction = legend.direction,
theme_use = theme_use, theme_args = theme_args,
Expand All @@ -3629,9 +3631,9 @@ FeatureStatPlot <- function(srt, stat.by, group.by = NULL, split.by = NULL, bg.b
calculate_coexp = calculate_coexp, range = range,
same.y.lims = same.y.lims, y.min = y.min, y.max = y.max, y.trans = y.trans, y.nbreaks = y.nbreaks,
sort = sort, stack = stack, flip = flip,
comparisons = comparisons, ref_group = ref_group, pairwise_method = pairwise_method,
multiplegroup_comparisons = multiplegroup_comparisons, multiple_method = multiple_method,
sig_label = sig_label, sig_labelsize = sig_labelsize,
comparisons = comparisons, ref_group = ref_group, pairwise_method = pairwise_method, pairwise_method_args = pairwise_method_args,
multiplegroup_comparisons = multiplegroup_comparisons, multiple_method = multiple_method, multiple_method_args = multiple_method_args,
sig_label = sig_label, sig_labelsize = sig_labelsize, sig_stepincrease = sig_stepincrease,
aspect.ratio = aspect.ratio, title = title, subtitle = subtitle, xlab = xlab, ylab = ylab,
legend.position = legend.position, legend.direction = legend.direction,
theme_use = theme_use, theme_args = theme_args,
Expand Down Expand Up @@ -3753,9 +3755,9 @@ ExpressionStatPlot <- function(exp.data, meta.data, stat.by, group.by = NULL, sp
calculate_coexp = FALSE, range = c(-Inf, Inf),
same.y.lims = FALSE, y.min = NULL, y.max = NULL, y.trans = "identity", y.nbreaks = 5,
sort = FALSE, stack = FALSE, flip = FALSE,
comparisons = NULL, ref_group = NULL, pairwise_method = "wilcox.test",
multiplegroup_comparisons = FALSE, multiple_method = "kruskal.test",
sig_label = c("p.signif", "p.format"), sig_labelsize = 3.5,
comparisons = NULL, ref_group = NULL, pairwise_method = "wilcox.test", pairwise_method_args = list(),
multiplegroup_comparisons = FALSE, multiple_method = "kruskal.test", multiple_method_args = list(),
sig_label = c("p.signif", "p.format"), sig_labelsize = 3.5, sig_stepincrease = 0.15,
aspect.ratio = NULL, title = NULL, subtitle = NULL, xlab = NULL, ylab = "Expression",
legend.position = "right", legend.direction = "vertical",
theme_use = "theme_scp", theme_args = list(),
Expand Down Expand Up @@ -4218,6 +4220,7 @@ ExpressionStatPlot <- function(exp.data, meta.data, stat.by, group.by = NULL, sp
border_layer <- geom_vline(xintercept = border_data[["xintercept"]], linetype = 2, alpha = 0.5)
p <- p + border_layer
}
y_min_use <- layer_scales(p)$y$range$range[1]
}

if (length(comparisons) > 0) {
Expand All @@ -4226,49 +4229,52 @@ ExpressionStatPlot <- function(exp.data, meta.data, stat.by, group.by = NULL, sp
if (any(rowSums(table(dat[["group.by"]], dat[["split.by"]]) >= 2) >= 3)) {
message("Detected more than 2 groups. Use multiple_method for comparison")
method <- multiple_method
method_args <- multiple_method_args
} else {
method <- pairwise_method
method_args <- pairwise_method_args
}
p <- p + ggpubr::stat_compare_means(
data = dat[dat[["group.by"]] %in% group_use, , drop = FALSE],
mapping = aes(x = .data[["group.by"]], y = .data[["value"]], group = .data[["group.unique"]]),
label = sig_label,
label.y = y_max_use,
size = sig_labelsize,
step.increase = 0.1,
tip.length = 0.03,
step.increase = sig_stepincrease,
vjust = 1,
method = method
method = method,
method.args = method_args,
)

y_max_use <- layer_scales(p)$y$range$range[2]
} else {
p <- p + ggpubr::stat_compare_means(
mapping = aes(x = .data[["group.by"]], y = .data[["value"]], group = .data[["group.unique"]]),
label = sig_label,
label.y = y_max_use,
size = sig_labelsize,
step.increase = 0.1,
tip.length = 0.03,
step.increase = sig_stepincrease,
vjust = 0,
comparisons = comparisons,
ref.group = ref_group,
method = pairwise_method
method = pairwise_method,
method.args = pairwise_method_args,
)
y_max_use <- layer_scales(p)$y$range$range[1] + (layer_scales(p)$y$range$range[2] - layer_scales(p)$y$range$range[1]) * 1.15
y_max_use <- layer_scales(p)$y$range$range[1] + (layer_scales(p)$y$range$range[2] - layer_scales(p)$y$range$range[1]) * (1 + sig_stepincrease + 0.05)
}
}
if (isTRUE(multiplegroup_comparisons)) {
p <- p + ggpubr::stat_compare_means(
aes(x = .data[["group.by"]], y = .data[["value"]], group = .data[["group.unique"]]),
method = multiple_method,
label = sig_label,
label.y = y_max_use,
size = sig_labelsize,
step.increase = sig_stepincrease,
vjust = 1.2,
hjust = 0
hjust = 0,
method = multiple_method,
method.args = multiple_method_args
)
y_max_use <- layer_scales(p)$y$range$range[1] + (layer_scales(p)$y$range$range[2] - layer_scales(p)$y$range$range[1]) * 1.15
y_max_use <- layer_scales(p)$y$range$range[1] + (layer_scales(p)$y$range$range[2] - layer_scales(p)$y$range$range[1]) * (1 + sig_stepincrease + 0.05)
}

if (isTRUE(add_point)) {
Expand Down Expand Up @@ -4416,8 +4422,9 @@ ExpressionStatPlot <- function(exp.data, meta.data, stat.by, group.by = NULL, sp
}

if (isTRUE(stack)) {
digits <- max(gregexpr("\\.0+", as.character(y_max_use - y_min_use))[[1]][1], 1)
p <- p + scale_y_continuous(
trans = y.trans, breaks = c(y_min_use, y_max_use), labels = c(round(y_min_use, 1), round(y_max_use, 1))
trans = y.trans, breaks = c(y_min_use, y_max_use), labels = c(round(y_min_use, digits), round(y_max_use, digits))
)
} else {
p <- p + scale_y_continuous(trans = y.trans, n.breaks = y.nbreaks)
Expand All @@ -4444,6 +4451,7 @@ ExpressionStatPlot <- function(exp.data, meta.data, stat.by, group.by = NULL, sp
)
}
# plist[[paste0(f, ":", g, ":", paste0(single_group, collapse = ","), ":", paste0(sp, collapse = ","))]] <- p
return(p)
})

return(plist)
Expand Down Expand Up @@ -9363,9 +9371,8 @@ FeatureHeatmap <- function(srt, features = NULL, cells = NULL, group.by = NULL,
cell_groups[[cell_group]] <- unlist(lapply(levels([email protected][[cell_group]]), function(x) {
cells_sub <- colnames(srt@assays[[1]])[which([email protected][[cell_group]] == x)]
cells_sub <- intersect(cells, cells_sub)
size <- ifelse(length(cells_sub) > max_cells, max_cells, length(cells_sub))
cells_sample <- sample(cells_sub, size)
out <- setNames(rep(x, size), cells_sample)
cells_sample <- if (length(cells_sub) > max_cells) sample(cells_sub, max_cells) else cells_sub
out <- setNames(rep(x, length(cells_sample)), cells_sample)
return(out)
}), use.names = TRUE)
levels <- levels([email protected][[cell_group]])
Expand All @@ -9380,9 +9387,8 @@ FeatureHeatmap <- function(srt, features = NULL, cells = NULL, group.by = NULL,
cells_tmp <- NULL
for (sp in levels([email protected][[split.by]])) {
cells_sp <- cells_sub[[email protected][cells_sub, split.by] == sp]
size <- ifelse(length(cells_sp) > max_cells, max_cells, length(cells_sp))
cells_sample <- sample(cells_sp, size)
cells_tmp <- c(cells_tmp, setNames(rep(paste0(x, " : ", sp), size), cells_sample))
cells_sample <- if (length(cells_sp) > max_cells) sample(cells_sp, max_cells) else cells_sp
cells_tmp <- c(cells_tmp, setNames(rep(paste0(x, " : ", sp), length(cells_sample)), cells_sample))
}
size <- ifelse(length(cells_tmp) > max_cells, max_cells, length(cells_tmp))
out <- sample(cells_tmp, size)
Expand Down Expand Up @@ -12874,7 +12880,10 @@ EnrichmentPlot <- function(srt, db = "GO_BP", group_by = NULL, test.use = "wilco
}
enrichment <- do.call(rbind, enrichment_list)
} else {
enrichment <- enrichment[enrichment[["ID"]] %in% unlist(id_use), , drop = FALSE]
id_order <- intersect(unique(unlist(id_use)), enrichment[["ID"]])
id_match <- match(enrichment[["ID"]], id_order)
id_index <- order(id_match)
enrichment <- enrichment[id_index[seq_len(sum(!is.na(id_match)))], , drop = FALSE]
}
}

Expand All @@ -12888,9 +12897,7 @@ EnrichmentPlot <- function(srt, db = "GO_BP", group_by = NULL, test.use = "wilco
enrichment_sim <- enrichment[enrichment[["Database"]] %in% gsub("_sim", "", db), , drop = FALSE]
}
enrichment <- enrichment[enrichment[["Database"]] %in% db, , drop = FALSE]

enrichment_sig <- enrichment[enrichment[[metric]] < metric_value | enrichment[["ID"]] %in% unlist(id_use), , drop = FALSE]
enrichment_sig <- enrichment_sig[order(enrichment_sig[[metric]]), , drop = FALSE]
if (nrow(enrichment_sig) == 0) {
stop(
"No term enriched using the threshold: ",
Expand All @@ -12910,15 +12917,19 @@ EnrichmentPlot <- function(srt, db = "GO_BP", group_by = NULL, test.use = "wilco
if (plot_type == "comparison") {
# comparison -------------------------------------------------------------------------------------------------
ids <- NULL
for (i in seq_along(df_list)) {
df <- df_list[[i]]
df_groups <- split(df, list(df$Database, df$Groups))
df_groups <- lapply(df_groups, function(group) {
filtered_group <- group[head(seq_len(nrow(group)), topTerm), , drop = FALSE]
return(filtered_group)
})
df <- do.call(rbind, df_groups)
ids <- unique(c(ids, df[, "ID"]))
if (length(id_use) > 0) {
ids <- unique(unlist(id_use))
} else {
for (i in seq_along(df_list)) {
df <- df_list[[i]]
df_groups <- split(df, list(df$Database, df$Groups))
df_groups <- lapply(df_groups, function(group) {
filtered_group <- group[head(seq_len(nrow(group)), topTerm), , drop = FALSE]
return(filtered_group)
})
df <- do.call(rbind, df_groups)
ids <- unique(c(ids, df[, "ID"]))
}
}
if (any(db %in% c("GO_sim", "GO_BP_sim", "GO_CC_sim", "GO_MF_sim"))) {
enrichment_sub <- subset(enrichment_sim, ID %in% ids)
Expand Down
Loading

0 comments on commit 5c4023f

Please sign in to comment.