lapply 列表上的 paste0 函数

Question

具有可重现示例的数据

我有以下列表

library(arrangements)

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

看起来像这样：

[[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

我需要的

我想对列表 a（即 [[1]], [[2]], [[3]]）的每个元素的每一行使用一些函数，以便输出如下所示：

[[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"

到目前为止我做了什么以及我被困在哪里

我已经设法为列表的各个元素生成了我需要的输出。例如，下面的 for 循环产生我需要的输出，但只针对列表 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"

我无法为整个列表编写 for 循环，因为列表的每个元素都有不同的维度，而且我收到下标越界的错误。此外，我无法处理列表 a 的单个元素，因为它只是一个示例，列表可能会更大，所以我需要一种自动化方法。

我怀疑这可以通过组合 lapply 和 apply 来完成，但我就是不知道如何让它工作。例如，这里 lapply 和 apply 一起工作，但我不知道如何让它们输出我需要的东西。

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

提前致谢

Answer 1

使用 Map 和 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用于统计a的每个矩阵的行数。在 Map 中，我们传递矩阵列表 a 和 nr 的累加和，这将告诉我们每个序列将在何处结束 (cumsum(nr))。在函数中，我们使用此信息获取序列的开头 ((y - nrow(x) + 1)) 并按行粘贴矩阵以获得所需的输出。

Answer 2

我认为这可以满足您的需求。诀窍是生成第二个列表 a2 由单行组成，以便 F 的编号正常工作...

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"

Answer 3

使用 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))

使用 RcppAlgos::comboGeneral() 的替代方法，其 FUN= 参数可能优于 arrangements::combinations。（注意： 只需将 comboGeneral() 替换为 combn() 以获得纯基础 R 选项。

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))

结果：

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"

lapply 列表上的 paste0 函数

lapply a paste0 function over a list

r

list

paste

apply

lapply

具有可重现示例的数据

我需要的

到目前为止我做了什么以及我被困在哪里