add plotMarkers mixOmicsTeam#134

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: mixOmics
 Type: Package
 Title: Omics Data Integration Project
-Version: 6.17.23
+Version: 6.17.24
 Depends: R (>= 3.5.0), 
          MASS, 
          lattice, 
@@ -50,7 +50,7 @@ URL: http://www.mixOmics.org
 BugReports: https://github.com/mixOmicsTeam/mixOmics/issues/
 Repository: Bioconductor
 VignetteBuilder: knitr
-Date: 2021-07-13
+Date: 2021-07-15
 Packaged: 2017-02-06 06:49:17 UTC; klecao
 NeedsCompilation: no
 biocViews: ImmunoOncology, 

NAMESPACE

@@ -146,6 +146,7 @@ export(plotArrow)
 export(plotDiablo)
 export(plotIndiv)
 export(plotLoadings)
+export(plotMarkers)
 export(plotVar)
 export(pls)
 export(plsda)

NEWS.md

@@ -2,6 +2,7 @@
 
 ### new features / enhancements / changes
 
+* new function `plotMarkers` to visualise the selected features in block analyses (see #134)
 * `auroc` title now fixed (#135)
 * `cimDiablo` takes `trim` argument to customise outlier filtering (#136)
 * `plotIndiv.pca` default shape set to `16`

R/plotMarkers.R

@@ -0,0 +1,110 @@
+#' Plot the values for multivariate markers in block analyses
+#'
+#' Plots the standardised values (after centring and/or scaling) for the
+#' selected variables for a given block on a given component. Only applies to
+#' \code{block.splsda} or \code{block.spls}.
+#' 
+#' @param object An object of class \code{block.splsda} or \code{block.spls}
+#' @param block Name or index of the block to use
+#' @param comp Integer, the component to use
+#' @param markers Character or integer, only include these markers. If integer,
+#'   the top 'markers' features are shown
+#' @param group Factor, the grouping variable (only required for
+#'   \code{block.spls} objects)
+#' @template arg/col.per.group
+#' @param global Logical indicating whether to show the global plots (TRUE) or
+#'   segregate by feature (FALSE)
+#' @param title The plot title
+#'
+#' @return A ggplot object
+#' @seealso \code{\link{plotLoadings}}, \code{\link{block.splsda}}, \code{\link{block.spls}}
+#' @export
+#'
+#' @examples
+#' # see ?block.splsda and ?block.spls
+plotMarkers <-
+    function(object,
+             block,
+             markers = NULL,
+             comp = 1,
+             group = NULL,
+             col.per.group = NULL,
+             global = FALSE,
+             title = NULL)
+    {
+
+    blocks <- names(object$X)
+    if (is.numeric(block))
+    {
+        blocks <- blocks[block]
+    }
+    if (!block %in% blocks)
+        stop(message = sprintf("block must be one of: %s", paste0(blocks, collapse = ', ')))
+    df <- data.frame(object$X[[block]], check.names = FALSE)
+
+    ## group factor
+    group <- .get.group(group, object, n_ind = nrow(df))
+
+    col.group <- .get.cols.and.group(col.per.group = col.per.group, 
+                                     group = group)
+    group <- col.group$group
+    col.per.group <- col.group$col.per.group
+    vars <- selectVar(object, block=block, comp=comp)[[1]]$value
+
+    var.names <- rownames(vars)
+
+    df <- df[,var.names]
+    df$group <- group
+    df <-
+        melt(df,
+             id.vars = 'group',
+             variable.name = 'feature',
+             value.name = 'value')
+    df$feature <- factor(df$feature, levels = var.names, ordered = TRUE)
+    df$sign <- ifelse(df$value > 0, 'Positive Loading', 'Negative Loading')
+    # to show +ves on top
+    df$sign <- factor(df$sign, levels = c('Positive Loading', 'Negative Loading'), ordered = TRUE)
+
+    if (!is.null(markers))
+    {
+        if (is.numeric(markers))
+        {
+            markers <- selectVar(object = object, comp = comp)[[block]]$name
+        }
+        if ( is.character(markers))
+        {
+            invalid.markers <- setdiff(markers, df$feature)
+            if (length(invalid.markers) > 0)
+                stop("invalid feature names: ", paste0(invalid.markers, collapse = ", "), call. = FALSE)
+            #' @importFrom dplyr filter
+            feature <- NULL
+            df <- filter(df, feature %in% markers)
+        }
+    }
+    if (global)
+    {
+        df$feature <- 'plotMarkers'
+    }
+
+    if (is.null(title))
+        title <- sprintf("Block: %s | Component: %s", block, comp)
+    p <- ggplot(df, aes_string('group', 'value', fill='group')) +  
+        geom_violin(adjust=0.9) +
+        geom_boxplot(width=0.1) + 
+        scale_fill_manual(values = col.per.group) + 
+        theme_classic() + 
+        labs(x='', 
+             y='value (standardised)', 
+             title = title) + 
+        theme(legend.position = 'none', 
+              axis.text.x = element_text(angle = 45, vjust = 1, hjust=1), 
+              plot.title = element_text(hjust = 0.5, colour = "grey40"), 
+              strip.background = element_rect(colour="black", fill="grey80"))
+    if (global)
+    {
+        p <- p + facet_grid(sign~feature, scales = 'free') 
+    } else {
+        p <- p + facet_grid(.~feature, scales = 'free') 
+    }
+    p
+}

R/selectVar.R

@@ -10,15 +10,16 @@
 #' 
 #' \code{selectVar} provides the variables selected on a given component. \
 #' \describe{ \item{list("name")}{outputs the name of the selected variables
-#' (provided that the input data have colnames) ranked in decreasing order of
+#' (provided that the input data have column names) ranked in decreasing order of
 #' importance.} \item{list("value")}{outputs the loading value for each
 #' selected variable, the loadings are ranked according to their absolute
 #' value.} } These functions are only implemented for the sparse versions.
 #' 
 #' @aliases selectVar selectVar.mixo_pls selectVar.mixo_spls selectVar.pca
 #' selectVar.sgcca selectVar.rgcca select.var
 #' @param object object of class inherited from \code{"pls"}, \code{"spls"},
-#' \code{"plsda"},\code{"splsda"}, \code{"pca"}, \code{"spca"}, \code{"sipca"}.
+#'   \code{"plsda"},\code{"splsda"},\code{"sgcca"}, \code{"rgcca"},
+#'   \code{"pca"}, \code{"spca"}, \code{"sipca"}.
 #' @param comp integer value indicating the component of interest.
 #' @param block for an object of class \code{"sgcca"}, the block data sets can
 #' be specified as an input vector, for example \code{c(1,2)} for the first two

README.md

@@ -251,6 +251,9 @@ Thank you for using `mixOmics`!
 
 #### July 2021
 
+-   new function `plotMarkers` to visualise the selected features in
+    block analyses (see
+    <https://github.com/mixOmicsTeam/mixOmics/issues/134>)
 -   `tune.spls` now able to tune the selected variables on both `X` and
     `Y`. See `?tune.spls`
 -   new function `impute.nipals` to impute missing values using the

examples/block.spls-examples.R

@@ -11,7 +11,7 @@ design
 # set number of component per data set
 ncomp = c(2)
 # set number of variables to select, per component and per data set (this is set arbitrarily)
-list.keepX = list(mrna = rep(20, 2), mirna = rep(10,2))
+list.keepX = list(mrna = rep(5, 2), mirna = rep(5,2))
 list.keepY = c(rep(10, 2))
 
 TCGA.block.spls = block.spls(X = data, Y = breast.TCGA$data.train$protein,
@@ -22,6 +22,16 @@ plotIndiv(TCGA.block.spls, group =  breast.TCGA$data.train$subtype, ind.names =
 # illustrates coefficient weights in each block
 plotLoadings(TCGA.block.spls, ncomp = 1)
 plotVar(TCGA.block.spls, style = 'graphics', legend = TRUE)
+
+## plot markers (selected markers) for mrna and mirna
+group <- breast.TCGA$data.train$subtype
+# mrna: show each selected feature separately and group by subtype
+plotMarkers(object = TCGA.block.spls, comp = 1, block = 'mrna', group = group)
+# mrna: aggregate all selected features, separate by loadings signs and group by subtype
+plotMarkers(object = TCGA.block.spls, comp = 1, block = 'mrna', group = group, global = TRUE)
+# proteins
+plotMarkers(object = TCGA.block.spls, comp = 1, block = 'Y', group = group)
+
 \dontrun{
 network(TCGA.block.spls)
 }

examples/block.splsda-examples.R

@@ -12,7 +12,7 @@ design
 # set number of component per data set
 ncomp = c(2)
 # set number of variables to select, per component and per data set (this is set arbitrarily)
-list.keepX = list(mrna = rep(20, 2), mirna = rep(10,2), protein = rep(10, 2))
+list.keepX = list(mrna = rep(5,2), mirna = rep(5,2), protein = rep(5,2))
 
 
 TCGA.block.splsda = block.splsda(X = data, Y = breast.TCGA$data.train$subtype, 
@@ -34,3 +34,17 @@ TCGA.block.splsda$design
 # illustrates coefficient weights in each block
 plotLoadings(TCGA.block.splsda, ncomp = 1, contrib = 'max')
 plotVar(TCGA.block.splsda, style = 'graphics', legend = TRUE)
+
+## plot markers (selected variables) for mrna and mirna
+# mrna: show each selected feature separately
+plotMarkers(object = TCGA.block.splsda, comp = 1, block = 'mrna')
+# mrna: aggregate all selected features and separate by loadings signs
+plotMarkers(object = TCGA.block.splsda, comp = 1, block = 'mrna', global = TRUE)
+# proteins
+plotMarkers(object = TCGA.block.splsda, comp = 1, block = 'protein')
+# show top 5 markers
+plotMarkers(object = TCGA.block.splsda, comp = 1, block = 'protein', markers = 1:5)
+# show specific markers
+my.markers <- selectVar(TCGA.block.splsda, comp = 1)[['protein']]$name[c(1,3,5)]
+my.markers
+plotMarkers(object = TCGA.block.splsda, comp = 1, block = 'protein', markers = my.markers)

inst/README-WhatsNew.Rmd

@@ -19,6 +19,7 @@ opts_chunk$set( echo = TRUE, eval = FALSE, warning = FALSE, message = FALSE)
 
 #### July 2021
 
+* new function `plotMarkers` to visualise the selected features in block analyses (see https://github.com/mixOmicsTeam/mixOmics/issues/134)
 * `tune.spls` now able to tune the selected variables on both `X` and `Y`. See `?tune.spls`
 * new function `impute.nipals` to impute missing values using the nipals algorithm
 * new function `tune.spca` to tune the number of selected variables for pca components