Enable row/col selection

R/class-AbundanceDensityPlot.R

@@ -162,14 +162,19 @@ setMethod(".defineOutput", "AbundanceDensityPlot", function(x) {
 #' @importFrom iSEE .processMultiSelections .textEval
 #' @importFrom miaViz plotRowTree
 setMethod(".generateOutput", "AbundanceDensityPlot", function(x, se, all_memory, all_contents) {
-  plot_env <- new.env()
-  plot_env[["se"]] <- se
-
+  panel_env <- new.env()
+
   all_cmds <- list()
   args <- character(0)
 
-  all_cmds[["select"]] <- .processMultiSelections(x, all_memory, all_contents, plot_env)
+  all_cmds[["select"]] <- .processMultiSelections(x, all_memory, all_contents, panel_env)
 
+  if (is.null(panel_env[["row_selected"]])){
+    panel_env[["se"]] <- se
+  } else {
+    panel_env[["se"]] <- se[unlist(panel_env[["row_selected"]]), ]
+  }
+
   args[["layout"]] <- deparse(slot(x, "layout"))
   args[["add_legend"]] <- deparse(slot(x, "add_legend"))
   args[["assay.type"]] <- deparse(slot(x, "assay.type"))
@@ -189,7 +194,7 @@ setMethod(".generateOutput", "AbundanceDensityPlot", function(x, se, all_memory,
   fun_call <- sprintf("p <- miaViz::plotAbundanceDensity(se, %s)", args)
 
   fun_cmd <- paste(strwrap(fun_call, width = 80, exdent = 4), collapse = "\n")
-  plot_out <- .textEval(fun_cmd, plot_env)
+  plot_out <- .textEval(fun_cmd, panel_env)
   all_cmds[["fun"]] <- fun_cmd
 
   list(commands=all_cmds, plot=plot_out, varname=NULL, contents=NULL)
@@ -218,8 +223,6 @@ setMethod(".hideInterface", "AbundanceDensityPlot", function(x, field) {
   }
 })
 
-setMethod(".multiSelectionDimension", "AbundanceDensityPlot", function(x) "row")
-
 setMethod(".multiSelectionRestricted", "AbundanceDensityPlot", function(x) {
   slot(x, "RowSelectionRestrict")
 })
@@ -231,8 +234,6 @@ setMethod(".multiSelectionResponsive", "AbundanceDensityPlot", function(x, dims
   return(FALSE)
 })
 
-setMethod(".singleSelectionDimension", "AbundanceDensityPlot", function(x) "feature")
-
 #' @importFrom iSEE .getEncodedName collapseBox .selectInput.iSEE
 #'   .radioButtons.iSEE .conditionalOnRadio
 #' @importFrom methods slot

R/class-AbundancePlot.R

@@ -111,43 +111,64 @@ setMethod(".defineOutput", "AbundancePlot", function(x) {
 })
 
 #' @importFrom miaViz plotRowTree
+#' @importFrom iSEE .processMultiSelections
 setMethod(".generateOutput", "AbundancePlot", function(x, se, all_memory, all_contents) {
-  plot_env <- new.env()
-  plot_env$se <- se
+  panel_env <- new.env()
 
-  selected <- .processMultiSelections(x, all_memory, all_contents, plot_env)
+  all_cmds <- list()
+  args <- character(0)
 
-  # simplify this to plotRowTree
-  fn_call <- "gg <- %s(se"
+  all_cmds[["select"]] <- .processMultiSelections(x, all_memory, all_contents, panel_env)
+
+  if (is.null(panel_env[["col_selected"]])){
+    panel_env[["se"]] <- se
+  } else {
+    panel_env[["se"]] <- se[ , unlist(panel_env[["col_selected"]])]
+  }
 
-  args <- list()
   args[["rank"]] <- deparse(slot(x, "rank"))
   args[["add_legend"]] <- deparse(slot(x, "add_legend"))
 
-  args <- paste(sprintf("%s=%s", names(args), unlist(args)), collapse=", ")
-  fn_call <- paste(fn_call, args, sep = ", ")
-  fn_call <- paste0(fn_call, ")")
-  fn_call <- paste(strwrap(fn_call, exdent=4), collapse="\n")
+  args <- sprintf("%s=%s", names(args), args)
+  args <- paste(args, collapse=", ")
+  fun_call <- sprintf("p <- miaViz::plotAbundance(se, %s)", args)
 
-  plot_env$.customFUN <- miaViz::plotAbundance
-  tmp_call <- sprintf(fn_call, ".customFUN")
-  .textEval(tmp_call, plot_env)
+  fun_cmd <- paste(strwrap(fun_call, width = 80, exdent = 4), collapse = "\n")
+  plot_out <- .textEval(fun_cmd, panel_env)
+  all_cmds[["fun"]] <- fun_cmd
 
-  commands <- sprintf(fn_call, "AbundancePlot")
-
-  commands <- sub("^gg <- ", "", commands) # to avoid an unnecessary variable.
-  list(contents=plot_env$gg, commands=list(select=selected, plot=commands))
+  list(commands=all_cmds, plot=plot_out, varname=NULL, contents=NULL)
 })
 
-#' @importMethodsFrom iSEE .renderOutput
 #' @importFrom iSEE .getEncodedName .retrieveOutput
 #' @importFrom shiny renderPlot
+#' @importFrom methods callNextMethod
 setMethod(".renderOutput", "AbundancePlot", function(x, se, output, pObjects, rObjects) {
   plot_name <- .getEncodedName(x)
   force(se) # defensive programming to avoid difficult bugs due to delayed evaluation.
+
   output[[plot_name]] <- renderPlot({
-    .retrieveOutput(plot_name, se, pObjects, rObjects)$contents
+    .retrieveOutput(plot_name, se, pObjects, rObjects)
   })
+
+  callNextMethod()
+})
+
+#' @importFrom methods callNextMethod
+setMethod(".hideInterface", "AbundancePlot", function(x, field) {
+  if (field %in% c("SelectionHistory", "RowSelectionRestrict",
+                   "RowSelectionDynamicSource", "RowSelectionSource")) {
+    TRUE
+  } else {
+    callNextMethod()
+  }
+})
+
+setMethod(".multiSelectionResponsive", "AbundancePlot", function(x, dims = character(0)) {
+  if ("column" %in% dims) {
+    return(TRUE)
+  }
+  return(FALSE)
 })
 
 #' @importFrom methods slot

R/class-RowTreePlot.R

@@ -146,13 +146,18 @@ setMethod(".defineOutput", "RowTreePlot", function(x) {
 #' @importFrom iSEE .processMultiSelections .textEval
 #' @importFrom miaViz plotRowTree
 setMethod(".generateOutput", "RowTreePlot", function(x, se, all_memory, all_contents) {
-  plot_env <- new.env()
-  plot_env[["se"]] <- se
-
+  panel_env <- new.env()
+
   all_cmds <- list()
   args <- character(0)
-
-  all_cmds[["select"]] <- .processMultiSelections(x, all_memory, all_contents, plot_env)
+
+  all_cmds[["select"]] <- .processMultiSelections(x, all_memory, all_contents, panel_env)
+
+  if (is.null(panel_env[["row_selected"]])){
+    panel_env[["se"]] <- se
+  } else {
+    panel_env[["se"]] <- se[unlist(panel_env[["row_selected"]]), ]
+  }
 
   args[["layout"]] <- deparse(slot(x, "layout"))
   args[["add_legend"]] <- deparse(slot(x, "add_legend"))
@@ -164,27 +169,27 @@ setMethod(".generateOutput", "RowTreePlot", function(x, se, all_memory, all_cont
   if (slot(x, "tip_colour") == "Row data") {
     args[["tip_colour_by"]] <- deparse(slot(x, "tip_colour_by"))
   }
-
+  
   args <- sprintf("%s=%s", names(args), args)
   args <- paste(args, collapse=", ")
   fun_call <- sprintf("p <- miaViz::plotRowTree(se, %s)", args)
-  
+
   fun_cmd <- paste(strwrap(fun_call, width = 80, exdent = 4), collapse = "\n")
-  plot_out <- .textEval(fun_cmd, plot_env)
+  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", "RowTreePlot", function(x, se, output, pObjects, rObjects) {
-  plot_name <- .getEncodedName(x)
+  panel_name <- .getEncodedName(x)
   force(se) # defensive programming to avoid difficult bugs due to delayed evaluation.
 
-  output[[plot_name]] <- renderPlot({
-      .retrieveOutput(plot_name, se, pObjects, rObjects)
+  output[[panel_name]] <- renderPlot({
+      .retrieveOutput(panel_name, se, pObjects, rObjects)
   })
 
   callNextMethod()
@@ -200,6 +205,17 @@ setMethod(".hideInterface", "RowTreePlot", function(x, field) {
   }
 })
 
+setMethod(".multiSelectionRestricted", "RowTreePlot", function(x) {
+  slot(x, "RowSelectionRestrict")
+})
+
+setMethod(".multiSelectionResponsive", "RowTreePlot", function(x, dims = character(0)) {
+  if ("row" %in% dims) {
+    return(TRUE)
+  }
+  return(FALSE)
+})
+
 #' @importFrom methods callNextMethod
 #' @importFrom iSEE .getEncodedName .getPanelColor .addTourStep
 setMethod(".definePanelTour", "RowTreePlot", function(x) {

tests/testthat.R

@@ -1,11 +1,3 @@
-# This file is part of the standard setup for testthat.
-# It is recommended that you do not modify it.
-#
-# Where should you do additional test configuration?
-# Learn more about the roles of various files in:
-# * https://r-pkgs.org/testing-design.html#sec-tests-files-overview
-# * https://testthat.r-lib.org/articles/special-files.html
-
 library(testthat)
 library(iSEEtree)
 

vignettes/iSEEtree.Rmd

@@ -110,7 +110,7 @@ tse <- GlobalPatterns
 
 # Agglomerate TreeSE by Genus
 tse_genus <- mergeFeaturesByRank(tse,
-                                 rank = "Order",
+                                 rank = "Genus",
                                  onRankOnly = TRUE)
 
 # Add relabundance assay
@@ -121,7 +121,7 @@ tse_genus <- scater::runPCA(tse_genus, assay.type = "counts")
 
 # Launch iSEE
 if (interactive()) {
-  iSEE(tse_genus, initial = c(ColumnDataTable(), ComplexHeatmapPlot(), AbundanceDensityPlot()))
+  iSEE(tse_genus)
 }
 ```