add plot method for eigenvalues

Signed-off-by: Daena Rys <rysdaena8@gmail.com>

NAMESPACE

@@ -14,6 +14,7 @@ export(plotRDA)
 export(plotRowGraph)
 export(plotRowPrevalence)
 export(plotRowTile)
+export(plotScree)
 export(plotSeries)
 export(plotTaxaPrevalence)
 exportMethods("colTreeData<-")
@@ -37,6 +38,7 @@ exportMethods(plotRowGraph)
 exportMethods(plotRowPrevalence)
 exportMethods(plotRowTile)
 exportMethods(plotRowTree)
+exportMethods(plotScree)
 exportMethods(plotSeries)
 exportMethods(plotTaxaPrevalence)
 exportMethods(rowTreeData)

R/plotScree.R

@@ -0,0 +1,151 @@
+#' Plot Scree Plot or Eigenvalues
+#'
+#' \code{plotScree} creates a scree plot or eigenvalues plot starting from a
+#' SingleCellExperiment object or a vector of eigenvalues. This visualization
+#' shows how the eigenvalues decrease across components.
+#'
+#' @param x a
+#' \code{\link[SingleCellExperiment:SingleCellExperiment]{SingleCellExperiment}}
+#' or a vector of eigenvalues.
+#' 
+#' @param dimred \code{Character scalar} or \code{integer scalar}. Determines
+#' the reduced dimension to plot. This is used when x is a SingleCellExperiment
+#' to extract the eigenvalues from \code{reducedDim(x, dimred)}.
+#' 
+#' @param show.barplot \code{Logical}. Whether to show a barplot. Default is 
+#' TRUE.
+#' 
+#' @param show.points \code{Logical}. Whether to show points. Default is TRUE.
+#' 
+#' @param show.line \code{Logical}. Whether to show a line connecting points. 
+#' Default is TRUE.
+#' 
+#' @param show.labels \code{Logical}. Whether to show labels for each point. 
+#' Default is FALSE.
+#' 
+#' @param cumulative \code{Logical}. Whether to show cumulative explained 
+#' variance. Default is FALSE.
+#' 
+#' @param ... additional parameters for plotting
+#'
+#' @details
+#' \code{plotScree} creates a scree plot or eigenvalues plot, which is useful
+#' for visualizing the relative importance of components in dimensionality
+#' reduction techniques like PCA, RDA, or CCA. When the input is a
+#' SingleCellExperiment, the function extracts eigenvalues from the specified
+#' reduced dimension slot. When the input is a vector, it directly uses these
+#' values as eigenvalues.
+#' 
+#' The plot can include a combination of barplot, points, connecting lines,
+#' and labels, which can be controlled using the \code{show.*} parameters.
+#' 
+#' An option to show cumulative explained variance is also available by setting
+#' \code{cumulative = TRUE}.
+#' 
+#' @return 
+#' A \code{ggplot2} object 
+#'
+#' @name plotScree
+#'
+#' @examples
+#' # Load necessary libraries
+#' library(ggplot2)
+#' 
+#' # Load dataset
+#' library(miaViz)
+#' data("enterotype", package = "mia")
+#' tse <- enterotype
+#'  
+#' # Run RDA and store results into TreeSE
+#' tse <- addRDA(
+#'     tse,
+#'     formula = assay ~ ClinicalStatus + Gender + Age,
+#'     FUN = getDissimilarity,
+#'     distance = "bray",
+#'     na.action = na.exclude
+#'     )
+#' 
+#' # Plot scree plot
+#' plotScree(sce, "RDA")
+#' 
+NULL
+
+#' @rdname plotScree
+#' @export
+setGeneric("plotScree", signature = c("x"),
+    function(x, ...) standardGeneric("plotScree"))
+
+#' @rdname plotScree
+#' @export
+setMethod("plotScree", signature = c(x = "SingleCellExperiment"),
+    function(x, dimred, show.barplot = TRUE, show.points = TRUE, 
+             show.line = TRUE, show.labels = FALSE, cumulative = FALSE, ...) {
+        # Check if dimred exists
+        if (!dimred %in% reducedDimNames(x)) {
+            stop("'dimred' must specify a valid reducedDim.", call. = FALSE)
+        }
+
+        # Extract eigenvalues
+        eig <- attr(reducedDim(x, dimred), "eig")
+        if (is.null(eig)) {
+            stop("No eigenvalues found in the specified reducedDim.", 
+                 call. = FALSE)
+        }
+
+        # Call the vector method
+        plotScree(as.numeric(eig), names(eig), show.barplot = show.barplot, 
+                  show.points = show.points, show.line = show.line, 
+                  show.labels = show.labels, cumulative = cumulative, ...)
+    }
+)
+
+#' @rdname plotScree
+#' @export
+setMethod("plotScree", signature = c(x = "vector"),
+    function(x, names = NULL, show.barplot = TRUE, show.points = TRUE, 
+             show.line = TRUE, show.labels = FALSE, cumulative = FALSE, ...) {
+        if (!is.numeric(x)) {
+            stop("'x' must be a numeric vector.", call. = FALSE)
+        }
+
+        # Create data frame
+        df <- data.frame(
+            Component = if (!is.null(names)) names else seq_along(x),
+            Eigenvalue = x
+        )
+
+        # Calculate cumulative proportion if needed
+        if (cumulative) {
+            df$CumulativeProportion <- cumsum(df$Eigenvalue) / sum(df$Eigenvalue)
+        }
+
+        # Create base plot
+        p <- ggplot(df, aes(x = Component, y = if (cumulative) 
+            CumulativeProportion else Eigenvalue))
+
+        # Add layers based on user preferences
+        if (show.barplot) {
+            p <- p + geom_col(fill = "lightblue", color = "black")
+        }
+        if (show.points) {
+            p <- p + geom_point(size = 3)
+        }
+        if (show.line) {
+            p <- p + geom_line()
+        }
+        if (show.labels) {
+            p <- p + geom_text(aes(label = round(if (cumulative) 
+                CumulativeProportion else Eigenvalue, 2)), vjust = -0.5)
+        }
+
+        # Customize appearance
+        p <- p + theme_minimal() +
+            labs(x = "Component", 
+                 y = if (cumulative) "Cumulative Proportion of Variance" 
+                 else "Eigenvalue",
+                 title = if (cumulative) "Cumulative Explained Variance" 
+                 else "Scree Plot")
+
+        return(p)
+    }
+)

