Heatmap GFC export & PNG companions, notebook rendering, LLM model listing, Docker 1.98

.gitignore

@@ -14,4 +14,7 @@ github-job-*.html
 job-*-logs.zip
 job-*-logs/
 tests/testthat/Rplots.pdf
+Rplots.pdf
 docker/project_data/*.rds
+realdata-output/
+realdata-reference/

DESCRIPTION

@@ -55,7 +55,7 @@ Imports: Cairo (>= 1.5-12.2), circlize, clusterProfiler (>= 3.18.1),
         1.6.2), stringr (>= 1.5.1), SummarizedExperiment, tibble (>=
         3.1.2), tidyselect (>= 1.1.1)
 Suggests: BiocStyle, CALIBERrfimpute, decoupleR, dorothea, ellmer,
-        ExperimentHub, emmeans, ggh4x, graphlayouts, GSVA, htmlwidgets,
+        ExperimentHub, emmeans, ggh4x, ggrepel, graphlayouts, GSVA, htmlwidgets,
         knitr (>= 1.33), lme4, limma, mice, networkD3 (>= 0.4),
         nlme, progeny, RANN, RCy3 (>= 2.10.2), RcppAnnoy, rmarkdown,
         testthat (>= 3.0.0), umap, uwot, withr

NAMESPACE

@@ -34,6 +34,7 @@ export(hc_init_save_folder)
 export(hc_integration)
 export(hc_layer_results)
 export(hc_list_celltype_databases)
+export(hc_list_llm_models)
 export(hc_longitudinal_endotype_clustering)
 export(hc_longitudinal_meta_clustering)
 export(hc_longitudinal_module_cap)
@@ -55,6 +56,7 @@ export(hc_pca)
 export(hc_pca_algo_compare)
 export(hc_plot_celltype_annotation_matrix)
 export(hc_plot_cluster_heatmap)
+export(hc_plot_cluster_heatmap_view)
 export(hc_plot_cutoffs)
 export(hc_plot_deg_dist)
 export(hc_plot_enrichment_panels)

NEWS.md

@@ -7,6 +7,19 @@
   gap size control.
 - Switched functional-enrichment defaults to consistent term selection across
   modules and wrappers.
+- Added optional DoRAG retrieval support to `hc_module_function_llm()` so LLM
+  module summaries can be grounded in retrieved passages and stored citations.
+- Added `compare_interpretation_levels = TRUE` for side-by-side LLM
+  interpretations without biological context, with context, and with DoRAG.
+- Added `rag_connect_timeout_sec` and `rag_continue_on_error` to make DoRAG
+  retrieval robust to unreachable or slow RAG servers.
+- Extended `hc_plot_module_function_llm()` to plot RAG comparison fields such
+  as `contextual_state_rag`.
+- Added common RNA-seq differential-expression packages to the Docker image,
+  including `DESeq2`, `limma`, `sva`, `edgeR`, and supporting visualization,
+  shrinkage, import, and organism annotation packages.
+- Allowed `hc_split_modules()` to use one Leiden `resolution` value per
+  selected module.
 - Clarified that `hc_read_data()` now removes zero-variance genes and drops
   non-numeric helper columns from object-based count inputs, which can shift
   `hc_suggest_topvar()` inflection points slightly compared with older

R/aaa_rng_helpers.R

@@ -2,7 +2,13 @@
 #' @noRd
 .hc_with_seed <- function(seed, expr) {
   expr <- substitute(expr)
-  seed <- .hc_as_integer_safely(seed[[1]])
+  # Guard against NULL / empty before indexing: `NULL[[1]]` and
+  # `integer(0)[[1]]` both error. A missing seed simply means "do not fix RNG".
+  seed <- if (is.null(seed) || length(seed) == 0L) {
+    NA_integer_
+  } else {
+    .hc_as_integer_safely(seed[[1]])
+  }
   if (length(seed) == 0L || is.na(seed)) {
     return(eval.parent(expr))
   }

R/hc_api.R

@@ -2049,14 +2049,19 @@ hc_unsplit_modules <- function(hc,
 
   panel_key_chr <- as.character(panel_key[[1]])
   title_drawn <- FALSE
+  is_combined_panel <- panel_key_chr %in% c("top_all_dbs", "top_all_dbs_mixed")
   slice_candidates <- if (identical(panel_key_chr, "top_all_dbs")) c(2L, 1L) else 1L
-  title_offset_mm <- max(4, 0.35 * as.numeric(fontsize))
+  title_offset_mm <- if (isTRUE(is_combined_panel)) {
+    max(8, 0.50 * as.numeric(fontsize))
+  } else {
+    max(4, 0.35 * as.numeric(fontsize))
+  }
   components <- try(ComplexHeatmap::list_components(), silent = TRUE)
   if (inherits(components, "try-error")) {
     components <- character(0)
   }
 
-  if (identical(panel_key_chr, "top_all_dbs") && length(components) > 0) {
+  if (isTRUE(is_combined_panel) && length(components) > 0) {
     body_pattern <- paste0("^", panel_target, "_heatmap_body_[0-9]+_[0-9]+$")
     body_components <- components[grepl(body_pattern, components)]
     if (length(body_components) >= 1) {
@@ -2960,6 +2965,11 @@ hc_plot_cluster_heatmap <- function(hc, file_name = "Heatmap_modules.pdf", ...)
   if (!inherits(hc, "HCoCenaExperiment")) {
     stop("`hc` must be a `HCoCenaExperiment`.")
   }
+  dot_args <- list(...)
+  if (!("module_label_numbering" %in% names(dot_args)) &&
+    .hc_module_label_map_has_split_labels(hc@integration@cluster[["module_label_map"]])) {
+    dot_args[["module_label_numbering"]] <- "preserve_existing"
+  }
 
   legacy_envo <- .hc_bridge_state_env()
   legacy_state <- .hc_bind_bridge_hcobject(
@@ -2972,7 +2982,7 @@ hc_plot_cluster_heatmap <- function(hc, file_name = "Heatmap_modules.pdf", ...)
   options(hcocena.suppress_legacy_warning = TRUE)
   on.exit(options(hcocena.suppress_legacy_warning = old_opt), add = TRUE)
 
-  base::do.call(.hc_plot_cluster_heatmap_driver, c(list(file_name = file_name), list(...)))
+  base::do.call(.hc_plot_cluster_heatmap_driver, c(list(file_name = file_name), dot_args))
   .hc_update_hc_from_cluster_plot(
     hc = hc,
     hcobject = base::get("hcobject", envir = legacy_envo, inherits = FALSE)

R/hc_display_helpers.R

@@ -1,5 +1,13 @@
 .hc_display_htmlwidget <- function(x) {
-  if (isTRUE(getOption("knitr.in.progress", FALSE)) &&
+  display_mode <- base::tolower(base::as.character(
+    getOption("hcocena.htmlwidget_display", "auto")
+  )[[1]])
+  if (!display_mode %in% c("auto", "inline", "viewer")) {
+    display_mode <- "auto"
+  }
+
+  if (!identical(display_mode, "viewer") &&
+      isTRUE(getOption("knitr.in.progress", FALSE)) &&
       requireNamespace("knitr", quietly = TRUE) &&
       isTRUE(knitr::is_html_output())) {
     rendered <- tryCatch(
@@ -16,7 +24,42 @@
     }
   }
 
-  utils::getFromNamespace("print.htmlwidget", "htmlwidgets")(x)
+  # Emit a raw text/html representation only for front-ends that consume HTML
+  # written to stdout (e.g. some Jupyter/IRkernel setups). This is strictly
+  # opt-in: RStudio notebooks and the console must NOT take this path, otherwise
+  # the widget is dumped as raw HTML text below the chunk instead of rendering.
+  emit_html <- identical(display_mode, "inline") ||
+    isTRUE(getOption("hcocena.htmlwidget_emit_html", FALSE))
+
+  if (isTRUE(emit_html) &&
+      requireNamespace("repr", quietly = TRUE)) {
+    displayed <- tryCatch(
+      {
+        html <- repr::repr_html(x)
+        if (base::is.character(html) &&
+            base::length(html) > 0 &&
+            base::any(base::nzchar(html))) {
+          base::cat(html, sep = "\n")
+          TRUE
+        } else {
+          FALSE
+        }
+      },
+      error = function(e) FALSE
+    )
+    if (isTRUE(displayed)) {
+      return(invisible(x))
+    }
+  }
+
+  # Default path. Dispatch through the `print` generic exactly like a bare
+  # `print(widget)` in a chunk would. RStudio's notebook execution renders
+  # widgets inline only when they go through the generic dispatch (this works
+  # even from inside a function); calling `print.htmlwidget` directly (e.g. via
+  # getFromNamespace) bypasses that hook, so the widget ends up in the Viewer
+  # pane instead of inline below the chunk. View defaults to interactive(), the
+  # same as a top-level `print(widget)`.
+  print(x)
   invisible(x)
 }
 
@@ -30,12 +73,23 @@
     return(base::invisible(x))
   }
 
+  if (inherits(x, "hc_llm_heatmap_plot")) {
+    print(x)
+    return(base::invisible(x))
+  }
+
   if (inherits(x, "gtable")) {
     grid::grid.newpage()
     grid::grid.draw(x)
     return(base::invisible(x))
   }
 
+  if (inherits(x, "grob")) {
+    grid::grid.newpage()
+    grid::grid.draw(x)
+    return(base::invisible(x))
+  }
+
   if (base::is.list(x) && !base::is.null(x$gtable) && inherits(x$gtable, "gtable")) {
     grid::grid.newpage()
     grid::grid.draw(x$gtable)

R/hc_functional_enrichment.R

@@ -1130,17 +1130,40 @@ functional_enrichment <- function(gene_sets = "Hallmark",
       )
     )
   }
+  module_label_fit <- .hc_module_label_fit_pt(
+    module_label_pt_size = module_label_pt_size,
+    module_box_width_cm = module_box_width_cm,
+    module_labels_display = if (heatmap_module_label_mode == "same") module_labels else NULL,
+    n_heat_rows = n_hc_rows,
+    cell_size_mm = hc_cell_mm,
+    module_label_fontsize = label_fontsize,
+    use_fontsize_request = !base::is.null(heatmap_module_label_fontsize),
+    fontface = "bold"
+  )
+  module_label_pt_size_unit <- if (heatmap_module_label_mode == "same" &&
+    base::length(module_labels) > 0 &&
+    base::length(module_label_fit$pt_size) == base::length(module_labels)) {
+    grid::unit(module_label_fit$pt_size, "pt")
+  } else {
+    grid::unit(module_label_pt_size, "snpc")
+  }
+  module_label_fontsize_draw <- .hc_module_label_effective_fontsize(
+    module_label_fit = module_label_fit,
+    fallback_fontsize = label_fontsize,
+    fallback_pt_size = module_label_pt_size
+  )
 
   module_color_map <- stats::setNames(cluster_order, cluster_order)
   shared_heatmap_line_lwd <- 0.5
-  module_box_anno <- ComplexHeatmap::anno_simple(
-    cluster_order,
-    col = module_color_map,
-    pch = if (heatmap_module_label_mode == "same") module_labels else NULL,
-    pt_gp = grid::gpar(col = "white", fontsize = label_fontsize, fontface = "bold"),
-    pt_size = grid::unit(module_label_pt_size, "snpc"),
-    simple_anno_size = grid::unit(module_box_width_cm, "cm"),
-    gp = grid::gpar(col = "black", lwd = shared_heatmap_line_lwd),
+  module_box_anno <- .hc_module_label_box_annotation(
+    values = cluster_order,
+    colors = module_color_map,
+    labels = if (heatmap_module_label_mode == "same") module_labels else NULL,
+    label_color = "white",
+    label_fontsize_pt = module_label_fit$base_pt_size,
+    fontface = "bold",
+    width_cm = module_box_width_cm,
+    border_gp = grid::gpar(col = "black", lwd = shared_heatmap_line_lwd),
     which = "row"
   )
 
@@ -1806,12 +1829,19 @@ functional_enrichment <- function(gene_sets = "Hallmark",
         "mm",
         valueOnly = TRUE
       )
+      panel_title_default_offset_mm <- 2.8 * overall_plot_scale
+      panel_title_top_padding_mm <- base::max(
+        6 * overall_plot_scale,
+        panel_title_default_offset_mm +
+          (font_title * 25.4 / 72) +
+          (2.0 * overall_plot_scale)
+      )
       draw_padding_mm <- c(
-        8,
-        base::max(22, sig_legend_width_mm + 20),
-        6,
-        6
-      ) * overall_plot_scale
+        14 * overall_plot_scale,
+        6 * overall_plot_scale,
+        panel_title_top_padding_mm,
+        base::max(22, sig_legend_width_mm + 20) * overall_plot_scale
+      )
       draw_padding <- grid::unit(draw_padding_mm, "mm")
       draw_with_body_borders <- function(ht_obj,
                                          panel_title = NULL,
@@ -1870,13 +1900,13 @@ functional_enrichment <- function(gene_sets = "Hallmark",
         invisible(drawn_ht)
       }
       pdf_height <- base::max(
-        8.0,
+        8.8,
         base::min(
           24.0,
           (
             hc_body_h_mm +
               base::max(20, enrichment_colname_max_cm * 10) +
-              34
+              46
           ) / 25.4
         )
       )
@@ -2249,18 +2279,32 @@ functional_enrichment <- function(gene_sets = "Hallmark",
         "mm",
         valueOnly = TRUE
       )
+      panel_title_default_offset_mm_all <- 2.8 * overall_plot_scale
+      db_header_height_mm_all <- db_header_fontsize * 25.4 / 72
+      panel_title_height_mm_all <- font_title * 25.4 / 72
+      panel_title_header_offset_mm_all <- base::max(
+        panel_title_default_offset_mm_all,
+        db_header_height_mm_all + (4.2 * overall_plot_scale)
+      )
+      panel_title_top_padding_mm_all <- base::max(
+        6 * overall_plot_scale,
+        panel_title_header_offset_mm_all +
+          panel_title_height_mm_all +
+          (2.0 * overall_plot_scale)
+      )
       draw_padding_mm_all <- c(
-        8,
-        base::max(22, sig_legend_width_mm_all + 20),
-        6,
-        6
-      ) * overall_plot_scale
+        16 * overall_plot_scale,
+        6 * overall_plot_scale,
+        panel_title_top_padding_mm_all,
+        base::max(22, sig_legend_width_mm_all + 20) * overall_plot_scale
+      )
       draw_padding_all <- grid::unit(draw_padding_mm_all, "mm")
       draw_with_body_borders_all <- function(ht_obj,
                                              panel_title = NULL,
                                              panel_title_target = "enrichment_all",
                                              panel_title_slice = 1L,
                                              panel_border_slices = NULL,
+                                             panel_title_offset_mm = panel_title_default_offset_mm_all,
                                              ...) {
         drawn_ht <- ComplexHeatmap::draw(
           ht_obj,
@@ -2331,12 +2375,16 @@ functional_enrichment <- function(gene_sets = "Hallmark",
           if (!base::is.finite(panel_title_slice) || panel_title_slice < 1) {
             panel_title_slice <- 1L
           }
+          panel_title_offset_mm <- .hc_first_numeric_value(panel_title_offset_mm)
+          if (!base::is.finite(panel_title_offset_mm) || panel_title_offset_mm <= 0) {
+            panel_title_offset_mm <- panel_title_default_offset_mm_all
+          }
           try(
             ComplexHeatmap::decorate_heatmap_body(panel_title_target, slice = panel_title_slice, {
               grid::grid.text(
                 label = panel_title,
                 x = grid::unit(0.5, "npc"),
-                y = grid::unit(1, "npc") + grid::unit(2.8 * overall_plot_scale, "mm"),
+                y = grid::unit(1, "npc") + grid::unit(panel_title_offset_mm, "mm"),
                 just = c("center", "bottom"),
                 gp = grid::gpar(fontsize = font_title, fontface = "bold")
               )
@@ -2348,13 +2396,13 @@ functional_enrichment <- function(gene_sets = "Hallmark",
       }
 
       pdf_height_all <- base::max(
-        8.2,
+        9.2,
         base::min(
           24.0,
           (
             hc_body_h_mm +
               base::max(20, enrichment_colname_max_cm_all * 10) +
-              36
+              54
           ) / 25.4
         )
       )
@@ -2398,6 +2446,7 @@ functional_enrichment <- function(gene_sets = "Hallmark",
             panel_title_target = "enrichment_all",
             panel_title_slice = all_db_title_slice,
             panel_border_slices = panel_border_slices_all,
+            panel_title_offset_mm = panel_title_header_offset_mm_all,
             padding = draw_padding_all
           )
         }
@@ -2408,6 +2457,7 @@ functional_enrichment <- function(gene_sets = "Hallmark",
         panel_title_target = "enrichment_all",
         panel_title_slice = all_db_title_slice,
         panel_border_slices = panel_border_slices_all,
+        panel_title_offset_mm = panel_title_header_offset_mm_all,
         padding = draw_padding_all
       )
 
@@ -2553,13 +2603,13 @@ functional_enrichment <- function(gene_sets = "Hallmark",
         enrichment_ht_all_mixed + hc_ht
       }
       pdf_height_all_mixed <- base::max(
-        8.2,
+        9.2,
         base::min(
           24.0,
           (
             hc_body_h_mm +
               base::max(20, enrichment_colname_max_cm_all_mixed * 10) +
-              36
+              54
           ) / 25.4
         )
       )