##

## jamba-string.r

##

## igrepHas

## rbindList

## makeNames

## nameVector

## nameVectorN

##

#' vector contains any case-insensitive grep match

#'

#' vector contains any case-insensitive grep match

#'

#' This function checks the input vector for any elements matching the

#' grep pattern. The grep is performed case-insensitive (igrep). This function

#' is particularly useful when checking function arguments or object class,

#' where the class(a) might return multiple values, or where the name of

#' the class might be slightly different than expected, e.g. data.frame,

#' data_frame, DataFrame.

#'

#' @param pattern the grep pattern to use with `base::grep()`

#' @param x vector to use in the grep

#' @param ignore.case logical default TRUE, meaning the grep will be performed

#' in case-insensitive mode.

#' @param minCount integer minimum number of matches required to return TRUE.

#' @param naToBlank logical whether to convert NA to blank, instead of

#' allowing grep to handle NA values as-is.

#' @param ... additional arguments are ignored.

#'

#' @returns logical indicating whether the grep match criteria were met,

#' TRUE indicates the grep pattern was present in minCount or more

#' number of entries.

#'

#' @seealso `base::grep()`

#'

#' @examples

#' a <- c("data.frame","data_frame","tibble","tbl");

#' igrepHas("Data.*Frame", a);

#' igrepHas("matrix", a);

#'

#' @family jam grep functions

#'

#' @export

igrepHas <- function

(pattern,

x=NULL,

ignore.case=TRUE,

minCount=1,

naToBlank=FALSE,

...)

{

## Purpose is a quick check for greppable substring, for if() statements

##

## naToBlank=TRUE will convert NA values to "" prior to running grep

##

## The special case where minCount is negative (minCount == -1) or larger

## than length(x), it will be set to length(x) and therefore

## requires all elements of x to meet the grep criteria

if (minCount < 0 || minCount > length(x)) {

minCount <- length(x);

}

if (length(x) == 0) {

return(FALSE);

} else {

if (naToBlank && any(is.na(x))) {

x[is.na(x)] <- "";

}

length(grep(pattern=pattern,

x=x,

ignore.case=ignore.case,

...)) >= as.integer(minCount);

}

}

#' case-insensitive grep, returning values

#'

#' case-insensitive grep, returning values

#'

#' This function is a simple wrapper around `base::grep()` which

#' runs in case-insensitive mode, and returns matching values. It is

#' particularly helpful when grabbing values from a vector.

#'

#' @param ...,value,ignore.case parameters sent to `base::grep()`

#'

#' @returns vector of matching values

#'

#' @examples

#' V <- paste0(LETTERS[1:5], LETTERS[4:8]);

#' vigrep("d", V);

#'

#' @family jam grep functions

#'

#' @export

vigrep <- function

(..., value=TRUE, ignore.case=TRUE)

{

## Purpose is simple to provide quicker wrapper to igrep, returning values

igrep(..., value=value, ignore.case=ignore.case);

}

#' grep, returning values

#'

#' grep, returning values

#'

#' This function is a simple wrapper around `base::grep()` which

#' returns matching values. It is

#' particularly helpful when grabbing values from a vector, but where the

#' case (uppercase or lowercase) is known.

#'

#' @param ...,value,ignore.case parameters sent to `base::grep()`

#'

#' @returns vector of matching values

#'

#' @examples

#' V <- paste0(LETTERS[1:5], LETTERS[4:8]);

#' vgrep("D", V);

#' vgrep("d", V);

#' vigrep("d", V);

#'

#' @family jam grep functions

#'

#' @export

vgrep <- function

(..., value=TRUE, ignore.case=FALSE)

{

## Purpose is simple to provide quicker wrapper to grep, returning values

grep(..., value=value, ignore.case=ignore.case);

}

#' case-insensitive grep

#'

#' case-insensitive grep

#'

#' This function is a simple wrapper around `base::grep()` which

#' runs in case-insensitive mode. It is mainly used to save keystrokes,

#' but is consistently named alongside `vgrep()` and

#' `vigrep()`.

#'

#' @param ...,ignore.case parameters sent to `base::grep()`

#'

#' @returns vector of matching indices

#'

#' @examples

#' V <- paste0(LETTERS[1:5], LETTERS[4:8]);

#' igrep("D", V);

#' igrep("d", V);

#' vigrep("d", V);

#'

#' @family jam grep functions

#'

#' @export

igrep <- function

(..., ignore.case=TRUE)

