对列表的每个矩阵使用 lapply

Question

我正在尝试对列表的每个矩阵使用lapply。

我想应用sample函数，使用lapply。

让我们举个例子。我生成了概率，它将用于sample 函数。 （抱歉没有优化。）

set.seed(1001)
given<-replicate(3,list(matrix(unlist(replicate(5,sample(c(0.2,0.3,0.4,0.1),4,replace=FALSE),simplify=FALSE)),ncol=4)))
given   


   [[1]]
     [,1] [,2] [,3] [,4]
[1,]  0.1  0.4  0.2  0.4
[2,]  0.3  0.2  0.1  0.2
[3,]  0.2  0.1  0.1  0.3
[4,]  0.4  0.3  0.3  0.1
[5,]  0.3  0.4  0.2  0.4

[[2]]
     [,1] [,2] [,3] [,4]
[1,]  0.4  0.4  0.3  0.4
[2,]  0.3  0.1  0.4  0.2
[3,]  0.1  0.2  0.1  0.4
[4,]  0.2  0.1  0.3  0.3
[5,]  0.3  0.2  0.2  0.1

[[3]]
     [,1] [,2] [,3] [,4]
[1,]  0.3  0.2  0.2  0.1
[2,]  0.2  0.3  0.3  0.3
[3,]  0.1  0.4  0.2  0.2
[4,]  0.4  0.4  0.3  0.4
[5,]  0.1  0.1  0.4  0.1

所以这个列表有三个分量，每个分量都是一个 5*4 的矩阵。矩阵的每一行（因此，它有 15 行）都有概率。我想以给定的概率生成 10 个样本。为简单起见，我将以给定的概率将“1”重新采样为“4”。

在本文档(How to generate random data set with predicted probability?) 的帮助下，我学会了将sample 函数应用于一个矩阵的组件。如果given 是一个矩阵，我会执行这个函数。

lapply(1:nrow(given), function(x) sample(1:4, 10, replace = TRUE, prob = given[x, ]))

但是，如您所见，given 是一个包含 3 个矩阵的列表。我尝试了几次尝试，例如prob=given$x、prob=given[[x,]] 等......但都失败了。有没有办法应用它？

*补充问题

致罗纳克·沙阿

结果完全正确。谢谢！

但是，很抱歉没有提出所有问题。事实上，概率集中有一些缺失的数据。

我将在given 中设置缺失值。

given[[2]][1,]<-NA
given

[[1]]
     [,1] [,2] [,3] [,4]
[1,]  0.1  0.4  0.2  0.4
[2,]  0.3  0.2  0.1  0.2
[3,]  0.2  0.1  0.1  0.3
[4,]  0.4  0.3  0.3  0.1
[5,]  0.3  0.4  0.2  0.4

[[2]]
     [,1] [,2] [,3] [,4]
[1,]   NA   NA   NA   NA
[2,]  0.3  0.1  0.4  0.2
[3,]  0.1  0.2  0.1  0.4
[4,]  0.2  0.1  0.3  0.3
[5,]  0.3  0.2  0.2  0.1

[[3]]
     [,1] [,2] [,3] [,4]
[1,]  0.3  0.2  0.2  0.1
[2,]  0.2  0.3  0.3  0.3
[3,]  0.1  0.4  0.2  0.2
[4,]  0.4  0.4  0.3  0.4
[5,]  0.1  0.1  0.4  0.1

阅读您的答案后，我在您的答案中处理了一些代码。但结果却大不相同。

 lapply(given, function(x) t(sapply(seq_len(nrow(x)), function(y)
 ifelse(is.na(x[y,]),NA,sample(1:4, 10, replace = TRUE, prob = x[y, ])))))

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

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

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

如您所见，NA 结果是正确的，但它只生成了 4 个样本，而不是 10 个样本。 你能告诉我如何解决这个问题吗？

Answer 1

不要过度复杂化并继续您的尝试，我们可以在lapply 中使用sapply。 lapply 将遍历每个列表，而 sapply 将遍历列表中的每一行。

lapply(given, function(x) t(sapply(seq_len(nrow(x)), function(y) 
             sample(1:4, 10, replace = TRUE, prob = x[y, ]))))

#[[1]]
#     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
#[1,]    2    3    4    4    3    4    4    4    2     1
#[2,]    1    1    1    2    4    1    2    2    2     3
#[3,]    1    4    4    1    4    1    1    2    2     4
#[4,]    1    1    3    2    3    2    3    1    1     3
#[5,]    4    2    3    1    2    2    1    4    1     4

#[[2]]
#     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
#[1,]    1    3    2    3    2    1    1    1    2     1
#[2,]    3    1    1    1    3    3    2    3    1     4
#[3,]    4    3    4    2    4    4    4    4    4     4
#[4,]    3    3    4    4    3    4    4    2    3     4
#[5,]    1    1    2    2    4    1    1    2    1     4

#[[3]]
#     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
#[1,]    3    1    1    2    1    3    3    1    2     1
#[2,]    4    4    3    1    3    3    3    3    2     4
#[3,]    1    1    2    2    2    3    4    4    2     4
#[4,]    2    1    4    4    1    3    3    4    4     1
#[5,]    3    3    3    3    3    3    1    2    3     3

---

我们可以处理NA 值

lapply(given, function(x) t(sapply(seq_len(nrow(x)), function(y) 
      if (anyNA(x[y,])) rep(NA, 10) else 
         sample(1:4, 10, replace = TRUE, prob = x[y, ]))))