tests/testthat/test-plotScree.R

@@ -0,0 +1,44 @@
+test_that("plot Eigenvalues", {
+    data("enterotype", package = "mia")
+    tse <- enterotype
+
+    tse <- addRDA(
+             tse,
+             formula = assay ~ ClinicalStatus + Gender + Age,
+             FUN = getDissimilarity,
+             distance = "bray",
+             na.action = na.exclude
+             )
+
+    # Define some eigenvalues for vector-based tests
+    eigenvalues <- sort(runif(10), decreasing = TRUE)
+
+    # plotScree handles non-numeric eigenvalues in vector
+    expect_error(plotScree(c("a", "b", "c")), 
+                 "'x' must be a numeric vector.")
+
+    # missing eigenvalues in SingleCellExperiment
+    sce <- SingleCellExperiment(assays = list(counts = matrix(rpois(1000, 5), 
+                                                              ncol = 10)))
+
+    # Add reducedDim without eigenvalues
+    reducedDim(sce, "PCA") <- matrix(rnorm(100), ncol = 10)
+
+    expect_error(plotScree(sce, "PCA"), 
+                 "No eigenvalues found in the specified reducedDim.")
+
+    # invalid dimred input in SingleCellExperiment
+    expect_error(plotScree(tse, "invalid_dimred"), 
+                 "'dimred' must specify a valid reducedDim.")
+
+    p <- plotScree(eigenvalues)
+
+    # Check if a ggplot object is returned
+    expect_s3_class(p, "ggplot")
+
+
+    p <- plotScree(tse, "RDA")
+
+    # Check if a ggplot object is returned
+    expect_s3_class(p, "ggplot")
+    })