{

## Purpose is simply to provide quick wrapper for case-insensitive grep()

grep(ignore.case=ignore.case, ...);

}

#' case-insensitive logical grepl

#'

#' case-insensitive logical grepl

#'

#' This function is a simple wrapper around `base::grepl()` which

#' runs in case-insensitive mode simply by adding default `ignore.case=TRUE`.

#' It is mainly used for convenience.

#'

#' @param ...,ignore.case parameters sent to `base::grep()`

#'

#' @returns `logical` vector indicating pattern match

#'

#' @examples

#' V <- paste0(LETTERS[1:5], LETTERS[4:8]);

#' ig1 <- grepl("D", V);

#' ig2 <- igrepl("D", V);

#' ig3 <- grepl("d", V);

#' ig4 <- igrepl("d", V);

#' data.frame(V,

#' grepl_D=ig1,

#' grepl_d=ig3,

#' igrepl_D=ig2,

#' igrepl_d=ig4);

#'

#' @family jam grep functions

#'

#' @export

igrepl <- function

(...,

ignore.case=TRUE)

{

## Purpose is simply to provide quick wrapper for case-insensitive grep()

grepl(ignore.case=ignore.case,

...);

}

#' case-insensitive grep, returning unmatched indices

#'

#' case-insensitive grep, returning unmatched indices

#'

#' This function is a simple wrapper around `base::grep()` which

#' runs in case-insensitive mode, and returns unmatched entries.

#' It is mainly used to save keystrokes,

#' but is consistently named alongside `vgrep()` and

#' `vigrep()`, and quite helpful for writing concise code.

#'

#' @param ...,ignore.case,invert parameters sent to `base::grep()`

#'

#' @returns vector of non-matching indices

#'

#' @examples

#' V <- paste0(LETTERS[1:5], LETTERS[4:8]);

#' unigrep("D", V);

#' igrep("D", V);

#'

#' @family jam grep functions

#'

#' @export

unigrep <- function

(..., ignore.case=TRUE, invert=TRUE)

{

## purpose is to un-grep, return non-hits in case-insensitive fashion

igrep(..., ignore.case=ignore.case, invert=invert);

}

#' case-insensitive grep, returning unmatched values

#'

#' case-insensitive grep, returning unmatched values

#'

#' This function is a simple wrapper around `base::grep()` which

#' runs in case-insensitive mode, and returns unmatched values.

#' It is mainly used to save keystrokes,

#' but is consistently named alongside `vgrep()` and

#' `vigrep()`, and quite helpful for writing concise code.

#' It is particularly useful for removing unwanted entries from a long

#' vector, for example removing accession numbers from a long

#' vector of gene symbols in order to review gene annotations.

#'

#' @param ...,ignore.case,value,invert parameters sent to `base::grep()`

#'

#' @returns vector of non-matching indices

#'

#' @examples

#' V <- paste0(LETTERS[1:5], LETTERS[4:8]);

#' unigrep("D", V);

#' igrep("D", V);

#'

#' @family jam grep functions

#'

#' @export

unvigrep <- function

(..., ignore.case=TRUE, value=TRUE, invert=TRUE)

{

## purpose is to un-grep, return non-hits in case-insensitive fashion

grep(..., ignore.case=ignore.case, value=value, invert=invert);

}

#' provigrep: progressive case-insensitive value-grep

#'

#' case-insensitive value-grep for a vector of patterns

#'

#' Purpose is to provide "progressive vigrep()",which is value-returning,

#' case-insensitive grep, starting with an ordered vector of grep patterns.

#' For example, it returns entries in the order they are matched, by the

#' progressive use of grep patterns.

#'

#' It is particularly good when using multiple grep patterns, since

#' `grep()` does not accept multiple patterns as input. This function

#' also only returns the unique matches in the order they were matched,

#' which alleviates the need to run a series of `grep()` functions

#' and collating their results.

#'

#' It is mainly to allow for prioritized ordering of matching entries, where

#' one would like certain matching entries first, followed by another

#' set of matching entries, without duplication. For example,

#' one might grep for a few patterns, but want certain pattern hits to be

#' listed first.

#'

#' @param patterns `character` vector of regular expression patterns,

#' ultimately passed to `base::grep()`.

#' @param x `character` vector that is the subject of `base::grep()`.

#' @param maxValues `integer` or NULL, the maximum matching entries to

#' return per grep pattern. Note that each grep pattern may match multiple

#' values, and values are only returned at most once each, so restricting

