R 即使硬币没有被抛出，也要保持对其的跟踪

发布于03月19日

我正在使用R编程语言.

我有以下问题:

有100个硬币:硬币在轮数= 0时随机初始化(即0.5的正面概率和0.5的反面概率)
在每一轮，任何给定的硬币都有0.5的概率被选中和翻转，
当一枚硬币被翻转时，有0.6的概率会落在翻转时面朝上的同一侧，有0.4的概率会落在另一侧
在每一回合结束时，我们判断每一枚硬币(抛或不抛，无关紧要).如果一枚硬币正面朝上，则+1，否则-1
我们这样做100圈

My Question:对于这My Question:个回合中的每一个，对于这My Question:个硬币中的每一个—我想跟踪累积的正面数量和累积的反面数量.

例如，假设硬币43被翻转了7次:

头，尾，未选中，未选中，头，未选中，尾

那么，分数将是:

+1，-1，-1，-1，+1，+1，-1

而在最近的一个回合中，累积的数字将是:

三头四尾

首先，我对硬币进行了初始化:

num_coins <- 100
num_turns <- 100
coins <- sample(c(-1, 1), num_coins, replace = TRUE)
cumulative_heads <- matrix(0, nrow = num_turns, ncol = num_coins)
cumulative_tails <- matrix(0, nrow = num_turns, ncol = num_coins)

接下来，我try 编写大量模拟代码:

# Simulation
for (turn in 1:num_turns) {
  if(turn > 1){

    cumulative_heads[turn,] <- cumulative_heads[turn-1,]
    cumulative_tails[turn,] <- cumulative_tails[turn-1,]
  }
  for (coin in 1:num_coins) {
    # Check if coin is selected
    if (runif(1) < 0.5) {
      # Flip the coin
      if (runif(1) < 0.6) {
        # Coin lands on the same side
        coins[coin] <- coins[coin]
      } else {
        # Coin lands on the other side
        coins[coin] <- -coins[coin]
      }
    }
    # Update cumulative counts
    if (coins[coin] == 1) {
      cumulative_heads[turn, coin] <- cumulative_heads[turn, coin] + 1
    } else {
      cumulative_tails[turn, coin] <- cumulative_tails[turn, coin] + 1
    }
  }
}

然后，我创建了一个数据框来存储结果:

results <- data.frame(matrix(ncol = num_coins, nrow = num_turns))
names(results) <- paste0("coin", 1:num_coins)

for (turn in 1:num_turns) {
  for (coin in 1:num_coins) {
    results[turn, coin] <- paste("Heads: ", cumulative_heads[turn, coin], ", Tails: ", cumulative_tails[turn, coin])
  }
}

最后的结果如下(示例):

> results[1:5, 1:5]
                  coin1                 coin2                 coin3                 coin4                 coin5
1 Heads:  1 , Tails:  0 Heads:  0 , Tails:  1 Heads:  1 , Tails:  0 Heads:  1 , Tails:  0 Heads:  1 , Tails:  0
2 Heads:  1 , Tails:  1 Heads:  0 , Tails:  2 Heads:  2 , Tails:  0 Heads:  2 , Tails:  0 Heads:  2 , Tails:  0
3 Heads:  1 , Tails:  2 Heads:  0 , Tails:  3 Heads:  3 , Tails:  0 Heads:  3 , Tails:  0 Heads:  2 , Tails:  1
4 Heads:  2 , Tails:  2 Heads:  0 , Tails:  4 Heads:  4 , Tails:  0 Heads:  4 , Tails:  0 Heads:  2 , Tails:  2
5 Heads:  3 , Tails:  2 Heads:  0 , Tails:  5 Heads:  5 , Tails:  0 Heads:  5 , Tails:  0 Heads:  2 , Tails:  3

我想我把这个问题复杂化了--有人能告诉我我能做些什么来简化这个问题吗？

谢谢！

Idea and Code

