lapply a paste0 function over a list

user_8523339 0
Viewed 656

Data with the reproducible example

I have the following list

library(arrangements)

a <- list(
arrangements::combinations(x = 5, k = 5),
arrangements::combinations(x = 5, k = 4),
arrangements::combinations(x = 4, k = 4))

Which looks like this:

[[1]]
     [,1] [,2] [,3] [,4] [,5]
[1,]    1    2    3    4    5

[[2]]
     [,1] [,2] [,3] [,4]
[1,]    1    2    3    4
[2,]    1    2    3    5
[3,]    1    2    4    5
[4,]    1    3    4    5
[5,]    2    3    4    5

[[3]]
     [,1] [,2] [,3] [,4]
[1,]    1    2    3    4

What I need

I would like to use some function over each row of each element of the list a (i.e. [[1]], [[2]], [[3]]) so that the output would look something like the following:

[[1]]
"F1 =~ 1 + 2 + 3 + 4 +5"

[[2]]
"F2 =~ 1 + 2 + 3 + 4" 
"F3 =~ 1 + 2 + 3 + 5" 
"F4 =~ 1 + 2 + 4 + 5" 
"F5 =~ 1 + 3 + 4 + 5"
"F6 =~ 2 + 3 + 4 + 5"

[[3]]
"F7 =~ 2 + 3 + 4 + 5"

What I have managed to do so far and where I am stuck

I have managed to produce the output that I need for individual elements of the list. For example, the below for loop produces the output that I need but only for the second element of list a.

z <- list(
arrangements::combinations(x = 5, k = 4))

qq <- vector(mode = "character", length = 0L)

    for(i in 1:5) {
            qq[i] <- paste0("F", i+1, sep = " =~ ", paste(z[[1]][i, ], collapse=" + "))
}   

qq

[1] "F2 =~ 1 + 2 + 3 + 4" "F3 =~ 1 + 2 + 3 + 5" "F4 =~ 1 + 2 + 4 + 5" "F5 =~ 1 + 3 + 4 + 5"
[5] "F6 =~ 2 + 3 + 4 + 5"

I was not able to write the for loop for the whole list because each element of the list has different dimensions and I get an error that the subscript is out of bounds. Also, I cannot tackle individual elements of list a because it is an example and a list might be much larger, so I need a way to automate it.

I suspect that this can be done by combining lapply and apply but I just cannot figure out how to make it work. For example, here lapply and apply work together but I just cannot figure out how to make them output what I need.

lapply(a, function(x) apply(a[[2]], 1, paste, collapse=""))

Thank you in advance

lapply apply paste r list
3 Answers

Using reformulate().

b <- lapply(a, \(i) 
            apply(i, 1, \(x) 
                  Reduce(paste0, as.character(reformulate(as.character(x))))))
b <- Map(\(x, y) paste(sprintf('F%s=', seq(b[[y]]) + x), b[[y]]),
    c(0, cumsum(lengths(b)[-length(b)])), seq(b))

Alternative approach using RcppAlgos::comboGeneral() which might have benefits over arrangements::combinations with its FUN= argument. (Note: Just replace comboGeneral() with combn() for a purely base R option).

library(RcppAlgos)
b <- Map(\(x, m) comboGeneral(as.character(x), m, FUN=\(i) 
                       Reduce(paste0, as.character(reformulate(i)))),
         lapply(c(5, 5, 4), seq), c(5, 4, 4))
b <- Map(\(x, y) paste(sprintf('F%s=', seq(b[[y]]) + x), b[[y]]),
    c(0, cumsum(lengths(b)[-length(b)])), seq(b))

Results:

b
# [[1]]
# [1] "F1= ~1 + 2 + 3 + 4 + 5"
# 
# [[2]]
# [1] "F2= ~1 + 2 + 3 + 4" "F3= ~1 + 2 + 3 + 5" "F4= ~1 + 2 + 4 + 5"
# [4] "F5= ~1 + 3 + 4 + 5" "F6= ~2 + 3 + 4 + 5"
# 
# [[3]]
# [1] "F7= ~1 + 2 + 3 + 4"
user_65740380

Using Map with sprintf -

nr <- sapply(a, nrow)
Map(function(x, y) sprintf('F%d = ~%s', (y - nrow(x) + 1):y, 
                   apply(x, 1,paste0, collapse = '+')), a, cumsum(nr))

#[[1]]
#[1] "F1 = ~1+2+3+4+5"

#[[2]]
#[1] "F2 = ~1+2+3+4" "F3 = ~1+2+3+5" "F4 = ~1+2+4+5" "F5 = ~1+3+4+5"
#[5] "F6 = ~2+3+4+5"

#[[3]]
#[1] "F7 = ~1+2+3+4"

nr is used to count number of rows in each matrix of a. In Map we pass the list of matrix a and cumulative sum of nr which will tell us where each sequence is going to end (cumsum(nr)). In the function we use this information to get the start of the sequence ((y - nrow(x) + 1)) and rowwise paste the matrix to get the required output.

user_39629140

I think this does what you need. The trick is to produce a second list a2 consisting of single rows, so that the numbering of F works properly...

a2 <- unlist(lapply(a, apply, 1, identity, simplify = FALSE), #separates the rows
             recursive = FALSE)                               #keeps as list

relist(sapply(seq_along(a2),                                  #to get overall id no i
              function(i) paste0("F", i, " =~ ", 
                                 paste(a2[i][[1]], collapse=" + "))),
       lapply(a, rowSums))                                    #a list for relisting by

[[1]]
[1] "F1 =~ 1 + 2 + 3 + 4 + 5"

[[2]]
[1] "F2 =~ 1 + 2 + 3 + 4" "F3 =~ 1 + 2 + 3 + 5" "F4 =~ 1 + 2 + 4 + 5" 
    "F5 =~ 1 + 3 + 4 + 5" "F6 =~ 2 + 3 + 4 + 5"

[[3]]
[1] "F7 =~ 1 + 2 + 3 + 4"
user_77274290
Related