#' items returned by one grep pattern may allow an item to be matched

#' by subsequent patterns, see examples. This argument is most commonly

#' used with `maxValues=1` which returns only the first matching entry

#' per pattern.

#' @param sortFunc `function` or NULL, used to sort entries within each set of

#' matching entries. Use NULL to avoid sorting entries.

#' @param rev `logical` whether to reverse the order of matching entries. Use

#' TRUE if you would like entries matching the patterns to be placed last,

#' and entries not matching the grep patterns to be placed first. This

#' technique is effective at placing "noise names" at the end of a long

#' vector, for example.

#' @param returnType `character` indicating whether to return a vector or list.

#' A list will be in order of the grep patterns, using empty elements to

#' indicate when no entries matched each pattern. This output is useful

#' when you would like to know which patterns matched specific entries.

#' @param ignore.case `logical` parameter sent to `base::grep()`, TRUE

#' runs in case-insensitive mode, as by default.

#' @param value `logical` indicating whether to return the matched value,

#' or when `value=FALSE` the index position is returned.

#' @param ... additional arguments are passed to `vigrep()`.

#'

#' @returns `character` vector with entries in `x` reordered to match

#' the order of `patterns` provided, or `list` when `returnType="list"`

#' named by `patterns` in the order provided. When `value=FALSE` then

#' it returns `integer` index values of `x`.

#'

#' @examples

#' # a rather comical example

#' # set up a test set with labels containing several substrings

#' set.seed(1);

#' testTerms <- c("robot","tree","dog","mailbox","pizza","noob");

#' testWords <- pasteByRow(t(combn(testTerms,3)));

#'

#' # now pull out entries matching substrings in order

#' provigrep(c("pizza", "dog", "noob", "."), testWords);

#' # more detail about the sort order is shown with returnType="list"

#' provigrep(c("pizza", "dog", "noob", "."), testWords, returnType="list");

#' # rev=TRUE will reverse the order of the list

#' provigrep(c("pizza", "dog", "noob", "."), testWords, returnType="list", rev=TRUE);

#' provigrep(c("pizza", "dog", "noob", "."), testWords, rev=TRUE);

#'

#' # another example showing ordering of duplicated entries

#' set.seed(1);

#' x <- paste0(

#' sample(letters[c(1,2,2,3,3,3,4,4,4,4)]),

#' sample(1:5));

#' x;

#' # sort by letter

#' provigrep(letters[1:4], x)

#'

#' # show more detail about how the sort is performed

#' provigrep(letters[1:4], x, returnType="list")

#'

#' # rev=TRUE will reverse the order of pattern matching

#' # which is most useful when "." is the last pattern:

#' provigrep(c(letters[1:3], "."), x, returnType="list")

#' provigrep(c(letters[1:3], "."), x, returnType="list", rev=TRUE)

#'

#' # example demonstrating maxValues

#' # return in list format

#' provigrep(c("[ABCD]", "[CDEF]", "[FGHI]"), LETTERS, returnType="list")

#'

#' # maxValues=1

#' provigrep(c("[ABCD]", "[CDEF]", "[FGHI]"), LETTERS, returnType="list", maxValues=1)

#' provigrep(c("[ABCD]", "[CDEF]", "[FGHI]"), LETTERS, returnType="list", maxValues=1, value=FALSE)

#' proigrep(c("[ABCD]", "[CDEF]", "[FGHI]"), LETTERS, maxValues=1)

#'

#' @family jam grep functions

#'

#' @export

provigrep <- function

(patterns,

x,

maxValues=NULL,

sortFunc=c,

rev=FALSE,

returnType=c("vector", "list"),

ignore.case=TRUE,

value=TRUE,

...)

