From 719eaefe0e6499a7ef16fd2ea488d292fd3e05d6 Mon Sep 17 00:00:00 2001 From: Abel Vertesy Date: Wed, 6 Aug 2025 12:49:16 +0200 Subject: [PATCH 1/6] Add AGENTS guidelines and repository overview (#24) --- AGENTS.md | 36 ++++++++++++++++++++++++++++++++++++ 1 file changed, 36 insertions(+) create mode 100644 AGENTS.md diff --git a/AGENTS.md b/AGENTS.md new file mode 100644 index 0000000..5117c7b --- /dev/null +++ b/AGENTS.md @@ -0,0 +1,36 @@ +# AGENTS + +## Overview +This repository contains the **CodeAndRoll2** R package, a collection of utility functions for vector, matrix, and list manipulations. + +### Structure +- `R/` – core package functions. + - `CodeAndRoll2.R` exposes the main utilities. + - `deprecated.R` lists legacy helpers that should not be used in new code. +- `man/` – roxygen2-generated documentation. +- `DESCRIPTION` & `NAMESPACE` – package metadata. +- `Development/` – auxiliary scripts used for building and maintenance; not required for package use. +- `README.md` – package description, installation instructions, and an extensive function catalogue. + +## Development Workflow +1. Use R (>= 4.0). +2. After editing code in `R/`, keep roxygen2-style comments and regenerate documentation with: + ```r + devtools::document() + ``` +3. Run checks before committing: + ```sh + R CMD build . + R CMD check CodeAndRoll2_*.tar.gz + ``` + (or in R: `devtools::check()`). +4. Delete the generated `CodeAndRoll2_*.tar.gz` archive and `CodeAndRoll2.Rcheck` directory after the check. +5. Commit only when checks complete without errors or warnings. + +## Getting Started for New Contributors +- Read `README.md` for a package overview and list of available functions. +- Explore `R/CodeAndRoll2.R` to see implementation style and naming conventions. +- Review `DESCRIPTION` to understand package dependencies (e.g., Stringendo, ReadWriter). +- Check `deprecated.R` to avoid relying on obsolete functions. +- Suggested next steps: learn roxygen2 for documentation, devtools for package development, and review dependent packages (MarkdownReports, ggExpress, Seurat.utils) to see CodeAndRoll2 in action. + From cb20c0b7d8b208aa3c213e36820f689b518bb356 Mon Sep 17 00:00:00 2001 From: Abel Vertesy Date: Wed, 6 Aug 2025 12:49:40 +0200 Subject: [PATCH 2/6] Fix typos in docs and development scripts (#22) --- Development/zacc/CodeAndRoll2.orig.R | 2 +- Development/zacc/oxy-CodeAndRoll2.orig.R | 2 +- README.md | 14 +++++++------- man/as.numeric.wNames.character.Rd | 4 ++-- man/splititsnames_byValues.Rd | 2 +- 5 files changed, 12 insertions(+), 12 deletions(-) diff --git a/Development/zacc/CodeAndRoll2.orig.R b/Development/zacc/CodeAndRoll2.orig.R index 76d52e5..5066932 100644 --- a/Development/zacc/CodeAndRoll2.orig.R +++ b/Development/zacc/CodeAndRoll2.orig.R @@ -275,7 +275,7 @@ zigzagger <- function(vec = 1:9) { # mix entries so that they differ intermingle2vec(vec, rev(vec))[1:length(vec)] } -numerate <- function(x = 1, y = 100, zeropadding = TRUE, pad_length = floor( log10( max(abs(x), abs(y)) ) ) + 1) { # numerate from x to y with additonal zeropadding +numerate <- function(x = 1, y = 100, zeropadding = TRUE, pad_length = floor( log10( max(abs(x), abs(y)) ) ) + 1) { # numerate from x to y with additional zeropadding z = x:y if (zeropadding) { z = stringr::str_pad(z, pad = 0, width = pad_length) } return(z) diff --git a/Development/zacc/oxy-CodeAndRoll2.orig.R b/Development/zacc/oxy-CodeAndRoll2.orig.R index 336e01b..55db0be 100644 --- a/Development/zacc/oxy-CodeAndRoll2.orig.R +++ b/Development/zacc/oxy-CodeAndRoll2.orig.R @@ -854,7 +854,7 @@ zigzagger <- function(vec = 1:9) { # mix entries so that they differ #' @rdname numerate #' @export #' @importFrom stringr str_pad -numerate <- function(x = 1, y = 100, zeropadding = TRUE, pad_length = floor( log10( max(abs(x), abs(y)) ) ) + 1) { # numerate from x to y with additonal zeropadding +numerate <- function(x = 1, y = 100, zeropadding = TRUE, pad_length = floor( log10( max(abs(x), abs(y)) ) ) + 1) { # numerate from x to y with additional zeropadding z = x:y if (zeropadding) { z = stringr::str_pad(z, pad = 0, width = pad_length) } return(z) diff --git a/README.md b/README.md index 013f2af..88a77a9 100644 --- a/README.md +++ b/README.md @@ -225,10 +225,10 @@ as_tibble_from_namedVec. Convert a vector with names into a tibble, keeping the Unique elements. Get the unique elements of a vector, keep their names - #### 36 `as.numeric.wNames.character()` -as.numeric.wNames.character. Converts (1) a 'character' v. into a numeric v., or a 'factor' v. as as.numeric(as.character(vec)) and preserves the original names. The old 'as.numeric.wNames()' is deprecated as it was not clearly documented that it converts via facotr in any case. Code saved at the end. +as.numeric.wNames.character. Converts (1) a 'character' v. into a numeric v., or a 'factor' v. via as.numeric(as.character(vec)) and preserves the original names. The old 'as.numeric.wNames()' is deprecated as it was not clearly documented that it converts via factor in any case. Code saved at the end. - #### 37 `as.numeric.wNames.factor()` -as.numeric.wNames.factor. Turn any vector into numeric categories as.numeric(as.factor(vec)) Forerly as.factor.numeric +as.numeric.wNames.factor. Turn any vector into numeric categories as.numeric(as.factor(vec)). Formerly as.factor.numeric - #### 38 `as.character.wNames()` as.character.wNames. Converts your input vector into a character vector, and puts the original character values into the names of the new vector, unless it already has names. @@ -537,10 +537,10 @@ as.list.df.by.col. Split a dataframe into a list by its rows. reorder.list. Reorder elements of lists in your custom order of names / indices. - #### 140 `range.list()` -range.list. Calculates the range of values in the entire a list. +range.list. Calculates the range of values in the entire list. - #### 141 `intermingle2lists()` -intermingle2lists. Combine 2 lists (of the same length) so that form every odd and every even element of a unified list. Useful for side-by-side comparisons, e.g. in wstripchart_list(). +intermingle2lists. Combine 2 lists (of the same length) so that they form every odd and every even element of a unified list. Useful for side-by-side comparisons, e.g. in wstripchart_list(). - #### 142 `as.listalike()` as.listalike. Converts a vector to a list with the same dimensions as a given list. @@ -558,13 +558,13 @@ list2fullDF.presence. Converts a list to a full matrix, with rows and columns na splitbyitsnames. Split a list by its names. - #### 147 `splititsnames_byValues()` -Split the names of list by its values.. Split the names of a list by its its values. +Split the names of a list by its values. - #### 148 `intermingle2vec()` -intermingle2vec. Combine 2 vectors (of the same length) so that form every odd and every even element of a unified vector. +intermingle2vec. Combine 2 vectors (of the same length) so that they form every odd and every even element of a unified vector. - #### 149 `intermingle.cbind()` -intermingle.cbind. Combine 2 data frames (of the same length) so that form every odd and every even element of a unified list. Useful for side-by-side comparisons, e.g. in wstripchart_list(). +intermingle.cbind. Combine 2 data frames (of the same length) so that they form every odd and every even element of a unified list. Useful for side-by-side comparisons, e.g. in wstripchart_list(). - #### 150 `ls2categvec()` ls2categvec. Converts a list to a vector repeating list-element names, while vector names are the list elements. diff --git a/man/as.numeric.wNames.character.Rd b/man/as.numeric.wNames.character.Rd index b6008a6..cce0b32 100644 --- a/man/as.numeric.wNames.character.Rd +++ b/man/as.numeric.wNames.character.Rd @@ -17,8 +17,8 @@ } \description{ Converts (1) a 'character' v. into a numeric v., or -a 'factor' v. as as.numeric(as.character(vec)) and preserves the original names. -The old 'as.numeric.wNames()' is deprecated as it was not clearly documented that it converts via facotr in any case. Code saved at the end. +a 'factor' v. via as.numeric(as.character(vec)) and preserves the original names. +The old 'as.numeric.wNames()' is deprecated as it was not clearly documented that it converts via factor in any case. Code saved at the end. } \examples{ vec <- as.character(c(1, 2, 8, 9)) diff --git a/man/splititsnames_byValues.Rd b/man/splititsnames_byValues.Rd index 23b22b3..972e3c8 100644 --- a/man/splititsnames_byValues.Rd +++ b/man/splititsnames_byValues.Rd @@ -13,7 +13,7 @@ splititsnames_byValues(namedVec) A list of vectors, each of which contains the elements of \code{namedVec} that have the corresponding value. } \description{ -Split the names of a list by its its values. +Split the names of a list by its values. } \examples{ namedVec <- c("A", "B", "C", "A", "B", "D") From df37d91296ad4f7519b33579ea962f35d758aebc Mon Sep 17 00:00:00 2001 From: Abel Vertesy Date: Wed, 6 Aug 2025 12:50:00 +0200 Subject: [PATCH 3/6] Use explicit logical values and operators (#23) --- R/CodeAndRoll2.R | 44 +++++++++++++++++----------------- man/as.named.vector.2colDF.Rd | 2 +- man/as_tibble_from_namedVec.Rd | 2 +- 3 files changed, 24 insertions(+), 24 deletions(-) diff --git a/R/CodeAndRoll2.R b/R/CodeAndRoll2.R index 75af953..f150556 100644 --- a/R/CodeAndRoll2.R +++ b/R/CodeAndRoll2.R @@ -196,7 +196,7 @@ list.fromNames <- function(x = LETTERS[1:5], fill = NaN, use.names = FALSE) { # } names(liszt) <- - if (!is.null(names(x)) & use.names) { + if (!is.null(names(x)) && use.names) { names(x) } else { x @@ -218,7 +218,7 @@ list.fromNames <- function(x = LETTERS[1:5], fill = NaN, use.names = FALSE) { #' @param fill The value to fill the new vector. Default: `NA` #' @export vec.from.template <- function(x = table(LETTERS[1:5]), fill = NA) { - stopifnot(is.list(x) | is.vector(x) | is.table(x)) + stopifnot(is.list(x) || is.vector(x) || is.table(x)) v <- rep(fill, length(x)) names(v) <- names(x) return(v) @@ -234,7 +234,7 @@ vec.from.template <- function(x = table(LETTERS[1:5]), fill = NA) { #' #' @export list.from.template <- function(x, fill = NA) { - stopifnot(is(x)[1] == "list" | is.vector(x) | is.table(x)) + stopifnot(is(x)[1] == "list" || is.vector(x) || is.table(x)) liszt <- as.list(rep(fill, length(x))) names(liszt) <- names(x) return(liszt) @@ -741,7 +741,7 @@ as.named.vector.table <- function(table, verbose = TRUE, ...) { #' @param df data frame #' @param values Index of column with values, Default: 1 #' @param names Index of column with names, Default: 2 -#' @param make.names make.names, Default: F +#' @param make.names make.names, Default: FALSE #' #' @export as.named.vector.2colDF <- function(df, values = 1, names = 2, make.names = FALSE) { @@ -816,7 +816,7 @@ tibble_summary_to_namedVec <- function( #' @title as_tibble_from_namedVec #' @description Convert a vector with names into a tibble, keeping the names as rownames. #' @param vec.w.names A vector with names, Default: c(a = 1, b = 2) -#' @param transpose Transpose? Default: T +#' @param transpose Transpose? Default: TRUE #' @examples as_tibble_from_namedVec() #' @importFrom dplyr bind_rows #' @@ -863,7 +863,7 @@ unique.wNames <- function(x) { as.numeric.wNames.character <- function( vec, verbose = TRUE, factor.to.character = TRUE, ...) { - if (is.character(vec) | is.logical(vec)) { + if (is.character(vec) || is.logical(vec)) { numerified_vec <- as.numeric(vec, ...) } else { if (verbose) print("Input vector is not 'character' or 'logical'.") @@ -955,10 +955,10 @@ as.character.wNames <- function(vec) { #' #' @export translate <- function(vec, old, new) { - stopifnot(length(old) == length(new) | length(new) == 1) + stopifnot(length(old) == length(new) || length(new) == 1) # "PROVIDE ONE NEW VALUE, OR THE SAME NUMBER OF NEW VALUES AS OLD VALUES!" - if (length(old) > length(new) & length(new) == 1) { + if (length(old) > length(new) && length(new) == 1) { new <- rep(new, length(old)) } @@ -1053,7 +1053,7 @@ sortbyitsnames <- function(vec_or_list, decreasing = FALSE, ...) { #' @export any.duplicated any.duplicated <- function(vec, summarize = TRUE, max.shown = 25) { y <- sum(duplicated(vec)) - if (summarize & y) { + if (summarize && y > 0) { x <- table(vec) x <- sort.decreasing(x[x > 1]) @@ -1396,7 +1396,7 @@ which_names_grep <- function(namedVec, pattern, ...) { #' @examples # CodeAndRoll2::na.omit.strip(c(1, 2, 3, NA, NaN, 2)) na.omit.strip <- function(object, silent = FALSE, ...) { if (is.data.frame(object)) { - if (min(dim(object)) > 1 & silent == FALSE) { + if (min(dim(object)) > 1 && silent == FALSE) { iprint(dim(object), "dimensional array is converted to a vector.") } object <- unlist(object) @@ -2050,11 +2050,11 @@ sortEachColumn <- function(data, ...) sapply(data, sort, ...) # Sort each column #' @export sort_matrix_rows <- function(df, column = NULL, rownames = FALSE, decrease = FALSE, na_last = TRUE) { stopifnot( - is.data.frame(df) | is.matrix(df), - is.character(column) | is.numeric(column) | if (rownames) is.null(column), - "cannot handle multi column sort" = length(column) == 1 | if (rownames) is.null(column), + is.data.frame(df) || is.matrix(df), + is.character(column) || is.numeric(column) || if (rownames) is.null(column), + "cannot handle multi column sort" = length(column) == 1 || if (rownames) is.null(column), is.logical(rownames), is.logical(decrease), is.logical(na_last), - (if (isFALSE(rownames) & is.character(column)) column %in% colnames(df) else TRUE) + (if (isFALSE(rownames) && is.character(column)) column %in% colnames(df) else TRUE) ) message("Sorting by ", if (rownames) "rownames" else paste(column, "column"), " in ", if (decrease) "Decreasing" else "Increasing", " order.") @@ -3180,7 +3180,7 @@ splititsnames_byValues <- function(namedVec) { intermingle2vec <- function(V1, V2, wNames = TRUE, name_prefix = NULL) { stopifnot( length(V1) == length(V2), - is.null(name_prefix) | length(name_prefix) == 2 + is.null(name_prefix) || length(name_prefix) == 2 ) if (!is.null(name_prefix)) { @@ -3222,7 +3222,7 @@ intermingle.cbind <- function(df1, df2) { } # Create New column names - if (length(colnames(df1)) == ncol(df1) & length(colnames(df2)) == ncol(df2)) { + if (length(colnames(df1)) == ncol(df1) && length(colnames(df2)) == ncol(df2)) { NewColNames <- intermingle2vec(paste0("df1.", colnames(df1)), paste0("df2.", colnames(df2))) } else { NewColNames <- intermingle2vec(paste0("df1.", 1:ncol(df1)), paste0("df2.", 1:ncol(df2))) @@ -3330,8 +3330,8 @@ intersect.wNames <- function(x, y, names = "x") { is.vector(x), is.vector(y), names %in% c("x", "y") ) warnif( - "x argument has no names!" = (names == "x" & !Stringendo::HasNames(x) ) - , "y argument has no names!" = (names == "y" & !Stringendo::HasNames(y) ) + "x argument has no names!" = (names == "x" && !Stringendo::HasNames(x) ) + , "y argument has no names!" = (names == "y" && !Stringendo::HasNames(y) ) ) @@ -3394,7 +3394,7 @@ union.wNames <- function(x, y, names = "x") { # Check for name conflicts: if names of common elements are different, issue a warning. if ( !identical(names_x, names_y) ) { - warning("Names of intersecting elements is not the same in x & y!", immediate. = T) + warning("Names of intersecting elements is not the same in x & y!", immediate. = TRUE) iprint("names_x: ", head(names_x)) iprint("names_y: ", head(names_y)) @@ -3532,7 +3532,7 @@ mean_of_log <- function(x, k = 2, na.rm = TRUE) { negs <- sum(x < 0) zeros <- sum(x == 0) - if (negs | zeros) { + if (negs || zeros) { iprint("The input vector has", negs, "negative values and", zeros, "zeros.") } mean(log(x, base = k), na.rm = na.rm) @@ -3680,7 +3680,7 @@ as.factor.numeric <- function(vec, rename = FALSE, ...) { .Deprecated("as.numeric.wNames.factor") vec2 <- as.numeric(as.factor(vec, ...)) - names(vec2) <- if (!rename & !is.null(names(vec))) { + names(vec2) <- if (!rename && !is.null(names(vec))) { names(vec) } else { vec @@ -3702,7 +3702,7 @@ as.named.vector.deprecated <- function(df_col, WhichDimNames = 1) { # use RowNames: WhichDimNames = 1 , 2: use ColNames # !!! might require drop = FALSE in subsetting!!! eg: df_col[, 3, drop = FALSE] # df_col[which(unlist(lapply(df_col, is.null)))] = "NULL" # replace NULLs - they would fall out of vectors - DOES not work yet - if (is.list(df_col) & !is.data.frame(df_col)) { + if (is.list(df_col) && !is.data.frame(df_col)) { namez <- names(df_col) } vecc <- as.vector(unlist(df_col)) diff --git a/man/as.named.vector.2colDF.Rd b/man/as.named.vector.2colDF.Rd index 1057a30..dfc3749 100644 --- a/man/as.named.vector.2colDF.Rd +++ b/man/as.named.vector.2colDF.Rd @@ -13,7 +13,7 @@ as.named.vector.2colDF(df, values = 1, names = 2, make.names = FALSE) \item{names}{Index of column with names, Default: 2} -\item{make.names}{make.names, Default: F} +\item{make.names}{make.names, Default: FALSE} } \description{ Convert a 2-column dataframe (value, name) into a named vector. Use for simple tibbles. diff --git a/man/as_tibble_from_namedVec.Rd b/man/as_tibble_from_namedVec.Rd index 233f319..5acafcc 100644 --- a/man/as_tibble_from_namedVec.Rd +++ b/man/as_tibble_from_namedVec.Rd @@ -9,7 +9,7 @@ as_tibble_from_namedVec(vec.w.names = c(a = 1, b = 2), transpose = TRUE) \arguments{ \item{vec.w.names}{A vector with names, Default: c(a = 1, b = 2)} -\item{transpose}{Transpose? Default: T} +\item{transpose}{Transpose? Default: TRUE} } \description{ Convert a vector with names into a tibble, keeping the names as rownames. From a266564a3a3e80135766f817ea2378cbfffc1cdf Mon Sep 17 00:00:00 2001 From: Abel Vertesy Date: Wed, 6 Aug 2025 12:50:26 +0200 Subject: [PATCH 4/6] Add input validation (#25) --- R/CodeAndRoll2.R | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) diff --git a/R/CodeAndRoll2.R b/R/CodeAndRoll2.R index f150556..b29832d 100644 --- a/R/CodeAndRoll2.R +++ b/R/CodeAndRoll2.R @@ -31,6 +31,7 @@ #' #' @export getScriptName <- function(OutDir = getwd()) { + stopifnot(is.character(OutDir), length(OutDir) == 1, dir.exists(OutDir)) scriptName <- "" # Check if rstudioapi is available if (requireNamespace("rstudioapi", quietly = TRUE)) { @@ -156,6 +157,7 @@ pLength <- function(x) { #' @param fill The value to fill the new vector, Default: `NA` #' @export vec.fromNames <- function(name_vec = LETTERS[1:5], fill = NA) { + stopifnot(is.vector(name_vec), length(name_vec) > 0) if (length(fill) == 1) { v <- rep(fill, length(name_vec)) } else if (length(fill) == length(name_vec)) { @@ -182,6 +184,8 @@ vec.fromNames <- function(name_vec = LETTERS[1:5], fill = NA) { #' list.fromNames() # Default behavior with `LETTERS[1:5]` and `NaN` #' @export list.fromNames <- function(x = LETTERS[1:5], fill = NaN, use.names = FALSE) { + stopifnot(is.vector(x) || !is.null(names(x)), + is.logical(use.names), length(use.names) == 1) liszt <- as.list(rep(fill, length(x))) # names(liszt) <- @@ -249,6 +253,7 @@ list.from.template <- function(x, fill = NA) { #' @param fill The value to fill the new vector, Default: `NA` #' @export matrix.fromNames <- function(rowname_vec = 1:10, colname_vec = LETTERS[1:5], fill = NA) { + stopifnot(is.vector(rowname_vec), is.vector(colname_vec)) mx <- matrix( data = fill, nrow = length(rowname_vec), ncol = length(colname_vec), dimnames = list(rowname_vec, colname_vec) @@ -266,6 +271,7 @@ matrix.fromNames <- function(rowname_vec = 1:10, colname_vec = LETTERS[1:5], fil #' @param fill The value to fill the new vector, Default: `NA` #' @export data.frame.fromNames <- function(rowname_vec = 1:10, colname_vec = LETTERS[1:5], fill = NA) { + stopifnot(is.vector(rowname_vec), is.vector(colname_vec)) df <- matrix( data = fill, nrow = length(rowname_vec), ncol = length(colname_vec), dimnames = list(rowname_vec, colname_vec) @@ -285,6 +291,9 @@ data.frame.fromNames <- function(rowname_vec = 1:10, colname_vec = LETTERS[1:5], #' @param IsItARow Transpose? Swap rows an columns. Default: `TRUE` #' @export matrix.fromVector <- function(vector = 1:5, HowManyTimes = 3, IsItARow = TRUE) { + stopifnot(is.vector(vector), length(vector) > 0, + is.numeric(HowManyTimes), length(HowManyTimes) == 1, HowManyTimes > 0, + is.logical(IsItARow), length(IsItARow) == 1) matt <- matrix(vector, nrow = length(vector), ncol = HowManyTimes) if (!IsItARow) { matt <- t(matt) @@ -305,6 +314,7 @@ matrix.fromVector <- function(vector = 1:5, HowManyTimes = 3, IsItARow = TRUE) { array.fromNames <- function( rowname_vec = 1:3, colname_vec = letters[1:2], z_name_vec = LETTERS[4:6], fill = NA) { + stopifnot(is.vector(rowname_vec), is.vector(colname_vec), is.vector(z_name_vec)) DimNames <- list(rowname_vec, colname_vec, z_name_vec) Dimensions_ <- lapply(DimNames, length) mx <- array(data = fill, dim = Dimensions_, dimnames = DimNames) @@ -415,6 +425,10 @@ printEveryN <- function(i = i, N = 1000, prefix = NULL) { #' #' @export printProgress <- function(i = i, total, message = "Progress", digits = 0) { + stopifnot(is.numeric(i), length(i) == 1, + is.numeric(total), length(total) == 1, total > 0, + is.character(message), length(message) == 1, + is.numeric(digits), length(digits) == 1) percentage <- formatC(100 * i / total, format = "f", digits = digits) cat(paste0(message, ": ", i, "/", total, " (", percentage, "%)\n")) } @@ -610,6 +624,9 @@ count_occurrence_each_element <- function(vec) { #' #' @export top_indices <- function(x, n = 3, top = TRUE) { + stopifnot(is.vector(x), + is.numeric(n), length(n) == 1, n > 0, + is.logical(top), length(top) == 1) head(order(x, decreasing = top), n) } From 599aec046713ca17ca2457f6ec5c38987e06a6ef Mon Sep 17 00:00:00 2001 From: Abel Vertesy Date: Tue, 2 Dec 2025 15:50:00 +0100 Subject: [PATCH 5/6] Rename list variables for clarity (#28) --- R/CodeAndRoll2.R | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/R/CodeAndRoll2.R b/R/CodeAndRoll2.R index b29832d..5872830 100644 --- a/R/CodeAndRoll2.R +++ b/R/CodeAndRoll2.R @@ -186,9 +186,9 @@ vec.fromNames <- function(name_vec = LETTERS[1:5], fill = NA) { list.fromNames <- function(x = LETTERS[1:5], fill = NaN, use.names = FALSE) { stopifnot(is.vector(x) || !is.null(names(x)), is.logical(use.names), length(use.names) == 1) - liszt <- as.list(rep(fill, length(x))) + named_list <- as.list(rep(fill, length(x))) - # names(liszt) <- + # names(named_list) <- # if (is.character(x) | ) { # x # } else { @@ -199,18 +199,18 @@ list.fromNames <- function(x = LETTERS[1:5], fill = NaN, use.names = FALSE) { # } # } - names(liszt) <- + names(named_list) <- if (!is.null(names(x)) && use.names) { names(x) } else { x } message( - "List of ", length(liszt), - " | names: ", paste(head(names(liszt)), collapse = " "), + "List of ", length(named_list), + " | names: ", paste(head(names(named_list)), collapse = " "), " ..." ) - return(liszt) + return(named_list) } @@ -239,9 +239,9 @@ vec.from.template <- function(x = table(LETTERS[1:5]), fill = NA) { #' @export list.from.template <- function(x, fill = NA) { stopifnot(is(x)[1] == "list" || is.vector(x) || is.table(x)) - liszt <- as.list(rep(fill, length(x))) - names(liszt) <- names(x) - return(liszt) + named_list <- as.list(rep(fill, length(x))) + names(named_list) <- names(x) + return(named_list) } From b0815e99e56796e6d75eaf28634880b3cde5296f Mon Sep 17 00:00:00 2001 From: Abel Vertesy Date: Tue, 2 Dec 2025 20:17:18 +0100 Subject: [PATCH 6/6] Clarify verbose messaging and print control --- R/CodeAndRoll2.R | 53 ++++++++++++++++++++-------------- man/get_max_colname_per_row.Rd | 4 +-- 2 files changed, 33 insertions(+), 24 deletions(-) diff --git a/R/CodeAndRoll2.R b/R/CodeAndRoll2.R index 5872830..28c86cb 100644 --- a/R/CodeAndRoll2.R +++ b/R/CodeAndRoll2.R @@ -1116,7 +1116,8 @@ which.NA <- function(vec, verbose = TRUE) { #' @title clip.at.fixed.value #' @description Signal clipping. Cut values in a distribution, above or below a threshold. #' @param x A vector of numeric values (distribution). -#' @param high Clip above threshold? Default: TRUE +#' @param high Clip above the upper threshold (`TRUE`) or below the lower threshold (`FALSE`). +#' Default: TRUE #' @param thr threshold values, Default: 3 #' #' @export @@ -1136,7 +1137,8 @@ clip.at.fixed.value <- function(x, high = TRUE, thr = 3) { #' in a distribution above or below the extreme N% of the distribution. #' #' @param x A vector of numeric values. -#' @param high Clip above threshold? Default: TRUE +#' @param high Clip above the upper threshold (`TRUE`) or below the lower threshold (`FALSE`). +#' Default: TRUE #' @param percentiles At which percentiles to cut off?, Default: c(0.01, 0.99) #' @param na.rm Remove NA values for calculation? Default: TRUE #' @param showhist PARAM_DESCRIPTION, Default: FALSE @@ -1148,6 +1150,8 @@ clip.outliers.at.percentile <- function(x, high = TRUE, percentiles = c(.01, .99), na.rm = TRUE, showhist = FALSE, ...) { + stopifnot(is.logical(high), length(high) == 1) + qnt <- quantile(x, probs = percentiles, na.rm = na.rm) if (showhist) { hist(unlist(x), @@ -1159,8 +1163,11 @@ clip.outliers.at.percentile <- function(x, high = TRUE, } # if (showhist) { MarkdownReports::whist(unlist(x), breaks = 50 ,vline = qnt, filtercol = -1)} #if y <- x - y[x < qnt[1]] <- qnt[1] - y[x > qnt[2]] <- qnt[2] + if (isTRUE(high)) { + y[x > qnt[2]] <- qnt[2] + } else { + y[x < qnt[1]] <- qnt[1] + } y } @@ -2147,12 +2154,13 @@ rowsplit <- function(df, f = rownames(df)) { #' @param na.remove Logical. Should NA values be removed before finding the maximum value? #' Default: TRUE #' @param collapse Character. The character to use to collapse multiple column names into a single -#' string. Default: "-" +#' string when a row has several maxima. Set to `NULL` or `NA` to use `multi_max_str` instead. +#' Default: "-" #' @param verbose Logical. Should messages be printed to the console? Default: TRUE -#' @param multi_max_str Character. The string to use when multiple columns have the maximum value. -#' Default: "multiple.maxima" -#' @param suffix Character. The suffix to add to the `multi_max_str` string. Default: "rows have -#' +#' @param multi_max_str Character. The string to use when multiple columns have the maximum value +#' and `collapse` is `NULL` or `NA`. Default: "multiple.maxima" +#' @param suffix Character. The suffix used in the verbose message reporting how many rows have +#' multiple maxima. Default: "rows have multiple maxima." #' #' @examples #' mat <- matrix(data = c(1, 2, 3, 9, 5, 6), nrow = 2, ncol = 3, byrow = TRUE) @@ -2179,24 +2187,26 @@ get_max_colname_per_row <- function( which.max.multi <- function(x) which(x == max(x, na.rm = TRUE)) # Apply function to find the maximum indices to each row and return appropriate result - max_colname_per_row <- apply(mat, 1, function(row) { - # One or more maximum values - max_indices <- which.max.multi(row) + max_indices_per_row <- apply(mat, 1, which.max.multi) - # If there are multiple maximum values, return the "multi_max_str" + max_colname_per_row <- vapply(max_indices_per_row, function(max_indices) { if (length(max_indices) > 1) { - return(multi_max_str) + if (is.null(collapse) || is.na(collapse)) { + return(multi_max_str) + } + return(paste(colnames(mat)[max_indices], collapse = collapse)) } return(colnames(mat)[max_indices]) - }) + }, character(1)) # Name the result with row names (cell names) names(max_colname_per_row) <- rownames(mat) # stats if (verbose) { - message(paste(sum(max_colname_per_row == multi_max_str), "of", length(max_colname_per_row), suffix)) + multi_max_count <- sum(vapply(max_indices_per_row, length, integer(1)) > 1) + message(paste(multi_max_count, "of", length(max_colname_per_row), suffix)) } return(max_colname_per_row) @@ -2461,9 +2471,10 @@ get_col_types <- function(df, print_it = TRUE) { typetable <- t(t(x)) colnames(typetable) <- "Type" print(typetable) + + print("Summary") + print(table(x)) } - print("Summary") - print(table(x)) return(x) } @@ -2497,10 +2508,8 @@ fix_tibble_lists <- function(df, verbose = TRUE, print_full = FALSE, collapse_by is.logical(print_full), is.character(collapse_by) ) - if (verbose) { - cat("Before conversion:\n") - coltypes <- get_col_types(df, print_it = print_full) - } + if (verbose) cat("Before conversion:\n") + coltypes <- get_col_types(df, print_it = if (verbose) print_full else FALSE) list_cols <- which(coltypes %in% "list") # Identify list columns diff --git a/man/get_max_colname_per_row.Rd b/man/get_max_colname_per_row.Rd index 3176446..d6684e9 100644 --- a/man/get_max_colname_per_row.Rd +++ b/man/get_max_colname_per_row.Rd @@ -27,8 +27,8 @@ string. Default: "-"} \item{multi_max_str}{Character. The string to use when multiple columns have the maximum value. Default: "multiple.maxima"} -\item{suffix}{Character. The suffix to add to the \code{multi_max_str} string. Default: "rows have} -} +\item{suffix}{Character. The suffix used in the verbose message reporting how many rows have +multiple maxima. Default: "rows have multiple maxima."} \description{ This function takes a numeric matrix as input and returns a named vector where each element corresponds to a row of the matrix. The names of the vector are the row names of the matrix,