diff --git a/R/class-AbundanceDensityPlot.R b/R/class-AbundanceDensityPlot.R index 4c60793..ea4ef72 100644 --- a/R/class-AbundanceDensityPlot.R +++ b/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 diff --git a/R/class-AbundancePlot.R b/R/class-AbundancePlot.R index 78e5e98..8680494 100644 --- a/R/class-AbundancePlot.R +++ b/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 diff --git a/R/class-RowTreePlot.R b/R/class-RowTreePlot.R index 88bf90e..030048c 100644 --- a/R/class-RowTreePlot.R +++ b/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,15 +169,15 @@ 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) }) @@ -180,11 +185,11 @@ setMethod(".generateOutput", "RowTreePlot", function(x, se, all_memory, all_cont #' @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) { diff --git a/tests/testthat.R b/tests/testthat.R index c4ca9b0..98a2b81 100644 --- a/tests/testthat.R +++ b/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) diff --git a/vignettes/iSEEtree.Rmd b/vignettes/iSEEtree.Rmd index 6a2c882..84d659c 100644 --- a/vignettes/iSEEtree.Rmd +++ b/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) } ```