{

## Purpose is to provide "progressive vigrep()" (which is value-returning,

## case-insensitive) mainly to allow for prioritized ordering of matching

## entries.

## For example, one might grep for a few patterns, but want certain pattern

## hits to come back before others.

##

## rev will return the entries in reverse order, which is effective if

## using set of patterns to down-prioritize.

##

## sortFunc is intended to allow for sorting each set of matched entries

## along the way, particularly useful when using a non-standard sort

## function.

##

## returnType="vector" returns the vector of matching entries

## returnType="list" returns a named list of matching entries, using

## the grep patterns as list names

##

returnType <- match.arg(returnType);

x_unique <- make.unique(as.character(x),

sep="_v");

## Iterate each grep pattern

valueSetL <- lapply(patterns, function(i){

z <- vigrep(pattern=i,

x=x,

value=TRUE,

ignore.case=ignore.case,

...);

if (length(sortFunc) > 0 && !identical(c, sortFunc)) {

## If sortFunc is not c(), then run it

z <- sortFunc(z);

}

## Here the values are converted to index positions

match(make.unique(as.character(z), sep="_v"),

x_unique);

});

## Apply maxValues

if (length(maxValues) > 0) {

valueSetL <- jamba::heads(valueSetL,

n=maxValues);

}

## Make each item only represented once across the list

if (length(names(patterns)) == 0) {

names(valueSetL) <- makeNames(patterns);

} else {

names(valueSetL) <- names(patterns);

}

f1 <- factor(names(valueSetL),

levels=names(valueSetL));

m1 <- match(

make.unique(sep="_v",

as.character(unlist(valueSetL))),

as.character(seq_along(x)));

r1 <- rep(f1, lengths(valueSetL));

if (value && "list" %in% returnType) {

valueSetL <- split(x[m1[!is.na(m1)]], r1[!is.na(m1)]);

} else {

valueSetL <- split(m1[!is.na(m1)], r1[!is.na(m1)]);

}

## Optionally reverse the list

if (rev) {

valueSetL <- rev(valueSetL);

}

## Optionally return the list format

if ("list" %in% returnType) {

return(valueSetL);

}

if (value) {

valueSet <- x[unique(unlist(valueSetL))];

} else {

valueSet <- unique(unlist(valueSetL));

}

return(valueSet);

}

#' proigrep: progressive case-insensitive grep

#'

#' case-insensitive grep for a vector of patterns

#'

#' @rdname provigrep

#'

#' @export

proigrep <- function

(...,

value=FALSE)

{

provigrep(...,

value=value);

}

#' rbind a list of vectors into matrix or data.frame

#'

#' rbind a list of vectors into matrix or data.frame

#'

#' The purpose of this function is to emulate `do.call(rbind, x)` on a list

#' of vectors, while specifically handling when there are different

#' numbers of entries per vector. The output `matrix` number of columns

#' will be the longest vector (or largest number of columns) in the

#' input list `x`.

#'

#' Instead of recycling values in each row to fill the target number

#' of columns, this function fills cells with blank fields,

#' with default argument `fixBlanks=TRUE`.

#'

#' In extensive timings tests at the time this function was created,

#' this technique was notably faster than alternatives.

#' It runs `do.call(rbind, x)` then subsequently replaces recycled values

#' with blank entries, in a manner that is notably faster than

#' alternative approaches such as pre-processing the input data.

#'

#' @returns `matrix` unless `returnDF=TRUE` in which the output is coerced

#' to a `data.frame`.

#' The rownames by default are derived from the list names,

#' but the colnames are not derived from the vector names.

#' If input `x` contains `data.frame` or `matrix` objects, the output

#' will retain those values.

#'

#' @param x `list` of atomic `vector`, `matrix`, or `data.frame`

#' objects.

#' @param emptyValue `character` value to use to represent missing values,

#' whenever a blank cell is introduced into the resulting matrix

#' @param nullValue optional value used to replace NULL entries in

#' the input list, useful especially when the data was produced

#' by `strsplit()` with `""`. Use `nullValue=""` to replace 'NULL'

#' with `""` and preserve the original list length. Otherwise when

#' `nullValue=NULL` any empty entries will be silently dropped.

#' @param keepListNames `logical` whether to use list names as rownames

#' in the resulting matrix or data.frame.

#' @param newColnames NULL or `character` vector of colnames to use for the

#' resulting matrix or data.frame.

#' @param newRownames NULL or `character` vector of rownames to use for the

#' resulting matrix or data.frame. If supplied, this value overrides the

#' keepListNames=TRUE use of list names as rownames.

#' @param fixBlanks `logical` whether to use blank values instead of repeating

#' each vector to the length of the maximum vector length when filling

#' each row of the matrix or data.frame.

#' @param returnDF `logical` whether to return a data.frame, by default FALSE,

#' a matrix is returned.

#' @param verbose `logical` whether to print verbose output during processing.

#' @param ... Additional arguments are ignored.

#'

#' @examples

#' L <- list(a=LETTERS[1:4], b=letters[1:3]);

#' rbindList(L);

#' rbindList(L, returnDF=TRUE);

#'

#' @family jam list functions

#'

#' @export

rbindList <- function

