Selections from R feature request

NAMESPACE

@@ -85,7 +85,6 @@ export(chmSetDeployServerConfig)
 export(chmStringopFunction)
 export(chmTreeGaps)
 export(chmWriteCustomJS)
-export(default_panel_configuration)
 export(detailMap)
 export(getDimensions)
 export(initLogging)

R/allMethods.R

@@ -1205,9 +1205,65 @@ setMethod("chmMake",
     } else if (is(chm@colOrder, "character")) {
       chm@colOrder <- chmUserLabelsToShaid(chm@colOrder)
     }
+    chm <- convertPanelSelectionsFromLabelToIndex(chm)
     chm
   }
 )
+
+#' Convert Panel Selections from Labels to Indices
+#'
+#' Converts panel selections from label-based to index-based format for both row and column axes.
+#' This internal function is called during the heatmap compilation process to prepare selections
+#' for the NG-CHM viewer, which expects numeric indices rather than label strings.
+#'
+#' @param chm An NG-CHM object containing panel configuration with selections
+#'
+#' @return The modified NG-CHM object with selections converted from labels to indices
+#'
+#' @section Error Handling:
+#' If conversion fails for an axis, the function logs an error, issues a warning,
+#' and sets an empty selection list for that axis to prevent downstream failures.
+#'
+#' @keywords internal
+#' @noRd
+convertPanelSelectionsFromLabelToIndex <- function(chm) {
+  for (axis in c("row", "col")) {
+    tryCatch({
+      orderType <- slot(chm, paste0(axis, "Order"))@type # one of `dendrogram`, or `label`
+      selectionIndexes <- list() # Initialize empty list for selection indexes
+      selectionLabels <- chm@panel_configuration@selections[[axis]]
+      if (orderType == "label") {
+        labels_vector <- getLabelsFromFile(slot(chm, paste0(axis, "Order")))
+        selectionIndexes <- lapply(chm@panel_configuration@selections[[axis]], function(selection_label) {
+          indexVal <- match(selection_label, labels_vector)
+          if (is.na(indexVal)) {
+            warning(sprintf("%s selection '%s' not found in %s labels", axis, selection_label, axis))
+          }
+          indexVal
+        })
+      } else if (orderType == "dendrogram") {
+        labels_df <- getDendrogramOrderFromFile(slot(chm, paste0(axis, "Order")))
+        selectionIndexes <- lapply(chm@panel_configuration@selections[[axis]], function(selection_label) {
+          indexVal <- labels_df[labels_df$Id == selection_label, "Order"]
+          if (length(indexVal) == 0) {
+            warning(sprintf("%s selection '%s' not found in %s labels", axis, selection_label, axis))
+          }
+          indexVal
+        })
+      } else {
+        log_error(sprintf("Selections not implemented for %s", orderType))
+      }
+      chm@panel_configuration@selections[[axis]] <- selectionIndexes
+    }, error = function(e) {
+      log_error(e$message)
+      warning(sprintf("Unable to set panel selections for %s", axis))
+      chm@panel_configuration@selections[[axis]] <- list()
+    })
+  }
+  chm
+}
+
+
 #' Make an original format NGCHM.
 #'
 #' @param chm The original format CHM to compile.

R/ngchmshaidy.R

@@ -638,6 +638,60 @@ ngchmSaveLabelsAsBlob <- function(shaidyRepo, labels) {
   res
 }
 
+#' Get Dendrogram Order from File
+#'
+#' Reads the dendrogram order information from a TSV file stored in a shaidy repository.
+#' This function retrieves both the labels and their corresponding order indices from
+#' the "dendrogram-order.tsv" file associated with a dendrogram shaid.
+#'
+#' @param shaid A shaid object of type "dendrogram" containing the identifier
+#'   for the dendrogram blob in the repository
+#'
+#' @return A data.frame with two columns:
+#'           1. Id: Character vector containing the dendrogram labels
+#'           2. Order: Numeric vector containing the order indices for each label
+#'         Returns NULL if an error occurs during file reading.
+#'
+#' @keyword internal
+#' @noRd
+getDendrogramOrderFromFile <- function(shaid) {
+  tryCatch({
+    srcRepo <- ngchmFindRepo(shaid)
+    labelsWithOrder <- read.delim(srcRepo$blob.path(shaid@type, shaid@value, "dendrogram-order.tsv"), header = TRUE, colClasses = c("character", "numeric"))
+    return(labelsWithOrder)
+  }, error = function(e) {
+    warning("Error getting labels with order from file: ", e$message)
+    return(NULL)
+  })
+}
+
+#' Get Labels from File
+#'
+#' Reads axis labels from a text file stored in a shaidy repository.
+#' This function retrieves labels from the "labels.txt" file associated
+#' with a label shaid.
+#'
+#' @param shaid A shaid object containing the identifier for the label blob
+#'   in the repository
+#'
+#' @return A character vector containing the labels read from the file,
+#'   with one label per element. Returns NULL if an error occurs during
+#'   file reading.
+#'
+#' @keywords internal
+#' @noRd
+getLabelsFromFile <- function(shaid) {
+  tryCatch({
+    srcRepo <- ngchmFindRepo(shaid)
+    labelsWithOrder <- readLines(srcRepo$blob.path(shaid@type, shaid@value, "labels.txt"))
+    return(labelsWithOrder)
+  }, error = function(e) {
+    warning("Error getting labels with order from file: ", e$message)
+    return(NULL)
+  })
+}
+
+
 #' Get the axis labels of a shaidy dataset or dendrogram
 #'
 #' @param shaid The shaid of the dataset or dendrogram to get the labels of

