使用 purrr 的 R 多个循环，其中输出是数据表/小标题/矩阵答案

【问题标题】：R multiple loops using purrr where output is a data table/tibble/matrix使用 purrr 的 R 多个循环，其中输出是数据表/小标题/矩阵
【发布时间】：2021-09-30 21:29:43
【问题描述】：

rc<-1 # the number of red balls
wc<-1 # the number of white balls
red<-rep("Red",rc)
white<-rep("White",wc)
jar<-c(red,white)
nb<-5 ### number of draws
N=10 # Number of experiments
new_data<-matrix(NA,nrow = N,ncol = nb+1)
count_red_new<-matrix(NA,nrow = N,ncol = nb)
red_count<-rep(NA,N)
#### nested loop
for(i in 1:N){
  for(j in 1:nb){
    new_data[i,j]<-sample(jar,1,replace = T)
    if(new_data[i,j]=="Red"){
      count_red_new[i,j]=1
    }else{
      count_red_new[i,j]=0
    }
    red_count[i]=sum(count_red_new[i,])
    new_data[i,nb+1]=red_count[i]
  }
}
colnames(new_data)<-c("Draw1","Draw2","Draw3","Draw4","Draw5","Red Ball Count")
new_data<-data.frame(new_data)
#new_data$Red.Ball.Count<-as.integer(new_data$Red.Ball.Count)
new_data

上面的代码用于运行一个关于在 5 次平局中拉红球和白球的实验。这个实验进行了 10 次迭代。如上所述，我在两者之间使用了嵌套循环。如何使用 purrr 进行嵌套循环，以便将输出存储在矩阵或数据框中？

【问题讨论】：

标签： r nested-loops purrr

【解决方案1】：

您可以使用函数式方法降低复杂性并增加表现力。

这模拟了 3 个实验，您随机抽取 5 个红/白概率相等的球。它返回一个列表，每个项目代表随机抽取的序列。

set.seed(0)

samples <- lapply(1:3, function(x)
    sample(c('red', 'white'), size = 5,
           prob = c(0.5, 0.5), replace = TRUE))

samples

[[1]]
[1] "red"   "white" "white" "red"   "red"  

[[2]]
[1] "white" "red"   "red"   "red"   "red"  

[[3]]
[1] "white" "white" "white" "red"   "white"

为了总结每个实验中挑选的红球的数量，这将返回一个向量，每个实验包含一个项目（即红球的数量）。

sapply(samples, function(x) sum(x == 'red'))
[1] 3 4 1

如果您仍然想要数据框中的所有内容...

 results <- as.data.frame(Reduce(rbind, samples))
 
 results$n.reds <- Reduce("+", lapply(results,
                                      function(x) x == 'red'))
 
 results
        V1    V2    V3  V4    V5 n.reds
init   red white white red   red      3
X    white   red   red red   red      4
X.1  white white white red white      1

【讨论】：

【解决方案2】：

这是map 的一种方法。如果您只有红球和白球，您可以利用rbinom() 进行抽奖。假设 1 的平局是红球。

library(tidyverse)

nb <- 1:5
n <- 10

nb %>% 
  set_names(paste0("draw", .)) %>% 
  map_df(~rbinom(n, 1, prob = .5)) %>% 
  rowwise() %>% 
  mutate(red_ball_count = sum(c_across(everything())))

# A tibble: 10 x 6
# Rowwise: 
   draw1 draw2 draw3 draw4 draw5 red_ball_count
   <int> <int> <int> <int> <int>          <int>
 1     1     1     1     0     0              3
 2     0     1     0     0     1              2
 3     0     0     0     1     1              2
 4     0     0     0     1     1              2
 5     1     0     0     0     0              1
 6     1     0     1     0     1              3
 7     1     0     1     1     1              4
 8     0     0     1     0     1              2
 9     1     1     0     1     0              3
10     0     1     0     1     1              3

请注意，这在技术上执行 5 轮 10 次平局，而不是 10 轮 5 次平局。如果真想做10轮5抽，也是一样的思路，但是需要转置t()。

FWIW 这是一个基本的 R 方法：

df <- data.frame(t(replicate(n, rbinom(nb, 1, prob = .5))))
colnames(df) <- gsub("X", "Draw", colnames(df))
df['red_ball_count'] <- rowSums(df)

最后，考虑到在伯努利试验中（通常）顺序并不重要，请注意，您可以通过指定 n=10 和 size=5 单独使用 rbinom() 获得 red_ball_count：

rbinom(n, nb, prob = .5)

【讨论】：