/
sim_fict.R
142 lines (130 loc) · 5.81 KB
/
sim_fict.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
#' @title Simulates fictitious plays of a game
#' @description \code{sim_fict()} simulates a fictitious play of a game
#' @details Simulate fictitious plays of a normal-form game defined by
#' \code{normal_form()}.
#' @param n_samples A positive integer specifying the number of samples to be
#' simulated.
#' @param plot_range_y Choose the range of vertical axis for plots. Available
#' choices are \code{"fixed"}, \code{"full"} and \code{"free"}.
#' If \code{plot_range_y = "free"}, the range of y-axis depends on
#' simulation results. If \code{plot_range_y = "full"}, The range
#' defined in \code{game} is used for each player, which can be different
#' between players. With \code{"fixed"}, the same y-axis is used for both
#' players.
#' @param plot_id An integer between 1 and n_samples to specify for which
#' sample, playing history should be displayed. If \code{plot_id = NULL},
#' plot_B and plot_P will be NULL.
#' @inheritParams sim_fict_one
#' @return A list containing (1) a data frames of strategies chosen by each
#' player, (2) a single long data frame of (1)'s data frames combined,
#' (3) a list of each player's belief about the opponent's behavior
#' (data frames), (4) a list of probability of each strategy being chosen
#' (data frames), and (5) three plots of simulation result.
#' @author Yoshio Kamijo and Yuki Yanai <yanai.yuki@@kochi-tech.ac.jp>
#' @export
sim_fict <- function(game,
n_samples = 1,
n_periods = 50,
lambda = 1,
init = NULL,
sigma = 0,
plot_range_y = NULL,
plot_id = 1) {
player <- player1 <- player2 <- period <- strategy <- NULL
belief <- probability <- NULL
data_list <- B1_list <- B2_list <- P1_list <- P2_list <- list()
for (i in 1:n_samples) {
res <- sim_fict_one(game = game,
n_periods = n_periods,
lambda = lambda,
init = init,
sigma = sigma)
df <- res$data
df$sample <- i
data_list[[i]] <- df
B1_list[[i]] <- res$belief$B1
B2_list[[i]] <- res$belief$B2
P1_list[[i]] <- res$choice_prob$P1
P2_list[[i]] <- res$choice_prob$P2
}
data_long <- dplyr::bind_rows(data_list) |>
tidyr::pivot_longer(player1:player2,
names_to = "player",
values_to = "strategy") |>
dplyr::select(sample, period, player, strategy) |>
dplyr::mutate(player = ifelse(player == "player1",
game$player[1],
game$player[2]))
p <- plot_sim(data_long,
game = game,
plot_range_y = plot_range_y)
if (is.null(plot_id)) {
plt_B <- plt_P <- NULL
} else {
# Plot beliefs
p_B1 <- B1_list[[plot_id]] |>
tidyr::pivot_longer(cols = -period,
values_to = "belief",
names_to = "strategy") |>
ggplot2::ggplot(ggplot2::aes(x = period,
y = belief,
color = strategy,
linetype = strategy)) +
ggplot2::geom_line() +
ggplot2::scale_color_brewer(name = paste("strategy of\n", game$player[2]),
palette = "Dark2") +
ggplot2::scale_linetype_discrete(name = paste("strategy of\n", game$player[2])) +
ggplot2::ylim(0, 1) +
ggplot2::labs(subtitle = paste("Belief of", game$player[1]))
p_B2 <- B2_list[[plot_id]] |>
tidyr::pivot_longer(cols = -period,
values_to = "belief",
names_to = "strategy") |>
ggplot2::ggplot(ggplot2::aes(x = period,
y = belief,
color = strategy,
linetype = strategy)) +
ggplot2::geom_line() +
ggplot2::scale_color_brewer(name = paste("strategy of\n", game$player[1]),
palette = "Dark2") +
ggplot2::scale_linetype_discrete(name = paste("strategy of\n", game$player[1])) +
ggplot2::ylim(0, 1) +
ggplot2::labs(subtitle = paste("Belief of", game$player[2]))
plt_B <- patchwork::wrap_plots(p_B1, p_B2)
# Plot choice probabilities
p_P1 <- P1_list[[plot_id]] |>
tidyr::pivot_longer(cols = -period,
values_to = "probability",
names_to = "strategy") |>
ggplot2::ggplot(ggplot2::aes(x = period,
y = probability,
color = strategy,
linetype = strategy)) +
ggplot2::geom_line() +
ggplot2::scale_color_brewer(palette = "Dark2") +
ggplot2::ylim(0, 1) +
ggplot2::labs(subtitle = game$player[1])
p_P2 <- P2_list[[plot_id]] |>
tidyr::pivot_longer(cols = -period,
values_to = "probability",
names_to = "strategy") |>
ggplot2::ggplot(ggplot2::aes(x = period,
y = probability,
color = strategy,
linetype = strategy)) +
ggplot2::geom_line() +
ggplot2::scale_color_brewer(palette = "Dark2") +
ggplot2::ylim(0, 1) +
ggplot2::labs(subtitle = game$player[2])
plt_P <- patchwork::wrap_plots(p_P1, p_P2)
}
return(list(data = data_list,
data_long = data_long,
belief = list(B1 = B1_list,
B2 = B2_list),
choice_prob = list(P1 = P1_list,
P2 = P2_list),
plot_mean = p,
plot_B = plt_B,
plot_P = plt_P))
}