Pull request for altexp functionality

DESCRIPTION

@@ -39,7 +39,9 @@ Imports:
     SummarizedExperiment,
     TreeSummarizedExperiment,
     utils,
-    vegan
+    vegan,
+    SingleCellExperiment,
+    SummarizedExperiment
 Suggests:
     BiocStyle,
     knitr,

R/landing_page.R

@@ -70,6 +70,46 @@
                                   label = "colTree:", placeholder = "col.tree",
                                   accept = c(".tree", ".tre")),
                             div(style = "margin-top: -20px")),
+
+
+                        tabPanel(title = "Alternative Experiments", value = "altexp", br(),
+
+                            fileInput(inputId = "alt_assay", label = "Alternative Assays:",
+                                accept = ".csv", multiple = TRUE,
+                                placeholder = "alt_assay.csv"),
+                            div(style = "margin-top: -20px"),
+
+                            fileInput(inputId = "alt_coldata", label = "Alternative colData:",
+                                accept = ".csv", placeholder = "alt_coldata.csv"),
+                            div(style = "margin-top: -20px"),
+
+                            fileInput(inputId = "alt_rowdata", label = "Alternative rowData:",
+                                accept = ".csv", placeholder = "alt_rowdata.csv"),
+                            div(style = "margin-top: -20px"),
+
+                            textInput(inputId = "alt_name", 
+                                label = "Alternative Experiment Name:",
+                                placeholder = "e.g. agglomerated"),
+
+                            actionButton("add_altexp", "Add Alternative Experiment", 
+                                class = "btn-primary")),
+
+
+                        tabPanel(title = "Merged Data", value = "merged", br(),
+                            fileInput(inputId = "merged_file", label = "Merged Dataset:",
+                                accept = ".rds", placeholder = "merged_dataset.rds"),
+                            selectInput(inputId = "agglomeration_levels",
+                                label = "Auto-create experiments for taxonomic levels:",
+                                choices = c("None", "All", "Custom"),
+                                selected = "None"),
+                            conditionalPanel(
+                                condition = "input.agglomeration_levels == 'Custom'",
+                                checkboxGroupInput(inputId = "custom_levels",
+                                    label = "Select levels:",
+                                    choices = c("Phylum", "Class", "Order", "Family", "Genus", "Species"))
+                            )),
+
+
 
                         tabPanel(title = "Foreign", value = "foreign", br(),
 
@@ -109,6 +149,10 @@
                 box(id = "manipulate.panel", title = "Manipulate", width = 4,
                     status = "primary", solidHeader = TRUE, collapsible = TRUE,
 
+                    selectInput(inputId = "target_experiment",
+                        label = "Apply to:",
+                        choices = c("Main Experiment" = "main")),
+
                     tabsetPanel(id = "manipulate",
 
                         tabPanel(title = "Subset", value = "subset", br(),
@@ -129,11 +173,16 @@
                                 step = 1)),
 
                         tabPanel(title = "Agglomerate", value = "agglomerate",
-
                             br(),
-
                             selectInput(inputId = "taxrank",
-                                label = "Taxonomic rank:", choices = NULL)),
+                                label = "Taxonomic rank:", choices = NULL),
+                            # Add these new inputs here
+                            checkboxInput(inputId = "save_as_altexp",
+                                label = "Save as Alternative Experiment", 
+                                value = FALSE),
+                            textInput(inputId = "altexp_name",
+                                label = "Alternative Experiment Name:",
+                                placeholder = "e.g. genus_level")),
 
                         tabPanel(title = "Transform", value = "transform", br(),
 
@@ -203,6 +252,20 @@
                     width = 4, status = "primary", solidHeader = TRUE,
                     collapsible = TRUE,
 
+                    selectInput(inputId = "experiment_choice", 
+                        label = "Select Experiment:",
+                        choices = c("Main" = "main"),
+                        selected = "main"),
+
+                    checkboxGroupInput(inputId = "altexp_panels",
+                        label = "Show in Panels:",
+                        choices = c("Abundance Plot" = "AbundancePlot",
+                                    "Heatmap" = "ComplexHeatmapPlot",
+                                    "Data Table" = "RowDataTable"),
+                        selected = "AbundancePlot"),
+
+                    hr(),
+
                     selectInput(inputId = "panels", label = "Panels:",
                         choices = c(default_panels, other_panels),
                         multiple = TRUE, selected = c(default_panels)),
@@ -250,6 +313,8 @@
     })
 
     .create_import_observers(input, rObjects)
+    .create_altexp_observers(input, rObjects)
+    .create_merged_file_observers(input, rObjects)
     .create_manipulate_observers(input, rObjects)
     .create_estimate_observers(input, rObjects)
     .update_observers(input, session, rObjects)
@@ -261,4 +326,4 @@
 
     invisible(NULL)
     # nocov end
-}
+}

R/miaDash.R

