Refactor header formatting in tbl_format_header to enhance covariate label alignment and improve overall output presentation.

Author: stemangiola

R/pillar_utlis.R

@@ -19,6 +19,7 @@ pillar___strwrap2 <- function (x, width, indent, strip.spaces = TRUE)
 
 pillar___wrap <- function (..., indent=0, prefix="", width, strip.spaces = TRUE)
 {
+  
   x <- paste0(..., collapse="")
   wrapped <- pillar___strwrap2(x, width - get_extent(prefix), indent, strip.spaces = strip.spaces)
   wrapped <- paste0(prefix, wrapped)

R/print_methods.R

@@ -269,7 +269,9 @@ but they do not completely overlap.")
         add_attr(names(col_), "covariate_names") |> 
 
         add_attr(
-          colnames(out_sub),
+          # Get the actual column names that will be printed on screen
+          # This uses tibble's internal method to determine visible columns
+          pillar::tbl_format_setup(out_sub, width = getOption("width", 80) + 4)$body[1] |> as.character(),
           "printed_colnames"
         ) %>%
         add_attr(
@@ -284,6 +286,7 @@ but they do not completely overlap.")
       invisible(x)
     }
 
+    
     print_tidyprint_1(x, ...)
     invisible(x)
 

R/tidyprint_1_utlis.R

@@ -155,35 +155,44 @@ tbl_format_header.SE_print_abstraction <- function(x, setup, ...) {
   number_of_total_rows = (x |> attr("number_of_features")) * (x |> attr("number_of_samples"))
 
   printed_colnames <- x |> attr("printed_colnames")
-
-  # Identify covariate columns: those from colData
-  # Assume covariate columns are after .sample, .feature, .count, and assay columns
-  # We'll use heuristics: find the first and last covariate column positions
 
-  # .feature and .samples SHOULD BE A GLOBAL VARIABLE CREATED ONES
-  # SO IT CAN BE CHANGED ACROSS THE PACKAGE
-  # THIS BREAKS IF I HAVE ROWDATA
-  covariate_candidates <- setdiff(printed_colnames, c(".sample", ".feature", "|", assay_names))
-  # Remove gene/rowData columns if possible (e.g., chromosome, gene_feature, ...)
-  # For now, just use all columns after .count and before gene_feature as covariates
-  first_covariate <- which(printed_colnames %in% covariate_candidates)[1]
-  last_covariate <- which(printed_colnames %in% covariate_candidates) |> tail(1)
-  last_covariate <- if (length(last_covariate) > 0) max(last_covariate) else NA
-
-  # Only add header if there are covariate columns
-  covariate_header <- NULL
+  # Find the positions of all '|' characters in the string
+  pipe_positions <- stringr::str_locate_all(printed_colnames, "\\|")[[1]][, "start"]
 
-  if (!is.na(first_covariate) && !is.na(last_covariate) && last_covariate >= first_covariate) {
-    covariate_header <- format_covariate_header(
-      separator_row = separator_row,
-      printed_colnames = printed_colnames,
-      covariate_names = covariate_names,
-      number_of_total_rows = number_of_total_rows,
-      label = " COVARIATES "
-    )
-    covariate_header <- cli::col_br_blue(covariate_header)
+  # Calculate character length to the start of the second '|'
+  chars_to_second_pipe <- pipe_positions[2] - 2
+  
+  # Check if there's a third pipe
+  if (length(pipe_positions) >= 3) {
+    # Calculate character length between second and third pipe
+    chars_to_third_pipe <- pipe_positions[3] - pipe_positions[2] - 2
+  } else {
+    # Calculate character length to the end of the line
+    chars_to_third_pipe <- nchar(printed_colnames) - pipe_positions[2]
   }
 
+  label = " COVARIATES "
+  label_length <- nchar(label)
+
+  # Center the label in the total covariate width, using only dashes and the label
+  left_pad <- floor((chars_to_third_pipe - label_length) / 2)
+  right_pad <- chars_to_third_pipe - label_length - left_pad
+  merged_label <- paste0(
+    paste(rep("-", left_pad), collapse = ""),
+    label,
+    paste(rep("-", right_pad), collapse = "")
+  )
+  
+  # Add '|' at the beginning and end
+  merged_label <- paste0("|", merged_label, "|")
+  
+  # Pad with the spaces until chars to second pipe
+  merged_label <- c(paste(rep(" ", chars_to_second_pipe), collapse = ""), merged_label) |> 
+    paste0(collapse = "")
+
+  covariate_header <- cli::col_br_blue(merged_label)
+
+
   # Compose the main header as before
   if (all(names2(named_header) == "")) {
     header <- named_header

R/tidyse_utils.R

@@ -4,43 +4,6 @@
 #' @importFrom dplyr full_join
 # This file is a replacement of the unexported functions in the tibble
 # package, in order to specify "tibble abstraction in the header"
-
-#' @importFrom rlang names2
-#' @importFrom pillar align
-#' @importFrom pillar get_extent
-#' @importFrom pillar style_subtle
-#' @importFrom pillar tbl_format_header
-#' @importFrom cli col_br_black
-#' @importFrom tibble as_tibble
-#' @export
-tbl_format_header.tidySummarizedExperiment <- function(x, setup, ...) {
-
-  number_of_features <- x |> attr("number_of_features")
-  number_of_samples <- x |> attr("number_of_samples")
-  named_header <- x |> attr("named_header")
-  assay_names <- x |> attr("assay_names")
-
-
-  if (all(names2(named_header) == "")) {
-    header <- named_header
-  } else {
-    header <-
-      paste0(
-        align(paste0(names2(named_header), ":"), space=NBSP),
-        " ",
-        named_header
-      ) %>%
-      # Add further info single-cell
-      append( cli::col_br_black( sprintf(
-        " Features=%s | Samples=%s | Assays=%s",
-        number_of_features,
-        number_of_samples,
-        assay_names %>% paste(collapse=", ")
-      )), after = 1)
-  }
-  style_subtle(pillar___format_comment(header, width=setup$width))
-}
-
 check_if_assays_are_NOT_overlapped <- function(se, dim = "cols") {
 
   stopifnot(dim %in% c("rows", "cols"))