(x,

emptyValue="",

nullValue=NULL,

keepListNames=TRUE,

newColnames=NULL,

newRownames=NULL,

fixBlanks=TRUE,

returnDF=FALSE,

verbose=FALSE,

...)

{

## Purpose is to emulate do.call(rbind, x) on a list with variable

## numbers of entries but instead of repeating the values to fill the

## number of resulting columns, it goes back and empties out the fields

## which should have no value. In extensive timings tests at the time

## this function was created, this method was notably faster than

## alternatives.

##

## keepListNames=TRUE is default, the way R prepends list names to

## the element names when unlisting an object.

## keepListNames=FALSE will not use the list names, but keep the element

## names without changing them.

##

## newColnames and newRownames are optionally intended for assigning colnames

## and rownames to the resulting matrix, respectively.

##

## fixBlanks=FALSE will turn off the fixing of duplicated entries

##

## returnDF=TRUE will convert the output to data.frame, when usually it

## would be a matrix after calling rbind(). This step checks for non-unique

## rownames, and if present, calls makeNames(rownames(x), ...). The "..."

## can be used to customize how duplicate rownames are assigned.

##

xLslen <- lengths(x);

if (any(xLslen %in% 0)) {

if (length(nullValue) > 0) {

x[xLslen == 0] <- head(nullValue, 1);

xLslen[xLslen == 0] <- 1;

}

if (all(xLslen == 0)) {

return(invisible(NULL));

}

x <- x[!xLslen == 0];

xLslen <- xLslen[!xLslen == 0];

#x[xLslen == 0] <- "";

}

## Now run the normal do.call(rbind, ...) which duplicates entries

## but we will clean them up

xDF <- suppressWarnings(do.call(rbind, x));

if (!keepListNames) {

rownames(xDF) <- unlist(lapply(x, function(ix){

if (igrepHas("data.*frame|matrix", class(ix))) {

rownames(ix);

} else {

names(ix);

}}));

}

## Mark the row entries to fix

if (fixBlanks) {

xLfix <- unique(xLslen[xLslen < ncol(xDF)]);

if (length(xLfix) > 0) {

## Iterate chunks of rows which share the same lengths

## and blank out their subsequent column values

for(i in xLfix) {

whichRows <- which(xLslen == i);

xDF[whichRows,((i+1):ncol(xDF))] <- "";

}

}

}

if (!is.null(newColnames)) {

colnames(xDF) <- makeNames(rep(newColnames, length.out=ncol(xDF)));

}

if (!is.null(newRownames)) {

rownames(xDF) <- makeNames(rep(newRownames, length.out=nrow(xDF)));

}

if (returnDF) {

## Check for duplicated rownames, allowed in matrices but not

## in data.frames

if (length(tcount(rownames(xDF), minCount=2)) > 0) {

rownames(xDF) <- makeNames(rownames(xDF), ...);

}

#xDF <- unlistDataFrame(as.data.frame(xDF), verbose=verbose, ...);

xDF <- data.frame(check.names=FALSE,

xDF);

}

return(xDF);

}

#' make unique vector names

#'

#' make unique vector names

#'

#' This function extends the basic goal from `base::make.names()`

#' which is intended to make syntactically valid names from a character vector.

#' This makeNames function makes names unique, and offers configurable methods

#' to handle duplicate names. By default, any duplicated entries receive a

#' suffix _v# where # is s running count of entries observed, starting at 1.

#' The `base::make.names()` function, by contrast, renames the

#' second observed entry starting at .1, leaving the original entry

#' unchanged. Optionally, makeNames can rename all entries with a numeric

#' suffix, for consistency.

#'

#' For example:

#' \code{A, A, A, B, B, C}

#' becomes:

#' \code{A_v1, A_v2, A_v3, B_v1, B_v2, C}

#'

#' Also, makeNames always allows "_".

#'

#' This makeNames function is similar to `base::make.unique()`

#' which also converts a vector into a unique vector by adding suffix values,

#' however the `base::make.unique()` function intends to allow

#' repeated operations which recognize duplicated entries and continually

#' increment the suffix number. This makeNames function currently does not

#' handle repeat operations. The recommended approach to workaround having

#' pre-existing versioned names would be to remove suffix values prior to

#' running this function. One small distinction from

#' `base::make.unique()` is that makeNames does version the first

#' entry in a set.

#'

#' @returns character vector of unique names

#'

#' @family jam string functions

#'

#' @param x character vector to be used when defining names. All other

