diff --git a/DESCRIPTION b/DESCRIPTION index e2cfeb0..17eabb4 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,5 +1,5 @@ Package: iSEEtree -Version: 0.1.2 +Version: 0.1.3 Authors@R: person(given = "Giulio", family = "Benedetti", role = c("aut", "cre"), email = "giulio.benedetti@utu.fi", @@ -22,6 +22,7 @@ Imports: miaViz, S4Vectors, shiny, + shinyWidgets, SingleCellExperiment, SummarizedExperiment, TreeSummarizedExperiment diff --git a/NAMESPACE b/NAMESPACE index 8521f31..c90e517 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -9,6 +9,8 @@ exportClasses(AbundanceDensityPlot) exportClasses(AbundancePlot) exportClasses(RDAPlot) exportClasses(RowTreePlot) +exportMethods(.multiSelectionDimension) +exportMethods(.multiSelectionRestricted) exportMethods(iSEE) importFrom(S4Vectors,isEmpty) importFrom(S4Vectors,setValidity2) @@ -49,10 +51,7 @@ importFrom(methods,slot) importFrom(miaViz,plotRowTree) importFrom(shiny,plotOutput) importFrom(shiny,renderPlot) +importFrom(shinyWidgets,addSpinner) importMethodsFrom(iSEE,.createObservers) -importMethodsFrom(iSEE,.defineInterface) -importMethodsFrom(iSEE,.defineOutput) -importMethodsFrom(iSEE,.fullName) importMethodsFrom(iSEE,.generateOutput) -importMethodsFrom(iSEE,.panelColor) importMethodsFrom(iSEE,.renderOutput) diff --git a/R/class-AbundanceDensityPlot.R b/R/class-AbundanceDensityPlot.R index 7b4258f..39c4c13 100644 --- a/R/class-AbundanceDensityPlot.R +++ b/R/class-AbundanceDensityPlot.R @@ -48,7 +48,9 @@ NULL #' @export setClass("AbundanceDensityPlot", contains="Panel", - slots=c(layout="character", assay.type="character", n="numeric")) + slots=c(layout="character", assay.type="character", n="numeric", + dots_colour="character", dots_colour_by="character", + add_legend="logical")) #' @importFrom iSEE .singleStringError .validNumberError #' @importFrom S4Vectors setValidity2 @@ -74,6 +76,9 @@ setMethod("initialize", "AbundanceDensityPlot", function(.Object, ...) { args <- .emptyDefault(args, "layout", "jitter") args <- .emptyDefault(args, "assay.type", "counts") args <- .emptyDefault(args, "n", 5) + args <- .emptyDefault(args, "add_legend", TRUE) + args <- .emptyDefault(args, "dots_colour", "None") + args <- .emptyDefault(args, "dots_colour_by", NA_character_) do.call(callNextMethod, c(list(.Object), args)) }) @@ -84,35 +89,37 @@ AbundanceDensityPlot <- function(...) { new("AbundanceDensityPlot", ...) } -#' @importMethodsFrom iSEE .defineInterface -#' @importFrom iSEE .getEncodedName collapseBox .selectInput.iSEE .numericInput.iSEE +#' @importFrom iSEE .getEncodedName .selectInput.iSEE .numericInput.iSEE #' @importFrom methods slot -#' @importFrom SummarizedExperiment rowData assayNames -#' @importFrom TreeSummarizedExperiment rowTreeNames +#' @importFrom SummarizedExperiment assayNames +setMethod(".defineDataInterface", "AbundanceDensityPlot", function(x, se, select_info) { + panel_name <- .getEncodedName(x) + + list( + .selectInput.iSEE( + x, field="assay.type", label="Assay type", + choices=assayNames(se), selected=slot(x, "assay.type") + ), + # Number of taxa + .numericInput.iSEE( + x, field="n", label="Number of taxa", value=slot(x, "n") + ) + ) + +}) + +#' @importFrom methods callNextMethod setMethod(".defineInterface", "AbundanceDensityPlot", function(x, se, select_info) { - tab_name <- .getEncodedName(x) - # Define what parameters the user can adjust - collapseBox(paste0(tab_name, "_Visual"), - title="Visual parameters", - open=FALSE, - # Tree layout - .selectInput.iSEE( - x, field="layout", label="Layout", - choices=c("jitter", "density", "point"), selected=slot(x, "layout") - ), - .selectInput.iSEE( - x, field="assay.type", label="Assay type", - choices=assayNames(se), selected=slot(x, "assay.type") - ), - # Number of taxa - .numericInput.iSEE( - x, field="n", label="Number of taxa", value=slot(x, "n") - ) + out <- callNextMethod() + list( + out[1], + .create_visual_box_for_abunddens_plot(x, se), + out[-1] ) + }) -#' @importMethodsFrom iSEE .createObservers #' @importFrom iSEE .getEncodedName .createProtectedParameterObservers setMethod(".createObservers", "AbundanceDensityPlot", function(x, se, input, session, pObjects, rObjects) { callNextMethod() @@ -121,23 +128,32 @@ setMethod(".createObservers", "AbundanceDensityPlot", function(x, se, input, ses .createProtectedParameterObservers( panel_name, - c("layout", "assay.type", "n"), + c("layout", "assay.type", "n", "add_legend"), + input=input, pObjects=pObjects, rObjects=rObjects + ) + + .createUnprotectedParameterObservers( + panel_name, + c("dots_colour", "dots_colour_by"), input=input, pObjects=pObjects, rObjects=rObjects ) invisible(NULL) }) -#' @importMethodsFrom iSEE .fullName setMethod(".fullName", "AbundanceDensityPlot", function(x) "Abundance density plot") -#' @importMethodsFrom iSEE .panelColor setMethod(".panelColor", "AbundanceDensityPlot", function(x) "#8B5A2B") -#' @importMethodsFrom iSEE .defineOutput #' @importFrom iSEE .getEncodedName +#' @importFrom shiny plotOutput +#' @importFrom shinyWidgets addSpinner setMethod(".defineOutput", "AbundanceDensityPlot", function(x) { - plotOutput(.getEncodedName(x)) + plot_name <- .getEncodedName(x) + addSpinner( + plotOutput(plot_name, height = paste0(slot(x, "PanelHeight"), "px")), + color=.panelColor(x) + ) }) #' @importMethodsFrom iSEE .generateOutput @@ -145,40 +161,110 @@ setMethod(".defineOutput", "AbundanceDensityPlot", function(x) { #' @importFrom miaViz plotRowTree setMethod(".generateOutput", "AbundanceDensityPlot", function(x, se, all_memory, all_contents) { plot_env <- new.env() - plot_env$se <- se - - selected <- .processMultiSelections(x, all_memory, all_contents, plot_env) + plot_env[["se"]] <- se - # simplify this to plotRowTree - fn_call <- "gg <- %s(se" + all_cmds <- list() + args <- character(0) - args <- list() + all_cmds[["select"]] <- .processMultiSelections(x, all_memory, all_contents, plot_env) + args[["layout"]] <- deparse(slot(x, "layout")) + args[["add_legend"]] <- deparse(slot(x, "add_legend")) args[["assay.type"]] <- deparse(slot(x, "assay.type")) - args[["n"]] <- deparse(slot(x, "n")) - - 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") - plot_env$.customFUN <- miaViz::plotAbundanceDensity - tmp_call <- sprintf(fn_call, ".customFUN") - .textEval(tmp_call, plot_env) + if (is.na(slot(x, "n")) || slot(x, "n") <= 0) { + args[["n"]] <- 5 + } else { + args[["n"]] <- deparse(slot(x, "n")) + } + + if (slot(x, "dots_colour") == "Column data") { + args[["colour_by"]] <- deparse(slot(x, "dots_colour_by")) + } + + args <- sprintf("%s=%s", names(args), args) + args <- paste(args, collapse=", ") + fun_call <- sprintf("p <- miaViz::plotAbundanceDensity(se, %s)", args) - commands <- sprintf(fn_call, "AbundanceDensityPlot") + fun_cmd <- paste(strwrap(fun_call, width = 80, exdent = 4), collapse = "\n") + plot_out <- .textEval(fun_cmd, plot_env) + all_cmds[["fun"]] <- fun_cmd - 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", "AbundanceDensityPlot", 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", "AbundanceDensityPlot", function(x, field) { + if (field %in% c("SelectionHistory")) { + TRUE + } else { + callNextMethod() + } +}) + +#' @export +setMethod(".multiSelectionDimension", "AbundanceDensityPlot", function(x) "row") + +#' @export +setMethod(".multiSelectionRestricted", "AbundanceDensityPlot", function(x) { + slot(x, "RowSelectionRestrict") +}) + +setMethod(".multiSelectionResponsive", "AbundanceDensityPlot", function(x, dims = character(0)) { + if ("row" %in% dims) { + return(TRUE) + } + return(FALSE) +}) + +setMethod(".singleSelectionDimension", "AbundanceDensityPlot", function(x) "feature") + +#' @importFrom iSEE .getEncodedName collapseBox .selectInput.iSEE +#' .radioButtons.iSEE .conditionalOnRadio +#' @importFrom methods slot +#' @importFrom SummarizedExperiment colData +.create_visual_box_for_abunddens_plot <- function(x, se) { + + panel_name <- .getEncodedName(x) + + # Define what parameters the user can adjust + collapseBox(paste0(panel_name, "_Visual"), + title="Visual parameters", + open=FALSE, + # Tree layout + .selectInput.iSEE( + x, field="layout", label="Layout", + choices=c("jitter", "density", "point"), selected=slot(x, "layout") + ), + # Colour legend + .checkboxInput.iSEE( + x, field="add_legend", label="View legend", value=slot(x, "add_legend") + ), + .radioButtons.iSEE( + x, field="dots_colour", label="Dot color:", inline=TRUE, + choices=c("None", "Column data"), selected=slot(x, "dots_colour") + ), + .conditionalOnRadio( + paste0(panel_name, "_dots_colour"), "Column data", + iSEE:::.selectInputHidden(x, field="dots_colour_by", + label="Color dots by", + choices=names(colData(se)), + selected=slot(x, "dots_colour_by")) + ) + ) + +} diff --git a/R/class-AbundancePlot.R b/R/class-AbundancePlot.R index 93e54b3..78e5e98 100644 --- a/R/class-AbundancePlot.R +++ b/R/class-AbundancePlot.R @@ -75,25 +75,16 @@ AbundancePlot <- function(...) { new("AbundancePlot", ...) } -#' @importFrom methods slot -#' @importFrom SummarizedExperiment rowData +#' @importFrom methods callNextMethod setMethod(".defineInterface", "AbundancePlot", function(x, se, select_info) { - tab_name <- .getEncodedName(x) - # Define what parameters the user can adjust - collapseBox(paste0(tab_name, "_Visual"), - title="Visual parameters", - open=FALSE, - # Tree layout - .selectInput.iSEE( - x, field="rank", label="Rank", - choices=names(rowData(se)), selected=slot(x, "rank") - ), - # Colour legend - .checkboxInput.iSEE( - x, field="add_legend", label="View legend", value=slot(x, "add_legend") - ) + out <- callNextMethod() + list( + out[1], + .create_visual_box_for_abund_plot(x, se), + out[-1] ) + }) #' @importMethodsFrom iSEE .createObservers @@ -157,4 +148,27 @@ setMethod(".renderOutput", "AbundancePlot", function(x, se, output, pObjects, rO output[[plot_name]] <- renderPlot({ .retrieveOutput(plot_name, se, pObjects, rObjects)$contents }) -}) \ No newline at end of file +}) + +#' @importFrom methods slot +#' @importFrom SummarizedExperiment rowData +.create_visual_box_for_abund_plot <- function(x, se) { + + tab_name <- .getEncodedName(x) + + # Define what parameters the user can adjust + collapseBox(paste0(tab_name, "_Visual"), + title="Visual parameters", + open=FALSE, + # Tree layout + .selectInput.iSEE( + x, field="rank", label="Rank", + choices=names(rowData(se)), selected=slot(x, "rank") + ), + # Colour legend + .checkboxInput.iSEE( + x, field="add_legend", label="View legend", value=slot(x, "add_legend") + ) + ) + +} \ No newline at end of file diff --git a/R/class-RowTreePlot.R b/R/class-RowTreePlot.R index 7387e64..ef6c794 100644 --- a/R/class-RowTreePlot.R +++ b/R/class-RowTreePlot.R @@ -113,7 +113,13 @@ setMethod(".createObservers", "RowTreePlot", function(x, se, input, session, pOb .createProtectedParameterObservers( panel_name, - c("layout", "add_legend", "edge_colour", "edge_colour_by", "tip_colour", "tip_colour_by"), + c("layout", "add_legend", "RowSelectionSource"), + input=input, pObjects=pObjects, rObjects=rObjects + ) + + .createUnprotectedParameterObservers( + panel_name, + c("edge_colour", "edge_colour_by", "tip_colour", "tip_colour_by"), input=input, pObjects=pObjects, rObjects=rObjects ) @@ -126,54 +132,60 @@ setMethod(".panelColor", "RowTreePlot", function(x) "#4EEE94") #' @importFrom iSEE .getEncodedName #' @importFrom shiny plotOutput +#' @importFrom shinyWidgets addSpinner setMethod(".defineOutput", "RowTreePlot", function(x) { - plotOutput(.getEncodedName(x)) + plot_name <- .getEncodedName(x) + addSpinner( + plotOutput(plot_name, height = paste0(slot(x, "PanelHeight"), "px")), + color=.panelColor(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 + plot_env[["se"]] <- se - 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, plot_env) - args <- list() args[["layout"]] <- deparse(slot(x, "layout")) args[["add_legend"]] <- deparse(slot(x, "add_legend")) + if (slot(x, "edge_colour") == "Row data") { args[["edge_colour_by"]] <- deparse(slot(x, "edge_colour_by")) } + if (slot(x, "tip_colour") == "Row data") { args[["tip_colour_by"]] <- deparse(slot(x, "tip_colour_by")) } - 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") - - plot_env$.customFUN <- miaViz::plotRowTree - tmp_call <- sprintf(fn_call, ".customFUN") - .textEval(tmp_call, plot_env) + args <- sprintf("%s=%s", names(args), args) + args <- paste(args, collapse=", ") + fun_call <- sprintf("p <- miaViz::plotRowTree(se, %s)", args) - commands <- sprintf(fn_call, "PlotRowTree") + fun_cmd <- paste(strwrap(fun_call, width = 80, exdent = 4), collapse = "\n") + plot_out <- .textEval(fun_cmd, plot_env) + all_cmds[["fun"]] <- fun_cmd - 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) }) #' @importFrom iSEE .getEncodedName .retrieveOutput #' @importFrom shiny renderPlot +#' @importFrom methods callNextMethod setMethod(".renderOutput", "RowTreePlot", 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 @@ -186,13 +198,7 @@ setMethod(".hideInterface", "RowTreePlot", function(x, field) { } }) -setMethod(".multiSelectionResponsive", "RowTreePlot", function(x, dims = character(0)) { - if ("row" %in% dims || slot(x, "RowSelectionRestrict")) { - return(TRUE) - } - return(FALSE) -}) - +#' @importFrom methods callNextMethod #' @importFrom iSEE .getEncodedName .getPanelColor .addTourStep setMethod(".definePanelTour", "RowTreePlot", function(x) { rbind(