I am working with the R programming language.
I have the following problem:
My Question: For each of these 100 turns, for each of these 100 coins - I want to track the cumulative number of heads and the cumulative number of tails.
As an example, suppose coin43 was flipped 7 times:
Then, the scores would be:
And at the most recent turn, the cumulative numbers would be:
First, I initialized the coins:
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)
Next, I tried to write the bulk of the simulation code:
# 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
}
}
}
Then, I created a data frame to store the results:
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])
}
}
The final results look something like this (a sample):
> 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
I think I have overcomplicated this - can someone please show me what I can do to simplify this?
Thanks!
You can define a function that updates the selected coins for flips, e.g.,
f <- function(v) {
selected <- runif(length(v)) <= 0.5
updated <- v[selected] * (1 - 2 * (runif(sum(selected)) <= 0.6))
replace(v, selected, updated)
}
then we use Reduce function (but enable the accumulate argument) to keep track of the progress of changes, where the updated coin status from the previous iteration will be the taken as the input for the upcoming iteration
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)
Finally, if you would like to obtain the cumulative statistics of the heads and tails of each coin, you can first rbind the outcomes of p, and then analyze the distribution of heads and tails by column, e.g.,
out <- apply(
do.call(rbind, p),
2,
\(u) data.frame(
heads = cumsum(u == 1),
tails = cumsum(u == -1)
)
)
The outcome of the first 6 turns (incl. turn=0) is shown as below
> 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
and the updating progress of the first 6 coins
> 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