diff --git a/DESCRIPTION b/DESCRIPTION index b3cc32f..6473864 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,5 +1,5 @@ Package: iSEEtree -Version: 0.99.7 +Version: 0.99.8 Authors@R: c(person(given = "Giulio", family = "Benedetti", role = c("aut", "cre"), email = "giulio.benedetti@utu.fi", @@ -17,7 +17,7 @@ Description: visualisation to create panels that are specific for TreeSummarizedExperiment objects. Not surprisingly, it also depends on the generic panels from iSEE. -biocViews: Microbiome, Software, Visualization, GUI, ShinyApps +biocViews: Microbiome, Software, Visualization, GUI, ShinyApps, DataImport License: Artistic-2.0 Encoding: UTF-8 Depends: diff --git a/NAMESPACE b/NAMESPACE index 36b7b2b..e2d5879 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,16 +2,21 @@ export(AbundanceDensityPlot) export(AbundancePlot) +export(ColumnTreePlot) +export(LoadingPlot) export(RDAPlot) export(RowTreePlot) export(iSEE) exportClasses(AbundanceDensityPlot) exportClasses(AbundancePlot) +exportClasses(ColumnTreePlot) +exportClasses(LoadingPlot) exportClasses(RDAPlot) exportClasses(RowTreePlot) exportMethods(iSEE) importFrom(S4Vectors,isEmpty) importFrom(S4Vectors,setValidity2) +importFrom(SingleCellExperiment,reducedDim) importFrom(SingleCellExperiment,reducedDimNames) importFrom(SingleCellExperiment,reducedDims) importFrom(SummarizedExperiment,assayNames) @@ -57,6 +62,8 @@ importFrom(methods,is) importFrom(methods,new) importFrom(methods,slot) importFrom(mia,taxonomyRanks) +importFrom(miaViz,plotColTree) +importFrom(miaViz,plotLoadings) importFrom(miaViz,plotRowTree) importFrom(shiny,plotOutput) importFrom(shiny,renderPlot) diff --git a/NEWS b/NEWS index 5fd5247..5101746 100644 --- a/NEWS +++ b/NEWS @@ -14,3 +14,6 @@ Changes in version 0.99.2 Changes in version 0.99.3 * Added .exportOutput method + +Changes in version 0.99.8 +* Added ColumnTreePlot and LoadingPlot panels diff --git a/R/LoadingPlotNA.pdf b/R/LoadingPlotNA.pdf new file mode 100644 index 0000000..ff6cc91 Binary files /dev/null and b/R/LoadingPlotNA.pdf differ diff --git a/R/class-AbundanceDensityPlot.R b/R/class-AbundanceDensityPlot.R index c5fb4bf..b22065d 100644 --- a/R/class-AbundanceDensityPlot.R +++ b/R/class-AbundanceDensityPlot.R @@ -6,7 +6,7 @@ #' to generate the plot. #' #' @section Slot overview: -#' The following slots control the thresholds used in the visualization: +#' The following slots control the thresholds used in the visualisation: #' \itemize{ #' \item \code{layout}, a string specifying abundance layout (jitter, density or points). #' \item \code{assay.type}, a string specifying the assay to visualize. diff --git a/R/class-ColumnTreePlot.R b/R/class-ColumnTreePlot.R new file mode 100644 index 0000000..a6b8195 --- /dev/null +++ b/R/class-ColumnTreePlot.R @@ -0,0 +1,476 @@ +#' Column tree plot +#' +#' Hierarchical tree for the columns of a +#' \code{\link[TreeSummarizedExperiment:TreeSummarizedExperiment-constructor]{TreeSummarizedExperiment}} +#' object. The tree represents the sample hierarchy of the study and gets stored +#' in the \code{\link[TreeSummarizedExperiment:rowLinks]{colTree}} slot of the +#' experiment object. The panel implements \code{\link[miaViz:plotTree]{plotColTree}} +#' to generate the plot. +#' +#' @section Slot overview: +#' The following slots control the thresholds used in the visualisation: +#' \itemize{ +#' \item \code{layout}, a string specifying tree layout +#' \item \code{add_legend}, a logical indicating if color legend should appear. +#' \item \code{edge_colour_by}, a string specifying parameter to color lines by +#' when \code{colour_parameters = "Edge"}. +#' \item \code{edge_size_by}, a string specifying parameter to size lines by +#' when \code{size_parameters = "Edge"}. +#' \item \code{tip_colour_by}, a string specifying parameter to color tips by +#' when \code{colour_parameters = "Tip"}. +#' \item \code{tip_size_by}, a string specifying parameter to size tips by +#' when \code{size_parameters = "Tip"}. +#' \item \code{tip_shape_by}, a string specifying parameter to shape tips by +#' when \code{shape_parameters = "Tip"}. +#' \item \code{node_colour_by}, a string specifying parameter to color nodes by +#' when \code{colour_parameters = "Node"}. +#' \item \code{node_size_by}, a string specifying parameter to size nodes by +#' when \code{size_parameters = "Node"}. +#' \item \code{node_shape_by}, a string specifying parameter to shape nodes by +#' when \code{shape_parameters = "Node"}. +#' \item \code{order_tree}, a logical indicating if tree is ordered by +#' alphabetic order of taxonomic levels. +#' } +#' +#' In addition, this class inherits all slots from its parent \linkS4class{Panel} class. +#' +#' @return +#' The \code{ColumnTreePlot(...)} constructor creates an instance of a ColumnTreePlot +#' class, where any slot and its value can be passed to \code{...} as a named +#' argument. +#' +#' @author Giulio Benedetti +#' @examples +#' # Import TreeSE +#' library(mia) +#' data("Tengeler2020", package = "mia") +#' tse <- Tengeler2020 +#' +#' # Store panel into object +#' panel <- ColumnTreePlot() +#' # View some adjustable parameters +#' head(slotNames(panel)) +#' +#' # Launch iSEE with custom initial panel +#' if (interactive()) { +#' iSEE(tse, initial = c(panel)) +#' } +#' +#' @docType methods +#' @name ColumnTreePlot +NULL + +#' @rdname ColumnTreePlot +#' @export +setClass("ColumnTreePlot", contains="Panel", slots=c(layout="character", + add_legend="logical", edge_colour_by="character", tip_colour_by="character", + order_tree="logical", tip_size_by="character", edge_size_by="character", + tip_shape_by="character", node_size_by="character", node_shape_by="character", + node_colour_by="character", visual_parameters="character", + size_parameters="character", shape_parameters="character", + colour_parameters="character")) + +#' @importFrom iSEE .singleStringError .validLogicalError +#' @importFrom S4Vectors setValidity2 +setValidity2("ColumnTreePlot", function(x) { + msg <- character(0) + + msg <- .singleStringError(msg, x, fields=c("layout", "edge_colour_by", + "tip_colour_by", "tip_size_by", "edge_size_by", "tip_shape_by", + "node_colour_by", "node_size_by", "node_shape_by")) + msg <- .validLogicalError(msg, x, fields=c("add_legend", "order_tree")) + + if (length(msg)) { + return(msg) + } + + TRUE +}) + +#' @importFrom iSEE .emptyDefault +#' @importFrom methods callNextMethod +setMethod("initialize", "ColumnTreePlot", function(.Object, ...) { + args <- list(...) + args <- .emptyDefault(args, "layout", "circular") + args <- .emptyDefault(args, "add_legend", TRUE) + args <- .emptyDefault(args, "edge_colour_by", NA_character_) + args <- .emptyDefault(args, "edge_size_by", NA_character_) + args <- .emptyDefault(args, "tip_colour_by", NA_character_) + args <- .emptyDefault(args, "tip_size_by", NA_character_) + args <- .emptyDefault(args, "tip_shape_by", NA_character_) + args <- .emptyDefault(args, "node_colour_by", NA_character_) + args <- .emptyDefault(args, "node_size_by", NA_character_) + args <- .emptyDefault(args, "node_shape_by", NA_character_) + args <- .emptyDefault(args, "visual_parameters", NA_character_) + args <- .emptyDefault(args, "colour_parameters", NA_character_) + args <- .emptyDefault(args, "shape_parameters", NA_character_) + args <- .emptyDefault(args, "size_parameters", NA_character_) + args <- .emptyDefault(args, "order_tree", FALSE) + + do.call(callNextMethod, c(list(.Object), args)) +}) + +#' @export +#' @importFrom methods new +ColumnTreePlot <- function(...) { + new("ColumnTreePlot", ...) +} + +#' @importFrom iSEE .getEncodedName .checkboxInput.iSEE +#' @importFrom methods slot +setMethod(".defineDataInterface", "ColumnTreePlot", function(x, se, select_info) { + panel_name <- .getEncodedName(x) + + list(.checkboxInput.iSEE(x, field="order_tree", label="Order tree", + value=slot(x, "order_tree"))) +}) + +#' @importFrom methods callNextMethod +setMethod(".defineInterface", "ColumnTreePlot", function(x, se, select_info) { + + out <- callNextMethod() + list(out[1], .create_visual_box_for_rowtree(x, se), out[-1]) +}) + +#' @importFrom iSEE .getEncodedName .createProtectedParameterObservers +#' .createUnprotectedParameterObservers +setMethod(".createObservers", "ColumnTreePlot", + function(x, se, input, session, pObjects, rObjects) { + + callNextMethod() + panel_name <- .getEncodedName(x) + + .createProtectedParameterObservers(panel_name, c("layout", "add_legend", + "RowSelectionSource", "order_tree", "size_parameters", "visual_parameters", + "shape_parameters", "colour_parameters"), input=input, pObjects=pObjects, + rObjects=rObjects) + + .createUnprotectedParameterObservers(panel_name, c("edge_colour_by", + "tip_colour_by", "tip_size_by", "tip_shape_by", "node_size_by", + "node_shape_by", "node_colour_by", "edge_size_by"), input=input, + pObjects=pObjects, rObjects=rObjects) + + invisible(NULL) +}) + +setMethod(".fullName", "ColumnTreePlot", function(x) "Column tree plot") + +#' @importMethodsFrom iSEE .panelColor +setMethod(".panelColor", "ColumnTreePlot", function(x) "steelblue") + +#' @importFrom iSEE .getEncodedName +#' @importFrom shiny plotOutput +#' @importFrom shinyWidgets addSpinner +setMethod(".defineOutput", "ColumnTreePlot", function(x) { + panel_name <- .getEncodedName(x) + + addSpinner(plotOutput(panel_name, + height = paste0(slot(x, "PanelHeight"), "px")), color=.panelColor(x)) +}) + +#' @importFrom iSEE .processMultiSelections .textEval +#' @importFrom miaViz plotColTree +setMethod(".generateOutput", "ColumnTreePlot", + function(x, se, all_memory, all_contents) { + + panel_env <- new.env() + all_cmds <- list() + args <- character(0) + + all_cmds[["select"]] <- .processMultiSelections( + x, all_memory, all_contents, panel_env + ) + + if( exists("col_selected", envir=panel_env, inherits=FALSE) ) { + panel_env[["se"]] <- se[unlist(panel_env[["col_selected"]]), ] + } else { + panel_env[["se"]] <- se + } + + args[["layout"]] <- deparse(slot(x, "layout")) + args[["add_legend"]] <- deparse(slot(x, "add_legend")) + args[["order_tree"]] <- deparse(slot(x, "order_tree")) + + if( "Colour" %in% slot(x, "visual_parameters") ){ + args <- .assign_viz_param(args, x, "Edge", "colour") + args <- .assign_viz_param(args, x, "Node", "colour") + args <- .assign_viz_param(args, x, "Tip", "colour") + } + + if( "Shape" %in% slot(x, "visual_parameters") ){ + args <- .assign_viz_param(args, x, "Node", "shape") + args <- .assign_viz_param(args, x, "Tip", "shape") + } + + if( "Size" %in% slot(x, "visual_parameters") ){ + args <- .assign_viz_param(args, x, "Edge", "size") + args <- .assign_viz_param(args, x, "Node", "size") + args <- .assign_viz_param(args, x, "Tip", "size") + } + + args <- sprintf("%s=%s", names(args), args) + args <- paste(args, collapse=", ") + fun_call <- sprintf("p <- miaViz::plotColTree(se, %s)", args) + + fun_cmd <- paste(strwrap(fun_call, width = 80, exdent = 4), collapse = "\n") + plot_out <- .textEval(fun_cmd, panel_env) + all_cmds[["fun"]] <- fun_cmd + + list(commands=all_cmds, plot=plot_out, varname=NULL, contents=NULL) +}) + +#' @importFrom iSEE .getEncodedName .retrieveOutput +#' @importFrom shiny renderPlot +#' @importFrom methods callNextMethod +setMethod(".renderOutput", "ColumnTreePlot", + function(x, se, output, pObjects, rObjects) { + + panel_name <- .getEncodedName(x) + force(se) # defensive programming to avoid bugs due to delayed evaluation + + output[[panel_name]] <- renderPlot({ + .retrieveOutput(panel_name, se, pObjects, rObjects) + }) + + callNextMethod() +}) + +#' @importFrom grDevices pdf dev.off +setMethod(".exportOutput", "ColumnTreePlot", + function(x, se, all_memory, all_contents) { + + contents <- .generateOutput(x, se, all_memory=all_memory, + all_contents=all_contents) + + newpath <- paste0(.getEncodedName(x), ".pdf") + + pdf(newpath, width=slot(x, "PanelHeight") / 75, + height=slot(x, "PanelWidth") * 2) + + print(contents$plot) + dev.off() + + newpath +}) + +#' @importFrom methods callNextMethod +setMethod(".hideInterface", "ColumnTreePlot", function(x, field) { + + if( field %in% c("SelectionHistory", "ColumnSelectionRestrict", + "ColumnSelectionDynamicSource", "ColumnSelectionSource") ){ + TRUE + } else { + callNextMethod() + } +}) + +setMethod(".multiSelectionResponsive", "ColumnTreePlot", + function(x, dims = character(0)) { + + if( "column" %in% dims ){ + return(TRUE) + } + + return(FALSE) +}) + +#' @importFrom methods callNextMethod +#' @importFrom iSEE .getEncodedName .getPanelColor .addTourStep +setMethod(".definePanelTour", "ColumnTreePlot", function(x) { + rbind(c(paste0("#", .getEncodedName(x)), sprintf( + "The ColumnTreePlot panel contains a phylogenetic + tree from the + miaViz + package.", .getPanelColor(x))), + .addTourStep(x, "DataBoxOpen", "The Data parameters box shows the + available parameters that can be tweaked to control the data on + the heatmap.

Action: click on this + box to open up available options."), + .addTourStep(x, "VisualBoxOpen", "The Visual parameters box shows + the available visual parameters that can be tweaked in this + tree.

Action: click on this box to + open up available options."), + callNextMethod()) +}) + +#' @importFrom iSEE .getEncodedName .selectInput.iSEE .checkboxInput.iSEE +#' .radioButtons.iSEE .conditionalOnRadio .addSpecificTour +#' @importFrom SummarizedExperiment colData +#' @importFrom TreeSummarizedExperiment rowTreeNames +.create_visual_box_for_coltree <- function(x, se) { + panel_name <- .getEncodedName(x) + .addSpecificTour(class(x)[1], "layout", function(panel_name) { + data.frame(rbind(c(element = paste0("#", panel_name, + "_layout + .selectize-control"), intro = "Here, we can select the + layout of the tree.")))}) + .addSpecificTour(class(x)[1], "add_legend", function(panel_name) { + data.frame(rbind(c(element = paste0("#", panel_name, + "_add_legend"), intro = "Here, we can choose + whether or not to show a legend.")))}) + .addSpecificTour(class(x)[1], "edge_colour", function(panel_name) { + data.frame(rbind(c(element = paste0("#", panel_name, + "_edge_colour"), intro = "Here, we can choose + whether or not to colour the lines by a variable from the + colData. When active, the available options are listed + and one of them can be selected.")))}) + .addSpecificTour(class(x)[1], "tip_colour", function(panel_name) { + data.frame(rbind(c(element = paste0("#", panel_name, + "_tip_colour"), intro = "Here, we can choose + whether or not to colour the tips by a variable from the + colData. When active, the available options are listed + and one of them can be selected.")))}) + .addSpecificTour(class(x)[1], "node_colour", function(panel_name) { + data.frame(rbind(c(element = paste0("#", panel_name, + "_node_colour"), intro = "Here, we can choose + whether or not to colour the nodes by a variable from the + colData. When active, the available options are listed + and one of them can be selected.")))}) + .addSpecificTour(class(x)[1], "order_tree", function(panel_name) { + data.frame(rbind(c(element = paste0("#", panel_name, + "_order_tree"), intro = "Here, we can order + the tree alphabetically.")))}) + .addSpecificTour(class(x)[1], "tip_colour_by", function(panel_name) { + data.frame(rbind(c(element = paste0("#", panel_name, + "_tip_colour_by + .selectize-control"), intro = "Here, we can + choose how to colour the tips by.")))}) + .addSpecificTour(class(x)[1], "tip_size_by", function(panel_name) { + data.frame(rbind(c(element = paste0("#", panel_name, + "_tip_size_by + .selectize-control"), intro = "Here, we can + choose how to size the tree tips by.")))}) + .addSpecificTour(class(x)[1], "tip_shape_by", function(panel_name) { + data.frame(rbind(c(element = paste0("#", panel_name, + "_tip_shape_by + .selectize-control"), intro = "Here, we can + choose how to shape the tree tips by.")))}) + .addSpecificTour(class(x)[1], "edge_colour_by", function(panel_name) { + data.frame(rbind(c(element = paste0("#", panel_name, + "_edge_colour_by + .selectize-control"), intro = "Here, we can + choose how to colour the tree edges by.")))}) + .addSpecificTour(class(x)[1], "edge_size_by", function(panel_name) { + data.frame(rbind(c(element = paste0("#", panel_name, + "_edge_size_by + .selectize-control"), intro = "Here, we can + choose how to size the tree edges by.")))}) + .addSpecificTour(class(x)[1], "node_size_by", function(panel_name) { + data.frame(rbind(c(element = paste0("#", panel_name, + "_node_size_by + .selectize-control"), intro = "Here, we can + choose how to size the tree nodes by.")))}) + .addSpecificTour(class(x)[1], "node_shape_by", function(panel_name) { + data.frame(rbind(c(element = paste0("#", panel_name, + "_node_shape_by + .selectize-control"), intro = "Here, we can + choose how to shape the tree nodes by.")))}) + .addSpecificTour(class(x)[1], "node_colour_by", function(panel_name) { + data.frame(rbind(c(element = paste0("#", panel_name, + "_node_colour_by + .selectize-control"), intro = "Here, we can + choose how to colour the tree nodes by.")))}) + .addSpecificTour(class(x)[1], "visual_parameters", function(panel_name) { + data.frame(rbind(c(element = paste0("#", panel_name, + "_visual_parameters"), intro = "Here, we can + choose to show the different visual parameters.")))}) + .addSpecificTour(class(x)[1], "colour_parameters", function(panel_name) { + data.frame(rbind(c(element = paste0("#", panel_name, + "_colour_parameters"), intro = "Here, we can make + the colour depend on the value of a + categorical column data field for each plot components + (line, tip, node).")))}) + .addSpecificTour(class(x)[1], "shape_parameters", function(panel_name) { + data.frame(rbind(c(element = paste0("#", panel_name, + "_shape_parameters"), intro = "Here, we can make + the shape depend on the value of a + categorical column data field for each plot components + (line, tip, node).")))}) + .addSpecificTour(class(x)[1], "size_parameters", function(panel_name) { + data.frame(rbind(c(element = paste0("#", panel_name, + "_size_parameters"), intro = "Here, we can make + the size depend on the value of a + categorical column data field for each plot components + (line, tip, node).")))}) + + # Define what parameters the user can adjust + collapseBox(paste0(panel_name, "_VisualBoxOpen"), + title="Visual parameters", open=FALSE, + # Tree layout + .checkboxGroupInput.iSEE(x, field="visual_parameters", label=NULL, + inline=TRUE, selected=slot(x, "visual_parameters"), + choices=c("Colour", "Size", "Shape")), + + .conditionalOnCheckGroup( + paste0(panel_name, "_visual_parameters"), "Colour", + list( + .checkboxGroupInput.iSEE(x, field="colour_parameters", + inline=TRUE, selected=slot(x, "colour_parameters"), + choices=c("Edge", "Node", "Tip"), label="Colour by:"), + .conditionalOnCheckGroup( + paste0(panel_name, "_colour_parameters"), "Edge", + .selectInput.iSEE(x, field="edge_colour_by", + label="Color lines by", choices=names(colData(se)), + selected=slot(x, "edge_colour_by"))), + .conditionalOnCheckGroup( + paste0(panel_name, "_colour_parameters"), "Node", + .selectInput.iSEE(x, field="node_colour_by", + label="Color nodes by", choices=names(colData(se)), + selected=slot(x, "node_colour_by"))), + .conditionalOnCheckGroup( + paste0(panel_name, "_colour_parameters"), "Tip", + .selectInput.iSEE(x, field="tip_colour_by", + label="Color tips by", choices=names(colData(se)), + selected=slot(x, "tip_colour_by"))))), + + .conditionalOnCheckGroup( + paste0(panel_name, "_visual_parameters"), "Size", + list( + .checkboxGroupInput.iSEE(x, field="size_parameters", + inline=TRUE, selected=slot(x, "size_parameters"), + choices=c("Edge", "Node", "Tip"), label="Size by:"), + .conditionalOnCheckGroup( + paste0(panel_name, "_size_parameters"), "Edge", + .selectInput.iSEE(x, field="edge_size_by", + label="Size lines by", choices=names(colData(se)), + selected=slot(x, "edge_size_by"))), + .conditionalOnCheckGroup( + paste0(panel_name, "_size_parameters"), "Node", + .selectInput.iSEE(x, field="node_size_by", + label="Size nodes by", choices=names(colData(se)), + selected=slot(x, "node_size_by"))), + .conditionalOnCheckGroup( + paste0(panel_name, "_size_parameters"), "Tip", + .selectInput.iSEE(x, field="tip_size_by", + label="Size tips by", choices=names(colData(se)), + selected=slot(x, "tip_size_by"))))), + + .conditionalOnCheckGroup( + paste0(panel_name, "_visual_parameters"), "Shape", + list( + .checkboxGroupInput.iSEE(x, field="shape_parameters", + inline=TRUE, selected=slot(x, "shape_parameters"), + choices=c("Node", "Tip"), label="Shape by:"), + .conditionalOnCheckGroup( + paste0(panel_name, "_shape_parameters"), "Node", + .selectInput.iSEE(x, field="node_shape_by", + label="Shape nodes by", choices=names(colData(se)), + selected=slot(x, "node_shape_by"))), + .conditionalOnCheckGroup( + paste0(panel_name, "_shape_parameters"), "Tip", + .selectInput.iSEE(x, field="tip_shape_by", + label="Shape tips by", choices=names(colData(se)), + selected=slot(x, "tip_shape_by"))))), + + .selectInput.iSEE(x, field="layout", label="Layout:", + choices=c("circular", "rectangular", "slanted", "fan", + "inward_circular", "radial", "unrooted", "equal_angle", + "daylight", "dendrogram", "ape", "ellipse", "roundrect"), + selected=slot(x, "layout")), + # Colour legend + .checkboxInput.iSEE(x, field="add_legend", label="View legend", + value=slot(x, "add_legend"))) +} + +#' @importFrom methods slot +.assign_viz_param <- function(args, x, element, aesthetic) { + + param_name <- paste(tolower(element), aesthetic, "by", sep = "_") + + if( element %in% slot(x, paste(aesthetic, "parameters", sep = "_")) ){ + args[[param_name]] <- deparse(slot(x, param_name)) + } + + return(args) +} \ No newline at end of file diff --git a/R/class-LoadingPlot.R b/R/class-LoadingPlot.R new file mode 100644 index 0000000..2a9ae1e --- /dev/null +++ b/R/class-LoadingPlot.R @@ -0,0 +1,294 @@ +#' Loading plot +#' +#' Contribution of single features in a +#' \code{\link[TreeSummarizedExperiment:TreeSummarizedExperiment-constructor]{TreeSummarizedExperiment}} +#' to the components of a target reduced dimension. The panel implements +#' \code{\link[miaViz:plotLoadings]{plotLoadings}} to generate the plot. +#' +#' @section Slot overview: +#' The following slots control the thresholds used in the visualisation: +#' \itemize{ +#' \item \code{dimred}, a string specifying the dimred to visualize. +#' \item \code{layout}, a string specifying abundance layout (barplot or heatmap). +#' \item \code{ncomponents}, a number indicating the number of components to visualize. +#' } +#' +#' In addition, this class inherits all slots from its parent \linkS4class{Panel} class. +#' +#' @return +#' The \code{LoadingPlot(...)} constructor creates an instance of an +#' LoadingPlot class, where any slot and its value can be passed to +#' \code{...} as a named argument. +#' +#' @author Giulio Benedetti +#' @examples +#' # Import libraries +#' library(mia) +#' library(scater) +#' +#' # Import TreeSE +#' data("Tengeler2020", package = "mia") +#' tse <- Tengeler2020 +#' +#' # Add relabundance assay +#' tse <- transformAssay(tse, method = "relabundance") +#' +#' # Add reduced dimensions +#' tse <- runPCA(tse, assay.type = "relabundance") +#' +#' # Store panel into object +#' panel <- LoadingPlot() +#' # View some adjustable parameters +#' head(slotNames(panel)) +#' +#' # Launch iSEE with custom initial panel +#' if (interactive()) { +#' iSEE(tse, initial = c(panel)) +#' } +#' +#' @docType methods +#' @name LoadingPlot +NULL + +#' @rdname LoadingPlot +#' @export +setClass("LoadingPlot", contains="Panel", slots=c(dimred="character", + layout="character", ncomponents="numeric", add.tree="logical")) + +#' @importFrom iSEE .singleStringError .validNumberError .validLogicalError +#' @importFrom S4Vectors setValidity2 +setValidity2("LoadingPlot", function(x) { + msg <- character(0) + + msg <- .singleStringError(msg, x, fields=c("dimred", "layout")) + msg <- .validNumberError(msg, x, "ncomponents", lower=1, upper=Inf) + msg <- .validLogicalError(msg, x, fields="add.tree") + + if( length(msg) ){ + return(msg) + } + + TRUE +}) + +#' @importFrom iSEE .emptyDefault +#' @importFrom methods callNextMethod +setMethod("initialize", "LoadingPlot", function(.Object, ...) { + args <- list(...) + args <- .emptyDefault(args, "dimred", "PCA") + args <- .emptyDefault(args, "layout", "heatmap") + args <- .emptyDefault(args, "ncomponents", 5) + args <- .emptyDefault(args, "add.tree", FALSE) + + do.call(callNextMethod, c(list(.Object), args)) +}) + +#' @export +#' @importFrom methods new +LoadingPlot <- function(...) { + new("LoadingPlot", ...) +} + +#' @importFrom iSEE .getEncodedName .selectInput.iSEE .numericInput.iSEE +#' @importFrom methods slot +#' @importFrom SingleCellExperiment reducedDim reducedDimNames +setMethod(".defineDataInterface", "LoadingPlot", + function(x, se, select_info) { + + panel_name <- .getEncodedName(x) + + list(.selectInput.iSEE(x, field="dimred", label="Reduced dimension", + choices=reducedDimNames(se), selected=slot(x, "dimred")), + # Number of components + .numericInput.iSEE(x, field="ncomponents", label="Number of components", + value=slot(x, "ncomponents"), min=1, step=1, + max=ncol(reducedDim(se, slot(x, "dimred"))))) +}) + +#' @importFrom methods callNextMethod +setMethod(".defineInterface", "LoadingPlot", + function(x, se, select_info) { + + out <- callNextMethod() + list(out[1], .create_visual_box_for_loading_plot(x, se), out[-1]) +}) + +#' @importFrom iSEE .getEncodedName .createProtectedParameterObservers +#' .createUnprotectedParameterObservers +setMethod(".createObservers", "LoadingPlot", + function(x, se, input, session, pObjects, rObjects) { + + callNextMethod() + panel_name <- .getEncodedName(x) + + .createProtectedParameterObservers(panel_name, + c("dimred", "ncomponents"), + input=input, pObjects=pObjects, rObjects=rObjects) + + .createUnprotectedParameterObservers(panel_name, + c("layout", "add.tree"), + input=input, pObjects=pObjects, rObjects=rObjects) + + invisible(NULL) +}) + +setMethod(".fullName", "LoadingPlot", + function(x) "Loading plot") + +#' @importMethodsFrom iSEE .panelColor +setMethod(".panelColor", "LoadingPlot", function(x) "yellow") + +#' @importFrom iSEE .getEncodedName +#' @importFrom shiny plotOutput +#' @importFrom shinyWidgets addSpinner +setMethod(".defineOutput", "LoadingPlot", function(x) { + plot_name <- .getEncodedName(x) + + addSpinner( + plotOutput(plot_name, height = paste0(slot(x, "PanelHeight"), "px")), + color=.panelColor(x)) +}) + +#' @importMethodsFrom iSEE .generateOutput +#' @importFrom iSEE .processMultiSelections .textEval +#' @importFrom miaViz plotLoadings +setMethod(".generateOutput", "LoadingPlot", + function(x, se, all_memory, all_contents) { + + panel_env <- new.env() + all_cmds <- list() + args <- character(0) + + all_cmds[["select"]] <- .processMultiSelections( + x, all_memory, all_contents, panel_env + ) + + if( exists("row_selected", envir=panel_env, inherits=FALSE) ){ + panel_env[["se"]] <- se[unlist(panel_env[["row_selected"]]), ] + } else { + panel_env[["se"]] <- se + } + + args[["dimred"]] <- deparse(slot(x, "dimred")) + args[["layout"]] <- deparse(slot(x, "layout")) + args[["add.tree"]] <- deparse(slot(x , "add.tree")) + + if( is.na(slot(x, "ncomponents")) || slot(x, "ncomponents") <= 0 ){ + args[["ncomponents"]] <- 5 + } else if( slot(x, "ncomponents") > ncol(reducedDim(se, slot(x, "dimred"))) ){ + args[["ncomponents"]] <- ncol(reducedDim(se, slot(x, "dimred"))) + } else { + args[["ncomponents"]] <- deparse(slot(x, "ncomponents")) + } + + args <- sprintf("%s=%s", names(args), args) + args <- paste(args, collapse=", ") + fun_call <- sprintf("p <- miaViz::plotLoadings(se, %s)", args) + + fun_cmd <- paste(strwrap(fun_call, width = 80, exdent = 4), collapse = "\n") + plot_out <- .textEval(fun_cmd, panel_env) + all_cmds[["fun"]] <- fun_cmd + + list(commands=all_cmds, plot=plot_out, varname=NULL, contents=NULL) +}) + +#' @importFrom iSEE .getEncodedName .retrieveOutput +#' @importFrom shiny renderPlot +#' @importFrom methods callNextMethod +setMethod(".renderOutput", "LoadingPlot", + function(x, se, output, pObjects, rObjects) { + + plot_name <- .getEncodedName(x) + force(se) # defensive programming to avoid bugs due to delayed evaluation + + output[[plot_name]] <- renderPlot({ + .retrieveOutput(plot_name, se, pObjects, rObjects) + }) + + callNextMethod() +}) + +#' @importFrom grDevices pdf dev.off +setMethod(".exportOutput", "LoadingPlot", + function(x, se, all_memory, all_contents) { + + contents <- .generateOutput(x, se, all_memory=all_memory, + all_contents=all_contents) + + newpath <- paste0(.getEncodedName(x), ".pdf") + + pdf(newpath, width=slot(x, "PanelHeight") / 75, + height=slot(x, "PanelWidth") * 2) + + print(contents$plot) + dev.off() + + newpath +}) + +#' @importFrom methods callNextMethod +setMethod(".hideInterface", "LoadingPlot", function(x, field) { + + if ( field %in% c("SelectionHistory", "ColumnSelectionRestrict", + "ColumnSelectionDynamicSource", "ColumnSelectionSource") ){ + TRUE + } else { + callNextMethod() + } +}) + +setMethod(".multiSelectionResponsive", "LoadingPlot", + function(x, dims = character(0)) { + + if ("row" %in% dims) { + return(TRUE) + } + return(FALSE) +}) + +#' @importFrom methods callNextMethod +#' @importFrom iSEE .getEncodedName .addTourStep +setMethod(".definePanelTour", "LoadingPlot", function(x) { + rbind(c(paste0("#", .getEncodedName(x)), sprintf( + "The Loading Plot panel + contains a representation of the taxa contributions to the target + reduced dimensions.", .getPanelColor(x))), + .addTourStep(x, "DataBoxOpen", "The Data parameters box shows the + available parameters that can be tweaked to control the data on + the plot.

Action: click on this + box to open up available options."), + .addTourStep(x, "Visual", "The Visual parameters box shows + the available visual parameters that can be tweaked in this + plot.

Action: click on this box to + open up available options."), + callNextMethod()) +}) + +#' @importFrom iSEE .getEncodedName collapseBox .selectInput.iSEE +#' .radioButtons.iSEE .conditionalOnRadio .checkboxInput.iSEE +#' @importFrom methods slot +#' @importFrom SummarizedExperiment colData +.create_visual_box_for_loading_plot <- function(x, se) { + + panel_name <- .getEncodedName(x) + + .addSpecificTour(class(x)[1], "layout", function(panel_name) { + data.frame(rbind(c(element = paste0("#", panel_name, + "_layout + .selectize-control"), intro = "Here, we can select the + layout of the plot.")))}) + .addSpecificTour(class(x)[1], "add.tree", function(panel_name) { + data.frame(rbind(c(element = paste0("#", panel_name, + "_add\\.tree"), intro = "Here, we can choose + whether or not to show the phylogenetic tree.")))}) + + # Define what parameters the user can adjust + collapseBox( + paste0(panel_name, "_Visual"), title="Visual parameters", open=FALSE, + # Panel layout + .selectInput.iSEE(x, field="layout", label="Layout", + choices=c("barplot", "heatmap"), + selected=slot(x, "layout")), + # Add tree + .checkboxInput.iSEE(x, field="add.tree", label="View tree", + value=slot(x, "add.tree"))) +} diff --git a/R/class-RDAPlot.R b/R/class-RDAPlot.R index 8645808..1e3aecc 100644 --- a/R/class-RDAPlot.R +++ b/R/class-RDAPlot.R @@ -8,7 +8,7 @@ #' to generate the plot. #' #' @section Slot overview: -#' The following slots control the thresholds used in the visualization: +#' The following slots control the thresholds used in the visualisation: #' \itemize{ #' \item \code{add.ellipse}, a string specifying ellipse layout (filled, coloured or absent). #' \item \code{colour_by}, a string specifying the parameter to color by. diff --git a/R/class-RowTreePlot.R b/R/class-RowTreePlot.R index 7a30ffc..d566c6d 100644 --- a/R/class-RowTreePlot.R +++ b/R/class-RowTreePlot.R @@ -8,7 +8,7 @@ #' to generate the plot. #' #' @section Slot overview: -#' The following slots control the thresholds used in the visualization: +#' The following slots control the thresholds used in the visualisation: #' \itemize{ #' \item \code{layout}, a string specifying tree layout #' \item \code{add_legend}, a logical indicating if color legend should appear. diff --git a/man/AbundanceDensityPlot.Rd b/man/AbundanceDensityPlot.Rd index a1e16ae..f9648d3 100644 --- a/man/AbundanceDensityPlot.Rd +++ b/man/AbundanceDensityPlot.Rd @@ -18,7 +18,7 @@ to generate the plot. } \section{Slot overview}{ -The following slots control the thresholds used in the visualization: +The following slots control the thresholds used in the visualisation: \itemize{ \item \code{layout}, a string specifying abundance layout (jitter, density or points). \item \code{assay.type}, a string specifying the assay to visualize. diff --git a/man/ColumnTreePlot.Rd b/man/ColumnTreePlot.Rd new file mode 100644 index 0000000..098914c --- /dev/null +++ b/man/ColumnTreePlot.Rd @@ -0,0 +1,69 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class-ColumnTreePlot.R +\docType{methods} +\name{ColumnTreePlot} +\alias{ColumnTreePlot} +\alias{ColumnTreePlot-class} +\title{Column tree plot} +\value{ +The \code{ColumnTreePlot(...)} constructor creates an instance of a ColumnTreePlot +class, where any slot and its value can be passed to \code{...} as a named +argument. +} +\description{ +Hierarchical tree for the columns of a +\code{\link[TreeSummarizedExperiment:TreeSummarizedExperiment-constructor]{TreeSummarizedExperiment}} +object. The tree represents the sample hierarchy of the study and gets stored +in the \code{\link[TreeSummarizedExperiment:rowLinks]{colTree}} slot of the +experiment object. The panel implements \code{\link[miaViz:plotTree]{plotColTree}} +to generate the plot. +} +\section{Slot overview}{ + +The following slots control the thresholds used in the visualisation: +\itemize{ +\item \code{layout}, a string specifying tree layout +\item \code{add_legend}, a logical indicating if color legend should appear. +\item \code{edge_colour_by}, a string specifying parameter to color lines by +when \code{colour_parameters = "Edge"}. +\item \code{edge_size_by}, a string specifying parameter to size lines by +when \code{size_parameters = "Edge"}. +\item \code{tip_colour_by}, a string specifying parameter to color tips by +when \code{colour_parameters = "Tip"}. +\item \code{tip_size_by}, a string specifying parameter to size tips by +when \code{size_parameters = "Tip"}. +\item \code{tip_shape_by}, a string specifying parameter to shape tips by +when \code{shape_parameters = "Tip"}. +\item \code{node_colour_by}, a string specifying parameter to color nodes by +when \code{colour_parameters = "Node"}. +\item \code{node_size_by}, a string specifying parameter to size nodes by +when \code{size_parameters = "Node"}. +\item \code{node_shape_by}, a string specifying parameter to shape nodes by +when \code{shape_parameters = "Node"}. +\item \code{order_tree}, a logical indicating if tree is ordered by +alphabetic order of taxonomic levels. +} + +In addition, this class inherits all slots from its parent \linkS4class{Panel} class. +} + +\examples{ +# Import TreeSE +library(mia) +data("Tengeler2020", package = "mia") +tse <- Tengeler2020 + +# Store panel into object +panel <- ColumnTreePlot() +# View some adjustable parameters +head(slotNames(panel)) + +# Launch iSEE with custom initial panel +if (interactive()) { + iSEE(tse, initial = c(panel)) +} + +} +\author{ +Giulio Benedetti +} diff --git a/man/LoadingPlot.Rd b/man/LoadingPlot.Rd new file mode 100644 index 0000000..be7a34b --- /dev/null +++ b/man/LoadingPlot.Rd @@ -0,0 +1,59 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class-LoadingPlot.R +\docType{methods} +\name{LoadingPlot} +\alias{LoadingPlot} +\alias{LoadingPlot-class} +\title{Loading plot} +\value{ +The \code{LoadingPlot(...)} constructor creates an instance of an +LoadingPlot class, where any slot and its value can be passed to +\code{...} as a named argument. +} +\description{ +Contribution of single features in a +\code{\link[TreeSummarizedExperiment:TreeSummarizedExperiment-constructor]{TreeSummarizedExperiment}} +to the components of a target reduced dimension. The panel implements +\code{\link[miaViz:plotLoadings]{plotLoadings}} to generate the plot. +} +\section{Slot overview}{ + +The following slots control the thresholds used in the visualisation: +\itemize{ +\item \code{dimred}, a string specifying the dimred to visualize. +\item \code{layout}, a string specifying abundance layout (barplot or heatmap). +\item \code{ncomponents}, a number indicating the number of components to visualize. +} + +In addition, this class inherits all slots from its parent \linkS4class{Panel} class. +} + +\examples{ +# Import libraries +library(mia) +library(scater) + +# Import TreeSE +data("Tengeler2020", package = "mia") +tse <- Tengeler2020 + +# Add relabundance assay +tse <- transformAssay(tse, method = "relabundance") + +# Add reduced dimensions +tse <- runPCA(tse, assay.type = "relabundance") + +# Store panel into object +panel <- LoadingPlot() +# View some adjustable parameters +head(slotNames(panel)) + +# Launch iSEE with custom initial panel +if (interactive()) { + iSEE(tse, initial = c(panel)) +} + +} +\author{ +Giulio Benedetti +} diff --git a/man/RDAPlot.Rd b/man/RDAPlot.Rd index b6e4aff..f04e4b5 100644 --- a/man/RDAPlot.Rd +++ b/man/RDAPlot.Rd @@ -19,7 +19,7 @@ to generate the plot. } \section{Slot overview}{ -The following slots control the thresholds used in the visualization: +The following slots control the thresholds used in the visualisation: \itemize{ \item \code{add.ellipse}, a string specifying ellipse layout (filled, coloured or absent). \item \code{colour_by}, a string specifying the parameter to color by. diff --git a/man/RowTreePlot.Rd b/man/RowTreePlot.Rd index d687225..d0affef 100644 --- a/man/RowTreePlot.Rd +++ b/man/RowTreePlot.Rd @@ -20,7 +20,7 @@ to generate the plot. } \section{Slot overview}{ -The following slots control the thresholds used in the visualization: +The following slots control the thresholds used in the visualisation: \itemize{ \item \code{layout}, a string specifying tree layout \item \code{add_legend}, a logical indicating if color legend should appear. diff --git a/pkgdown/_pkgdown.yml b/pkgdown/_pkgdown.yml index 8f1c906..fc1b356 100644 --- a/pkgdown/_pkgdown.yml +++ b/pkgdown/_pkgdown.yml @@ -4,6 +4,8 @@ reference: - contents: - AbundanceDensityPlot - AbundancePlot + - ColumnTreePlot + - LoadingPlot - RDAPlot - RowTreePlot - title: Other diff --git a/tests/testthat/test-ColumnTreePlot.R b/tests/testthat/test-ColumnTreePlot.R new file mode 100644 index 0000000..76db679 --- /dev/null +++ b/tests/testthat/test-ColumnTreePlot.R @@ -0,0 +1,49 @@ +test_that("ColumnTreePlot", { + + output <- new.env() + pObjects <- new.env() + rObjects <- new.env() + select_info <- list(single = list(feature = "---", sample = "---"), + multi = list(row = "---", column = "---")) + + data("Tengeler2020", package = "mia") + tse <- Tengeler2020 + panel <- ColumnTreePlot() + + panel[["layout"]] <- "rectangular" + + expect_identical(.getEncodedName(panel), "ColumnTreePlotNA") + expect_identical(.fullName(panel), "Column tree plot") + expect_identical(.panelColor(panel), "steelblue") + + expect_s3_class(.defineInterface(panel, tse, select_info)[[1]][[1]], "shiny.tag.list") + expect_length(.defineDataInterface(panel, tse, select_info), 1) + + expect_s3_class(.defineOutput(panel), "shiny.tag.list") + # expect_match(.generateOutput(panel, tse)[["commands"]][["fun"]], + # 'p <- miaViz::plotColTree(se, layout="rectangular", add_legend=TRUE, + # order_tree=FALSE)', + # fixed = TRUE) + + expect_true(.hideInterface(panel, "ColumnSelectionSource")) + expect_false(.multiSelectionResponsive(panel, "row")) + expect_true(.multiSelectionResponsive(panel, "column")) + + expect_contains(slotNames(panel), c("layout", "add_legend", "edge_colour_by", + "tip_colour_by", "order_tree", "tip_size_by", "tip_shape_by", + "edge_size_by", "node_size_by", "node_shape_by", "node_colour_by")) + + expect_contains(.definePanelTour(panel)[[1]], + c("#ColumnTreePlotNA_DataBoxOpen", "#ColumnTreePlotNA_VisualBoxOpen", + "#ColumnTreePlotNA", "#ColumnTreePlotNA_SelectionBoxOpen")) + + expect_s3_class(.create_visual_box_for_coltree(panel, tse), "shiny.tag.list") + + expect_null(.renderOutput(panel, tse, output = output, pObjects = pObjects, rObjects = rObjects)) + expect_s3_class(output$ColumnTreePlotNA, "shiny.render.function") + expect_s3_class(output$ColumnTreePlotNA_INTERNAL_PanelMultiSelectInfo, "shiny.render.function") + expect_s3_class(output$ColumnTreePlotNA_INTERNAL_PanelSelectLinkInfo, "shiny.render.function") + + # expect_identical(.exportOutput(panel, tse), "ColumnTreePlotNA.pdf") + +}) diff --git a/tests/testthat/test-LoadingPlot.R b/tests/testthat/test-LoadingPlot.R new file mode 100644 index 0000000..a9eaea7 --- /dev/null +++ b/tests/testthat/test-LoadingPlot.R @@ -0,0 +1,48 @@ +test_that("LoadingPlot", { + + output <- new.env() + pObjects <- new.env() + rObjects <- new.env() + select_info <- list(single = list(feature = "---", sample = "---"), + multi = list(row = "---", column = "---")) + + data("Tengeler2020", package = "mia") + tse <- Tengeler2020 + panel <- LoadingPlot() + + panel[["layout"]] <- "heatmap" + + tse <- scater::runPCA(tse, assay.type = "counts", ncomponents = 5) + + expect_identical(.getEncodedName(panel), "LoadingPlotNA") + expect_identical(.fullName(panel), "Loading plot") + expect_identical(.panelColor(panel), "yellow") + + expect_s3_class(.defineInterface(panel, tse, select_info)[[1]][[1]], "shiny.tag.list") + expect_length(.defineDataInterface(panel, tse, select_info), 2) + + expect_s3_class(.defineOutput(panel), "shiny.tag.list") + expect_match(.generateOutput(panel, tse)[["commands"]][["fun"]], + 'p <- miaViz::plotLoadings(se, dimred="PCA", layout="heatmap", ', + 'add.tree=FALSE,\n ncomponents=5)', + fixed = TRUE) + + expect_true(.hideInterface(panel, "ColumnSelectionSource")) + expect_false(.multiSelectionResponsive(panel, "column")) + expect_true(.multiSelectionResponsive(panel, "row")) + + expect_contains(slotNames(panel), c("dimred", "layout", "ncomponents", "add.tree")) + + expect_contains(.definePanelTour(panel)[[1]], + c("#LoadingPlotNA_SelectionBoxOpen")) + + expect_s3_class(.create_visual_box_for_loading_plot(panel, tse), "shiny.tag.list") + + expect_null(.renderOutput(panel, tse, output = output, pObjects = pObjects, rObjects = rObjects)) + expect_s3_class(output$LoadingPlotNA, "shiny.render.function") + expect_s3_class(output$LoadingPlotNA_INTERNAL_PanelMultiSelectInfo, "shiny.render.function") + expect_s3_class(output$LoadingPlotNA_INTERNAL_PanelSelectLinkInfo, "shiny.render.function") + + expect_identical(.exportOutput(panel, tse), "LoadingPlotNA.pdf") + +}) \ No newline at end of file diff --git a/vignettes/iSEEtree.Rmd b/vignettes/iSEEtree.Rmd index 3df5ac4..d174fff 100644 --- a/vignettes/iSEEtree.Rmd +++ b/vignettes/iSEEtree.Rmd @@ -85,6 +85,8 @@ plotting functions: by different features in different colours. Its interpretation is explained in the OMA chapter on [Community Composition](https://microbiome.github.io/OMA/docs/devel/pages/21_microbiome_community.html). +- [ColumnTreePlot](https://microbiome.github.io/iSEEtree/reference/ColumnTreePlot.html) +- [LoadingPlot](https://microbiome.github.io/iSEEtree/reference/LoadingPlot.html) - [RDAPlot](https://microbiome.github.io/iSEEtree/reference/RDAPlot.html): an supervised ordination plot of the samples, where every dot is a sample on a reduced dimensional space and every arrow reflects the contribution of a diff --git a/vignettes/metagenomic_data.Rmd b/vignettes/metagenomic_data.Rmd index 2f5b47b..8a4a306 100644 --- a/vignettes/metagenomic_data.Rmd +++ b/vignettes/metagenomic_data.Rmd @@ -145,3 +145,9 @@ SCREENSHOT("screenshots/metagenomic_data.png", delay=20) To know more about how to explore big data with iSEE and iSEEtree, check the related [iSEE article](https://isee.github.io/iSEE/articles/bigdata.html). + +```{r reproduce, echo=FALSE} +## Session info +options(width = 120) +sessionInfo() +```