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 Dec 28, 2023
1 parent b0e49c8 commit 7942312
Show file tree
Hide file tree
Showing 5 changed files with 67 additions and 23 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(db))
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(db))
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
51 changes: 29 additions & 22 deletions R/SCP-plot.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3547,8 +3547,8 @@ 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",
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,
aspect.ratio = NULL, title = NULL, subtitle = NULL, xlab = NULL, ylab = "Expression",
legend.position = "right", legend.direction = "vertical",
Expand Down Expand Up @@ -3601,8 +3601,8 @@ 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,
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,
aspect.ratio = aspect.ratio, title = title, subtitle = subtitle, xlab = xlab, ylab = ylab,
legend.position = legend.position, legend.direction = legend.direction,
Expand All @@ -3629,8 +3629,8 @@ 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,
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,
aspect.ratio = aspect.ratio, title = title, subtitle = subtitle, xlab = xlab, ylab = ylab,
legend.position = legend.position, legend.direction = legend.direction,
Expand Down Expand Up @@ -3753,8 +3753,8 @@ 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",
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,
aspect.ratio = NULL, title = NULL, subtitle = NULL, xlab = NULL, ylab = "Expression",
legend.position = "right", legend.direction = "vertical",
Expand Down Expand Up @@ -4218,6 +4218,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,8 +4227,10 @@ 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],
Expand All @@ -4238,9 +4241,9 @@ ExpressionStatPlot <- function(exp.data, meta.data, stat.by, group.by = NULL, sp
step.increase = 0.1,
tip.length = 0.03,
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(
Expand All @@ -4253,20 +4256,22 @@ ExpressionStatPlot <- function(exp.data, meta.data, stat.by, group.by = NULL, sp
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
}
}
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,
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
}
Expand Down Expand Up @@ -4416,8 +4421,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 +4450,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 +9370,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 +9386,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 +12879,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,7 +12896,6 @@ 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) {
Expand Down
2 changes: 2 additions & 0 deletions man/FeatureStatPlot.Rd
View file

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

31 changes: 31 additions & 0 deletions man/MergeRows.Rd
View file

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

0 comments on commit 7942312

Please sign in to comment.