交通ルール調整ゲームの進化ゲーム

交通ルール調整ゲームの進化ゲーム

このメモは，2017年数理社会学8章「進化ゲームとレプリケーターダイナミクス」における講義内容と対応しています．

佐藤 (2005) に示された交通ルールの調整ゲームを考える．2人のプレイヤーは車に乗る際に，道路の左側を走る（L）か右側を走るかを決める（R）．2人が別々の側を選択すれば，すれ違うときに正面衝突してしまう．ゆえに，2人とも同じ側を選ぶことが双方にとってより良い利得をもたらすが，2人とも右ハンドルの車に乗っているために，右側通行よりも左側通行の方が良いと考えている．このゲームの利得表は以下のようになる．

このゲームについて，次のような進化ゲームのシミュレーションを構成しよう．

1. n人のプレイヤーがいる．いずれもLかRかの戦略を持っている．
2. n人のプレイヤー内でランダムにn/2組のペアをつくる（もし，nが奇数であれば，誰か1人が重複してペアに参加し，(n+1)/2組のペアを構成する）．
3. それぞれのペアで調整ゲームを行う．
   1. 結果が(L,L)であれば，Lプレイヤーが2人増える．
   2. 結果が(R,R)であれば，Rプレイヤーが1人増える．
   3. 結果が(L,R)もしくは(R,L)であれば，ゲームに参加したL,Rプレイヤー1人ずつが死ぬ．
4. 1に戻る

プログラムの実装

Lが2, Rが1として，プレイヤーの初期ベクトルを構成する．

data<-c(1,1,1,1,2,2,2,2,2,2)
### Lの割合
length(data[data ==2])/length(data)

## [1] 0.6

シミュレーションの手順にしたがったレプリケーター関数を用意する．

### レプリケータ関数, (L,L)->2人増える，(L,R)(R,L)->両方死ぬ，(R,R)->1人増える
replicater<-function(d) {
  after<-c() ### レプリケータ後のベクトルとして空ベクトルを用意
  
  ### ランダムに並べ替え（奇数個の場合は，1つを重複して追加でサンプリング）
  rpd<-if(length(d) %% 2 ==0) {sample(d)} else{c(sample(d),sample(d,1))}
  
  ### ペアごとにゲームしてレプリケート
  for(i in 1:(length(rpd)/2)) {
    resultofgame<-sum(rpd[(2*i-1):(2*i)])
    if(resultofgame == 4) replicate<-c(2,2,2,2)
    if(resultofgame == 3) replicate<-c()
    if(resultofgame == 2) replicate<-c(1,1,1)
    after<-append(after,replicate)
  }
  
  return(after)
}

一巡目の結果のプレイヤーベクトルが得られる．

replicater(data)

##  [1] 1 1 1 2 2 2 2 2 2 2 2

これを繰り返し実行する．

ここでは，初期プレイヤー数n=100として，戦略Lグループの初期比率が0.4と0.6の場合について，t=10回の繰り返しをシミュレートする．

piL1<-40
piL2<-60
data1<-c(rep(1,100-piL1),rep(2,piL1))
data2<-c(rep(1,100-piL2),rep(2,piL2))

pL1<-c()
pL2<-c()

for (t in 1:10) {
  pL1[t]<-length(data1[data1 ==2])/length(data1)
  data1<-replicater(data1)
}

for (t in 1:10) {
  pL2[t]<-length(data2[data2 ==2])/length(data2)
  data2<-replicater(data2)
}
matplot(1:10,cbind(pL1,pL2),type="b",lty=1:2,pch=1:2,
        xlab="t",ylab="proportion of L group")

自分でもプログラムの条件をいろいろ変えて遊んでみよう．