From d194680c93dccfe672492dd96203e524da578357 Mon Sep 17 00:00:00 2001 From: Stefano Mangiola Date: Fri, 27 Jun 2025 22:51:48 -0400 Subject: [PATCH 1/9] add header --- .gitignore | 1 + NAMESPACE | 4 +++ R/pillar_utlis.R | 14 +++++----- R/print_methods.R | 26 +++++++++--------- R/tidyprint_1_utlis.R | 56 +++++++++++++++++++++++++++++++++----- README.md | 58 +++++++++++----------------------------- vignettes/Introduction.R | 29 -------------------- 7 files changed, 89 insertions(+), 99 deletions(-) delete mode 100644 vignettes/Introduction.R diff --git a/.gitignore b/.gitignore index fe574a5..450fa4c 100644 --- a/.gitignore +++ b/.gitignore @@ -8,3 +8,4 @@ tidyprint.Rproj inst/doc /doc/ /Meta/ +.DS_Store diff --git a/NAMESPACE b/NAMESPACE index 673b2b4..80468f9 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -18,7 +18,9 @@ importFrom(SummarizedExperiment,colData) importFrom(SummarizedExperiment,rowData) importFrom(SummarizedExperiment,rowRanges) importFrom(cli,col_br_black) +importFrom(dplyr,if_else) importFrom(fansi,strwrap_ctl) +importFrom(magrittr,`%>%`) importFrom(methods,setMethod) importFrom(pillar,align) importFrom(pillar,ctl_new_pillar) @@ -33,12 +35,14 @@ importFrom(pillar,tbl_format_header) importFrom(pkgconfig,get_config) importFrom(purrr,map) importFrom(purrr,map2) +importFrom(purrr,map2_chr) importFrom(purrr,map_chr) importFrom(purrr,reduce) importFrom(purrr,when) importFrom(rlang,names2) importFrom(stats,setNames) importFrom(stringr,str_replace) +importFrom(stringr,str_replace_all) importFrom(tibble,as_tibble) importFrom(tibble,enframe) importFrom(tidyr,spread) diff --git a/R/pillar_utlis.R b/R/pillar_utlis.R index 214ff97..042c5ef 100644 --- a/R/pillar_utlis.R +++ b/R/pillar_utlis.R @@ -1,26 +1,26 @@ NBSP <- "\U00A0" -pillar___format_comment <- function (x, width) +pillar___format_comment <- function (x, width, strip.spaces = TRUE) { if (length(x) == 0L) { return(character()) } map_chr(x, pillar___wrap, prefix="# ", - width=min(width, cli::console_width())) + width=min(width, cli::console_width()), strip.spaces = strip.spaces) } #' @importFrom fansi strwrap_ctl -pillar___strwrap2 <- function (x, width, indent) +pillar___strwrap2 <- function (x, width, indent, strip.spaces = TRUE) { - fansi::strwrap_ctl(x, width=max(width, 0), indent=indent, - exdent=indent + 2) + fansi::strwrap2_ctl(x, width=max(width, 0), indent=indent, + exdent=indent + 2, strip.spaces = strip.spaces) } -pillar___wrap <- function (..., indent=0, prefix="", width) +pillar___wrap <- function (..., indent=0, prefix="", width, strip.spaces = TRUE) { x <- paste0(..., collapse="") - wrapped <- pillar___strwrap2(x, width - get_extent(prefix), indent) + wrapped <- pillar___strwrap2(x, width - get_extent(prefix), indent, strip.spaces = strip.spaces) wrapped <- paste0(prefix, wrapped) wrapped <- gsub(NBSP, " ", wrapped) paste0(wrapped, collapse="\n") diff --git a/R/print_methods.R b/R/print_methods.R index d56ec06..c6fb08d 100644 --- a/R/print_methods.R +++ b/R/print_methods.R @@ -8,6 +8,8 @@ #' @importFrom S4Vectors coolcat #' @importFrom purrr when map_chr #' @importFrom stringr str_replace +#' @importFrom magrittr `%>%` +#' @importFrom dplyr if_else #' @export print.SummarizedExperiment <- function(x, design = 1, n_print = 10, ...) { @@ -95,7 +97,7 @@ but they do not completely overlap.") ~ .[, 1:min(20, ncol(x)), drop=FALSE] ) %>% as_tibble() - # browser() + my_tibble |> vctrs::new_data_frame(class=c("tidySummarizedExperiment", "tbl")) %>% add_attr(nrow(x), "number_of_features") %>% @@ -219,8 +221,8 @@ but they do not completely overlap.") nn <- nc * nr out <- c( list( - .features = vctrs::vec_rep(.features, times = nc), - .samples = vctrs::vec_rep_each(.samples, times = nr) + .feature = vctrs::vec_rep(.features, times = nc), + .sample = vctrs::vec_rep_each(.samples, times = nr) ), list(`|` = sep_(nn)), assays_, @@ -240,8 +242,8 @@ but they do not completely overlap.") out_sub <- out[sub_seq, ] # Compute the max character width for each column - separator_row <- sapply(out_sub %>% colnames(), function(col) { - max_width <- max(nchar(as.character(col)), na.rm = TRUE) # Get max width in the column + separator_row <- map2_chr(out_sub, names(out_sub), ~ { + max_width <- max(nchar(as.character(.x)), na.rm = TRUE) |> max(nchar(.y)) # Get max width in the column paste(rep("-", max_width), collapse = "") # Generate a separator of the same length }) # Modify the entire tibble to include a separator row across all columns @@ -251,7 +253,6 @@ but they do not completely overlap.") out_sub[(top_n+1):nrow(out_sub), ] )) - # attr(out_sub, "n") <- n # attr(out_sub, "total_rows") <- x %>% dim %>% {(.)[1] * (.)[2]} @@ -264,14 +265,13 @@ but they do not completely overlap.") add_attr(nrow(x), "number_of_features") %>% add_attr(ncol(x), "number_of_samples") %>% add_attr(assays(x) %>% names, "assay_names") %>% + #add_attr(separator_row[!names(separator_row) %in% names(col_)] |> map_int(nchar) |> sum(), "length_non_covariate_columns") |> + add_attr(map2_chr(separator_row, names(separator_row), ~ if_else(.y %in% names(col_), " ", .x)), "separator_row_non_covariate_columns") |> + add_attr( + colnames(out_sub), + "printed_colnames" + ) %>% add_attr( - # sprintf( - # "%s %s %s", - # x %>% dim %>% {(.)[1] * (.)[2]} %>% - # format(format="f", big.mark=",", digits=1), - # cli::symbol$times, - # ncol(out_sub) - # ) %>% '' %>% setNames("A SummarizedExperiment-tibble abstraction"), "named_header" diff --git a/R/tidyprint_1_utlis.R b/R/tidyprint_1_utlis.R index 5d7b135..0a11402 100644 --- a/R/tidyprint_1_utlis.R +++ b/R/tidyprint_1_utlis.R @@ -1,4 +1,3 @@ - #' @importFrom pillar pillar_component #' @importFrom pillar new_pillar_shaft #' @importFrom pillar ctl_new_rowid_pillar @@ -82,15 +81,51 @@ ctl_new_pillar.SE_print_abstraction <- function(controller, x, width, ..., title #' @importFrom pillar tbl_format_header #' @importFrom cli col_br_black #' @importFrom tibble as_tibble +#' @importFrom stringr str_replace_all +#' @importFrom purrr map2_chr #' @export tbl_format_header.SE_print_abstraction <- 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") + separator_row_non_covariate_columns <- x |> attr("separator_row_non_covariate_columns") + + 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 + 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 + if (!is.na(first_covariate) && !is.na(last_covariate) && last_covariate >= first_covariate) { + # Build a header row with blanks except for the covariate span + header_row <- separator_row_non_covariate_columns |> str_replace_all("-", " ") #rep(" ", length(printed_colnames)) + span_length <- last_covariate - first_covariate + 1 + # Adapt label length + label <- paste0("-- COVARIATES ", paste(rep("-", max(0, span_length * 3 - 13)), collapse=""), "--") + # Abbreviate if too long + if (nchar(label) > span_length * 8) label <- "-- COVAR --" + header_row[first_covariate] <- paste0("| ", label) + header_row[last_covariate] <- paste0(header_row[last_covariate], "|") + header_row = paste(rep(" ", number_of_total_rows |> nchar() -2), collapse = "") |> c(header_row) + covariate_header <- paste(header_row, collapse=" ") + covariate_header <- cli::col_br_blue(covariate_header) + } - + # Compose the main header as before if (all(names2(named_header) == "")) { header <- named_header } else { @@ -101,14 +136,21 @@ tbl_format_header.SE_print_abstraction <- function(x, setup, ...) { named_header ) %>% # Add further info single-cell - append( cli::col_br_black( sprintf( - " Features=%s | Samples=%s | Assays=%s", + #append( + paste0( cli::col_br_black( sprintf( + "Features=%s | Samples=%s | Assays=%s", number_of_features, number_of_samples, assay_names %>% paste(collapse=", ") - )), after = 1) + ))) + # , after = 1) + } + # Add covariate header if present + if (!is.null(covariate_header)) { + header <- c(header, covariate_header) } - style_subtle(pillar___format_comment(header, width=setup$width)) + + style_subtle(pillar___format_comment(header, width=setup$width, strip.spaces = FALSE)) } # type_sum.sep <- function(x, ...) { diff --git a/README.md b/README.md index 144aaea..b5d86f2 100644 --- a/README.md +++ b/README.md @@ -104,21 +104,22 @@ plyxp/tidyverse style with tidySummarizedExperiment header: ``` r se_airway %>% print(design = "tidyprint_1") -#> # A SummarizedExperiment-tibble abstraction: +#> # A SummarizedExperiment-tibble abstraction: #> # Features=38694 | Samples=8 | Assays=counts -#> .features .samples | counts | | dex celltype geo_id -#> | | | -#> 1 ENSG00000000003 SRR1039508 | 723 | | control N61311 GSM1275862 -#> 2 ENSG00000000005 SRR1039508 | 0 | | control N61311 GSM1275862 -#> 3 ENSG00000000419 SRR1039508 | 467 | | control N61311 GSM1275862 -#> 4 ENSG00000000457 SRR1039508 | 347 | | control N61311 GSM1275862 -#> 5 ENSG00000000460 SRR1039508 | 96 | | control N61311 GSM1275862 -#> --------- -------- - ------ - - --- -------- ------ -#> 309548 ENSG00000283115 SRR1039521 | 0 | | treated N061011 GSM1275875 -#> 309549 ENSG00000283116 SRR1039521 | 0 | | treated N061011 GSM1275875 -#> 309550 ENSG00000283119 SRR1039521 | 0 | | treated N061011 GSM1275875 -#> 309551 ENSG00000283120 SRR1039521 | 0 | | treated N061011 GSM1275875 -#> 309552 ENSG00000283123 SRR1039521 | 0 | | treated N061011 GSM1275875 +#> # | -- COVARIATES -- | +#> .feature .sample `|` counts `|` `|` dex celltype geo_id +#> <|> <|> <|> +#> 1 ENSG00000000003 SRR1039508 | 723 | | control N61311 GSM1275862 +#> 2 ENSG00000000005 SRR1039508 | 0 | | control N61311 GSM1275862 +#> 3 ENSG00000000419 SRR1039508 | 467 | | control N61311 GSM1275862 +#> 4 ENSG00000000457 SRR1039508 | 347 | | control N61311 GSM1275862 +#> 5 ENSG00000000460 SRR1039508 | 96 | | control N61311 GSM1275862 +#> --------------- ---------- -- ------ -- -- ------- -------- ---------- +#> 309548 ENSG00000283115 SRR1039521 | 0 | | treated N061011 GSM1275875 +#> 309549 ENSG00000283116 SRR1039521 | 0 | | treated N061011 GSM1275875 +#> 309550 ENSG00000283119 SRR1039521 | 0 | | treated N061011 GSM1275875 +#> 309551 ENSG00000283120 SRR1039521 | 0 | | treated N061011 GSM1275875 +#> 309552 ENSG00000283123 SRR1039521 | 0 | | treated N061011 GSM1275875 ``` ### 2.4 **tidySummarizedExperiment** @@ -239,33 +240,4 @@ sessionInfo() #> [1] tidyprint_0.0.1 tidyr_1.3.1 dplyr_1.1.4 #> #> loaded via a namespace (and not attached): -#> [1] utf8_1.2.4 sass_0.4.9 -#> [3] generics_0.1.3 SparseArray_1.6.2 -#> [5] stringi_1.8.4 lattice_0.22-6 -#> [7] digest_0.6.37 magrittr_2.0.3 -#> [9] evaluate_1.0.3 grid_4.4.0 -#> [11] fastmap_1.2.0 rprojroot_2.0.4 -#> [13] jsonlite_1.9.1 Matrix_1.7-3 -#> [15] GenomeInfoDb_1.42.3 httr_1.4.7 -#> [17] fansi_1.0.6 purrr_1.0.4 -#> [19] UCSC.utils_1.2.0 jquerylib_0.1.4 -#> [21] abind_1.4-8 cli_3.6.4 -#> [23] rlang_1.1.5 crayon_1.5.3 -#> [25] XVector_0.46.0 Biobase_2.66.0 -#> [27] withr_3.0.2 cachem_1.1.0 -#> [29] DelayedArray_0.32.0 yaml_2.3.10 -#> [31] S4Arrays_1.6.0 tools_4.4.0 -#> [33] GenomeInfoDbData_1.2.13 SummarizedExperiment_1.36.0 -#> [35] BiocGenerics_0.52.0 vctrs_0.6.5 -#> [37] R6_2.6.1 matrixStats_1.5.0 -#> [39] stats4_4.4.0 lifecycle_1.0.4 -#> [41] stringr_1.5.1 zlibbioc_1.52.0 -#> [43] S4Vectors_0.44.0 IRanges_2.40.1 -#> [45] pkgconfig_2.0.3 pillar_1.10.1 -#> [47] bslib_0.9.0 glue_1.8.0 -#> [49] xfun_0.51 tibble_3.2.1 -#> [51] GenomicRanges_1.58.0 tidyselect_1.2.1 -#> [53] rstudioapi_0.17.1 MatrixGenerics_1.18.1 -#> [55] knitr_1.50 htmltools_0.5.8.1 -#> [57] rmarkdown_2.29 compiler_4.4.0 ``` diff --git a/vignettes/Introduction.R b/vignettes/Introduction.R deleted file mode 100644 index ed89b65..0000000 --- a/vignettes/Introduction.R +++ /dev/null @@ -1,29 +0,0 @@ -params <- -list(demo_metadata = TRUE) - -## ----include = FALSE---------------------------------------------------------- -knitr::opts_chunk$set( - collapse = TRUE, - comment = "#>" -) -root_dir <- knitr::opts_knit$get("root.dir") -if (!is.null(root_dir)){ - # This hack fixes the relative image paths. - # See https://github.com/rstudio/rmarkdown/issues/2473 - knitr::opts_knit$set( - output.dir = root_dir - ) -} -proj_root <- rprojroot::find_package_root_file() |> normalizePath() -# Utility function for figures to force them to have the correct path -find_figure <- function(names){ - rprojroot::find_package_root_file() |> - file.path("man", "figures", names) -} - -## ----eval=FALSE--------------------------------------------------------------- -# install.packages("devtools") - -## ----eval=FALSE--------------------------------------------------------------- -# devtools::install_github("tidyomics/tidyprint") - From 9cb0718331e2576f6721cab1c9e20123dd2c8549 Mon Sep 17 00:00:00 2001 From: Stefano Mangiola Date: Sat, 28 Jun 2025 15:30:16 -0400 Subject: [PATCH 2/9] imperfect placement of the covariate label --- R/print_methods.R | 9 +++++---- R/tidyprint_1_utlis.R | 20 +++++++++++++++++--- 2 files changed, 22 insertions(+), 7 deletions(-) diff --git a/R/print_methods.R b/R/print_methods.R index c6fb08d..13c02ba 100644 --- a/R/print_methods.R +++ b/R/print_methods.R @@ -227,9 +227,9 @@ but they do not completely overlap.") list(`|` = sep_(nn)), assays_, list(`|` = sep_(nn)), - row_, + col_, list(`|` = sep_(nn)), - col_ + row_ ) attr(out, "row.names") <- c(NA_integer_, -nn) class(out) <- c("SE_abstraction", "tbl_df", "tbl", "data.frame") @@ -265,8 +265,9 @@ but they do not completely overlap.") add_attr(nrow(x), "number_of_features") %>% add_attr(ncol(x), "number_of_samples") %>% add_attr(assays(x) %>% names, "assay_names") %>% - #add_attr(separator_row[!names(separator_row) %in% names(col_)] |> map_int(nchar) |> sum(), "length_non_covariate_columns") |> - add_attr(map2_chr(separator_row, names(separator_row), ~ if_else(.y %in% names(col_), " ", .x)), "separator_row_non_covariate_columns") |> + add_attr(separator_row, "separator_row") |> + add_attr(names(col_), "covariate_names") |> + add_attr( colnames(out_sub), "printed_colnames" diff --git a/R/tidyprint_1_utlis.R b/R/tidyprint_1_utlis.R index 0a11402..3eb0ad7 100644 --- a/R/tidyprint_1_utlis.R +++ b/R/tidyprint_1_utlis.R @@ -89,8 +89,9 @@ tbl_format_header.SE_print_abstraction <- function(x, setup, ...) { number_of_samples <- x |> attr("number_of_samples") named_header <- x |> attr("named_header") assay_names <- x |> attr("assay_names") - separator_row_non_covariate_columns <- x |> attr("separator_row_non_covariate_columns") - + separator_row <- x |> attr("separator_row") + covariate_names <- x |> attr("covariate_names") + number_of_total_rows = (x |> attr("number_of_features")) * (x |> attr("number_of_samples")) printed_colnames <- x |> attr("printed_colnames") @@ -101,9 +102,11 @@ tbl_format_header.SE_print_abstraction <- function(x, setup, ...) { # .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 + all_printed_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 @@ -112,14 +115,25 @@ tbl_format_header.SE_print_abstraction <- function(x, setup, ...) { covariate_header <- NULL if (!is.na(first_covariate) && !is.na(last_covariate) && last_covariate >= first_covariate) { # Build a header row with blanks except for the covariate span - header_row <- separator_row_non_covariate_columns |> str_replace_all("-", " ") #rep(" ", length(printed_colnames)) + header_row <- + map2_chr(separator_row, names(separator_row), ~ if_else(.y %in% covariate_names, " ", .x)) |> + str_replace_all("-", " ") + + span_length <- last_covariate - first_covariate + 1 # Adapt label length label <- paste0("-- COVARIATES ", paste(rep("-", max(0, span_length * 3 - 13)), collapse=""), "--") # Abbreviate if too long if (nchar(label) > span_length * 8) label <- "-- COVAR --" + + difference_spacing = separator_row[names(separator_row) %in% covariate_names & names(separator_row) %in% printed_colnames] |> map_int(nchar) |> sum() - nchar(label) + header_row[first_covariate] <- paste0("| ", label) header_row[last_covariate] <- paste0(header_row[last_covariate], "|") + + # Spacer + if(last_covariate > (first_covariate+1)) header_row[first_covariate +1] = rep("-", difference_spacing) |> paste(collapse = "") + header_row = paste(rep(" ", number_of_total_rows |> nchar() -2), collapse = "") |> c(header_row) covariate_header <- paste(header_row, collapse=" ") covariate_header <- cli::col_br_blue(covariate_header) From cdf094ee80a34d4942705a3cb3feaf7de7b8ff2c Mon Sep 17 00:00:00 2001 From: Stefano Mangiola Date: Sat, 28 Jun 2025 17:15:17 -0400 Subject: [PATCH 3/9] more scalable COVRIATE header --- R/tidyprint_1_utlis.R | 96 ++++++++++++---- test_header_formatting.R | 139 ++++++++++++++++++++++++ tests/testthat/test-header-formatting.R | 60 ++++++++++ 3 files changed, 272 insertions(+), 23 deletions(-) create mode 100644 test_header_formatting.R create mode 100644 tests/testthat/test-header-formatting.R diff --git a/R/tidyprint_1_utlis.R b/R/tidyprint_1_utlis.R index 3eb0ad7..ba74e70 100644 --- a/R/tidyprint_1_utlis.R +++ b/R/tidyprint_1_utlis.R @@ -2,6 +2,19 @@ #' @importFrom pillar new_pillar_shaft #' @importFrom pillar ctl_new_rowid_pillar #' @importFrom pillar new_pillar +#' @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 +#' @importFrom stringr str_replace_all +#' @importFrom purrr map2_chr +#' @importFrom purrr map_int +#' @importFrom dplyr if_else +#' @importFrom pillar pillar___format_comment +#' @importFrom pillar NBSP #' @export ctl_new_rowid_pillar.SE_print_abstraction <- function(controller, x, width, ...) { # message('attrx =', x %>% attributes()) @@ -52,6 +65,7 @@ ctl_new_rowid_pillar.SE_print_abstraction <- function(controller, x, width, ...) } +<<<<<<< HEAD #' @importFrom pillar pillar ctl_new_pillar #' @export @@ -83,6 +97,58 @@ ctl_new_pillar.SE_print_abstraction <- function(controller, x, width, ..., title #' @importFrom tibble as_tibble #' @importFrom stringr str_replace_all #' @importFrom purrr map2_chr +======= +#' Format covariate header by distributing label across covariate columns +#' @param separator_row The separator row with column widths +#' @param printed_colnames The printed column names +#' @param covariate_names The names of covariate columns +#' @param number_of_total_rows The total number of rows for spacing +#' @param label The label to distribute (default: "COVARIATES") +#' @return Formatted header string +#' @export +format_covariate_header <- function(separator_row, printed_colnames, covariate_names, number_of_total_rows, label = "COVARIATES") { + header_row <- + map2_chr(separator_row, names(separator_row), ~ if_else(.y %in% covariate_names, .x, .x |> str_replace_all("-", " "))) + + covariate_indices <- which(printed_colnames %in% covariate_names) + covariate_widths <- separator_row[printed_colnames[covariate_indices]] |> purrr::map_int(nchar) + total_covariate_width <- sum(covariate_widths) + + # Build a string of dashes for all covariate columns + dash_string <- paste(rep("-", total_covariate_width), collapse = "") + + # Overlay the label onto the dash string, centered + label_start <- floor((total_covariate_width - nchar(label)) / 2) + 1 + label_end <- label_start + nchar(label) - 1 + chars <- strsplit(dash_string, "")[[1]] + label_chars <- strsplit(label, "")[[1]] + if (label_start > 0 && label_end <= total_covariate_width) { + chars[label_start:label_end] <- label_chars + } else { + # If label is too long, truncate + chars[1:length(label_chars)] <- label_chars + } + overlayed <- paste(chars, collapse = "") + + # Split overlayed string back into covariate column widths + split_labels <- character(length(covariate_widths)) + pos <- 1 + for (i in seq_along(covariate_widths)) { + split_labels[i] <- substr(overlayed, pos, pos + covariate_widths[i] - 1) + pos <- pos + covariate_widths[i] + } + + # Place split_labels into the header_row at covariate_indices + for (i in seq_along(covariate_indices)) { + header_row[covariate_indices[i]] <- split_labels[i] + } + + # Add row ID spacing at the beginning + header_row <- c(paste(rep(" ", number_of_total_rows |> nchar() - 2), collapse = ""), header_row) + paste(header_row, collapse = " ") +} + +>>>>>>> 4b7ac46 (more scalable COVRIATE header) #' @export tbl_format_header.SE_print_abstraction <- function(x, setup, ...) { number_of_features <- x |> attr("number_of_features") @@ -106,7 +172,6 @@ tbl_format_header.SE_print_abstraction <- function(x, setup, ...) { 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 - all_printed_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 @@ -114,28 +179,13 @@ tbl_format_header.SE_print_abstraction <- function(x, setup, ...) { # Only add header if there are covariate columns covariate_header <- NULL if (!is.na(first_covariate) && !is.na(last_covariate) && last_covariate >= first_covariate) { - # Build a header row with blanks except for the covariate span - header_row <- - map2_chr(separator_row, names(separator_row), ~ if_else(.y %in% covariate_names, " ", .x)) |> - str_replace_all("-", " ") - - - span_length <- last_covariate - first_covariate + 1 - # Adapt label length - label <- paste0("-- COVARIATES ", paste(rep("-", max(0, span_length * 3 - 13)), collapse=""), "--") - # Abbreviate if too long - if (nchar(label) > span_length * 8) label <- "-- COVAR --" - - difference_spacing = separator_row[names(separator_row) %in% covariate_names & names(separator_row) %in% printed_colnames] |> map_int(nchar) |> sum() - nchar(label) - - header_row[first_covariate] <- paste0("| ", label) - header_row[last_covariate] <- paste0(header_row[last_covariate], "|") - - # Spacer - if(last_covariate > (first_covariate+1)) header_row[first_covariate +1] = rep("-", difference_spacing) |> paste(collapse = "") - - header_row = paste(rep(" ", number_of_total_rows |> nchar() -2), collapse = "") |> c(header_row) - covariate_header <- paste(header_row, collapse=" ") + 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) } diff --git a/test_header_formatting.R b/test_header_formatting.R new file mode 100644 index 0000000..d8af51d --- /dev/null +++ b/test_header_formatting.R @@ -0,0 +1,139 @@ +# Test script for header formatting function +# Load required packages +library(purrr) +library(stringr) +library(dplyr) + +# Source the function directly +source("R/tidyprint_1_utlis.R") + +# Mock data based on user's example +separator_row <- c( + ".feature" = " ", + ".sample" = " ", + "|" = " ", + "counts" = " ", + "|" = " ", + "dex" = "-------", + "celltype" = "--------", + "geo_id" = "----------", + "sample_id" = "----------", + "sample_id2" = "----------", + "|" = " ", + "gene_name" = " " +) + +printed_colnames <- c( + ".feature", ".sample", "|", "counts", "|", + "dex", "celltype", "geo_id", "sample_id", "sample_id2", + "|", "gene_name" +) + +covariate_names <- c("dex", "celltype", "geo_id", "sample_id", "sample_id2") +number_of_total_rows <- 1000 + +# Test the function +cat("=== Testing format_covariate_header function ===\n\n") + +cat("Input data:\n") +cat("separator_row names:", names(separator_row), "\n") +cat("printed_colnames:", printed_colnames, "\n") +cat("covariate_names:", covariate_names, "\n") +cat("number_of_total_rows:", number_of_total_rows, "\n\n") + +# Get covariate indices +covariate_indices <- which(printed_colnames %in% covariate_names) +cat("Covariate indices:", covariate_indices, "\n") + +# Get covariate widths +covariate_widths <- separator_row[printed_colnames[covariate_indices]] |> purrr::map_int(nchar) +cat("Covariate widths:", covariate_widths, "\n") +cat("Total covariate width:", sum(covariate_widths), "\n\n") + +# Test the function +result <- 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" +) + +cat("=== Result ===\n") +cat("Formatted header:\n") +cat(result, "\n\n") + +# Let's also test with a shorter label +cat("=== Testing with shorter label 'COVAR' ===\n") +result2 <- format_covariate_header( + separator_row = separator_row, + printed_colnames = printed_colnames, + covariate_names = covariate_names, + number_of_total_rows = number_of_total_rows, + label = "COVAR" +) + +cat("Formatted header with 'COVAR':\n") +cat(result2, "\n\n") + +# Let's also test with a longer label +cat("=== Testing with longer label 'COVARIATES_LONG' ===\n") +result3 <- 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_LONG" +) + +cat("Formatted header with 'COVARIATES_LONG':\n") +cat(result3, "\n\n") + +# Debug: Let's see what happens step by step +cat("=== Debug: Step by step analysis ===\n") + +# Build header row +header_row <- purrr::map2_chr(separator_row, names(separator_row), + ~ if(.y %in% covariate_names) .x else stringr::str_replace_all(.x, "-", " ")) + +cat("Initial header_row:\n") +for(i in seq_along(header_row)) { + cat(sprintf("%2d: '%s' (width: %d)\n", i, header_row[i], nchar(header_row[i]))) +} + +# Calculate character distribution +label <- "COVARIATES" +label_chars <- strsplit(label, "")[[1]] +total_label_chars <- length(label_chars) +total_covariate_width <- sum(covariate_widths) + +cat("\nLabel analysis:\n") +cat("Label:", label, "\n") +cat("Label characters:", paste(label_chars, collapse=", "), "\n") +cat("Total label chars:", total_label_chars, "\n") + +# Calculate distribution +char_distribution <- numeric(length(covariate_widths)) +remaining_chars <- total_label_chars + +for (i in seq_along(covariate_widths)) { + if (remaining_chars > 0) { + if (i == length(covariate_widths)) { + char_distribution[i] <- remaining_chars + } else { + prop <- covariate_widths[i] / total_covariate_width + chars_for_col <- max(1, round(prop * total_label_chars)) + chars_for_col <- min(chars_for_col, remaining_chars) + char_distribution[i] <- chars_for_col + remaining_chars <- remaining_chars - chars_for_col + } + } +} + +cat("\nCharacter distribution:\n") +for(i in seq_along(covariate_indices)) { + col_idx <- covariate_indices[i] + col_name <- printed_colnames[col_idx] + chars_to_use <- char_distribution[i] + cat(sprintf("Column %d (%s): %d characters\n", col_idx, col_name, chars_to_use)) +} \ No newline at end of file diff --git a/tests/testthat/test-header-formatting.R b/tests/testthat/test-header-formatting.R new file mode 100644 index 0000000..5648895 --- /dev/null +++ b/tests/testthat/test-header-formatting.R @@ -0,0 +1,60 @@ +library(testthat) +library(purrr) +library(stringr) +library(dplyr) +library(tidyprint) + +context("format_covariate_header") + +separator_row <- c( + ".feature" = " ", + ".sample" = " ", + "|" = " ", + "counts" = " ", + "|" = " ", + "dex" = "-------", + "celltype" = "--------", + "geo_id" = "----------", + "sample_id" = "----------", + "sample_id2" = "----------", + "|" = " ", + "gene_name" = " " +) + +printed_colnames <- c( + ".feature", ".sample", "|", "counts", "|", + "dex", "celltype", "geo_id", "sample_id", "sample_id2", + "|", "gene_name" +) + +covariate_names <- c("dex", "celltype", "geo_id", "sample_id", "sample_id2") +number_of_total_rows <- 1000 + +test_that("format_covariate_header overlays label as a continuous string", { + result <- tidyprint:::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" + ) + expect_snapshot_output(cat(result, "\n")) + + result2 <- tidyprint:::format_covariate_header( + separator_row = separator_row, + printed_colnames = printed_colnames, + covariate_names = covariate_names, + number_of_total_rows = number_of_total_rows, + label = "COVAR" + ) + expect_snapshot_output(cat(result2, "\n")) + + result3 <- 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_LONG" + ) + expect_snapshot_output(cat(result3, "\n")) +}) \ No newline at end of file From 69640379160c827971adb48c70d701f0f7e171bc Mon Sep 17 00:00:00 2001 From: Stefano Mangiola Date: Sun, 29 Jun 2025 09:34:01 +1000 Subject: [PATCH 4/9] Refactor covariate header formatting for improved alignment and scalability --- R/tidyprint_1_utlis.R | 61 +++++++++++++++++++++---------------------- 1 file changed, 30 insertions(+), 31 deletions(-) diff --git a/R/tidyprint_1_utlis.R b/R/tidyprint_1_utlis.R index ba74e70..de0e218 100644 --- a/R/tidyprint_1_utlis.R +++ b/R/tidyprint_1_utlis.R @@ -112,40 +112,38 @@ format_covariate_header <- function(separator_row, printed_colnames, covariate_n covariate_indices <- which(printed_colnames %in% covariate_names) covariate_widths <- separator_row[printed_colnames[covariate_indices]] |> purrr::map_int(nchar) - total_covariate_width <- sum(covariate_widths) - - # Build a string of dashes for all covariate columns - dash_string <- paste(rep("-", total_covariate_width), collapse = "") - - # Overlay the label onto the dash string, centered - label_start <- floor((total_covariate_width - nchar(label)) / 2) + 1 - label_end <- label_start + nchar(label) - 1 - chars <- strsplit(dash_string, "")[[1]] - label_chars <- strsplit(label, "")[[1]] - if (label_start > 0 && label_end <= total_covariate_width) { - chars[label_start:label_end] <- label_chars - } else { - # If label is too long, truncate - chars[1:length(label_chars)] <- label_chars - } - overlayed <- paste(chars, collapse = "") - - # Split overlayed string back into covariate column widths - split_labels <- character(length(covariate_widths)) - pos <- 1 - for (i in seq_along(covariate_widths)) { - split_labels[i] <- substr(overlayed, pos, pos + covariate_widths[i] - 1) - pos <- pos + covariate_widths[i] - } + total_covariate_width <- sum(covariate_widths) + length(covariate_widths) + 3 # To compensate the white spaces of the tibble + label_length <- nchar(label) + + # Center the label in the total covariate width, using only dashes and the label + left_pad <- floor((total_covariate_width - label_length) / 2) + right_pad <- total_covariate_width - 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, "|") + + # Guarantee the merged_label is exactly total_covariate_width + 2 + merged_label <- substr(merged_label, 1, total_covariate_width + 2) - # Place split_labels into the header_row at covariate_indices - for (i in seq_along(covariate_indices)) { - header_row[covariate_indices[i]] <- split_labels[i] - } + # Now replace the first and last elements of the header_row for the covariate columns with the only merged_label + header_row[covariate_indices[1]] <- merged_label + + # remove the other covariate columns + header_row[covariate_indices[-1]] <- "" + # Add row ID spacing at the beginning - header_row <- c(paste(rep(" ", number_of_total_rows |> nchar() - 2), collapse = ""), header_row) + header_row <- c(paste(rep(" ", number_of_total_rows |> nchar() - 3), collapse = ""), header_row) + + # Step 2: Collapse everything with space paste(header_row, collapse = " ") + + } >>>>>>> 4b7ac46 (more scalable COVRIATE header) @@ -178,13 +176,14 @@ tbl_format_header.SE_print_abstraction <- function(x, setup, ...) { # Only add header if there are covariate columns covariate_header <- NULL + 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" + label = " COVARIATES " ) covariate_header <- cli::col_br_blue(covariate_header) } From 59e8d0d2e0c2cff3812b4c15df6c1575dd6786cd Mon Sep 17 00:00:00 2001 From: Stefano Mangiola Date: Sun, 29 Jun 2025 09:39:00 +1000 Subject: [PATCH 5/9] Add format_covariate_header function and update NAMESPACE for documentation --- NAMESPACE | 2 +- R/tidyprint_1_utlis.R | 6 +++--- man/format_covariate_header.Rd | 31 +++++++++++++++++++++++++++++++ 3 files changed, 35 insertions(+), 4 deletions(-) create mode 100644 man/format_covariate_header.Rd diff --git a/NAMESPACE b/NAMESPACE index 80468f9..2a58f31 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -6,7 +6,6 @@ S3method(ctl_new_rowid_pillar,SE_print_abstraction) S3method(print,SummarizedExperiment) S3method(tbl_format_header,SE_print_abstraction) S3method(tbl_format_header,tidySummarizedExperiment) -export(demo_tidy_message) export(tidy_message) importClassesFrom(SummarizedExperiment,SummarizedExperiment) importFrom(S4Vectors,coolcat) @@ -37,6 +36,7 @@ importFrom(purrr,map) importFrom(purrr,map2) importFrom(purrr,map2_chr) importFrom(purrr,map_chr) +importFrom(purrr,map_int) importFrom(purrr,reduce) importFrom(purrr,when) importFrom(rlang,names2) diff --git a/R/tidyprint_1_utlis.R b/R/tidyprint_1_utlis.R index de0e218..7b1abf3 100644 --- a/R/tidyprint_1_utlis.R +++ b/R/tidyprint_1_utlis.R @@ -88,6 +88,8 @@ ctl_new_pillar.SE_print_abstraction <- function(controller, x, width, ..., title +#' Format covariate header by distributing label across covariate columns +#' #' @importFrom rlang names2 #' @importFrom pillar align #' @importFrom pillar get_extent @@ -97,8 +99,7 @@ ctl_new_pillar.SE_print_abstraction <- function(controller, x, width, ..., title #' @importFrom tibble as_tibble #' @importFrom stringr str_replace_all #' @importFrom purrr map2_chr -======= -#' Format covariate header by distributing label across covariate columns +#' #' @param separator_row The separator row with column widths #' @param printed_colnames The printed column names #' @param covariate_names The names of covariate columns @@ -146,7 +147,6 @@ format_covariate_header <- function(separator_row, printed_colnames, covariate_n } ->>>>>>> 4b7ac46 (more scalable COVRIATE header) #' @export tbl_format_header.SE_print_abstraction <- function(x, setup, ...) { number_of_features <- x |> attr("number_of_features") diff --git a/man/format_covariate_header.Rd b/man/format_covariate_header.Rd new file mode 100644 index 0000000..455351c --- /dev/null +++ b/man/format_covariate_header.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/tidyprint_1_utlis.R +\name{format_covariate_header} +\alias{format_covariate_header} +\title{Format covariate header by distributing label across covariate columns} +\usage{ +format_covariate_header( + separator_row, + printed_colnames, + covariate_names, + number_of_total_rows, + label = "COVARIATES" +) +} +\arguments{ +\item{separator_row}{The separator row with column widths} + +\item{printed_colnames}{The printed column names} + +\item{covariate_names}{The names of covariate columns} + +\item{number_of_total_rows}{The total number of rows for spacing} + +\item{label}{The label to distribute (default: "COVARIATES")} +} +\value{ +Formatted header string +} +\description{ +Format covariate header by distributing label across covariate columns +} From b69627c66afa0997a56b7c7d9ad85928bdd81743 Mon Sep 17 00:00:00 2001 From: Stefano Mangiola Date: Sun, 29 Jun 2025 09:51:32 +1000 Subject: [PATCH 6/9] Remove unused exports and delete obsolete test script for format_covariate_header function; update NAMESPACE accordingly. --- R/tidyprint_1_utlis.R | 2 - test_header_formatting.R | 139 ------------------------ tests/testthat/test-header-formatting.R | 2 +- 3 files changed, 1 insertion(+), 142 deletions(-) delete mode 100644 test_header_formatting.R diff --git a/R/tidyprint_1_utlis.R b/R/tidyprint_1_utlis.R index 7b1abf3..bfb30bd 100644 --- a/R/tidyprint_1_utlis.R +++ b/R/tidyprint_1_utlis.R @@ -13,8 +13,6 @@ #' @importFrom purrr map2_chr #' @importFrom purrr map_int #' @importFrom dplyr if_else -#' @importFrom pillar pillar___format_comment -#' @importFrom pillar NBSP #' @export ctl_new_rowid_pillar.SE_print_abstraction <- function(controller, x, width, ...) { # message('attrx =', x %>% attributes()) diff --git a/test_header_formatting.R b/test_header_formatting.R deleted file mode 100644 index d8af51d..0000000 --- a/test_header_formatting.R +++ /dev/null @@ -1,139 +0,0 @@ -# Test script for header formatting function -# Load required packages -library(purrr) -library(stringr) -library(dplyr) - -# Source the function directly -source("R/tidyprint_1_utlis.R") - -# Mock data based on user's example -separator_row <- c( - ".feature" = " ", - ".sample" = " ", - "|" = " ", - "counts" = " ", - "|" = " ", - "dex" = "-------", - "celltype" = "--------", - "geo_id" = "----------", - "sample_id" = "----------", - "sample_id2" = "----------", - "|" = " ", - "gene_name" = " " -) - -printed_colnames <- c( - ".feature", ".sample", "|", "counts", "|", - "dex", "celltype", "geo_id", "sample_id", "sample_id2", - "|", "gene_name" -) - -covariate_names <- c("dex", "celltype", "geo_id", "sample_id", "sample_id2") -number_of_total_rows <- 1000 - -# Test the function -cat("=== Testing format_covariate_header function ===\n\n") - -cat("Input data:\n") -cat("separator_row names:", names(separator_row), "\n") -cat("printed_colnames:", printed_colnames, "\n") -cat("covariate_names:", covariate_names, "\n") -cat("number_of_total_rows:", number_of_total_rows, "\n\n") - -# Get covariate indices -covariate_indices <- which(printed_colnames %in% covariate_names) -cat("Covariate indices:", covariate_indices, "\n") - -# Get covariate widths -covariate_widths <- separator_row[printed_colnames[covariate_indices]] |> purrr::map_int(nchar) -cat("Covariate widths:", covariate_widths, "\n") -cat("Total covariate width:", sum(covariate_widths), "\n\n") - -# Test the function -result <- 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" -) - -cat("=== Result ===\n") -cat("Formatted header:\n") -cat(result, "\n\n") - -# Let's also test with a shorter label -cat("=== Testing with shorter label 'COVAR' ===\n") -result2 <- format_covariate_header( - separator_row = separator_row, - printed_colnames = printed_colnames, - covariate_names = covariate_names, - number_of_total_rows = number_of_total_rows, - label = "COVAR" -) - -cat("Formatted header with 'COVAR':\n") -cat(result2, "\n\n") - -# Let's also test with a longer label -cat("=== Testing with longer label 'COVARIATES_LONG' ===\n") -result3 <- 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_LONG" -) - -cat("Formatted header with 'COVARIATES_LONG':\n") -cat(result3, "\n\n") - -# Debug: Let's see what happens step by step -cat("=== Debug: Step by step analysis ===\n") - -# Build header row -header_row <- purrr::map2_chr(separator_row, names(separator_row), - ~ if(.y %in% covariate_names) .x else stringr::str_replace_all(.x, "-", " ")) - -cat("Initial header_row:\n") -for(i in seq_along(header_row)) { - cat(sprintf("%2d: '%s' (width: %d)\n", i, header_row[i], nchar(header_row[i]))) -} - -# Calculate character distribution -label <- "COVARIATES" -label_chars <- strsplit(label, "")[[1]] -total_label_chars <- length(label_chars) -total_covariate_width <- sum(covariate_widths) - -cat("\nLabel analysis:\n") -cat("Label:", label, "\n") -cat("Label characters:", paste(label_chars, collapse=", "), "\n") -cat("Total label chars:", total_label_chars, "\n") - -# Calculate distribution -char_distribution <- numeric(length(covariate_widths)) -remaining_chars <- total_label_chars - -for (i in seq_along(covariate_widths)) { - if (remaining_chars > 0) { - if (i == length(covariate_widths)) { - char_distribution[i] <- remaining_chars - } else { - prop <- covariate_widths[i] / total_covariate_width - chars_for_col <- max(1, round(prop * total_label_chars)) - chars_for_col <- min(chars_for_col, remaining_chars) - char_distribution[i] <- chars_for_col - remaining_chars <- remaining_chars - chars_for_col - } - } -} - -cat("\nCharacter distribution:\n") -for(i in seq_along(covariate_indices)) { - col_idx <- covariate_indices[i] - col_name <- printed_colnames[col_idx] - chars_to_use <- char_distribution[i] - cat(sprintf("Column %d (%s): %d characters\n", col_idx, col_name, chars_to_use)) -} \ No newline at end of file diff --git a/tests/testthat/test-header-formatting.R b/tests/testthat/test-header-formatting.R index 5648895..eff75b7 100644 --- a/tests/testthat/test-header-formatting.R +++ b/tests/testthat/test-header-formatting.R @@ -49,7 +49,7 @@ test_that("format_covariate_header overlays label as a continuous string", { ) expect_snapshot_output(cat(result2, "\n")) - result3 <- format_covariate_header( + result3 <- tidyprint:::format_covariate_header( separator_row = separator_row, printed_colnames = printed_colnames, covariate_names = covariate_names, From a9d0a401d514bfe9bcaffc81796131e01a14740a Mon Sep 17 00:00:00 2001 From: Stefano Mangiola Date: Sun, 29 Jun 2025 10:00:35 +1000 Subject: [PATCH 7/9] Update .gitignore, export new functions in NAMESPACE, and add tests for format_covariate_header --- .gitignore | 1 + NAMESPACE | 2 ++ R/tidyprint_1_utlis.R | 2 -- tests/testthat/_snaps/header-formatting.md | 12 ++++++++++++ 4 files changed, 15 insertions(+), 2 deletions(-) create mode 100644 tests/testthat/_snaps/header-formatting.md diff --git a/.gitignore b/.gitignore index 450fa4c..f7e59a8 100644 --- a/.gitignore +++ b/.gitignore @@ -9,3 +9,4 @@ inst/doc /doc/ /Meta/ .DS_Store +..Rcheck diff --git a/NAMESPACE b/NAMESPACE index 2a58f31..5dde160 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -6,6 +6,8 @@ S3method(ctl_new_rowid_pillar,SE_print_abstraction) S3method(print,SummarizedExperiment) S3method(tbl_format_header,SE_print_abstraction) S3method(tbl_format_header,tidySummarizedExperiment) +export(demo_tidy_message) +export(format_covariate_header) export(tidy_message) importClassesFrom(SummarizedExperiment,SummarizedExperiment) importFrom(S4Vectors,coolcat) diff --git a/R/tidyprint_1_utlis.R b/R/tidyprint_1_utlis.R index bfb30bd..31d7b16 100644 --- a/R/tidyprint_1_utlis.R +++ b/R/tidyprint_1_utlis.R @@ -63,8 +63,6 @@ ctl_new_rowid_pillar.SE_print_abstraction <- function(controller, x, width, ...) } -<<<<<<< HEAD - #' @importFrom pillar pillar ctl_new_pillar #' @export ctl_new_pillar.SE_print_abstraction <- function(controller, x, width, ..., title = NULL) { diff --git a/tests/testthat/_snaps/header-formatting.md b/tests/testthat/_snaps/header-formatting.md new file mode 100644 index 0000000..43190c2 --- /dev/null +++ b/tests/testthat/_snaps/header-formatting.md @@ -0,0 +1,12 @@ +# format_covariate_header overlays label as a continuous string + + |---------------------COVARIATES----------------------| + +--- + + |------------------------COVAR------------------------| + +--- + + |-------------------COVARIATES_LONG-------------------| + From b698bad430ad5d4c10a5d1e7694f3e5df62a7e01 Mon Sep 17 00:00:00 2001 From: Stefano Mangiola Date: Sun, 29 Jun 2025 10:22:56 +1000 Subject: [PATCH 8/9] Enhance NAMESPACE and README with new imports and examples; update print method for SummarizedExperiment to improve design handling and output formatting. --- NAMESPACE | 6 + R/print_methods.R | 6 +- R/tibble_methods.R | 5 +- R/tidyprint_1_utlis.R | 4 +- R/tidyse_utils.R | 14 +- README.md | 241 ++++++++++++--------- tests/testthat/_snaps/header-formatting.md | 6 +- tests/testthat/test-print_methods.R | 2 +- vignettes/Introduction.Rmd | 38 ++-- 9 files changed, 188 insertions(+), 134 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 5dde160..9e63796 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -19,7 +19,10 @@ importFrom(SummarizedExperiment,colData) importFrom(SummarizedExperiment,rowData) importFrom(SummarizedExperiment,rowRanges) importFrom(cli,col_br_black) +importFrom(dplyr,full_join) importFrom(dplyr,if_else) +importFrom(dplyr,left_join) +importFrom(dplyr,select) importFrom(fansi,strwrap_ctl) importFrom(magrittr,`%>%`) importFrom(methods,setMethod) @@ -41,12 +44,15 @@ importFrom(purrr,map_chr) importFrom(purrr,map_int) importFrom(purrr,reduce) importFrom(purrr,when) +importFrom(rlang,enquo) importFrom(rlang,names2) importFrom(stats,setNames) importFrom(stringr,str_replace) importFrom(stringr,str_replace_all) importFrom(tibble,as_tibble) importFrom(tibble,enframe) +importFrom(tidyr,nest) +importFrom(tidyr,pivot_longer) importFrom(tidyr,spread) importFrom(vctrs,new_data_frame) importFrom(vctrs,vec_rep) diff --git a/R/print_methods.R b/R/print_methods.R index 13c02ba..a4d0744 100644 --- a/R/print_methods.R +++ b/R/print_methods.R @@ -11,7 +11,7 @@ #' @importFrom magrittr `%>%` #' @importFrom dplyr if_else #' @export -print.SummarizedExperiment <- function(x, design = 1, n_print = 10, ...) { +print.SummarizedExperiment <- function(x, design = 4, n_print = 10, ...) { # Match the user-supplied design argument to one of the valid choices: if (is.numeric(design)) { @@ -242,8 +242,8 @@ but they do not completely overlap.") out_sub <- out[sub_seq, ] # Compute the max character width for each column - separator_row <- map2_chr(out_sub, names(out_sub), ~ { - max_width <- max(nchar(as.character(.x)), na.rm = TRUE) |> max(nchar(.y)) # Get max width in the column + separator_row <- sapply(out_sub %>% colnames(), function(col) { + max_width <- max(nchar(as.character(col)), na.rm = TRUE) # Get max width in the column paste(rep("-", max_width), collapse = "") # Generate a separator of the same length }) # Modify the entire tibble to include a separator row across all columns diff --git a/R/tibble_methods.R b/R/tibble_methods.R index faf56dd..807d305 100644 --- a/R/tibble_methods.R +++ b/R/tibble_methods.R @@ -1,10 +1,11 @@ - #' @importFrom purrr reduce #' @importFrom purrr map map2 #' @importFrom tidyr spread #' @importFrom tibble enframe #' @importFrom SummarizedExperiment colData #' @importFrom pkgconfig get_config +#' @importFrom rlang enquo +#' @importFrom dplyr left_join #' @export as_tibble.SummarizedExperiment <- function(x, ..., .name_repair=c("check_unique", "unique", "universal", "minimal"), @@ -19,7 +20,7 @@ as_tibble.SummarizedExperiment <- function(x, ..., .name_repair=c("check_unique", "unique", "universal", "minimal"), rownames=pkgconfig::get_config("tibble::rownames", NULL)) { - .subset <- enquo(.subset) + .subset <- rlang::enquo(.subset) sample_info <- colData(x) %>% diff --git a/R/tidyprint_1_utlis.R b/R/tidyprint_1_utlis.R index 31d7b16..62fb3b9 100644 --- a/R/tidyprint_1_utlis.R +++ b/R/tidyprint_1_utlis.R @@ -109,7 +109,7 @@ format_covariate_header <- function(separator_row, printed_colnames, covariate_n covariate_indices <- which(printed_colnames %in% covariate_names) covariate_widths <- separator_row[printed_colnames[covariate_indices]] |> purrr::map_int(nchar) - total_covariate_width <- sum(covariate_widths) + length(covariate_widths) + 3 # To compensate the white spaces of the tibble + total_covariate_width <- sum(covariate_widths) + length(covariate_widths) + 1 # To compensate the white spaces of the tibble label_length <- nchar(label) # Center the label in the total covariate width, using only dashes and the label @@ -135,7 +135,7 @@ format_covariate_header <- function(separator_row, printed_colnames, covariate_n header_row[covariate_indices[-1]] <- "" # Add row ID spacing at the beginning - header_row <- c(paste(rep(" ", number_of_total_rows |> nchar() - 3), collapse = ""), header_row) + header_row <- c(paste(rep(" ", number_of_total_rows |> nchar() - 4), collapse = ""), header_row) # Step 2: Collapse everything with space paste(header_row, collapse = " ") diff --git a/R/tidyse_utils.R b/R/tidyse_utils.R index 0c9ba7c..82da3ac 100644 --- a/R/tidyse_utils.R +++ b/R/tidyse_utils.R @@ -1,3 +1,7 @@ +#' @importFrom tidyr nest +#' @importFrom dplyr select +#' @importFrom tidyr pivot_longer +#' @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" @@ -257,6 +261,14 @@ add_attr <- function(var, attribute, name) { var } +eliminate_GRanges_metadata_columns_also_present_in_Rowdata <- function(.my_data, se) { + .my_data %>% + select(-one_of(colnames(rowData(se)))) %>% + + # In case there is not metadata column + suppressWarnings() +} + get_special_datasets <- function(se) { rr = se %>% @@ -281,7 +293,7 @@ get_special_datasets <- function(se) { tibble::as_tibble(rr) %>% eliminate_GRanges_metadata_columns_also_present_in_Rowdata(se) %>% nest(GRangesList = -group_name) %>% - rename(!!f_(se)$symbol := group_name) + dplyr::rename(!!f_(se)$symbol := group_name) }, diff --git a/README.md b/README.md index b5d86f2..615d6ea 100644 --- a/README.md +++ b/README.md @@ -55,73 +55,89 @@ Below is an example demonstrating how to use **tidyprint** with a sample library(dplyr) library(tidyr) - -# Now load tidyprint - -library(tidyprint) - -# Example SummarizedExperiment data from the airway package - -data(se_airway) -se_airway -#> class: SummarizedExperiment -#> dim: 38694 8 -#> metadata(0): -#> assays(1): counts -#> rownames(38694): ENSG00000000003 ENSG00000000005 ... ENSG00000283120 -#> ENSG00000283123 -#> rowData names(0): -#> colnames(8): SRR1039508 SRR1039509 ... SRR1039520 SRR1039521 -#> colData names(3): dex celltype geo_id +library(airway) +data(airway) ``` ------------------------------------------------------------------------- - -### 2.2 **SummarizedExperiment** (Default) +### **SummarizedExperiment** The standard SummarizedExperiment display: ``` r -# The default style: -se_airway %>% print(design = "SummarizedExperiment") -#> class: SummarizedExperiment -#> dim: 38694 8 -#> metadata(0): -#> assays(1): counts -#> rownames(38694): ENSG00000000003 ENSG00000000005 ... ENSG00000283120 -#> ENSG00000283123 -#> rowData names(0): -#> colnames(8): SRR1039508 SRR1039509 ... SRR1039520 SRR1039521 -#> colData names(3): dex celltype geo_id +airway +#> Warning in max(nchar(as.character(.x)), na.rm = TRUE): no non-missing arguments +#> to max; returning -Inf +#> Warning in max(nchar(as.character(.x)), na.rm = TRUE): no non-missing arguments +#> to max; returning -Inf +#> # A SummarizedExperiment-tibble abstraction: Features=63677 | Samples=8 | +#> # Assays=counts +#> # +#> # |------------------------------------- COVARIATES +#> # --------------------------------------| +#> # +#> # +#> .feature .sample | counts | SampleName cell dex albut Run avgLength +#> | | +#> 1 ENSG0000… SRR103… | 679 | GSM1275862 N613… untrt untrt SRR1… 126 +#> 2 ENSG0000… SRR103… | 0 | GSM1275862 N613… untrt untrt SRR1… 126 +#> 3 ENSG0000… SRR103… | 467 | GSM1275862 N613… untrt untrt SRR1… 126 +#> 4 ENSG0000… SRR103… | 260 | GSM1275862 N613… untrt untrt SRR1… 126 +#> 5 ENSG0000… SRR103… | 60 | GSM1275862 N613… untrt untrt SRR1… 126 +#> --------… ------… - ------ - --------- +#> 509412 ENSG0000… SRR103… | 0 | GSM1275875 N061… trt untrt SRR1… 98 +#> 509413 ENSG0000… SRR103… | 0 | GSM1275875 N061… trt untrt SRR1… 98 +#> 509414 ENSG0000… SRR103… | 0 | GSM1275875 N061… trt untrt SRR1… 98 +#> 509415 ENSG0000… SRR103… | 0 | GSM1275875 N061… trt untrt SRR1… 98 +#> 509416 ENSG0000… SRR103… | 0 | GSM1275875 N061… trt untrt SRR1… 98 +#> # ℹ 14 more variables: Experiment , Sample , BioSample , +#> # `|` <|>, gene_id , gene_name , entrezid , +#> # gene_biotype , gene_seq_start , gene_seq_end , +#> # seq_name , seq_strand , seq_coord_system , symbol ``` -### 2.3 **tidyprint_1** +### **tidyprint** -For a more compact view (top and bottom rows), similar to a -plyxp/tidyverse style with tidySummarizedExperiment header: +Now we load tidyprint for a tidy data display ``` r - -se_airway %>% print(design = "tidyprint_1") -#> # A SummarizedExperiment-tibble abstraction: -#> # Features=38694 | Samples=8 | Assays=counts -#> # | -- COVARIATES -- | -#> .feature .sample `|` counts `|` `|` dex celltype geo_id -#> <|> <|> <|> -#> 1 ENSG00000000003 SRR1039508 | 723 | | control N61311 GSM1275862 -#> 2 ENSG00000000005 SRR1039508 | 0 | | control N61311 GSM1275862 -#> 3 ENSG00000000419 SRR1039508 | 467 | | control N61311 GSM1275862 -#> 4 ENSG00000000457 SRR1039508 | 347 | | control N61311 GSM1275862 -#> 5 ENSG00000000460 SRR1039508 | 96 | | control N61311 GSM1275862 -#> --------------- ---------- -- ------ -- -- ------- -------- ---------- -#> 309548 ENSG00000283115 SRR1039521 | 0 | | treated N061011 GSM1275875 -#> 309549 ENSG00000283116 SRR1039521 | 0 | | treated N061011 GSM1275875 -#> 309550 ENSG00000283119 SRR1039521 | 0 | | treated N061011 GSM1275875 -#> 309551 ENSG00000283120 SRR1039521 | 0 | | treated N061011 GSM1275875 -#> 309552 ENSG00000283123 SRR1039521 | 0 | | treated N061011 GSM1275875 +library(tidyprint) +airway +#> Warning in max(nchar(as.character(.x)), na.rm = TRUE): no non-missing arguments +#> to max; returning -Inf +#> Warning in max(nchar(as.character(.x)), na.rm = TRUE): no non-missing arguments +#> to max; returning -Inf +#> # A SummarizedExperiment-tibble abstraction: Features=63677 | Samples=8 | +#> # Assays=counts +#> # +#> # |------------------------------------- COVARIATES +#> # --------------------------------------| +#> # +#> # +#> .feature .sample | counts | SampleName cell dex albut Run avgLength +#> | | +#> 1 ENSG0000… SRR103… | 679 | GSM1275862 N613… untrt untrt SRR1… 126 +#> 2 ENSG0000… SRR103… | 0 | GSM1275862 N613… untrt untrt SRR1… 126 +#> 3 ENSG0000… SRR103… | 467 | GSM1275862 N613… untrt untrt SRR1… 126 +#> 4 ENSG0000… SRR103… | 260 | GSM1275862 N613… untrt untrt SRR1… 126 +#> 5 ENSG0000… SRR103… | 60 | GSM1275862 N613… untrt untrt SRR1… 126 +#> --------… ------… - ------ - --------- +#> 509412 ENSG0000… SRR103… | 0 | GSM1275875 N061… trt untrt SRR1… 98 +#> 509413 ENSG0000… SRR103… | 0 | GSM1275875 N061… trt untrt SRR1… 98 +#> 509414 ENSG0000… SRR103… | 0 | GSM1275875 N061… trt untrt SRR1… 98 +#> 509415 ENSG0000… SRR103… | 0 | GSM1275875 N061… trt untrt SRR1… 98 +#> 509416 ENSG0000… SRR103… | 0 | GSM1275875 N061… trt untrt SRR1… 98 +#> # ℹ 14 more variables: Experiment , Sample , BioSample , +#> # `|` <|>, gene_id , gene_name , entrezid , +#> # gene_biotype , gene_seq_start , gene_seq_end , +#> # seq_name , seq_strand , seq_coord_system , symbol ``` +------------------------------------------------------------------------ + +**For comparative purposes we display the alternative visualisations we +are trying to harmonise** + ### 2.4 **tidySummarizedExperiment** Use the “tidySummarizedExperiment” design to view your data in a @@ -131,22 +147,26 @@ Use the “tidySummarizedExperiment” design to view your data in a # Tidy SummarizedExperiment print: -se_airway %>% print(design = "tidySummarizedExperiment") -#> # A SummarizedExperiment-tibble abstraction: 309,552 × 6 -#> # Features=38694 | Samples=8 | Assays=counts -#> .feature .sample counts dex celltype geo_id -#> -#> 1 ENSG00000000003 SRR1039508 723 control N61311 GSM1275862 -#> 2 ENSG00000000005 SRR1039508 0 control N61311 GSM1275862 -#> 3 ENSG00000000419 SRR1039508 467 control N61311 GSM1275862 -#> 4 ENSG00000000457 SRR1039508 347 control N61311 GSM1275862 -#> 5 ENSG00000000460 SRR1039508 96 control N61311 GSM1275862 -#> 6 ENSG00000000938 SRR1039508 0 control N61311 GSM1275862 -#> 7 ENSG00000000971 SRR1039508 3413 control N61311 GSM1275862 -#> 8 ENSG00000001036 SRR1039508 2328 control N61311 GSM1275862 -#> 9 ENSG00000001084 SRR1039508 670 control N61311 GSM1275862 -#> 10 ENSG00000001167 SRR1039508 426 control N61311 GSM1275862 +airway %>% print(design = "tidySummarizedExperiment") +#> # A SummarizedExperiment-tibble abstraction: 509,416 × 23 +#> # Features=63677 | Samples=8 | Assays=counts +#> .feature .sample counts SampleName cell dex albut Run avgLength +#> +#> 1 ENSG00000000003 SRR10395… 679 GSM1275862 N613… untrt untrt SRR1… 126 +#> 2 ENSG00000000005 SRR10395… 0 GSM1275862 N613… untrt untrt SRR1… 126 +#> 3 ENSG00000000419 SRR10395… 467 GSM1275862 N613… untrt untrt SRR1… 126 +#> 4 ENSG00000000457 SRR10395… 260 GSM1275862 N613… untrt untrt SRR1… 126 +#> 5 ENSG00000000460 SRR10395… 60 GSM1275862 N613… untrt untrt SRR1… 126 +#> 6 ENSG00000000938 SRR10395… 0 GSM1275862 N613… untrt untrt SRR1… 126 +#> 7 ENSG00000000971 SRR10395… 3251 GSM1275862 N613… untrt untrt SRR1… 126 +#> 8 ENSG00000001036 SRR10395… 1433 GSM1275862 N613… untrt untrt SRR1… 126 +#> 9 ENSG00000001084 SRR10395… 519 GSM1275862 N613… untrt untrt SRR1… 126 +#> 10 ENSG00000001167 SRR10395… 394 GSM1275862 N613… untrt untrt SRR1… 126 #> # ℹ 40 more rows +#> # ℹ 14 more variables: Experiment , Sample , BioSample , +#> # gene_id , gene_name , entrezid , gene_biotype , +#> # gene_seq_start , gene_seq_end , seq_name , seq_strand , +#> # seq_coord_system , symbol , GRangesList ``` ### 2.5 **plyxp** @@ -156,20 +176,24 @@ plyxp/tidyverse style: ``` r -se_airway %>% print(design = "plyxp") -#> # A tibble: 10 × 9 -#> .features .samples `|` counts `|` `|` dex celltype geo_id -#> <|> <|> <|> -#> 1 ENSG00000000003 SRR1039508 | 723 | | control N61311 GSM1275862 -#> 2 ENSG00000000005 SRR1039508 | 0 | | control N61311 GSM1275862 -#> 3 ENSG00000000419 SRR1039508 | 467 | | control N61311 GSM1275862 -#> 4 ENSG00000000457 SRR1039508 | 347 | | control N61311 GSM1275862 -#> 5 ENSG00000000460 SRR1039508 | 96 | | control N61311 GSM1275862 -#> 6 ENSG00000283115 SRR1039521 | 0 | | treated N061011 GSM1275875 -#> 7 ENSG00000283116 SRR1039521 | 0 | | treated N061011 GSM1275875 -#> 8 ENSG00000283119 SRR1039521 | 0 | | treated N061011 GSM1275875 -#> 9 ENSG00000283120 SRR1039521 | 0 | | treated N061011 GSM1275875 -#> 10 ENSG00000283123 SRR1039521 | 0 | | treated N061011 GSM1275875 +airway %>% print(design = "plyxp") +#> # A tibble: 10 × 25 +#> .features .samples `|` counts `|` gene_id gene_name entrezid gene_biotype +#> <|> <|> +#> 1 ENSG0000… SRR1039… | 679 | ENSG000000… TSPAN6 NA protein_cod… +#> 2 ENSG0000… SRR1039… | 0 | ENSG000000… TNMD NA protein_cod… +#> 3 ENSG0000… SRR1039… | 467 | ENSG000000… DPM1 NA protein_cod… +#> 4 ENSG0000… SRR1039… | 260 | ENSG000000… SCYL3 NA protein_cod… +#> 5 ENSG0000… SRR1039… | 60 | ENSG000000… C1orf112 NA protein_cod… +#> 6 ENSG0000… SRR1039… | 0 | ENSG000002… RP11-180… NA antisense +#> 7 ENSG0000… SRR1039… | 0 | ENSG000002… TSEN34 NA protein_cod… +#> 8 ENSG0000… SRR1039… | 0 | ENSG000002… RP11-138… NA lincRNA +#> 9 ENSG0000… SRR1039… | 0 | ENSG000002… AP000230… NA lincRNA +#> 10 ENSG0000… SRR1039… | 0 | ENSG000002… RP11-80H… NA lincRNA +#> # ℹ 16 more variables: gene_seq_start , gene_seq_end , +#> # seq_name , seq_strand , seq_coord_system , symbol , +#> # `|` <|>, SampleName , cell , dex , albut , Run , +#> # avgLength , Experiment , Sample , BioSample ``` # 3. Messaging function @@ -190,13 +214,13 @@ tidyprint::tidy_message('message to print') You can specify the type of message as -- info (default) +- info (default) -- success +- success -- warning +- warning -- danger +- danger ``` r @@ -215,29 +239,48 @@ function, showing the name of package. ``` r sessionInfo() -#> R version 4.4.0 (2024-04-24) -#> Platform: x86_64-pc-linux-gnu -#> Running under: Red Hat Enterprise Linux 9.4 (Plow) +#> R version 4.5.0 (2025-04-11) +#> Platform: x86_64-apple-darwin20 +#> Running under: macOS Sonoma 14.6.1 #> #> Matrix products: default -#> BLAS/LAPACK: FlexiBLAS OPENBLAS; LAPACK version 3.10.1 +#> BLAS: /Library/Frameworks/R.framework/Versions/4.5-x86_64/Resources/lib/libRblas.0.dylib +#> LAPACK: /Library/Frameworks/R.framework/Versions/4.5-x86_64/Resources/lib/libRlapack.dylib; LAPACK version 3.12.1 #> #> locale: -#> [1] LC_CTYPE=en_AU.UTF-8 LC_NUMERIC=C -#> [3] LC_TIME=en_AU.UTF-8 LC_COLLATE=en_AU.UTF-8 -#> [5] LC_MONETARY=en_AU.UTF-8 LC_MESSAGES=en_AU.UTF-8 -#> [7] LC_PAPER=en_AU.UTF-8 LC_NAME=C -#> [9] LC_ADDRESS=C LC_TELEPHONE=C -#> [11] LC_MEASUREMENT=en_AU.UTF-8 LC_IDENTIFICATION=C +#> [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8 #> #> time zone: Australia/Melbourne -#> tzcode source: system (glibc) +#> tzcode source: internal #> #> attached base packages: -#> [1] stats graphics grDevices utils datasets methods base +#> [1] stats4 stats graphics grDevices utils datasets methods +#> [8] base #> #> other attached packages: -#> [1] tidyprint_0.0.1 tidyr_1.3.1 dplyr_1.1.4 +#> [1] tidyprint_0.0.1 airway_1.28.0 +#> [3] SummarizedExperiment_1.38.1 Biobase_2.68.0 +#> [5] GenomicRanges_1.60.0 GenomeInfoDb_1.44.0 +#> [7] IRanges_2.42.0 S4Vectors_0.46.0 +#> [9] BiocGenerics_0.54.0 generics_0.1.4 +#> [11] MatrixGenerics_1.20.0 matrixStats_1.5.0 +#> [13] tidyr_1.3.1 dplyr_1.1.4 #> #> loaded via a namespace (and not attached): +#> [1] utf8_1.2.6 sass_0.4.10 SparseArray_1.8.0 +#> [4] stringi_1.8.7 lattice_0.22-7 digest_0.6.37 +#> [7] magrittr_2.0.3 evaluate_1.0.4 grid_4.5.0 +#> [10] fastmap_1.2.0 rprojroot_2.0.4 jsonlite_2.0.0 +#> [13] Matrix_1.7-3 httr_1.4.7 fansi_1.0.6 +#> [16] purrr_1.0.4 UCSC.utils_1.4.0 jquerylib_0.1.4 +#> [19] abind_1.4-8 cli_3.6.5 rlang_1.1.6 +#> [22] crayon_1.5.3 XVector_0.48.0 withr_3.0.2 +#> [25] cachem_1.1.0 DelayedArray_0.34.1 yaml_2.3.10 +#> [28] S4Arrays_1.8.1 tools_4.5.0 GenomeInfoDbData_1.2.14 +#> [31] vctrs_0.6.5 R6_2.6.1 lifecycle_1.0.4 +#> [34] stringr_1.5.1 pkgconfig_2.0.3 pillar_1.10.2 +#> [37] bslib_0.9.0 glue_1.8.0 xfun_0.52 +#> [40] tibble_3.3.0 tidyselect_1.2.1 rstudioapi_0.17.1 +#> [43] knitr_1.50 htmltools_0.5.8.1 rmarkdown_2.29 +#> [46] compiler_4.5.0 ``` diff --git a/tests/testthat/_snaps/header-formatting.md b/tests/testthat/_snaps/header-formatting.md index 43190c2..99113b1 100644 --- a/tests/testthat/_snaps/header-formatting.md +++ b/tests/testthat/_snaps/header-formatting.md @@ -1,12 +1,12 @@ # format_covariate_header overlays label as a continuous string - |---------------------COVARIATES----------------------| + |--------------------COVARIATES---------------------| --- - |------------------------COVAR------------------------| + |-----------------------COVAR-----------------------| --- - |-------------------COVARIATES_LONG-------------------| + |------------------COVARIATES_LONG------------------| diff --git a/tests/testthat/test-print_methods.R b/tests/testthat/test-print_methods.R index acd1f71..ac23c1c 100644 --- a/tests/testthat/test-print_methods.R +++ b/tests/testthat/test-print_methods.R @@ -10,7 +10,7 @@ data(se_airway) # test for default design test_that("Default SummarizedExperiment print works", { - expect_output(print(se_airway), "class: SummarizedExperiment") + expect_output(print(se_airway), "A SummarizedExperiment-tibble abstraction:") }) test_that("Default SummarizedExperiment print works", { diff --git a/vignettes/Introduction.Rmd b/vignettes/Introduction.Rmd index 526e874..d8f2967 100644 --- a/vignettes/Introduction.Rmd +++ b/vignettes/Introduction.Rmd @@ -73,7 +73,7 @@ Depending on your workflow and desired console output, `tidyprint` makes it easy ## 1. Installation -You need the `remotes` package to install from GitHub. If you don’t have it, install it via: +You need the `remotes` package to install from GitHub. If you don't have it, install it via: ```{r eval=FALSE} install.packages("remotes") @@ -97,50 +97,42 @@ Below is an example demonstrating how to use **tidyprint** with a sample `Summar library(dplyr) library(tidyr) - -# Now load tidyprint - -library(tidyprint) - -# Example SummarizedExperiment data from the airway package - -data(se_airway) -se_airway - +library(airway) +data(airway) ``` ------------------------------------------------------------------------- - -### 2.2 **SummarizedExperiment** (Default) +### **SummarizedExperiment** The standard SummarizedExperiment display: ```{r} -# The default style: -se_airway %>% print(design = "SummarizedExperiment") +airway ``` -### 2.3 **tidyprint_1** +### **tidyprint** -For a more compact view (top and bottom rows), similar to a plyxp/tidyverse style with tidySummarizedExperiment header: +Now we load tidyprint for a tidy data display ```{r} +library(tidyprint) +airway +``` -se_airway %>% print(design = "tidyprint_1") +------------------------------------------------------------------------ -``` +**For comparative purposes we display the alternative visualisations we are trying to harmonise** ### 2.4 **tidySummarizedExperiment** -Use the “tidySummarizedExperiment” design to view your data in a **tidy-friendly tibble** format: +Use the "tidySummarizedExperiment" design to view your data in a **tidy-friendly tibble** format: ```{r} # Tidy SummarizedExperiment print: -se_airway %>% print(design = "tidySummarizedExperiment") +airway %>% print(design = "tidySummarizedExperiment") ``` @@ -150,7 +142,7 @@ For a more compact view (top and bottom rows), similar to a plyxp/tidyverse styl ```{r} -se_airway %>% print(design = "plyxp") +airway %>% print(design = "plyxp") ``` From e15675669a983404fb47df3884884f44dd03eecc Mon Sep 17 00:00:00 2001 From: Stefano Mangiola Date: Sun, 29 Jun 2025 12:07:48 +1000 Subject: [PATCH 9/9] Refactor header formatting in tbl_format_header to enhance covariate label alignment and improve overall output presentation. --- R/pillar_utlis.R | 1 + R/print_methods.R | 5 +++- R/tidyprint_1_utlis.R | 59 +++++++++++++++++++++++++------------------ R/tidyse_utils.R | 37 --------------------------- 4 files changed, 39 insertions(+), 63 deletions(-) diff --git a/R/pillar_utlis.R b/R/pillar_utlis.R index 042c5ef..0927f1d 100644 --- a/R/pillar_utlis.R +++ b/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) diff --git a/R/print_methods.R b/R/print_methods.R index a4d0744..758926a 100644 --- a/R/print_methods.R +++ b/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) diff --git a/R/tidyprint_1_utlis.R b/R/tidyprint_1_utlis.R index 62fb3b9..835c828 100644 --- a/R/tidyprint_1_utlis.R +++ b/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 diff --git a/R/tidyse_utils.R b/R/tidyse_utils.R index 82da3ac..69756b0 100644 --- a/R/tidyse_utils.R +++ b/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"))