你可以定义一个函数，updates的selected个硬币翻转，例如，

f <- function(v) { selected <- runif(length(v)) <= 0.5 updated <- v[selected] * (1 - 2 * (runif(sum(selected)) <= 0.6)) replace(v, selected, updated) }

然后我们使用Reduce函数(但启用accumulate参数)来跟踪更改的进展，102

set.seed(0) num_coins <- 100 num_turns <- 100 v <- sample(c(1, -1), num_coins, TRUE, prob = c(0.5, 0.5)) p <- Reduce(\(x, y) f(x), seq.int(num_turns), init = v, accumulate = TRUE)

最后，如果您想要获取每枚硬币的正反面的累计统计数据，您可以先对p的结果进行rbind，然后按列分析正反面的分布，例如:

out <- apply( do.call(rbind, p), 2, \(u) data.frame( heads = cumsum(u == 1), tails = cumsum(u == -1) ) )

Output

前6圈的结果(包括)turn=0)如下所示

> head(p) [[1]] [1] 1 -1 -1 1 1 -1 1 1 1 1 -1 -1 -1 1 -1 1 -1 1 1 -1 1 1 -1 1 -1 [26] -1 -1 -1 -1 1 -1 -1 1 -1 -1 1 1 1 -1 1 -1 1 1 1 1 1 1 -1 -1 1 [51] 1 -1 1 -1 -1 -1 -1 -1 1 1 -1 1 -1 -1 -1 1 -1 -1 1 -1 1 -1 1 -1 -1 [76] -1 1 1 -1 1 1 -1 1 -1 -1 1 -1 1 -1 -1 -1 -1 -1 1 1 1 1 -1 -1 1 [[2]] [1] 1 -1 -1 -1 1 -1 -1 -1 -1 1 -1 -1 -1 -1 1 -1 1 1 -1 -1 1 1 -1 -1 -1 [26] -1 -1 -1 -1 -1 -1 -1 1 -1 -1 1 1 1 -1 1 -1 1 1 1 -1 1 -1 1 -1 -1 [51] 1 -1 1 1 -1 -1 1 -1 -1 -1 1 1 -1 1 -1 1 1 1 1 -1 -1 -1 1 -1 -1 [76] -1 1 1 -1 1 1 1 -1 -1 -1 1 1 1 -1 -1 -1 -1 1 -1 1 1 1 1 -1 -1 [[3]] [1] -1 1 1 1 1 -1 -1 -1 -1 -1 1 -1 1 -1 1 -1 -1 1 -1 -1 -1 1 -1 -1 1 [26] 1 1 -1 1 1 -1 1 1 -1 -1 -1 1 1 1 -1 -1 -1 -1 -1 1 1 1 1 1 -1 [51] 1 1 -1 1 -1 -1 1 1 1 -1 1 1 -1 -1 -1 -1 -1 1 1 -1 1 1 -1 -1 -1 [76] -1 1 -1 -1 1 1 1 -1 1 -1 1 -1 1 -1 1 -1 -1 1 -1 1 1 1 1 1 -1 [[4]] [1] -1 1 1 1 1 -1 -1 -1 1 -1 -1 -1 1 1 1 -1 -1 1 1 -1 -1 1 -1 -1 -1 [26] -1 1 -1 1 1 -1 1 1 1 1 -1 1 -1 1 -1 -1 -1 -1 -1 1 1 -1 -1 1 -1 [51] 1 1 1 -1 1 1 -1 -1 1 -1 1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 1 -1 -1 1 [76] -1 1 -1 -1 -1 1 1 -1 -1 -1 -1 -1 1 1 -1 -1 -1 -1 -1 1 1 1 1 1 -1 [[5]] [1] -1 -1 1 1 1 -1 1 -1 1 -1 1 1 1 -1 1 -1 -1 -1 1 -1 -1 1 -1 -1 -1 [26] 1 1 -1 1 1 -1 -1 1 1 1 -1 -1 1 -1 1 -1 -1 1 -1 1 1 1 -1 1 -1 [51] 1 -1 1 -1 1 -1 1 1 1 1 1 1 -1 1 -1 -1 1 -1 1 -1 -1 1 1 -1 -1 [76] 1 1 1 -1 -1 1 1 -1 1 -1 -1 -1 1 1 -1 -1 -1 -1 -1 1 1 -1 1 1 -1 [[6]] [1] 1 -1 1 1 1 -1 -1 -1 -1 1 -1 -1 1 -1 -1 -1 -1 -1 -1 -1 -1 1 -1 1 -1 [26] 1 1 -1 1 -1 1 -1 1 1 1 -1 -1 -1 1 -1 1 -1 1 -1 1 1 1 -1 1 -1 [51] -1 1 1 1 1 -1 1 1 -1 1 1 1 -1 1 1 -1 -1 -1 1 1 1 1 -1 -1 -1 [76] 1 1 -1 -1 -1 1 1 1 1 -1 1 -1 1 1 -1 1 -1 -1 1 1 -1 -1 1 1 -1

