R 中的向量化循环

Question

我在 r-bloggers 上遇到了一个问题，我想我可以将其作为一个有趣的项目来尝试。但是，我发现

purrr::map()

函数中使用的循环是我的代码中的瓶颈，所以我想知道是否有人对如何向量化下面代码中的分数计算并避免循环有任何想法？

https://www.r-bloggers.com/2024/04/joint-fiddlin/

问题的要点是，爱丽丝和鲍勃根据一系列抛硬币的配对获得分数。如果有两个连续的正面，爱丽丝就得一分，而如果正面后面跟着反面，鲍勃就得一分。因此，在 (H, H, T, H, H) 序列中，Alice 得到 2 分，而 Bob 得到 1 分。

我正在使用除基础库之外的这些库 库（dplyr）#bind_rows 图书馆(purrr) # 地图

我正在使用此功能来创建一款游戏

fn_is_heads <- function(count, sample, sample_size){
  ret <- sample(sample, size = sample_size, replace = TRUE, prob = c(0.5, 0.5))
  return(ret)
}

然后我用它来创建一个游戏列表（在本例中为 100,000 个游戏，每局 100 次抛掷）

trials <- 1e5
flip_nbr <- 100

flips <- map(1:trials, .f = fn_is_heads, sample = c(TRUE, FALSE), sample_size = flip_nbr)

我写了这个函数来计算每场比赛的得分

fn_score_vec <- function(flips){
  # alice gets points -> TRUE, TRUE
  # bob gets points -> TRUE, FALSE
  
  alice_pts <- sum(flips[-length(flips)] == TRUE & flips[-1] == TRUE)
  bob_pts <- sum(flips[-length(flips)] == TRUE & flips[-1] == FALSE)
  
  return(data.frame(alice = alice_pts, bob = bob_pts))
}

..我使用 purrr::map() 迭代游戏列表并返回每场比赛的分数

score <- bind_rows(map(.x = flips, .f = fn_score_vec))

在我的电脑上计算分数大约需要 11 秒。有人对如何摆脱

purrr::map()

并加快分数计算（除了并行计算之外）有任何建议吗？

Answer 1

使用基础 R 的公平硬币：

trials <- 1e5
flip_nbr <- 100

system.time({
  flips <- matrix(sample(!(0:1), trials*flip_nbr, 1), trials)
  score <- data.frame(
    alice = rowSums(flips[,-flip_nbr] & flips[,-1]),
    bob = rowSums(flips[,-flip_nbr] & !flips[,-1])
  )
})
#>    user  system elapsed 
#>    0.67    0.08    0.75