Add scattermore

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: mutscan
 Title: Preprocessing and Analysis of Deep Mutational Scanning Data
-Version: 0.3.3
+Version: 0.3.4
 Authors@R: 
     c(person(given = "Charlotte",
              family = "Soneson",
@@ -55,7 +55,8 @@ Suggests:
     knitr,
     Biostrings,
     pwalign,
-    plotly
+    plotly,
+    scattermore
 SystemRequirements: GNU make
 biocViews: GeneticVariability, GenomicVariation, Preprocessing
 License: MIT + file LICENSE

NEWS.md

@@ -1,3 +1,7 @@
+# mutscan 0.3.4
+
+* Allow use of scattermore/scattermost in plotPairs
+
 # mutscan 0.3.3
 
 * Bugfix in mergeReadPairPartial for situation where specified minMergedLength/maxMergedLength is larger than the total length of the two merged sequences

R/plotPairs.R

@@ -23,8 +23,9 @@
 #'     to calculate.
 #' @param histBreaks Numeric scalar, the number of breaks in the histograms
 #'     to put in the diagonal panels.
-#' @param pointsType Either "points" or "smoothscatter", determining the
-#'     type of plots that will be made.
+#' @param pointsType Either "points", "smoothscatter", "scattermore" or 
+#'     "scattermost" (the latter two require the "scattermore" package to be 
+#'     installed), determining the type of plots that will be made.
 #' @param corSizeMult,corSizeAdd Numeric scalars determining how the
 #'     absolute correlation value is transformed into a font size. The
 #'     transformation is corSizeMult * abs(corr) + corSizeAdd.
@@ -71,7 +72,8 @@ plotPairs <- function(se, selAssay = "counts", doLog = TRUE, pseudocount = 1,
                   validValues = c("pearson", "spearman"))
     .assertScalar(x = histBreaks, type = "numeric", rngExcl = c(0, Inf))
     .assertScalar(x = pointsType, type = "character",
-                  validValues = c("smoothscatter", "points"))
+                  validValues = c("smoothscatter", "points", "scattermore",
+                                  "scattermost"))
     .assertScalar(x = corSizeMult, type = "numeric", rngExcl = c(0, Inf))
     .assertScalar(x = corSizeAdd, type = "numeric", rngIncl = c(0, Inf))
     .assertScalar(x = pointSize, type = "numeric", rngExcl = c(0, Inf))
@@ -83,6 +85,9 @@ plotPairs <- function(se, selAssay = "counts", doLog = TRUE, pseudocount = 1,
         stopifnot(corrColorRange[2] >= corrColorRange[1])
     }
     .assertScalar(x = addIdentityLine, type = "logical")
+    if (pointsType %in% c("scattermore", "scattermost")) {
+        .assertPackagesAvailable("scattermore")
+    }
 
     ## ----------------------------------------------------------------------- ##
     ## Define shared theme elements
@@ -140,31 +145,80 @@ plotPairs <- function(se, selAssay = "counts", doLog = TRUE, pseudocount = 1,
     ## ----------------------------------------------------------------------- ##
     ## Scatter plots
     ## ----------------------------------------------------------------------- ##
-    ## Define function to create smoothscatter-like plot (for use with ggpairs)
-    smoothscat <- function(data, mapping, ...) {
-        ggplot2::ggplot(data = data, mapping = mapping) +
-            ggplot2::stat_density2d(ggplot2::aes(fill = ggplot2::after_stat(.data$density)^0.25), geom = "tile",
-                                    contour = FALSE, n = 200) +
-            ggplot2::scale_fill_continuous(low = "white", high = "darkgreen") +
-            ggtheme +
-            ggplot2::scale_x_continuous(expand = c(0, 0)) +
-            ggplot2::scale_y_continuous(expand = c(0, 0))
-    }
-
-    ## Define function to create scatter plot (for use with ggpairs)
-    if (addIdentityLine) {
-        plotpoints <- function(data, mapping, ...) {
+    if (pointsType == "smoothscatter") {
+        ## Define function to create smoothscatter-like plot (for use with ggpairs)
+        smoothscat <- function(data, mapping, ...) {
             ggplot2::ggplot(data = data, mapping = mapping) +
-                ggplot2::geom_abline(slope = 1, intercept = 0, 
-                                     linetype = "dashed", color = "grey") + 
-                ggplot2::geom_point(alpha = pointAlpha, size = pointSize) +
-                ggtheme
+                ggplot2::stat_density2d(
+                    ggplot2::aes(fill = ggplot2::after_stat(.data$density)^0.25), geom = "tile",
+                    contour = FALSE, n = 200) +
+                ggplot2::scale_fill_continuous(low = "white", high = "darkgreen") +
+                ggtheme +
+                ggplot2::scale_x_continuous(expand = c(0, 0)) +
+                ggplot2::scale_y_continuous(expand = c(0, 0))
         }
-    } else {
-        plotpoints <- function(data, mapping, ...) {
-            ggplot2::ggplot(data = data, mapping = mapping) +
-                ggplot2::geom_point(alpha = pointAlpha, size = pointSize) +
-                ggtheme
+    } else if (pointsType == "points") {
+        ## Define function to create scatter plot (for use with ggpairs)
+        if (addIdentityLine) {
+            plotpoints <- function(data, mapping, ...) {
+                ggplot2::ggplot(data = data, mapping = mapping) +
+                    ggplot2::geom_abline(slope = 1, intercept = 0, 
+                                         linetype = "dashed", color = "grey") + 
+                    ggplot2::geom_point(alpha = pointAlpha, size = pointSize) +
+                    ggtheme
+            }
+        } else {
+            plotpoints <- function(data, mapping, ...) {
+                ggplot2::ggplot(data = data, mapping = mapping) +
+                    ggplot2::geom_point(alpha = pointAlpha, size = pointSize) +
+                    ggtheme
+            }
+        }
+    } else if (pointsType == "scattermore") {
+        ## Define function to create scattermore plot (for use with ggpairs)
+        if (addIdentityLine) {
+            plotscattermore <- function(data, mapping, ...) {
+                ggplot2::ggplot(data = data, mapping = mapping) +
+                    ggplot2::geom_abline(slope = 1, intercept = 0, 
+                                         linetype = "dashed", color = "grey") + 
+                    scattermore::geom_scattermore(alpha = pointAlpha, 
+                                                  pointsize = pointSize) +
+                    ggtheme
+            }
+        } else {
+            plotscattermore <- function(data, mapping, ...) {
+                ggplot2::ggplot(data = data, mapping = mapping) +
+                    scattermore::geom_scattermore(alpha = pointAlpha, 
+                                                  pointsize = pointSize) +
+                    ggtheme
+            }
+        }
+    } else if (pointsType == "scattermost") {
+        ## Define function to create scattermost plot (for use with ggpairs)
+        if (addIdentityLine) {
+            plotscattermost <- function(data, mapping, ...) {
+                ## Get data
+                xData <- GGally::eval_data_col(data, mapping$x)
+                yData <- GGally::eval_data_col(data, mapping$y)
+
+                ggplot2::ggplot(data = data, mapping = mapping) +
+                    ggplot2::geom_abline(slope = 1, intercept = 0, 
+                                         linetype = "dashed", color = "grey") + 
+                    scattermore::geom_scattermost(xy = cbind(xData, yData), 
+                                                  pointsize = pointSize) +
+                    ggtheme
+            }
+        } else {
+            plotscattermost <- function(data, mapping, ...) {
+                ## Get data
+                xData <- GGally::eval_data_col(data, mapping$x)
+                yData <- GGally::eval_data_col(data, mapping$y)
+
+                ggplot2::ggplot(data = data, mapping = mapping) +
+                    scattermore::geom_scattermost(xy = cbind(xData, yData), 
+                                                  pointsize = pointSize) +
+                    ggtheme
+            }
         }
     }
 
@@ -173,6 +227,10 @@ plotPairs <- function(se, selAssay = "counts", doLog = TRUE, pseudocount = 1,
         lower <- list(continuous = smoothscat)
     } else if (pointsType == "points") {
         lower <- list(continuous = plotpoints)
+    } else if (pointsType == "scattermore") {
+        lower <- list(continuous = plotscattermore)
+    } else if (pointsType == "scattermost") {
+        lower <- list(continuous = plotscattermost)
     }
 
     ## ----------------------------------------------------------------------- ##

R/utils.R

@@ -156,3 +156,54 @@
 
     return(invisible(TRUE))
 }
+
+#' Utility function that makes sure that packages are available
+#' 
+#' The function tries loading the namespaces of the packages given in
+#' \code{pkgs}, and throws an exception with an informative error message if
+#' that is not the case.
+#' 
+#' @param pkgs Character vector with package names. Can be either just a
+#'   package name or a string of the form \code{"githubuser/packagename"} for
+#'   packages hosted on GitHub.
+#' @param suggestInstallation Logical scalar. If \code{TRUE}, include an
+#'   expression to install the missing package(s) as part of the generated
+#'   error message.
+#' 
+#' @author Michael Stadler, Charlotte Soneson
+#' 
+#' @noRd
+#' @keywords internal
+.assertPackagesAvailable <- function(pkgs, suggestInstallation = TRUE) {
+    stopifnot(exprs = {
+        is.character(pkgs)
+        is.logical(suggestInstallation)
+        length(suggestInstallation) == 1L
+    })
+
+    avail <- unlist(lapply(sub("^[^/]+/", "", pkgs),
+                           function(pkg) {
+                               requireNamespace(pkg, quietly = TRUE)
+                           }))
+
+    if (any(!avail)) {
+        caller <- deparse(sys.calls()[[sys.nframe() - 1]])
+        callerfunc <- sub("\\(.+$", "", caller)
+        haveBioc <- requireNamespace("BiocManager", quietly = TRUE)
+        msg <- paste0("The package", ifelse(sum(!avail) > 1, "s '", " '"),
+                      paste(sub("^[^/]+/", "", pkgs[!avail]), collapse = "', '"),
+                      "' ",
+                      ifelse(sum(!avail) > 1, "are", "is"), " required for ",
+                      callerfunc, "(), but not installed.\n")
+        if (suggestInstallation) {
+            msg <- paste0(msg,
+                          "Install ", ifelse(sum(!avail) > 1, "them", "it"), " using:\n",
+                          ifelse(haveBioc, "", "install.packages(\"BiocManager\")\n"),
+                          "BiocManager::install(c(\"",
+                          paste(pkgs[!avail], collapse = "\", \""), "\"))")
+        }
+        stop(msg, call. = FALSE)
+    }
+
+    invisible(TRUE)
+}

tests/testthat/test_plotPairs.R

@@ -111,6 +111,22 @@ test_that("plotPairs works with correct arguments", {
                               corSizeAdd = 2, pointSize = 0.1, pointAlpha = 0.3,
                               colorByCorrelation = TRUE, corrColorRange = NULL, 
                               addIdentityLine = FALSE), "ggmatrix")
+
+    ## scattermore
+    expect_s3_class(plotPairs(se = se, selAssay = "counts", doLog = TRUE,
+                              pseudocount = 1, corMethod = "pearson",
+                              histBreaks = 40, pointsType = "scattermore", corSizeMult = 5,
+                              corSizeAdd = 2, pointSize = 3.5, pointAlpha = 0.3,
+                              colorByCorrelation = TRUE, corrColorRange = NULL, 
+                              addIdentityLine = FALSE), "ggmatrix")
+
+    ## scattermost
+    expect_s3_class(plotPairs(se = se, selAssay = "counts", doLog = TRUE,
+                              pseudocount = 1, corMethod = "pearson",
+                              histBreaks = 40, pointsType = "scattermost", corSizeMult = 5,
+                              corSizeAdd = 2, pointSize = 3.5, pointAlpha = 0.3,
+                              colorByCorrelation = TRUE, corrColorRange = NULL, 
+                              addIdentityLine = FALSE), "ggmatrix")
 
     ## Change font size to correlation relation
     expect_s3_class(plotPairs(se = se, selAssay = "counts", doLog = TRUE,

tests/testthat/tests-utils.R

@@ -92,3 +92,20 @@ expect_true(.assertVector(LETTERS[1:2], type = "character", validValues = LETTER
 test <- "text"
 expect_error(.assertVector(x = test, type = "numeric"),
              "'test' must be of class 'numeric")
+
+## -------------------------------------------------------------------------- ##
+## Checks, .assertPackagesAvailable
+## -------------------------------------------------------------------------- ##
+test_that(".assertPackagesAvailable works", {
+    testfunc <- function(...) .assertPackagesAvailable(...)
+    expect_error(testfunc(1L))
+    expect_error(testfunc("test", "error"))
+    expect_error(testfunc("test", c(TRUE, FALSE)))
+
+    expect_true(testfunc("base"))
+    expect_true(testfunc("githubuser/base"))
+    expect_true(testfunc(c("base", "methods")))
+    expect_error(testfunc(c("error", "error2")), "BiocManager")
+    expect_error(testfunc("error1", suggestInstallation = FALSE), "installed.\n$")
+    rm(testfunc)
+})