Implementing new methods

DESCRIPTION

@@ -1,5 +1,5 @@
 Package: iSEEtree
-Version: 0.99.2
+Version: 0.99.3
 Authors@R: 
     c(person(given = "Giulio", family = "Benedetti", role = c("aut", "cre"),
            email = "[email protected]",

NAMESPACE

@@ -20,6 +20,9 @@ importFrom(SummarizedExperiment,rowData)
 importFrom(TreeSummarizedExperiment,TreeSummarizedExperiment)
 importFrom(TreeSummarizedExperiment,rowLinks)
 importFrom(TreeSummarizedExperiment,rowTreeNames)
+importFrom(grDevices,dev.off)
+importFrom(grDevices,pdf)
+importFrom(grDevices,rainbow)
 importFrom(iSEE,.addSpecificTour)
 importFrom(iSEE,.addTourStep)
 importFrom(iSEE,.checkboxGroupInput.iSEE)
@@ -59,6 +62,7 @@ importFrom(shiny,plotOutput)
 importFrom(shiny,renderPlot)
 importFrom(shinyWidgets,addSpinner)
 importFrom(utils,stack)
+importMethodsFrom(iSEE,.exportOutput)
 importMethodsFrom(iSEE,.generateOutput)
 importMethodsFrom(iSEE,.panelColor)
 importMethodsFrom(iSEE,.renderOutput)

R/class-AbundanceDensityPlot.R

@@ -236,6 +236,21 @@ setMethod(".renderOutput", "AbundanceDensityPlot",
     callNextMethod()
 })
 
+#' @export
+#' @importFrom grDevices pdf dev.off
+setMethod(".exportOutput", "AbundanceDensityPlot",
+    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", "AbundanceDensityPlot", function(x, field) {
 

R/class-AbundancePlot.R

@@ -82,6 +82,7 @@ AbundancePlot <- function(...) {
 #' @importFrom iSEE .getEncodedName .checkboxInput.iSEE .radioButtons.iSEE
 #'   .conditionalOnRadio .selectInput.iSEE
 #' @importFrom methods slot
+#' @importFrom SummarizedExperiment colData
 setMethod(".defineDataInterface", "AbundancePlot", function(x, se, select_info) {
     panel_name <- .getEncodedName(x)
 
@@ -92,7 +93,7 @@ setMethod(".defineDataInterface", "AbundancePlot", function(x, se, select_info)
             selected=slot(x, "order_sample")),
             .conditionalOnRadio(paste0(panel_name, "_order_sample"), "Column data",
                 list(.selectInput.iSEE(x, field="order_sample_by_column",
-                label="Order samples by", choices=names(colData(se)),
+                label="Order sample by", choices=names(colData(se)),
                 selected=slot(x, "order_sample_by_column")),
                 .checkboxInput.iSEE(x, field="decreasing",
                 label="Order decreasing", value=slot(x, "decreasing")))),
@@ -204,6 +205,21 @@ setMethod(".renderOutput", "AbundancePlot",
     callNextMethod()
 })
 
+#' @export
+#' @importFrom grDevices pdf dev.off
+setMethod(".exportOutput", "AbundancePlot",
+    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", "AbundancePlot", function(x, field) {
     if( field %in% c("SelectionHistory", "RowSelectionRestrict",
@@ -268,6 +284,19 @@ setMethod(".definePanelTour", "AbundancePlot", function(x) {
         data.frame(rbind(c(element = paste0("#", panel_name,
             "_order_sample"), intro = "Here, we can choose
             how to order the abundance plot by.")))})
+    .addSpecificTour(class(x)[1], "decreasing", function(panel_name) {
+        data.frame(rbind(c(element = paste0("#", panel_name,
+            "_decreasing"), intro = "Here, we can choose
+            whether or not to plot by decreasing order.")))})
+    .addSpecificTour(class(x)[1], "order_sample_by_row", function(panel_name) {
+        data.frame(rbind(c(element = paste0("#", panel_name,
+            "_order_sample_by_row + .selectize-control"), intro = "Here, we can
+            choose a variable from the <code>rowData</code> to order the plot by.
+            It has to be part of the rank selected in the Visual Parameters.")))})
+    .addSpecificTour(class(x)[1], "order_sample_by_column", function(panel_name) {
+      data.frame(rbind(c(element = paste0("#", panel_name,
+            "_order_sample_by_column + .selectize-control"), intro = "Here, we can
+            choose a variable from the <code>colData</code> to order the plot by.")))})
 
     # Define what parameters the user can adjust
     collapseBox(paste0(panel_name, "_Visual"),

R/class-RDAPlot.R

@@ -264,6 +264,21 @@ setMethod(".renderOutput", "RDAPlot",
     callNextMethod()
 })
 
+#' @export
+#' @importFrom grDevices pdf dev.off
+setMethod(".exportOutput", "RDAPlot",
+    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", "RDAPlot", function(x, field) {
 

R/class-RowTreePlot.R

@@ -232,6 +232,21 @@ setMethod(".renderOutput", "RowTreePlot",
     callNextMethod()
 })
 
+#' @export
+#' @importFrom grDevices pdf dev.off
+setMethod(".exportOutput", "RowTreePlot",
+    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", "RowTreePlot", function(x, field) {
 
@@ -274,7 +289,7 @@ setMethod(".definePanelTour", "RowTreePlot", function(x) {
 
 #' @importFrom iSEE .getEncodedName .selectInput.iSEE .checkboxInput.iSEE
 #'   .radioButtons.iSEE .conditionalOnRadio .addSpecificTour
-#' @importFrom SummarizedExperiment rowData assayNames
+#' @importFrom SummarizedExperiment rowData
 #' @importFrom TreeSummarizedExperiment rowTreeNames
 .create_visual_box_for_rowtree <- function(x, se) {
     panel_name <- .getEncodedName(x)

tests/testthat/test-AbundanceDensityPlot.R

@@ -28,4 +28,16 @@ test_that("AbundanceDensityPlot", {
   expect_s3_class(.create_visual_box_for_abunddens_plot(panel, tse),
                   "shiny.tag.list")
 
+  output <- new.env()
+  pObjects <- new.env()
+  rObjects <- new.env()
+
+  expect_null(.renderOutput(panel, tse, output = output, pObjects = pObjects, rObjects = rObjects))
+  expect_s3_class(output$AbundanceDensityPlotNA, "shiny.render.function")
+  expect_s3_class(output$AbundanceDensityPlotNA_INTERNAL_PanelMultiSelectInfo, "shiny.render.function")
+  expect_s3_class(output$AbundanceDensityPlotNA_INTERNAL_PanelSelectLinkInfo, "shiny.render.function")
+
+
 })
+
+

tests/testthat/test-AbundancePlot.R

@@ -28,4 +28,13 @@ test_that("AbundancePlot", {
   expect_s3_class(.create_visual_box_for_abund_plot(panel, tse),
                   "shiny.tag.list")
 
+  output <- new.env()
+  pObjects <- new.env()
+  rObjects <- new.env()
+
+  expect_null(.renderOutput(panel, tse, output = output, pObjects = pObjects, rObjects = rObjects))
+  expect_s3_class(output$AbundancePlotNA, "shiny.render.function")
+  expect_s3_class(output$AbundancePlotNA_INTERNAL_PanelMultiSelectInfo, "shiny.render.function")
+  expect_s3_class(output$AbundancePlotNA_INTERNAL_PanelSelectLinkInfo, "shiny.render.function")
+
 })

tests/testthat/test-RDAPlot.R

@@ -34,5 +34,14 @@ test_that("RDAPlot", {
       c("#RDAPlotNA_SelectionBoxOpen"))
 
   expect_s3_class(.create_visual_box_for_rda(panel, tse), "shiny.tag.list")
+
+  output <- new.env()
+  pObjects <- new.env()
+  rObjects <- new.env()
+
+  expect_null(.renderOutput(panel, tse, output = output, pObjects = pObjects, rObjects = rObjects))
+  expect_s3_class(output$RDAPlotNA, "shiny.render.function")
+  expect_s3_class(output$RDAPlotNA_INTERNAL_PanelMultiSelectInfo, "shiny.render.function")
+  expect_s3_class(output$RDAPlotNA_INTERNAL_PanelSelectLinkInfo, "shiny.render.function")
 
 })

tests/testthat/test-RowTreePlot.R

@@ -32,4 +32,13 @@ test_that("RowTreePlot", {
 
   expect_s3_class(.create_visual_box_for_rowtree(panel, tse), "shiny.tag.list")
 
+  output <- new.env()
+  pObjects <- new.env()
+  rObjects <- new.env()
+
+  expect_null(.renderOutput(panel, tse, output = output, pObjects = pObjects, rObjects = rObjects))
+  expect_s3_class(output$RowTreePlotNA, "shiny.render.function")
+  expect_s3_class(output$RowTreePlotNA_INTERNAL_PanelMultiSelectInfo, "shiny.render.function")
+  expect_s3_class(output$RowTreePlotNA_INTERNAL_PanelSelectLinkInfo, "shiny.render.function")
+
 })