I am trying to wrap my head around the idea of recursion. However, when I apply my recursive R function, it does not return a string split into the number of chunks desired. It only returns two chunks. However, my goal is to split a long string into multiple chunks of smaller strings of size n. I am sure there are other ways to do this, but I am trying find a recursive solution. Any help is appreciated thanks in advance.
# Sample dataset
x <- paste0(rep(letters, 10000), collapse = "")
split_group <- function(x, n = 10) {
if (nchar(x) < n) {
return(x)
} else {
beginning <- substring(x, 1, n)
remaining <- substring(x, (n + 1), (n + 1) + (n - 1))
c(beginning, split_group(remaining, n))
}
}
split_group(x = x, n = 10)
# Returns: "abcdefghij" "klmnopqrst" ""
Use <= instead of < and fix remaining.
split_group <- function(x, n = 10) {
if (nchar(x) <= n) x
else {
beginning <- substring(x, 1, n)
remaining <- substring(x, n + 1)
c(beginning, split_group(remaining, n))
}
}
x <- substring(paste(letters, collapse = ""), 1, 24)
split_group(x, 2)
## [1] "ab" "cd" "ef" "gh" "ij" "kl" "mn" "op" "qr" "st" "uv" "wx"
split_group(x, 5)
## [1] "abcde" "fghij" "klmno" "pqrst" "uvwx"
split_group(x, 6)
## [1] "abcdef" "ghijkl" "mnopqr" "stuvwx"
split_group(x, 10)
## [1] "abcdefghij" "klmnopqrst" "uvwx"
split_group(x, 23)
## [1] "abcdefghijklmnopqrstuvw" "x"
split_group(x, 24)
## [1] "abcdefghijklmnopqrstuvwx"
split_group(x, 25)
## [1] "abcdefghijklmnopqrstuvwx"
2) and some approaches without recursion The first is the shortest but the second is the simplest and only uses base R. The third only uses base R as well.
library(gsubfn)
strapply(x, "(.{1,10})", simplify = c)
## [1] "abcdefghij" "klmnopqrst" "uvwx"
ix <- seq(1, nchar(x), 10)
substring(x, ix, ix + 10 - 1)
## [1] "abcdefghij" "klmnopqrst" "uvwx"
sapply(seq(1, nchar(x), 10), function(i) substring(x, i, i + 10 - 1))
## [1] "abcdefghij" "klmnopqrst" "uvwx"
library(zoo)
s <- strsplit(x, "")[[1]]
rollapply(s, 10, by = 10, paste0, collapse = "", partial = TRUE, align = "left")
## [1] "abcdefghij" "klmnopqrst" "uvwx"
A base R option would be
x1 <- strsplit(x, "(?<=.{10})(?=.)", perl = TRUE)[[1]]
-output
> head(x1, 10)
[1] "abcdefghij" "klmnopqrst" "uvwxyzabcd" "efghijklmn" "opqrstuvwx" "yzabcdefgh" "ijklmnopqr" "stuvwxyzab" "cdefghijkl" "mnopqrstuv"
Related
Vectors a and b can be shortened using toString(width = 10) in Base R resulting in a shorter vector that ends in ....
However, I wonder how I can make the shortened vector to end in ..., last vector element?
My desired_output is shown below.
a <- 1:26
b <- LETTERS
toString(a, width = 10)
# [1] "1,2,...."
desired_output1 = "1,2,...,26"
toString(b, width = 10)
# [1] "A,B,...."
desired_output2 = "A,B,...,Z"
You could just add the end on.
paste(toString(a, width = 10), a[length(a)], sep=", ")
[1] "1, 2, ...., 26"
paste(toString(b, width = 10), b[length(b)], sep=", ")
[1] "A, B, ...., Z"
After applting the toString, we may use sub to remove the substring to format
f1 <- function(vec, n = 2) {
gsub("\\s+", "",
sub(sprintf("^(([^,]+, ){%s}).*, ([^,]+)$", n), "\\1...,\\3", toString(vec)))
}
-testing
> f1(a)
[1] "1,2,...,26"
> f1(b)
[1] "A,B,...,Z"
> f1(a, 3)
[1] "1,2,3,...,26"
> f1(b, 3)
[1] "A,B,C,...,Z"
> f1(a, 4)
[1] "1,2,3,4,...,26"
> f1(b, 4)
[1] "A,B,C,D,...,Z"
We could do it this way:
Creating a function that extraxt the first two elements and the last element of the vector and paste them together:
my_func <- function(x) {
a <- paste(x[1:2], collapse=",")
b <- tail(x, n=1)
paste0(a,",...,",b)
}
my_func(a)
[1] "1,2,...,26"
my_func(b)
[1] "A,B,...,Z"
library(stringr)
a <- 1:26
b <- LETTERS
reduce_string <- function(x, n_show) {
str_c(x[1:n_show], collapse = ',') %>%
str_c('....,', x[[length(x)]])
}
reduce_string(a, 2)
#> [1] "1,2....,26"
Created on 2022-01-02 by the reprex package (v2.0.1)
I have a vector of K elements and I need to check if it contains a precise subset of 2 consecutive elements.
Assume K = 6
vec = c(4,4,3,1,2,2)
How can I get an indicator that checks for the subset (4,2) as consecutive elements? Should return FALSE in this example while (3,1) should return TRUE.
One another approach could be:
grepl("42", paste(vec, collapse = ""))
[1] FALSE
grepl("31", paste(vec, collapse = ""))
[1] TRUE
1) Use rollapply with the identical function.
library(zoo)
vec <- c(4,4,3,1,2,2)
x <- c(4, 2)
any(rollapply(vec, length(x), identical, x))
## [1] FALSE
x <- c(3, 1)
any(rollapply(vec, length(x), identical, x))
## [1] TRUE
2) Create strings out of vec and x and use grepl:
x <- c(4, 2)
grepl(sprintf("\\b%s\\b", toString(x)), toString(vec))
## [1] FALSE
x <- c(3, 1)
grepl(sprintf("\\b%s\\b", toString(x)), toString(vec))
## [1] TRUE
3) If x always has two elements then:
x <- c(4, 2)
any(head(vec, -1) == x[1] & tail(vec, -1) == x[2])
## [1] FALSE
x <- c(3, 1)
any(head(vec, -1) == x[1] & tail(vec, -1) == x[2])
## [1] TRUE
Especially if you have more than 2 elements to check, this might be worthwhile:
vec <-= c(4,4,3,1,2,2)
chk <- c(3, 1)
as.logical(length(Reduce(intersect, lapply(seq_along(chk), function(x) which(chk[x] == lead(vec, x - 1))))))
# [1] TRUE
chk <- c(4, 1)
as.logical(length(Reduce(intersect, lapply(seq_along(chk), function(x) which(chk[x] == lead(vec, x - 1))))))
# [1] FALSE
Using base R:
find_subsequence = function (vec, needle) {
sub_idx = seq_along(needle) - 1L
Filter(
function (i) all(needle == vec[sub_idx + i]),
seq_len(length(vec) - length(needle) + 1L)
)
}
find_subsequence(vec, c(3, 1))
# [1] 4
find_subsequence(vec, c(4, 2))
# integer(0)
For instance, how to convert the number '10010000110000011000011111011000' in Base2 to number in Base4 ?
Here is one approach that breaks up the string into units of length 2 and then looks up the corresponding base 4 for the pair:
convert <- c("00"="0","01"="1","10"="2","11"="3")
from2to4 <- function(s){
if(nchar(s) %% 2 == 1) s <- paste0('0',s)
n <- nchar(s)
bigrams <- sapply(seq(1,n,2),function(i) substr(s,i,i+1))
digits <- convert[bigrams]
paste0(digits, collapse = "")
}
A one-liner approach:
> paste(as.numeric(factor(substring(a,seq(1,nchar(a),2),seq(2,nchar(a),2))))-1,collapse="")
[1] "2100300120133120"
There are multiple ways to split the string into 2 digits, see Chopping a string into a vector of fixed width character elements
Here are a couple inverses:
bin_to_base4 <- function(x){
x <- strsplit(x, '')
vapply(x, function(bits){
bits <- as.integer(bits)
paste(2 * bits[c(TRUE, FALSE)] + bits[c(FALSE, TRUE)], collapse = '')
}, character(1))
}
base4_to_bin <- function(x){
x <- strsplit(x, '')
vapply(x, function(quats){
quats <- as.integer(quats)
paste0(quats %/% 2, quats %% 2, collapse = '')
}, character(1))
}
x <- '10010000110000011000011111011000'
bin_to_base4(x)
#> [1] "2100300120133120"
base4_to_bin(bin_to_base4(x))
#> [1] "10010000110000011000011111011000"
...and they're vectorized!
base4_to_bin(bin_to_base4(c(x, x)))
#> [1] "10010000110000011000011111011000" "10010000110000011000011111011000"
For actual use, it would be a good idea to put in some sanity checks to ensure the input is actually in the appropriate base.
Convert Base2 to Base10 first, then from Base10 to Base4
Given is vector:
vec <- c(LETTERS[1:10])
I would like to be able to combine it in a following manner:
resA <- c("AB", "CD", "EF", "GH", "IJ")
resB <- c("ABCDEF","GHIJ")
where elements of the vector vec are merged together according to the desired size of a new element constituting the resulting vector. This is 2 in case of resA and 5 in case of resB.
Desired solution characteristics
The solution should allow for flexibility with respect to the element sizes, i.e. I may want to have vectors with elements of size 2 or 20
There may be not enough elements in the vector to match the desired chunk size, in that case last element should be shortened accordingly (as shown)
This is shouldn't make a difference but the solution should work on words as well
Attempts
Initially, I was thinking of using something on the lines:
c(
paste0(vec[1:2], collapse = ""),
paste0(vec[3:4], collapse = ""),
paste0(vec[5:6], collapse = "")
# ...
)
but this would have to be adapted to jump through the remaining pairs/bigger groups of the vec and handle last group which often would be of a smaller size.
Here is what I came up with. Using Harlan's idea in this question, you can split the vector in different number of chunks. You also want to use your paste0() idea in lapply() here. Finally, you unlist a list.
unlist(lapply(split(vec, ceiling(seq_along(vec)/2)), function(x){paste0(x, collapse = "")}))
# 1 2 3 4 5
#"AB" "CD" "EF" "GH" "IJ"
unlist(lapply(split(vec, ceiling(seq_along(vec)/5)), function(x){paste0(x, collapse = "")}))
# 1 2
#"ABCDE" "FGHIJ"
unlist(lapply(split(vec, ceiling(seq_along(vec)/3)), function(x){paste0(x, collapse = "")}))
# 1 2 3 4
#"ABC" "DEF" "GHI" "J"
vec <- c(LETTERS[1:10])
f1 <- function(x, n){
f <- function(x) paste0(x, collapse = '')
regmatches(f(x), gregexpr(f(rep('.', n)), f(x)))[[1]]
}
f1(vec, 2)
# [1] "AB" "CD" "EF" "GH" "IJ"
or
f2 <- function(x, n)
apply(matrix(x, nrow = n), 2, paste0, collapse = '')
f2(vec, 5)
# [1] "ABCDE" "FGHIJ"
or
f3 <- function(x, n) {
f <- function(x) paste0(x, collapse = '')
strsplit(gsub(sprintf('(%s)', f(rep('.', n))), '\\1 ', f(x)), '\\s+')[[1]]
}
f3(vec, 4)
# [1] "ABCD" "EFGH" "IJ"
I would say the last is best of these since n for the others must be a factor or you will get warnings or recycling
edit - more
f4 <- function(x, n) {
f <- function(x) paste0(x, collapse = '')
Vectorize(substring, USE.NAMES = FALSE)(f(x), which((seq_along(x) %% n) == 1),
which((seq_along(x) %% n) == 0))
}
f4(vec, 2)
# [1] "AB" "CD" "EF" "GH" "IJ"
or
f5 <- function(x, n)
mapply(function(x) paste0(x, collapse = ''),
split(x, c(0, head(cumsum(rep_len(sequence(n), length(x)) %in% n), -1))),
USE.NAMES = FALSE)
f5(vec, 4)
# [1] "ABCD" "EFGH" "IJ"
Here is another way, working with the original array.
A side note, working with words is not straightforward, since there is at least two ways to understand it: you can either keep each word separately or collapse them first an get individual characters. The next function can deal with both options.
vec <- c(LETTERS[1:10])
vec2 <- c("AB","CDE","F","GHIJ")
cuts <- function(x, n, bychar=F) {
if (bychar) x <- unlist(strsplit(paste0(x, collapse=""), ""))
ii <- seq_along(x)
li <- split(ii, ceiling(ii/n))
return(sapply(li, function(y) paste0(x[y], collapse="")))
}
cuts(vec2,2,F)
# 1 2
# "ABCDE" "FGHIJ"
cuts(vec2,2,T)
# 1 2 3 4 5
# "AB" "CD" "EF" "GH" "IJ"
I use LETTERS most of the time for my factors but today I tried to go beyond 26 characters:
LETTERS[1:32]
Expecting there to be an automatic recursive factorization AA, AB, AC... But was disappointed. Is this simply a limitation of LETTERS or is there a way to get what I'm looking for using another function?
Would 702 be enough?
LETTERS702 <- c(LETTERS, sapply(LETTERS, function(x) paste0(x, LETTERS)))
If not, how about 18,278?
MOAR_LETTERS <- function(n=2) {
n <- as.integer(n[1L])
if(!is.finite(n) || n < 2)
stop("'n' must be a length-1 integer >= 2")
res <- vector("list", n)
res[[1]] <- LETTERS
for(i in 2:n)
res[[i]] <- c(sapply(res[[i-1L]], function(y) paste0(y, LETTERS)))
unlist(res)
}
ml <- MOAR_LETTERS(3)
str(ml)
# chr [1:18278] "A" "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "L" "M" "N" "O" ...
This solution uses recursion. Usage is a bit different in the sense MORELETTERS is not a long vector you will have to store and possibly expand as your inputs get larger. Instead, it is a function that converts your numbers into the new base.
extend <- function(alphabet) function(i) {
base10toA <- function(n, A) {
stopifnot(n >= 0L)
N <- length(A)
j <- n %/% N
if (j == 0L) A[n + 1L] else paste0(Recall(j - 1L, A), A[n %% N + 1L])
}
vapply(i-1L, base10toA, character(1L), alphabet)
}
MORELETTERS <- extend(LETTERS)
MORELETTERS(1:1000)
# [1] "A" "B" ... "ALL"
MORELETTERS(c(1, 26, 27, 1000, 1e6, .Machine$integer.max))
# [1] "A" "Z" "AA" "ALL" "BDWGN" "FXSHRXW"
You can make what you want like this:
LETTERS2<-c(LETTERS[1:26], paste0("A",LETTERS[1:26]))
Another solution for excel style column names, generalized to any number of letters
#' Excel Style Column Names
#'
#' #param n maximum number of letters in column name
excel_style_colnames <- function(n){
unlist(Reduce(
function(x, y) as.vector(outer(x, y, 'paste0')),
lapply(1:n, function(x) LETTERS),
accumulate = TRUE
))
}
A variant on eipi10's method (ordered correctly) using data.table:
library(data.table)
BIG_LETTERS <- c(LETTERS,
do.call("paste0",CJ(LETTERS,LETTERS)),
do.call("paste0",CJ(LETTERS,LETTERS,LETTERS)))
Yet another option:
l2 = c(LETTERS, sort(do.call("paste0", expand.grid(LETTERS, LETTERS[1:3]))))
Adjust the two instances of LETTERS inside expand.grid to get the number of letter pairs you'd like.
A function to produce Excel-style column names, i.e.
# A, B, ..., Z, AA, AB, ..., AZ, BA, BB, ..., ..., ZZ, AAA, ...
letterwrap <- function(n, depth = 1) {
args <- lapply(1:depth, FUN = function(x) return(LETTERS))
x <- do.call(expand.grid, args = list(args, stringsAsFactors = F))
x <- x[, rev(names(x)), drop = F]
x <- do.call(paste0, x)
if (n <= length(x)) return(x[1:n])
return(c(x, letterwrap(n - length(x), depth = depth + 1)))
}
letterwrap(26^2 + 52) # through AAZ
## This will take a few seconds:
# x <- letterwrap(1e6)
It's probably not the fastest, but it extends indefinitely and is nicely predictable. Took about 20 seconds to produce through 1 million, BDWGN.
(For a few more details, see here: https://stackoverflow.com/a/21689613/903061)
A little late to the party, but I want to play too.
You can also use sub, and sprintf in place of paste0 and get a length 702 vector.
c(LETTERS, sapply(LETTERS, sub, pattern = " ", x = sprintf("%2s", LETTERS)))
Here's another addition to the list. This seems a bit faster than Gregor's (comparison done on my computer - using length.out = 1e6 his took 12.88 seconds, mine was 6.2), and can also be extended indefinitely. The flip side is that it's 2 functions, not just 1.
make.chars <- function(length.out, case, n.char = NULL) {
if(is.null(n.char))
n.char <- ceiling(log(length.out, 26))
m <- sapply(n.char:1, function(x) {
rep(rep(1:26, each = 26^(x-1)) , length.out = length.out)
})
m.char <- switch(case,
'lower' = letters[m],
'upper' = LETTERS[m]
)
m.char <- LETTERS[m]
dim(m.char) <- dim(m)
apply(m.char, 1, function(x) paste(x, collapse = ""))
}
get.letters <- function(length.out, case = 'upper'){
max.char <- ceiling(log(length.out, 26))
grp <- rep(1:max.char, 26^(1:max.char))[1:length.out]
unlist(lapply(unique(grp), function(n) make.chars(length(grp[grp == n]), case = case, n.char = n)))
}
##
make.chars(5, "lower", 2)
#> [1] "AA" "AB" "AC" "AD" "AE"
make.chars(5, "lower")
#> [1] "A" "B" "C" "D" "E"
make.chars(5, "upper", 4)
#> [1] "AAAA" "AAAB" "AAAC" "AAAD" "AAAE"
tmp <- get.letters(800)
head(tmp)
#> [1] "A" "B" "C" "D" "E" "F"
tail(tmp)
#> [1] "ADO" "ADP" "ADQ" "ADR" "ADS" "ADT"
Created on 2019-03-22 by the reprex package (v0.2.1)