#' vector types will be coerced to character prior to use.

#' @param unique argument which is ignored, included only for

#' compatibility with `base::make.names`. All results from

#' `makeNames()` are unique.

#' @param suffix character separator between the original entry and the

#' version, if necessary.

#' @param renameOnes logical whether to rename single, unduplicated, entries.

#' @param doPadInteger logical whether to pad integer values to a consistent

#' number of digits, based upon all suffix values needed. This output

#' allows for more consistent sorting of names. To define a fixed number

#' of digits, use the useNchar parameter.

#' @param useNchar integer or NULL, number of digits to use when padding

#' integer values with leading zero, only relevant when usePadInteger=TRUE.

#' @param startN integer number used when numberStyle is "number", this integer

#' is used for the first entry to be renamed. You can use this value to

#' make zero-based suffix values, for example.

#' @param numberStyle character style for version numbering

#' \describe{

#' \item{"number"}{Use integer numbers to represent each duplicated

#' entry.}

#' \item{"letters"}{Use lowercase letters to represent each duplicated

#' entry. The 27th entry uses the pattern "aa" to represent two

#' 26-base digits. When doPadInteger=TRUE, a zero is still used

#' to pad the resulting version numbers, again to allow easy sorting

#' of text values, but also because there is no letter equivalent

#' for the number zero.

#' It is usually best to change the suffix to "_" or "" when using

#' "letters".}

#' \item{"LETTERS"}{Use uppercase letters to represent each duplicated

#' entry, with the same rules as applied to "letters".}

#' }

#' @param renameFirst logical whether to rename the first entry in a set of

#' duplicated entries. If FALSE then the first entry in a set will not

#' be versioned, even when renameOnes=TRUE.

#' @param keepNA logical whether to retain NA values using the string "NA".

#' If keepNA is FALSE, then NA values will remain NA, thus causing some

#' names to become `<NA>`, which can cause problems with some downstream

#' functions which assume all names are either NULL or non-NA.

#' @param ... Additional arguments are ignored.

#'

#' @examples

#' V <- rep(LETTERS[1:3], c(2,3,1));

#' makeNames(V);

#' makeNames(V, renameOnes=TRUE);

#' makeNames(V, renameFirst=FALSE);

#' exons <- makeNames(rep("exon", 3), suffix="");

#' makeNames(rep(exons, c(2,3,1)), numberStyle="letters", suffix="");

#'

#' @export

makeNames <- function

(x,

unique=TRUE,

suffix="_v",

renameOnes=FALSE,

doPadInteger=FALSE,

startN=1,

numberStyle=c("number","letters","LETTERS"),

useNchar=NULL,

renameFirst=TRUE,

keepNA=TRUE,

...)