@@ -24,6 +24,7 @@
 #' @importFrom iSEE iSEE
 #' @importFrom utils packageVersion
 #' @importFrom htmltools tags
+#' @importFrom SingleCellExperiment altExp altExpNames
 miaDash <- function() {
 
     addResourcePath("assets", system.file("assets", package = "miaDash"))
@@ -34,7 +35,8 @@ miaDash <- function() {
             paste0("Microbiome Analysis Dashboard - v", packageVersion("miaDash")),
             tags$img(src = "assets/mia_logo.png", height = "40px", style = "margin-left: 10px"),
             style = "cursor: pointer; font-weight: 500",
-            onclick = "window.location='https://miadash-microbiome.2.rahtiapp.fi/'") 
+            onclick = "window.location.href='https://miadash-microbiome.2.rahtiapp.fi/'; window.location.reload(true);"
+        )
 
     )
 
@@ -50,22 +52,64 @@ miaDash <- function() {
 #' @importFrom mia taxonomyRanks
 #' @importFrom SummarizedExperiment rowData colData
 #' @importFrom SingleCellExperiment reducedDims
-.launch_isee <- function(FUN, initial, session, rObjects) {
-
+.launch_isee <- function(FUN, initial, session, rObjects, input) {
     # nocov start
     tse <- rObjects$tse
+    current_exp <- .get_experiment(tse, input$experiment_choice)
+
+    # Filter panels based on experiment type
+    if(input$experiment_choice != "main") {
+        initial <- .filter_panels_by_experiment(initial, altexp_panels)
+    }
 
-    initial <- lapply(initial, function(x) eval(parse(text = paste0(x, "()"))))
+    initial <- lapply(initial, function(x) {
+        panel <- eval(parse(text = paste0(x, "()")))
+
+        # Configure panel based on experiment type
+        if(inherits(panel, "DimensionReducedPanel")) {
+            panel$ExperimentName <- input$experiment_choice
+        }
+
+        # Add feature set specific configurations
+        if(!is.null(input$experiment_choice) && 
+           input$experiment_choice != "main") {
+            panel$DataType <- "alternative"
+
+            # Handle agglomerated data
+            if(grepl("^agglomerated_", input$experiment_choice)) {
+                panel$AggregationLevel <- sub("^agglomerated_", "", 
+                                            input$experiment_choice)
+            }
+
+            # Configure specific panel types
+            if(inherits(panel, "AbundancePlot") || 
+               inherits(panel, "ComplexHeatmapPlot")) {
+                panel$ShowFeatureNames <- TRUE
+                panel$ShowAggregationLevel <- TRUE
+            }
+        }
+
+        return(panel)
+    })
+
 
-    initial <- .check_panel(tse, initial, "RowDataTable", rowData)
-    initial <- .check_panel(tse, initial, "ColumnDataTable", colData)
-    initial <- .check_panel(tse, initial, "RowTreePlot", rowLinks)
-    initial <- .check_panel(tse, initial, "AbundancePlot", taxonomyRanks)
-    initial <- .check_panel(tse, initial, "ReducedDimensionPlot", reducedDims)
-    initial <- .check_panel(tse, initial, "LoadingPlot", reducedDims)
-    initial <- .check_panel(tse, initial, "ColumnTreePlot", colLinks)
+    # Check panels for current experiment
+    initial <- .check_panel(tse, initial, "RowDataTable", rowData, 
+                          input$experiment_choice)
+    initial <- .check_panel(tse, initial, "ColumnDataTable", colData, 
+                          input$experiment_choice)
+    initial <- .check_panel(tse, initial, "RowTreePlot", rowLinks, 
+                          input$experiment_choice)
+    initial <- .check_panel(tse, initial, "AbundancePlot", taxonomyRanks, 
+                          input$experiment_choice)
+    initial <- .check_panel(tse, initial, "ReducedDimensionPlot", reducedDims, 
+                          input$experiment_choice)
+    initial <- .check_panel(tse, initial, "LoadingPlot", reducedDims, 
+                          input$experiment_choice)
+    initial <- .check_panel(tse, initial, "ColumnTreePlot", colLinks, 
+                          input$experiment_choice)
 
-    FUN(SE = tse, INIT = initial)#, EXTRA = initial)
+    FUN(SE = current_exp, INIT = initial)
 
     enable("iSEE_INTERNAL_organize_panels")  # organize panels
     enable("iSEE_INTERNAL_link_graph")       # link graph
@@ -74,8 +118,8 @@ miaDash <- function() {
     enable("iSEE_INTERNAL_panel_settings")   # panel settings
     enable("iSEE_INTERNAL_open_vignette")    # open vignette
     enable("iSEE_INTERNAL_session_info")     # session info
-    enable("iSEE_INTERNAL_citation_info")    # citation info
+    enable("iSEE_INTERNAL_citation_info")    # citation info 
 
     invisible(NULL)
     # nocov end
-}
+}