Revise tutorial; with bug fixes

R/DEG_marker.R

@@ -1240,20 +1240,21 @@ plotPairwiseDEGHeatmap <- function(
         dplyr::filter(
             abs(.data[['logFC']]) >= absLFCThresh,
             .data[['padj']] <= padjThresh
-        )
+        ) %>%
+        dplyr::mutate(regulation = factor(
+            ifelse(.data[['logFC']] > 0, "up", "down"),
+            levels = c("up", "down")
+        ))
     if ("pct_in" %in% colnames(result) &&
         "pct_out" %in% colnames(result)) {
-        result <- result %>%
-            dplyr::filter(
-                .data[['pct_in']] > pctInThresh,
-                .data[['pct_out']] < pctOutThresh
+        result <- result %>% filter(
+            dplyr::case_when(
+                .data[['logFC']] > 0 ~ .data[['pct_in']] > pctInThresh,
+                .data[['logFC']] < 0 ~ .data[['pct_out']] > pctOutThresh
             )
+        )
     }
     result <- result %>%
-        dplyr::mutate(regulation = factor(
-            ifelse(.data[['logFC']] > 0, "up", "down"),
-            levels = c("up", "down")
-        )) %>%
         dplyr::group_by(.data[['regulation']]) %>%
         dplyr::arrange(
             .data[['padj']],

R/GSEA.R

@@ -244,6 +244,9 @@ runGOEnrich <- function(
 #' @param result Returned list object from \code{\link{runGOEnrich}}.
 #' @param group Character vector of group names, must be available in
 #' \code{names(result)}. Default \code{NULL} make plots for all groups.
+#' @param query A single string selecting from which query to show the result.
+#' Choose from \code{"Up"} for results using up-regulated genes, \code{"Down"}
+#' for down-regulated genes. Default \code{"Up"}.
 #' @param pvalThresh Numeric scalar, cutoff for p-value where smaller values are
 #' considered as significant. Default \code{0.05}.
 #' @param n Number of top terms to be shown, ranked by p-value. Default
@@ -271,14 +274,15 @@ runGOEnrich <- function(
 #' # Setting `significant = FALSE` because it's hard for a gene list obtained
 #' # from small test dataset to represent real-life biology.
 #' if (requireNamespace("gprofiler2", quietly = TRUE)) {
-#'     go <- runGOEnrich(result, group = "0.stim", significant = FALSE)
+#'     go <- runGOEnrich(result, group = "0.stim", splitReg = TRUE, significant = FALSE)
 #'     # The toy example won't have significant result.
 #'     plotGODot(go)
 #' }
 #' }
 plotGODot <- function(
         result,
         group = NULL,
+        query = c("Up", "Down"),
         pvalThresh = 0.05,
         n = 20,
         termIDMatch = "^GO",
@@ -295,14 +299,15 @@ plotGODot <- function(
               i = "Available one{?s} {?is/are}: {.val {names(result)}}")
         )
     }
-
+    query <- match.arg(query)
     plotList <- list()
     for (i in seq_along(group)) {
         gname <- group[i]
         resdf <- result[[gname]]$result
+        resdf <- resdf[resdf$query == query, , drop = FALSE]
         if (is.null(resdf) || nrow(resdf) == 0) {
             cli::cli_alert_warning(
-                "No significant result returned for group {.val {gname}}."
+                "No significant result returned for group {.val {gname}} and query {.val {query}}."
             )
             next
         }

R/clustering.R

@@ -303,7 +303,7 @@ groupSingletons <- function(ids,
 #' pbmc <- mapCellMeta(pbmc, from = "dataset", newTo = "modal",
 #'                     ctrl = "rna", stim = "rna")
 mapCellMeta <- function(object, from, newTo = NULL, ...) {
-    object <- recordCommand(object, ...)
+    # object <- recordCommand(object, ...)
     from <- cellMeta(object, from)
     if (!is.factor(from))
         cli::cli_abort("{.var from} must be a {.cls factor}.")

R/dotplot.R

@@ -89,11 +89,11 @@ plotClusterGeneDot <- function(
     mat <- retrieveCellFeature(object, feature = unique(features[,1]),
                                slot = "normData", cellIdx = cellIdx,
                                verbose = verbose)
-    if (any(duplicated(features[,1]))) {
-        mat <- mat[,features[,1]]
-    }
     # In case specified features not found
-    features <- features[features[,1] %in% colnames(mat), , drop = FALSE]
+    geneAvail <- colnames(mat)
+    features <- features[features[,1] %in% geneAvail, , drop = FALSE]
+    # In case retriever function mess up the order or deduplicated the query
+    mat <- mat[, features[,1], drop = FALSE]
     allFeatures <- make.unique(features[,1])
     # Make sure everything consistent
     colnames(mat) <- allFeatures

R/embedding.R

@@ -27,7 +27,7 @@
 #' space. Default \code{"cosine"}, alternative options include:
 #' \code{"euclidean"}, \code{"manhattan"} and \code{"hamming"}.
 #' @param nNeighbors Number of neighboring points used in local approximations
-#' of manifold structure. Default \code{10}.
+#' of manifold structure. Default \code{20}.
 #' @param minDist Numeric. Controls how tightly the embedding is allowed
 #' compress points together. Default \code{0.1}.
 #' @param dimredName Name of the variable in \code{cellMeta} slot to store the

R/ggplotting.R

@@ -191,6 +191,11 @@ plotDimRed <- function(
 #' Does not work when continuous coloring is specified.
 #' @param labelTextSize Numeric, controls the size of label size when
 #' \code{labelText = TRUE}. Default \code{4}.
+#' @param ggrepelLabelTick Logical, whether to force showing the tick between
+#' label texts and the position they point to. Useful when a lot of text labels
+#' are required. Default \code{FALSE}. Run
+#' \code{options(ggrepel.max.overlaps = n)} before plotting to set allowed label
+#' overlaps.
 #' @param seed Random seed for reproducibility. Default \code{1}.
 #' @param ... More theme setting arguments passed to
 #' \code{\link{.ggplotLigerTheme}}.
@@ -212,6 +217,7 @@ plotDimRed <- function(
         labelBy = colorBy,
         labelText = TRUE,
         labelTextSize = 4,
+        ggrepelLabelTick = FALSE,
         seed = 1,
         ...
 ) {
@@ -290,14 +296,28 @@ plotDimRed <- function(
                     size = labelTextSize
                 )
             } else {
-                p <- p + ggrepel::geom_text_repel(
-                    data = textData,
-                    mapping = ggplot2::aes(x = .data[["x"]],
-                                           y = .data[["y"]],
-                                           label = .data[[labelBy]]),
-                    color = "black", size = labelTextSize, inherit.aes = FALSE,
-                    bg.colour = "white", bg.r = .2
-                )
+                if (isTRUE(ggrepelLabelTick)) {
+                    p <- p + ggrepel::geom_text_repel(
+                        data = textData,
+                        mapping = ggplot2::aes(x = .data[["x"]],
+                                               y = .data[["y"]],
+                                               label = .data[[labelBy]]),
+                        color = "black", size = labelTextSize, inherit.aes = FALSE,
+                        bg.colour = "white", bg.r = .2,
+                        force = 1,
+                        min.segment.length = 0,
+                        nudge_y = 1
+                    )
+                } else {
+                    p <- p + ggrepel::geom_text_repel(
+                        data = textData,
+                        mapping = ggplot2::aes(x = .data[["x"]],
+                                               y = .data[["y"]],
+                                               label = .data[[labelBy]]),
+                        color = "black", size = labelTextSize, inherit.aes = FALSE,
+                        bg.colour = "white", bg.r = .2, hjust = 0.5, vjust = 0.5
+                    )
+                }
             }
 
             # Important to have `inherit.aes = F` above, otherwise

R/visualization.R

@@ -371,7 +371,8 @@ plotBarcodeRank <- function(
 #' plot.
 #'
 #' Having package "ggrepel" installed can help adding tidier percentage
-#' annotation on the pie chart.
+#' annotation on the pie chart. Run \code{options(ggrepel.max.overlaps = n)}
+#' before plotting to set allowed label overlaps.
 #' @param object A \linkS4class{liger} object.
 #' @param class1,class2 Each should be a single name of a categorical variable
 #' available in \code{cellMeta} slot. Number of cells in each categories in
@@ -380,8 +381,9 @@ plotBarcodeRank <- function(
 #' "dataset"}.
 #' @param method For bar plot, choose whether to draw \code{"stack"} or
 #' \code{"group"} bar plot. Default \code{"stack"}.
-#' @param showLegend,panelBorder,... ggplot theme setting arguments passed to
-#' \code{\link{.ggplotLigerTheme}}.
+#' @param showLegend Whether to show the legend. Default \code{TRUE}.
+#' @param panelBorder Whether to show rectangle border of the panel instead of
+#' using ggplot classic bottom and left axis lines. Default \code{FALSE}.
 #' @param inclRev Logical, for barplot, whether to reverse the specification for
 #' \code{class1} and \code{class2} and produce two plots. Default \code{FALSE}.
 #' @param combinePlot Logical, whether to combine the two plots with
@@ -391,7 +393,8 @@ plotBarcodeRank <- function(
 #' while \code{class2} is hardcoded with \code{"dataset"}.
 #' @param labelSize,labelColor Settings on pie chart percentage label. Default
 #' \code{4} and \code{"white"}.
-#' @param return.plot \bold{defuncted}.
+#' @inheritDotParams .ggplotLigerTheme title subtitle xlab ylab legendFillTitle showLegend legendPosition baseSize titleSize subtitleSize xTextSize xTitleSize yTextSize yTitleSize legendTextSize legendTitleSize panelBorder legendNRow legendNCol colorLabels colorValues colorPalette colorDirection naColor colorLow colorMid colorHigh colorMidPoint plotly
+#' @param return.plot `r lifecycle::badge("defunct")`
 #' @return ggplot or list of ggplot
 #' @rdname plotProportion
 #' @export
@@ -537,7 +540,7 @@ plotProportionPie <- function(
         class1 = NULL,
         class2 = "dataset",
         labelSize = 4,
-        labelColor = "white",
+        labelColor = "black",
         circleColors = NULL,
         ...
 ) {
@@ -589,8 +592,8 @@ plotProportionPie <- function(
         )
     } else {
         p <- p + ggrepel::geom_text_repel(
-            size = labelSize, color = labelColor, force = 0.001, max.overlaps = 4,
-            position = ggplot2::position_nudge(y = 0.25)
+            size = labelSize, color = labelColor, force = 1,
+            nudge_y = 0.25, bg.colour = "white"
         )
     }
     .ggplotLigerTheme(p, ...) +
@@ -824,25 +827,29 @@ plotVolcano <- function(
               i = "Available ones: {.val {unique(result$group)}}")
         )
     }
-    result <- result[result$group == group, ]
-    result <- result[order(abs(result$logFC), decreasing = TRUE), ]
-    rownames(result) <- result$Gene
-    # Prepare for coloring that shows the filtering
-    result$Significance <- "Not significant"
-    result$Significance[abs(result$logFC) > logFCThresh] <- "logFC"
-    result$Significance[result$padj < padjThresh] <- "padj"
-    result$Significance[abs(result$logFC) > logFCThresh &
-                            result$padj < padjThresh] <- "padj & logFC"
-    result$Significance <- factor(result$Significance,
-                                  levels = c("Not significant",
-                                             "logFC", "padj", "padj & logFC"))
-    result$padj[result$padj == 0] <- min(result$padj[result$padj > 0]) / 10
-    result$padj <- -log10(result$padj)
-    # Prepare for Top result text labeling
+    minPosPadj <- min(result$padj[result$padj > 0], na.rm = TRUE) / 10
+    result <- result %>%
+        dplyr::filter(.data[['group']] == group, !is.na(.data[['padj']])) %>%
+        dplyr::mutate(Significance = dplyr::case_when(
+            abs(.data[['logFC']]) > logFCThresh &
+                .data[['padj']] < padjThresh ~ "padj & logFC",
+            abs(.data[['logFC']]) > logFCThresh ~ "logFC",
+            .data[['padj']] < padjThresh ~ "padj",
+            .default = "Not significant"
+        )) %>%
+        dplyr::mutate(Significance = factor(.data[["Significance"]],
+                                            levels = c("Not significant",
+                                                       "logFC", "padj", "padj & logFC"))) %>%
+        dplyr::mutate(padj = ifelse(.data[['padj']] == 0, minPosPadj, .data[['padj']])) %>%
+        dplyr::mutate(padj = -log10(.data[['padj']])) %>%
+        dplyr::arrange(dplyr::desc(.data[['padj']]),
+                       dplyr::desc(.data[['logFC']]))
+
     passIdx <- result$Significance == "padj & logFC"
+
     result$label <- NA
     if (!is.null(labelTopN) && !isFALSE(labelTopN)) {
-        labelTopN <- min(labelTopN, length(which(passIdx)))
+        labelTopN <- min(labelTopN, sum(passIdx))
         if (labelTopN > 0) {
             labelIdx <- which(passIdx)[seq(labelTopN)]
             result$label[labelIdx] <- result$feature[labelIdx]
@@ -868,7 +875,8 @@ plotVolcano <- function(
                     ylab = "-log10 Adjusted P-value",
                     colorValues = c("black", "#ef2301", "#416ae1", "#238b22"),
                     legendPosition = legendPosition,
-                    dotSize = dotSize, dotAlpha = dotAlpha, ...) +
+                    dotSize = dotSize, dotAlpha = dotAlpha,
+                    ggrepelLabelTick = TRUE, ...) +
         ggplot2::xlim(-max(abs(result$logFC)), max(abs(result$logFC))) +
         ggplot2::geom_vline(data = vlineLab,
                             mapping = ggplot2::aes(xintercept = .data[["X"]]),