diff --git a/NAMESPACE b/NAMESPACE index 84c5e6f4..4294d7c0 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -85,7 +85,6 @@ export(chmSetDeployServerConfig) export(chmStringopFunction) export(chmTreeGaps) export(chmWriteCustomJS) -export(default_panel_configuration) export(detailMap) export(getDimensions) export(initLogging) diff --git a/R/allMethods.R b/R/allMethods.R index 48f08eb3..17b6c30e 100644 --- a/R/allMethods.R +++ b/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. diff --git a/R/ngchmshaidy.R b/R/ngchmshaidy.R index 31cef3e0..a58ca585 100644 --- a/R/ngchmshaidy.R +++ b/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 diff --git a/R/panelClasses.R b/R/panelClasses.R index 5d02f6ed..504fb3ab 100644 --- a/R/panelClasses.R +++ b/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) }) diff --git a/R/panelFunctions.R b/R/panelFunctions.R index 6995ea6c..211bd065 100644 --- a/R/panelFunctions.R +++ b/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()) ) } diff --git a/man/default_panel_configuration.Rd b/man/default_panel_configuration.Rd deleted file mode 100644 index 84a320dc..00000000 --- a/man/default_panel_configuration.Rd +++ /dev/null @@ -1,35 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/panelFunctions.R -\name{default_panel_configuration} -\alias{default_panel_configuration} -\title{Create a default panel configuration} -\usage{ -default_panel_configuration() -} -\value{ -A \code{panel_configuration} object with: -\itemize{ -\item Two panes: "pane1" and "pane2" -\item Equal sizes (50\% width each) -\item pane1 configured as a detail map -\item pane2 configured as a summary map -} -} -\description{ -Creates a standard two-pane panel configuration with a detail map and a summary map. -The panes are arranged horizontally with equal widths (50\% each). -} -\examples{ - matrix_data <- matrix(rnorm(100), - nrow = 10, ncol = 10, - dimnames = list(paste0("r", 1:10), paste0("c", 1:10)) - ) -panel_configuration <- default_panel_configuration() -hm <- chmNew("my_ngchm", matrix_data, panel_configuration = panel_configuration) - -} -\seealso{ -\link{panel_configuration} for creating custom panel configurations. -\link{detailMap} for detail map configuration. -\link{summaryMap} for summary map configuration. -} diff --git a/man/panel_configuration-class.Rd b/man/panel_configuration-class.Rd index e2ec050a..98d64769 100644 --- a/man/panel_configuration-class.Rd +++ b/man/panel_configuration-class.Rd @@ -15,52 +15,11 @@ slot is converted to these individual pane configurations. \section{Slots}{ \describe{ -\item{\code{panes_list}}{A list containing pane objects and sizes information. \cr\cr -For example, this panes_list format: \cr\cr -\preformatted{ - list(pane(id="pane1"), - pane(id="pane2"), - sizes = c(50, 50)) - } -will produce a layout like this: -\preformatted{ - | - pane1 | pane2 - | - } -This panes_list format: -\preformatted{ - list(pane(id="pane1"), - list(pane(id="pane2"), - pane(id="pane3"), - sizes = c(50, 50)), - sizes = c(100)) - } -will produce a layout like this: -\preformatted{ - | pane2 - pane1 | ------- - | pane3 - }} +\item{\code{panes_list}}{A list containing pane objects and sizes information.} -\item{\code{pane_types}}{A named list mapping pane IDs to their configurations. -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( - pane1 = detailMap(id = "pane1"), - pane2 = summaryMap(id = "pane2") - ) - } -For example, a three-pane layout with a detail map, a summary map, and a plugin pane: -\preformatted{ - pane_types = list( - pane1 = detailMap(id = "pane1"), - pane2 = summaryMap(id = "pane2"), - pane3 = pluginPane(id = "pane3", - pluginName = "2D ScatterPlot: UMAP (column)") - ) - }} +\item{\code{pane_types}}{A named list mapping pane IDs to their configurations.} + +\item{\code{selections}}{A list of lists of row and column labels.} }} \seealso{ diff --git a/man/panel_configuration.Rd b/man/panel_configuration.Rd index 0e0b7de9..587f96b9 100644 --- a/man/panel_configuration.Rd +++ b/man/panel_configuration.Rd @@ -2,30 +2,87 @@ % Please edit documentation in R/panelClasses.R \name{panel_configuration} \alias{panel_configuration} -\title{Create a panel configuration} +\title{Constructor for panel_configuration} \usage{ -panel_configuration(panes_list, pane_types) +panel_configuration( + panes_list, + pane_types, + selections = list(row = list(), col = list()) +) } \arguments{ -\item{panes_list}{A list containing pane objects and sizes information. -See \code{\link{panel_configuration-class}} for format details.} +\item{panes_list}{A list containing pane objects and sizes information, where sizes is expressed as a percentage. +For example, this panes_list format: \cr\cr +\preformatted{ + list(pane(id="pane1"), + pane(id="pane2"), + sizes = c(40, 60)) + } +will produce a layout like the one below, where \code{pane1} accounts for 40\% of the horizontal space +and \code{pane2} accounts for 60\% of the horizontal space: +\preformatted{ + | + pane1 | pane2 + | + } +This panes_list format: +\preformatted{ + list(pane(id="pane1"), + list(pane(id="pane2"), + pane(id="pane3"), + sizes = c(30, 70)), # for pane2, pane3 + sizes = c(50, 50)) # for pane1 & container of pane2, pane3 + } +will produce a layout like the one below, where \code{pane2} accounts for 30\% of +the vertical space and \code{pane3} accounts for 70\% of the vertical space: +\preformatted{ + | pane2 + pane1 | ------- + | pane3 + }} \item{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( + pane1 = detailMap(id = "pane1"), + pane2 = summaryMap(id = "pane2") + ) + } +For example, a three-pane layout with a detail map, a summary map, and a plugin pane: +\preformatted{ + pane_types = list( + pane1 = detailMap(id = "pane1"), + pane2 = summaryMap(id = "pane2"), + pane3 = pluginPane(id = "pane3", + pluginName = "2D ScatterPlot: UMAP (column)") + ) + }} + +\item{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")) + }} } \value{ A new \code{panel_configuration} object } \description{ Creates a new panel configuration object that combines pane layout information -with individual pane configurations. +with individual pane specifications. } \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") pane3 <- pane(id = "pane3") -panes_list <- list(pane1, list(pane2, pane3, sizes = c(30, 70)), sizes = c(100)) +panes_list <- list(pane1, list(pane2, pane3, sizes = c(30, 70)), sizes = c(50, 50)) # Create pane configuration for each pane pane_types <- list( @@ -34,8 +91,13 @@ pane_types <- list( pane3 = pluginPane(id = "pane3", pluginName = "2D ScatterPlot: UMAP (column)") ) +# Select the 1st and 4th rows and 2nd and 5th columns: +selections <- list(row = c("r1", "r4"), col = c("c2", "c5")) + # Create panel configuration -config <- panel_configuration(panes_list, pane_types) +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{ @@ -44,5 +106,6 @@ config <- panel_configuration(panes_list, pane_types) \item \link{pane} for creating pane objects \item \link{detailMap} for detail map configuration \item \link{summaryMap} for summary map configuration +\item \link{pluginPane} for plugin pane configuration } } diff --git a/tests/testthat/test-selections.R b/tests/testthat/test-selections.R new file mode 100644 index 00000000..892ea3d7 --- /dev/null +++ b/tests/testthat/test-selections.R @@ -0,0 +1,55 @@ +test_that("Testing function convertPanelSelectionsFromLabelToIndex", { + ## Testing that the selections made via row and column labels + ## are converted to indices in the chm object. + ## + ## There are three entities to test: + ## 1. hclust + ## 2. dendrogram + ## 3. label + matrix_data <- matrix(c(5, 2, 4, 4, 5, 6, 7, 8, 9, 10, 11, 12), + nrow = 4, ncol = 3, + dimnames = list(c("row1", "row2", "row3", "row4"), c("col1", "col2", "col3")) + ) + + # 1. `hclust` test: cluster rows and create `hclust` object to send to chmNew + distRows <- stats::dist(matrix_data, method = "euclidean") + hclustRows <- stats::hclust(distRows, method = "complete") + + # 2. `dendrogram` test: cluster columns and `dendrogram` object to send to chmNew + distCols <- stats::dist(t(matrix_data), method = "euclidean") + ddgColumns <- stats::as.dendrogram(stats::hclust(distCols, method = "complete")) + + # Create panels in order to specify selections + panes_list <- list(pane(id = "pane1"), pane(id = "pane2"), sizes = 50, 50) + pane_types <- list( + pane1 = detailMap(id = "pane1"), + pane2 = summaryMap(id = "pane2") + ) + selections <- list(row = list("row2", "row3"), col = list("col1", "col2")) + panel_config <- panel_configuration(panes_list, pane_types, selections = selections) + + # Initialize the chm object + chm <- chmNew("test", matrix_data, + panel_configuration = panel_config, + rowOrder = hclustRows, + colOrder = ddgColumns + ) + + # Calling `chmMake` to call `convertPanelSelectionsFromLabelToIndex()`, which converts + # the selections made via row and column labels to indices in the chm object. + chm <- chmMake(chm) + + # This clustering is deterministic, so we can check the indices: + expect_equal(list(4, 1), chm@panel_configuration@selections$row) + expect_equal(list(2, 3), chm@panel_configuration@selections$col) + + # 3. `label` test: use don't do any clustering + chm <- chmNew("test", matrix_data, + panel_configuration = panel_config, + rowOrder = rownames(matrix_data), + colOrder = colnames(matrix_data) + ) + chm <- chmMake(chm) + expect_equal(list(2, 3), chm@panel_configuration@selections$row) + expect_equal(list(1, 2), chm@panel_configuration@selections$col) +})