diff --git a/R/SCP-plot.R b/R/SCP-plot.R index 3ef33bd8..dbaff0ec 100644 --- a/R/SCP-plot.R +++ b/R/SCP-plot.R @@ -6186,7 +6186,6 @@ ExpCorPlot <- function(srt, features, group.by = NULL, split.by = NULL, cells = } } - #' CellDensityPlot #' #' @examples @@ -6201,7 +6200,8 @@ ExpCorPlot <- function(srt, features, group.by = NULL, split.by = NULL, cells = #' @importFrom ggplot2 ggplot scale_fill_manual labs scale_y_discrete scale_x_continuous facet_grid labs coord_flip element_text element_line #' @importFrom cowplot plot_grid #' @export -CellDensityPlot <- function(srt, features, group.by, split.by = NULL, flip = FALSE, reverse = FALSE, +CellDensityPlot <- function(srt, features, group.by, split.by = NULL, + flip = FALSE, reverse = FALSE, x_order = c("value", "rank"), decreasing = NULL, palette = "Paired", palcolor = NULL, cells = NULL, assay = NULL, slot = "data", keep_empty = FALSE, y.nbreaks = 4, y.min = NULL, y.max = NULL, same.y.lims = FALSE, @@ -6210,6 +6210,7 @@ CellDensityPlot <- function(srt, features, group.by, split.by = NULL, flip = FAL combine = TRUE, nrow = NULL, ncol = NULL, byrow = TRUE, align = "hv", axis = "lr", force = FALSE) { check_R("ggridges") assay <- assay %||% DefaultAssay(srt) + x_order <- match.arg(x_order) if (is.null(features)) { stop("'features' must be provided.") } @@ -6287,7 +6288,11 @@ CellDensityPlot <- function(srt, features, group.by, split.by = NULL, flip = FAL dat[, f][dat[, f] == min(dat[, f])] <- min(dat[, f][is.finite(dat[, f])]) } dat[, "cell"] <- rownames(dat) - dat[, "value"] <- dat[, f] + if (x_order == "value") { + dat[, "value"] <- dat[, f] + } else { + dat[, "value"] <- rank(dat[, f]) + } dat[, "features"] <- f dat[, "split.by"] <- s dat <- dat[!is.na(dat[[f]]), ] @@ -6303,10 +6308,10 @@ CellDensityPlot <- function(srt, features, group.by, split.by = NULL, flip = FAL levels <- dat %>% group_by_at(g) %>% summarise_at(.funs = median, .vars = f, na.rm = TRUE) %>% - arrange_at(.vars = f, .funs = if (decreasing) desc else list(), na.rm = TRUE) %>% + arrange_at(.vars = f, .funs = if (decreasing) desc else list()) %>% pull(g) %>% as.character() - dat[["order"]] <- factor(dat[[g]], levels = rev(levels)) + dat[["order"]] <- factor(dat[[g]], levels = levels) } else { dat[["order"]] <- factor(dat[[g]], levels = rev(levels(dat[[g]]))) } @@ -6317,7 +6322,7 @@ CellDensityPlot <- function(srt, features, group.by, split.by = NULL, flip = FAL aspect.ratio <- NULL } } - p <- ggplot(dat, aes(x = .data[[f]], y = .data[["order"]], fill = .data[[g]])) + + p <- ggplot(dat, aes(x = .data[["value"]], y = .data[["order"]], fill = .data[[g]])) + ggridges::geom_density_ridges() p <- p + scale_fill_manual( name = paste0(g, ":"), @@ -9248,15 +9253,16 @@ SummaryPlot <- function(srt, #' @importFrom grDevices colorRampPalette #' @importFrom stats runif #' @export -DynamicPlot <- function(srt, features, lineages, cells = NULL, slot = "counts", assay = "RNA", family = NULL, +DynamicPlot <- function(srt, features, lineages, group.by = NULL, cells = NULL, slot = "counts", assay = "RNA", family = NULL, exp_method = c("log1p", "raw", "zscore", "fc", "log2fc"), lib_normalize = TRUE, libsize = NULL, - order.by = "pseudotime", group.by = NULL, compare_lineages = TRUE, compare_features = FALSE, + compare_lineages = TRUE, compare_features = FALSE, add_line = TRUE, add_interval = TRUE, line.size = 1, line_palette = "Dark2", line_palcolor = NULL, add_point = TRUE, pt.size = 1, point_palette = "Paired", point_palcolor = NULL, - add_rug = TRUE, flip = FALSE, reverse = FALSE, + add_rug = TRUE, flip = FALSE, reverse = FALSE, x_order = c("value", "rank"), aspect.ratio = NULL, legend.position = "right", legend.direction = "vertical", combine = TRUE, nrow = NULL, ncol = NULL, byrow = TRUE, align = "hv", axis = "lr") { check_R("MatrixGenerics") + x_order <- match.arg(x_order) if (!is.null(group.by) && !group.by %in% colnames(srt@meta.data)) { stop(group.by, " is not in the meta.data of srt object.") } @@ -9314,9 +9320,6 @@ DynamicPlot <- function(srt, features, lineages, cells = NULL, slot = "counts", } x_assign <- rowMeans(srt@meta.data[cell_union, lineages, drop = FALSE], na.rm = TRUE) - if (order.by == "rank") { - x_assign <- rank(x_assign) - } cell_metadata <- cbind.data.frame(data.frame(row.names = cell_union), x_assign = x_assign, srt@meta.data[cell_union, lineages, drop = FALSE] @@ -9458,8 +9461,10 @@ DynamicPlot <- function(srt, features, lineages, cells = NULL, slot = "counts", for (l in lineages_use) { for (f in features_use) { df <- subset(df_all, df_all[["Lineages"]] %in% l & df_all[["Features"]] %in% f) - random_noise <- runif(nrow(df), -0.01 * diff(range(df[, "exp", drop = FALSE], na.rm = TRUE)), 0.01 * diff(range(df[, "exp", drop = FALSE], na.rm = TRUE))) - df[, "random_noise"] <- random_noise + if (x_order == "rank") { + df[, "x_assign"] <- rank(df[, "x_assign"]) + df[, "Pseudotime"] <- rank(df[, "Pseudotime"]) + } df_point <- unique(df[df[["Value"]] == "raw", c("Cell", "x_assign", "exp", group.by)]) if (isTRUE(compare_features)) { raw_point <- NULL @@ -9560,7 +9565,7 @@ DynamicPlot <- function(srt, features, lineages, cells = NULL, slot = "counts", rug + interval + line + - labs(x = "Pseudotime", y = exp_name) + + labs(x = ifelse(x_order == "rank", "Pseudotime(rank)", "Pseudotime"), y = exp_name) + facet_grid(formula(formula), scales = "free") + theme_scp( aspect.ratio = aspect.ratio, @@ -10150,6 +10155,7 @@ DynamicHeatmap <- function(srt, lineages, features = NULL, feature_from = lineag lineage_cells <- gsub(pattern = l, replacement = "", x = cell_order_list[[l]]) subplots <- CellDensityPlot( srt = srt, cells = lineage_cells, group.by = cellan, features = l, + decreasing = TRUE, x_order = "rank", palette = palette, palcolor = palcolor, flip = flip, reverse = l %in% lineages[reverse_ht] || l %in% reverse_ht ) + theme_void() @@ -10195,7 +10201,7 @@ DynamicHeatmap <- function(srt, lineages, features = NULL, feature_from = lineag subplots <- DynamicPlot( srt = srt, cells = lineage_cells, lineages = l, group.by = NULL, features = cellan, line_palette = palette, line_palcolor = palcolor, - add_rug = FALSE, legend.position = "none", compare_features = TRUE, + add_rug = FALSE, legend.position = "none", compare_features = TRUE, x_order = "rank", flip = flip, reverse = l %in% lineages[reverse_ht] || l %in% reverse_ht ) + theme_void() subplots_list[[paste0(paste0(cellan, collapse = ","), ":", l)]] <- subplots diff --git a/README/README-DynamicHeatmap-1.png b/README/README-DynamicHeatmap-1.png index 52391de1..0a0ccdf3 100644 Binary files a/README/README-DynamicHeatmap-1.png and b/README/README-DynamicHeatmap-1.png differ diff --git a/README/README-DynamicPlot-1.png b/README/README-DynamicPlot-1.png index e86dbb0c..ad800d1d 100644 Binary files a/README/README-DynamicPlot-1.png and b/README/README-DynamicPlot-1.png differ diff --git a/man/CellDensityPlot.Rd b/man/CellDensityPlot.Rd index f9c7654e..8315d1ab 100644 --- a/man/CellDensityPlot.Rd +++ b/man/CellDensityPlot.Rd @@ -11,6 +11,7 @@ CellDensityPlot( split.by = NULL, flip = FALSE, reverse = FALSE, + x_order = c("value", "rank"), decreasing = NULL, palette = "Paired", palcolor = NULL, diff --git a/man/DynamicPlot.Rd b/man/DynamicPlot.Rd index a9be9758..77f1228b 100644 --- a/man/DynamicPlot.Rd +++ b/man/DynamicPlot.Rd @@ -8,6 +8,7 @@ DynamicPlot( srt, features, lineages, + group.by = NULL, cells = NULL, slot = "counts", assay = "RNA", @@ -15,8 +16,6 @@ DynamicPlot( exp_method = c("log1p", "raw", "zscore", "fc", "log2fc"), lib_normalize = TRUE, libsize = NULL, - order.by = "pseudotime", - group.by = NULL, compare_lineages = TRUE, compare_features = FALSE, add_line = TRUE, @@ -31,6 +30,7 @@ DynamicPlot( add_rug = TRUE, flip = FALSE, reverse = FALSE, + x_order = c("value", "rank"), aspect.ratio = NULL, legend.position = "right", legend.direction = "vertical",