对列表的每个矩阵使用 lapply

Using lapply to each matrix of list

我正在尝试对列表的每个矩阵使用 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”。

在这篇文档()的帮助下,我学会了将sample函数应用于一个矩阵的一个分量。如果given是一个矩阵,我会执行这个函数。

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

但是,如您所见,given 是一个包含 3 个矩阵的列表。我尝试了几次尝试,例如 prob=given$xprob=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 个样本。 你能告诉我如何解决这个问题吗?

没有 over-complicating 太多并继续您的尝试,我们可以在 lapply 中使用 sapplylapply 将遍历每个列表,而 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, ]))))