{

## Purpose is to make unique names without the R mangling that comes

## with make.names().

## By default, unique entries are not renamed, and entries with two or

## more replicates are renamed to NAME_v1, NAME_v2, NAME_v3, etc.

##

## if renameOnes=TRUE, it will rename singlets to NAME_v1 even if there

## is only one entry.

##

## renameFirst=TRUE will rename each duplicated entry NAME_v1, NAME_v2,

## NAME_v3, etc.

## renameFirst=FALSE will not rename the first in a set of duplicated

## entries, e.g. NAME, NAME_v1, NAME_v2, etc.

##

## The distinction between renameOnes and renameFirst:

## renameOnes=TRUE will rename all singlets and duplicated entries,

## starting with the first entry.

## renameOnes=FALSE will not rename singlet entries.

## renameFirst=TRUE will only rename duplicated entries, starting with

## the first entry.

## renameFirst=FALSE will not rename the first entry in a set of

## duplicated entries.

##

## the suffix can be changed, e.g. "_r" will name names NAME_r1,

## NAME_r2, NAME_r3, etc.

##

## numberStyle="number" uses integers as the suffix

## numberStyle="letters" uses lowercase letters as digits

## numberStyle="LETTERS" uses uppercase letters as digits

## Be aware that letters can only go to roughly 18,000 entries,

## given the current implementation of colNum2excelName

##

## When useNchar is numeric, it sets doPadInteger=TRUE,

## and will use at least that many digits in padding the integer.

##

##

## TODO:

## Update logic to be analogous to using make.unique(), which intends

## to maintain previous versioning of names without appending deeper

## suffices as appropriate.

## E.g. c("", "", "", "_v1", "_v2", "_v3")

## becomes c("_v4", "_v5", "_v6", "_v1", "_v2", "_v3")

## instead of

## c("_v1", "_v2", "_v3", "_v1", "_v2", "_v3")

## or

## c("_v1_v1", "_v2_v1", "_v3_v1", "_v1_v2", "_v2_v2", "_v3_v2")

##

if (length(x) == 0) {

return(x);

}

numberStyle <- match.arg(numberStyle);

if (!is.null(useNchar)) {

useNchar <- as.integer(useNchar);

doPadInteger=TRUE;

}

if (any(c("factor", "ordered") %in% class(x))) {

x <- as.character(x);

}

if (keepNA && any(is.na(x))) {

x <- rmNA(x,

naValue="NA");

}

## First check for duplicates using anyDuplicated()

## version 0.0.35.900, this change speeds assignment

## in large vectors when most entries are not duplicated.

dupes <- duplicated(x);

## Convert entries to a named count of occurences of each entry

if (any(dupes)) {

xSubDupes <- table(x[dupes]) + 1;

maxCt <- max(c(1,xSubDupes));

xSubOnes <- stats::setNames(rep(1, sum(!dupes)), x[!dupes]);

xSub <- c(xSubOnes, xSubDupes);

} else {

xSub <- stats::setNames(rep(1, sum(!dupes)), x[!dupes]);

maxCt <- 1;

}

## version 0.0.34.900 and previous used the method below

#xSub <- table(as.character(x));

## Vector of counts to be used

versionsV <- as.integer(renameFirst):maxCt + startN - 1;

## If using letters, define the set of letter upfront to save processing

if (igrepHas("letters", numberStyle)) {

if (numberStyle %in% "letters") {

useLetters <- letters[1:26];

zeroVal <- "A";

} else {

useLetters <- LETTERS[1:26];

zeroVal <- "a";

}

num2letters <- colNum2excelName(versionsV,

useLetters=useLetters,

zeroVal=zeroVal,

...);

versionsV <- num2letters;

}

if (doPadInteger) {

versionsV <- padInteger(versionsV,

useNchar=useNchar,

...);

}

## If no duplicated entries

if (max(xSub) %in% c(-Inf,1)) {

## If not renaming the singlet entries, send the same list back

if (!renameOnes) {

return(x);

} else {

## If renaming singlets, simply paste the suffix and first entry

return(paste0(x, suffix, head(versionsV, 1)));

}

}

if (renameOnes) {

xUse <- 1:length(x);

} else {

xUse <- (x %in% names(xSub)[xSub > 1]);

}

xSub1 <- x[xUse];

## Preserve the original order

names(xSub1) <- padInteger(seq_along(xSub1));

## Split the vector into a list of vectors, by name

xSub2 <- split(xSub1, xSub1);

names(xSub2) <- NULL;

## Optionally pad the integer to facilitate sorting

## Note: This padding only pads integers within each name,

## not across all names.

xSub3 <- lapply(xSub2, function(i){

versionsV[seq_along(i)];

});

## Now simply paste the value, the suffix, and the new version

xSub1v <- paste0(unlist(xSub2), suffix, unlist(xSub3));

## Re-order the vector using the original order

names(xSub1v) <- names(unlist(xSub2));

xSub1v2 <- xSub1v[names(xSub1)];

## Assign only the entries we versioned

x[xUse] <- xSub1v2;

## Last check for renameFirst=FALSE, in which case we remove the first

## versioned entry

if (!renameFirst) {

escapeRegex <- function(string){

gsub("([.|()\\^{}+$*?]|\\[|\\])", "\\\\\\1", string);

}

firstVer <- paste0(escapeRegex(paste0(suffix, head(versionsV, 1))), "$");

x[xUse] <- gsub(firstVer, "", x[xUse]);

}

return(x);

}

#' assign unique names for a vector

#'

#' assign unique names for a vector

#'

#' This function assigns unique names to a vector, if necessary it runs

#' `makeNames()` to create unique names. It differs from

#' `stats::setNames()` in that it ensures names are unique,

#' and when no names are supplied, it uses the vector itself to define

#' names. It is helpful to run this function inside an `base::lapply()`

#' function call, which by default maintains names, but does not assign

#' names if the input data did not already have them.

#'

#' When used with a data.frame, it is particularly convenient to pull out

#' a named vector of values. For example, log2 fold changes by gene, where

#' the gene symbols are the name of the vector.

#'

#' \code{nameVector(genedata[,c("Gene","log2FC")])}