以及首批6枚硬币的更新进度

> head(out) [[1]] heads tails 1 1 0 2 2 0 3 2 1 4 2 2 5 2 3 6 3 3 7 3 4 8 3 5 9 3 6 10 3 7 11 4 7 12 5 7 13 6 7 14 7 7 15 7 8 16 8 8 17 9 8 18 10 8 19 11 8 20 12 8 21 12 9 22 12 10 23 12 11 24 12 12 25 12 13 26 12 14 27 12 15 28 12 16 29 12 17 30 13 17 31 13 18 32 14 18 33 15 18 34 16 18 35 17 18 36 17 19 37 17 20 38 17 21 39 17 22 40 17 23 41 17 24 42 17 25 43 17 26 44 18 26 45 19 26 46 20 26 47 21 26 48 22 26 49 23 26 50 23 27 51 23 28 52 23 29 53 24 29 54 24 30 55 24 31 56 24 32 57 24 33 58 24 34 59 24 35 60 24 36 61 24 37 62 24 38 63 25 38 64 26 38 65 27 38 66 28 38 67 29 38 68 30 38 69 31 38 70 32 38 71 33 38 72 33 39 73 33 40 74 33 41 75 33 42 76 33 43 77 33 44 78 34 44 79 35 44 80 36 44 81 37 44 82 37 45 83 37 46 84 37 47 85 38 47 86 39 47 87 40 47 88 41 47 89 41 48 90 41 49 91 41 50 92 41 51 93 42 51 94 43 51 95 44 51 96 44 52 97 44 53 98 44 54 99 44 55 100 44 56 101 45 56 [[2]] heads tails 1 0 1 2 0 2 3 1 2 4 2 2 5 2 3 6 2 4 7 3 4 8 4 4 9 4 5 10 4 6 11 4 7 12 4 8 13 4 9 14 4 10 15 4 11 16 4 12 17 5 12 18 6 12 19 6 13 20 6 14 21 7 14 22 7 15 23 7 16 24 7 17 25 7 18 26 7 19 27 7 20 28 7 21 29 7 22 30 7 23 31 8 23 32 9 23 33 10 23 34 10 24 35 11 24 36 12 24 37 13 24 38 14 24 39 15 24 40 16 24 41 17 24 42 18 24 43 18 25 44 18 26 45 18 27 46 18 28 47 18 29 48 18 30 49 19 30 50 19 31 51 20 31 52 21 31 53 21 32 54 21 33 55 21 34 56 21 35 57 21 36 58 21 37 59 21 38 60 22 38 61 23 38 62 24 38 63 24 39 64 24 40 65 24 41 66 25 41 67 26 41 68 27 41 69 28 41 70 29 41 71 29 42 72 29 43 73 29 44 74 29 45 75 30 45 76 30 46 77 30 47 78 31 47 79 32 47 80 33 47 81 34 47 82 35 47 83 36 47 84 37 47 85 37 48 86 37 49 87 37 50 88 37 51 89 37 52 90 38 52 91 39 52 92 40 52 93 41 52 94 42 52 95 43 52 96 43 53 97 44 53 98 45 53 99 46 53 100 47 53 101 48 53 [[3]] heads tails 1 0 1 2 0 2 3 1 2 4 2 2 5 3 2 6 4 2 7 4 3 8 4 4 9 4 5 10 4 6 11 4 7 12 5 7 13 5 8 14 5 9 15 5 10 16 6 10 17 7 10 18 8 10 19 9 10 20 10 10 21 11 10 22 12 10 23 13 10 24 14 10 25 15 10 26 16 10 27 16 11 28 16 12 29 17 12 30 18 12 31 19 12 32 19 13 33 19 14 34 19 15 35 19 16 36 20 16 37 21 16 38 22 16 39 23 16 40 24 16 41 25 16 42 25 17 43 26 17 44 27 17 45 28 17 46 28 18 47 28 19 48 28 20 49 29 20 50 30 20 51 31 20 52 32 20 53 32 21 54 32 22 55 32 23 56 32 24 57 32 25 58 33 25 59 34 25 60 35 25 61 36 25 62 37 25 63 38 25 64 39 25 65 40 25 66 40 26 67 40 27 68 40 28 69 41 28 70 41 29 71 42 29 72 43 29 73 44 29 74 45 29 75 46 29 76 47 29 77 48 29 78 49 29 79 50 29 80 51 29 81 51 30 82 51 31 83 51 32 84 52 32 85 53 32 86 53 33 87 54 33 88 54 34 89 55 34 90 56 34 91 57 34 92 58 34 93 59 34 94 60 34 95 61 34 96 61 35 97 61 36 98 61 37 99 62 37 100 63 37 101 64 37 [[4]] heads tails 1 1 0 2 1 1 3 2 1 4 3 1 5 4 1 6 5 1 7 5 2 8 6 2 9 7 2 10 7 3 11 8 3 12 9 3 13 9 4 14 10 4 15 10 5 16 10 6 17 10 7 18 11 7 19 11 8 20 11 9 21 11 10 22 11 11 23 11 12 24 12 12 25 13 12 26 13 13 27 13 14 28 13 15 29 13 16 30 13 17 31 14 17 32 15 17 33 16 17 34 16 18 35 16 19 36 16 20 37 16 21 38 17 21 39 18 21 40 18 22 41 18 23 42 18 24 43 18 25 44 18 26 45 18 27 46 18 28 47 18 29 48 18 30 49 18 31 50 18 32 51 18 33 52 18 34 53 18 35 54 18 36 55 19 36 56 20 36 57 21 36 58 21 37 59 21 38 60 21 39 61 21 40 62 21 41 63 22 41 64 23 41 65 24 41 66 25 41 67 26 41 68 27 41 69 27 42 70 28 42 71 29 42 72 30 42 73 31 42 74 32 42 75 32 43 76 32 44 77 32 45 78 32 46 79 33 46 80 34 46 81 35 46 82 36 46 83 36 47 84 36 48 85 37 48 86 38 48 87 38 49 88 39 49 89 40 49 90 41 49 91 41 50 92 42 50 93 43 50 94 44 50 95 45 50 96 46 50 97 46 51 98 47 51 99 47 52 100 47 53 101 47 54 [[5]] heads tails 1 1 0 2 2 0 3 3 0 4 4 0 5 5 0 6 6 0 7 7 0 8 7 1 9 8 1 10 9 1 11 10 1 12 11 1 13 12 1 14 12 2 15 13 2 16 14 2 17 14 3 18 14 4 19 14 5 20 15 5 21 15 6 22 15 7 23 15 8 24 15 9 25 15 10 26 15 11 27 15 12 28 16 12 29 16 13 30 16 14 31 16 15 32 16 16 33 16 17 34 16 18 35 17 18 36 18 18 37 19 18 38 20 18 39 21 18 40 22 18 41 23 18 42 24 18 43 25 18 44 26 18 45 27 18 46 27 19 47 27 20 48 27 21 49 28 21 50 28 22 51 29 22 52 30 22 53 30 23 54 31 23 55 31 24 56 31 25 57 31 26 58 31 27 59 31 28 60 32 28 61 33 28 62 33 29 63 33 30 64 34 30 65 34 31 66 34 32 67 34 33 68 35 33 69 36 33 70 37 33 71 38 33 72 39 33 73 40 33 74 41 33 75 42 33 76 43 33 77 44 33 78 44 34 79 44 35 80 44 36 81 44 37 82 44 38 83 44 39 84 44 40 85 44 41 86 45 41 87 45 42 88 45 43 89 46 43 90 47 43 91 48 43 92 48 44 93 48 45 94 48 46 95 49 46 96 50 46 97 51 46 98 51 47 99 51 48 100 52 48 101 53 48 [[6]] heads tails 1 0 1 2 0 2 3 0 3 4 0 4 5 0 5 6 0 6 7 1 6 8 2 6 9 2 7 10 3 7 11 3 8 12 3 9 13 3 10 14 3 11 15 3 12 16 3 13 17 3 14 18 4 14 19 4 15 20 4 16 21 4 17 22 4 18 23 4 19 24 5 19 25 6 19 26 6 20 27 7 20 28 8 20 29 8 21 30 8 22 31 9 22 32 10 22 33 11 22 34 11 23 35 11 24 36 11 25 37 12 25 38 12 26 39 12 27 40 12 28 41 12 29 42 12 30 43 12 31 44 12 32 45 12 33 46 13 33 47 14 33 48 14 34 49 14 35 50 15 35 51 16 35 52 17 35 53 17 36 54 17 37 55 17 38 56 17 39 57 18 39 58 19 39 59 20 39 60 20 40 61 20 41 62 21 41 63 22 41 64 23 41 65 23 42 66 24 42 67 24 43 68 25 43 69 26 43 70 27 43 71 28 43 72 29 43 73 29 44 74 29 45 75 29 46 76 29 47 77 29 48 78 29 49 79 29 50 80 29 51 81 29 52 82 29 53 83 30 53 84 31 53 85 32 53 86 32 54 87 32 55 88 32 56 89 32 57 90 32 58 91 32 59 92 33 59 93 34 59 94 35 59 95 36 59 96 37 59 97 38 59 98 39 59 99 40 59 100 40 60 101 41 60

R 即使硬币没有被抛出，也要保持对其的跟踪

推荐答案

Idea and Code

Output

R相关问答推荐

R Highcharts与两个位置关联的注释

R spatstat Minkowski Sum()返回多个边界

绘制采样开始和采样结束之间的事件

根据列表中项目的名称合并数据框和列表

如何使用For-R循环在向量中找到一系列数字

使用未知字符数(不受限制的最大长度)的Lookback有什么好的替代方案？

在R中，如何从一系列具有索引名的变量快速创建数据帧？

按组内中位数分类

有没有办法将不等长的列表转换为R中的数据帧

Rmarkdown：：Render vs Source()

R预测包如何处理ARIMA(Auto.arima函数)中的缺失值

是否有一个R函数可以输出在输入的字符向量中找到的相应正则表达式模式？

R-使用stri_trans_General()将其音译为德语字母

有没有办法将勾选/审查标记添加到R中的累积关联图中？

通过比较来自多个数据框的值和R中的条件来添加新列

在R中添加要打印的垂直线

如何捕获这个shiny 的、可扩展的react 性用户输入矩阵作为另一个react 性对象，以便进一步操作？

修复标签重叠和ggploy内的空间

通过不完全重叠的多个柱连接

向内存不足的数据帧添加唯一行