R/panelClasses.R

@@ -6,10 +6,10 @@
 #                     The 'ngChmContainer1' represenst tree-structure of the panel layout.
 #   - keys for each of the panes, (e.g. `pane1`, `pane2`, etc.) which contain the actual panes
 #   - `flickInfo`, containing the flick state info. This is optional and not implemented here.
-#   - `selections`, containing selected items. This is optional and not implemented here.
+#   - `selections`, containing selected items.
 #
-# The classes in this file relate to the `panel_layout` key and the keys for the individual
-# panes (`pane1`, `pane2`, etc.)
+# The classes in this file relate to the `panel_layout` key, keys for the individual
+# panes (`pane1`, `pane2`, etc.), and the `selections` key.
 
 #' Panel Configuration Class for NG-CHM
 #'
@@ -20,6 +20,7 @@
 #'
 #' @slot panes_list A list containing pane objects and sizes information.
 #' @slot pane_types A named list mapping pane IDs to their configurations.
+#' @slot selections A list of lists of row and column labels.
 #'
 #' @seealso
 #' * [detailMap] for detail map configuration
@@ -30,7 +31,8 @@
 setClass("panel_configuration",
   slots = list(
     panes_list = "list",
-    pane_types = "list"
+    pane_types = "list",
+    selections = "list"
   )
 )
 
@@ -70,7 +72,6 @@ setClass("panel_configuration",
 #'        }
 #' @param pane_types A named list mapping pane IDs to their configurations.
 #'        Each element must be a detailMap, summaryMap, or pluginPane object.
-#'        Each element must be a detailMap, summaryMap, or pluginPane object.
 #'        For example, the default two-pane layout is a detailMap and a summaryMap:
 #'           \preformatted{
 #'             pane_types = list(
@@ -87,10 +88,19 @@ setClass("panel_configuration",
 #'                       pluginName = "2D ScatterPlot: UMAP (column)")
 #'             )
 #'           }
+#' @param selections A list of lists of row and column labels.
+#'        For example, to select rows "r1" and "r4" and columns "c2" and "c5":
+#'           \preformatted{
+#'             selections = list(row = c("r1", "r4"), col = c("c2", "c5"))
+#'           }
 #'
 #' @return A new \code{panel_configuration} object
 #'
 #' @examples
+#' matrix <- matrix(rnorm(100),
+#'   nrow = 10, ncol = 10,
+#'   dimnames = list(paste0("r", 1:10), paste0("c", 1:10))
+#' )
 #' # Create a three-pane layout with a detail map, a summary map, and a plugin pane:
 #' pane1 <- pane(id = "pane1")
 #' pane2 <- pane(id = "pane2")
@@ -104,14 +114,12 @@ setClass("panel_configuration",
 #'   pane3 = pluginPane(id = "pane3", pluginName = "2D ScatterPlot: UMAP (column)")
 #' )
 #'
-#' # Create panel configuration
-#' config <- panel_configuration(panes_list, pane_types)
+#' # Select the 1st and 4th rows and 2nd and 5th columns:
+#' selections <- list(row = c("r1", "r4"), col = c("c2", "c5"))
 #'
-#' # Create ngchm with the panel configuration
-#' matrix <- matrix(rnorm(100),
-#'   nrow = 10, ncol = 10,
-#'   dimnames = list(paste0("r", 1:10), paste0("c", 1:10))
-#' )
+#' # Create panel configuration
+#' config <- panel_configuration(panes_list, pane_types, selections = selections)
+#' # Create a new NG-CHM heatmap with this panel configuration
 #' hm <- chmNew("three-panel-ngchm", matrix, panel_configuration = config)
 #'
 #' @seealso
@@ -122,13 +130,14 @@ setClass("panel_configuration",
 #' * [pluginPane] for plugin pane configuration
 #'
 #' @export
-panel_configuration <- function(panes_list, pane_types) {
+panel_configuration <- function(panes_list, pane_types, selections = list(row = list(), col = list())) {
   pane_ids <- as.character(sort(get_all_pane_ids(panes_list)))
   types_ids <- as.character(sort(names(pane_types)))
   if (!identical(pane_ids, types_ids)) {
     stop("The ids from panes_list and pane_types must match.")
   }
-  new("panel_configuration", panes_list = panes_list, pane_types = pane_types)
+  selections <- selections
+  new("panel_configuration", panes_list = panes_list, pane_types = pane_types, selections = selections)
 }
 
 #' Container Class for Panel Layout
@@ -279,6 +288,7 @@ setMethod(jsonlite:::asJSON, "panel_configuration", function(x, ...) {
       jsonlite::toJSON(slot(x, "pane_types")[[pane_id]], ...)
     )
   }
+  panel_configuration_value$selections <- slot(x, "selections")
   jsonlite::toJSON(panel_configuration_value, auto_unbox = TRUE, pretty = TRUE)
 })
 

R/panelFunctions.R

@@ -19,7 +19,8 @@
 #' [detailMap] for detail map configuration.
 #' [summaryMap] for summary map configuration.
 #'
-#' @export
+#' @keywords internal
+#' @noRd
 default_panel_configuration <- function() {
   panel_configuration(
     list(
@@ -30,7 +31,8 @@ default_panel_configuration <- function() {
     list(
       pane1 = detailMap(id = "pane1"),
       pane2 = summaryMap(id = "pane2")
-    )
+    ),
+    list(row = list(), col = list())
   )
 }