ゲーム理論で考える、じゃんけんの拡張: ニュースの社会科学的な裏側で使ったコードです。通常のゲーム理論の数値演算で扱われる計算手順に習っていないと言うか、フィーリングで描いたので、何か勘違いがあるかも知れないです。
##########################
### 引き分けになる確率 ###
##########################p_even <- function(n){
if(1>n){
return(0)
}
1-(2^n-2)/3^(n-1)
}
##########################
### 確定的確率質量関数計算 ###
##########################mkdist <- function(p){
d2b <- function(num, digits=8){
r <- numeric(digits)
for(i in (digits-1):0){
if(2^i <= num){
num <- num - 2^i
r[digits - i] <- 1
}
}
return(r)
}
V <- matrix(0, 2^length(p), length(p)) # 組み合わせ
pV <- numeric(2^length(p)) # 組み合わせの発生確率
sV <- numeric(2^length(p)) # 戦略1の数
for(i in 1:(2^length(p))){
V[i, ] <- d2b(i-1, digits=length(p))
pV[i] <- prod((0==V[i, ])*(1-p) + (1==V[i, ])*p)
sV[i] <- sum(V[i, ])
}
tapply(pV, sV, sum) # 戦略1の数ごとの生起確率
}
######################
### 勝利確率の計算 ###
######################calc_p_win <- function(p){
p_win_sum <- 0# ぐー/ちょき/ぱーを出した他の参加者数ごとに計算していく
for(num_of_nq in 0:length(p_others)){
# ぐー/ちょき/ぱーで勝つ確率
if(0==num_of_nq){
# 自分だけぐー/ちょき/ぱーならば、確実に勝利
p_win_nq <- 1
}else{
# あいこにならなければ、半分の確率で勝利
p_win_nq <- (1 - p_even(num_of_nq + 1))/2
}
# きゅーで勝つ確率
if(2>num_of_nq){
# 一人がぐー/ちょき/ぱーならば、確実に敗北
p_win_q <- 0
} else {
# あいこになれば、勝利
p_win_q <- p_even(num_of_nq)
}# 勝利確率
p_win <- (1-p)*p_win_nq + p*p_win_q# ぐー/ちょき/ぱーで負ける確率
if(0==num_of_nq){
# 自分だけぐー/ちょき/ぱーならば、確実に負けない
p_lose_nq <- 0
}else{
# あいこになれば敗北
# あいこ以外でも半分の確率で敗北
p_lose_nq <- p_even(num_of_nq + 1) + (1 - p_even(num_of_nq + 1))/2
}
# きゅーで負ける確率
if(0 == num_of_nq){
# 全員がきゅーならば、引き分けで負けない
p_lose_q <- 0
}else if(1 == num_of_nq){
# 一人がぐー/ちょき/ぱーならば、確実に敗北
p_lose_q <- 1
}else{
# あいこ以外ならば、敗北
p_lose_q <- 1 - p_even(num_of_nq)
}# 敗北確率
p_lose <- (1-p)*p_lose_nq + p*p_lose_q# num_of_nqが生じる確率
s <- as.character(length(p_others) - num_of_nq)
p_num_of_nq <- dist[s][[1]]
if(is.na(p_num_of_nq)){
p_num_of_nq <- 0
}# 期待値調整をして勝利確率を合計する（引き分けは分母から除く）
p_win_sum <- p_win_sum + p_num_of_nq * p_win/(p_win+p_lose)
if(debug){
print(sprintf("num_of_nq_of_others: %d (%.3f) p_win_nq: %f p_win_q: %f p_win: %f p_lose_nq: %f p_lose_q: %f p_lose: %f", num_of_nq, p_num_of_nq, p_win_nq, p_win_q, p_win, p_lose_nq, p_lose_q, p_lose))
}
}
p_win_sum
}
####################
### 均衡値の計算 ###
##################### 拡張じゃんけん参加人数
n <- 5# 初期値
p_all <- runif(n)# n*10回ぐらい回せば収束するであろうと言う粗雑な方針
debug <- FALSE
for(c in 0:(n*10)){
# 最適化前の状態
print(sprintf("%.5f", p_all))# 最適化を行なうプレイヤー
i <- (c %% n) + 1# 最適化を行なうi以外のプレイヤーのpを固定して、
# キューを選択する人数の確率質量関数を作る
p_others <- p_all[-i]
dist <- mkdist(p_others)# 勝利確率の最大化を行なう
r_optimize <- optimize(calc_p_win, c(0, 1), maximum=TRUE)
p_all[i] <- r_optimize$maximum
}print(sprintf("%.5f", p_all))
sprintf("最適反応の平均値: %.5f", mean(p_all))
#############################################################
# p_allから負ける人数の期待値を計算し、通常じゃんけんと比較 #
#############################################################
dist <- mkdist(p_all)
expected_num_of_looser <- 0
compared <- (1-p_even(length(p_all)))*length(p_all)/2
for(num_of_nq in 0:length(p_all)){s <- as.character(length(p_all) - num_of_nq)
p_num_of_nq <- dist[s][[1]]t <- 0
if(1<num_of_nq){
if(1==num_of_nq){
# 一人だけぐー/ちょき/ぱー
t <- length(p_all) - 1
} else {
p_e <- p_even(num_of_nq)
t <- p_e*num_of_nq + (1-p_e)*(num_of_nq/2 + length(p_all) - num_of_nq)
}
expected_num_of_looser <- expected_num_of_looser + p_num_of_nq*t
}
}
sprintf("負ける人数の期待値 通常じゃんけん: %.5f 拡張じゃんけん: %.5f",compared, expected_num_of_looser)