#'

#' @returns vector with names defined

#'

#' @family jam string functions

#'

#' @param x `character` vector, or `data.frame` or equivalent

#' (matrix, or tibble) with two columns, the second column

#' is used to name values in the first column.

#' @param y `character` or NULL, with names. If NULL then x is used.

#' Note that y is recycled to the length of x, prior to being sent

#' to the makeNamesFunc.

#' In fringe cases, y can be a matrix, data.frame, or tibble, in which

#' case `pasteByRow()` will be used to create a character string

#' to be used for vector names. Note this case is activated only when x

#' is not a two column matrix, data.frame, or tibble.

#' @param makeNamesFunc `function` to make names unique, by default

#' `makeNames()` which ensures names are unique.

#' @param ... passed to `makeNamesFunc`, or to

#' `pasteByRow()` if y is a two column data.frame, matrix, or

#' tibble. Thus, `sep` can be defined here as a delimiter between

#' column values.

#'

#' @examples

#' # it generally just creates names from the vector values

#' nameVector(LETTERS[1:5]);

#'

#' # if values are replicated, the makeNames() function makes them unique

#' V <- rep(LETTERS[1:5], each=3);

#' nameVector(V);

#'

#' # for a two-column data.frame, it creates a named vector using

#' # the values in the first column, and names in the second column.

#' df <- data.frame(seq_along(V), V);

#' df;

#' nameVector(df);

#'

#' # Lastly, admittedly a fringe case, it can take a multi-column data.frame

#' # to generate labels:

#' nameVector(V, df);

#'

#' @export

nameVector <- function

(x,

y=NULL,

makeNamesFunc=makeNames,

...)

{

## Purpose is to name a vector with its own values,

## useful for lapply which only names output if the input

## vector has names.

##

## A neat trick is to use the _v# naming scheme in makeNames to

## create unique names based upon a single label, e.g.

## set1colors <- nameVector(brewer.pal(15, "Set1"), "Set1");

## Set1_v1 Set1_v2 Set1_v3 Set1_v4 Set1_v5 Set1_v6 Set1_v7 Set1_v8 Set1_v9

## "#E41A1C" "#377EB8" "#4DAF4A" "#984EA3" "#FF7F00" "#FFFF33" "#A65628" "#F781BF" "#999999"

##

## Added bonus, if given a 2-column table, it'll use them as x and y

if (igrepHas("dataframe", class(x))) {

x <- as.data.frame(x);

}

if (igrepHas("data.frame", class(x)) && ncol(x) == 2) {

y <- x[[2]];

x <- x[[1]];

} else if (igrepHas("matrix", class(x)) && ncol(x) == 2) {

y <- x[,2];

x <- x[,1];

}

if (length(y) > 0) {

if (igrepHas("data.frame|matrix", class(y))) {

## If given a data.frame use pasteByRow() to create a string

y <- pasteByRow(y, ...);

}

names(x) <- makeNamesFunc(rep(y, length.out=length(x)), ...);

} else {

names(x) <- makeNamesFunc(x, ...);

}

return(x);

}

#' define a named vector using vector names

#'

#' define a named vector using vector names

#'

#' This function creates a vector from the names of the input vector,

#' then assigns the same as names. The utility is mainly for

#' `base::lapply()` functions which maintain the name of a vector

#' in its output. The reason to run `base::lapply()` using names

#' is so the lapply function is operating only on the name and not the

#' data it references, which can be convenient when the name of the element

#' is useful to known inside the function body. The reason to name the names,

#' is so the list object returned by `base::lapply()` is also named

#' with these same consistent names.

#'

#' Consider a list of data.frames, each of which represents stats results

#' from a contrast and fold change. The data.frame may not indicate the name

#' of the contrast, while the list itself may be named by the contrast.

#' One would \code{lapply(nameVectorN(listDF), function(iName)iName)} which

#' allows the internal function access to the name of each list element. This

#' could for example be added to the data.frame.

#'

#' @returns vector of names, whose names are uniquely assigned using

#' `makeNames()` using the values of the vector.

#'

#' @family jam string functions

#'

#' @param x `character` vector or any object which has names available

#' `names(x)`.

#' @param makeNamesFunc `function` used to create unique names, in the event that

#' the names(x) are not unique.

#' @param ... Additional arguments are ignored.

#'

#' @examples

#' # a simple integer vector with character names

#' L <- nameVector(1:5, LETTERS[1:5]);

#' L;