タカ・ハトゲーム
タカ戦略とハト戦略のみが存在する世界において進化的に安定な状態を探るゲーム。
### 設定
# pay-offは以下の通り:
タカ vs. ハト、餌(food)を総取り
タカ vs. タカ、餌からコストを引いたものを2分割
ハト vs. タカ、無し(0)
ハト vs. ハト、餌を2分割
# 引数:
個体数の初期値([タカ、ハト])、世代数、コスト、餌
# 個体数の推移
p.hawk[i_gen]=(p.hawk[i_gen-1]*(p.hawk[i_gen-1]*eHawkHawk+p.dove[i_gen-1]*eHawkDove))
/mean.W;
HDgame<-function(N,generation,cost,food){ N.hawk=N[1]; N.dove=N[2]; p.hawk=rep(0,generation);p.hawk[1]=N.hawk/(N.dove+N.hawk) p.dove=rep(0,generation);p.dove[1]=1-p.hawk[1] eHawkHawk=0.5*(food-cost);eHawkDove=food eDoveHawk=0;eDoveDove=0.5*food for (i_gen in 2:generation){ mean.W=p.hawk[i_gen-1]^2*eHawkHawk+p.hawk[i_gen-1]*p.dove[i_gen-1]* (eHawkDove+eDoveHawk)+p.dove[i_gen-1]^2*eDoveDove p.hawk[i_gen]=(p.hawk[i_gen-1]*(p.hawk[i_gen-1]*eHawkHawk +p.dove[i_gen-1]*eHawkDove))/mean.W; p.dove[i_gen]=1-p.hawk[i_gen] } plot(1:generation,p.hawk,type='o',col='red',ylim=c(0,1),pch=19, main="Result of Hawk-Dove Game",ylab="Proportion",xlab="Generation") lines(1:generation, p.dove,type='o',col='blue',pch=17) legend("topright",c("Hawk","Dove"),pch=c(19,17),col=c('red','blue')) } # 実行例 HDgame(c(20,80),50,10,6) # 実装例、その2 HDgameDE<-function(N,generation,cost,food){ N.hawk=N[1]; N.dove=N[2]; tStep=0.01;ts=seq(0,generation,tStep);Nts=length(ts); p.hawk=rep(0,Nts);p.hawk[1]=N.hawk/(N.dove+N.hawk) p.dove=rep(0,Nts);p.dove[1]=1-p.hawk[1] eHawkHawk=0.5*(food-cost);eHawkDove=food eDoveHawk=0;eDoveDove=0.5*food for (i_gen in 2:Nts){ mean.W=p.hawk[i_gen-1]^2*eHawkHawk+p.hawk[i_gen-1]*p.dove[i_gen-1]* (eHawkDove+eDoveHawk)+p.dove[i_gen-1]^2*eDoveDove p.hawk[i_gen]=p.hawk[i_gen-1]+(p.hawk[i_gen-1]*(p.hawk[i_gen-1]*eHawkHawk +p.dove[i_gen-1]*eHawkDove-mean.W)/mean.W)*tStep; p.dove[i_gen]=1-p.hawk[i_gen] } plot(1:Nts,p.hawk,type='l',col='red',ylim=c(0,1),lwd=5, main="Result of Hawk-Dove Game",ylab="Proportion",xlab="Generation") lines(1:Nts, p.dove,type='l',col='blue',lwd=5) legend("topright",c("Hawk","Dove"),lwd=5,col=c('red','blue')) } # 実行例 HDgameDE(c(20,80),50,10,6)
読みやすい?例
## a simple version ## HDgame<-function(N,food,cost,n_gen){ p.hawk=N[1]/sum(N);p.dove=N[2]/sum(N) e.HH=1/2*(food-cost);e.HD=food;e.DH=0;e.DD=1/2*(food) p.vec=c(p.hawk,p.dove);p.mat<-outer(p.vec,p.vec) payMat<-matrix(c(e.HH,e.DH,e.HD,e.DD),ncol=2) hist=matrix(0,n_gen,2);hist[1,]=p.vec for (i_gen in 2:n_gen){ w.H=sum(p.vec*payMat[1,]) w.D=sum(p.vec*payMat[2,]) w.mean=sum(p.mat*payMat) p.vec=c(p.vec[1]*w.H/w.mean,p.vec[2]*w.D/w.mean) p.mat<-outer(p.vec,p.vec) hist[i_gen,]=p.vec } plot(1:n_gen,hist[,1],pch=20,type='o',lwd=2,cex=2,col='red', ylim=c(0,1),ylim=c(0,1.25),xlab="time",ylab="proportion",cex.lab=2) lines(1:n_gen,hist[,2],pch=20,type='o',lwd=2,cex=2,col='blue') legend("topright",c("Hawk","Dove"),col=c('red','blue'),lwd=2,pch=20) } ## DE version ## HDgameDE<-function(N,food,cost,n_gen){ p.hawk=N[1]/sum(N);p.dove=N[2]/sum(N) e.HH=1/2*(food-cost);e.HD=food;e.DH=0;e.DD=1/2*(food) p.vec=c(p.hawk,p.dove);p.mat<-outer(p.vec,p.vec) payMat<-matrix(c(e.HH,e.DH,e.HD,e.DD),ncol=2) ts=0.01;Nts=length(seq(1,n_gen,ts)); hist=matrix(0,Nts,2);hist[1,]=p.vec for (i_gen in 2:Nts){ w.H=sum(p.vec*payMat[1,]) w.D=sum(p.vec*payMat[2,]) w.mean=sum(p.mat*payMat) p.vec[1]=p.vec[1]+ts*p.vec[1]*(w.H-w.mean)/w.mean p.vec[2]=p.vec[2]+ts*p.vec[2]*(w.D-w.mean)/w.mean p.mat<-outer(p.vec,p.vec) hist[i_gen,]=p.vec } plot(1:Nts,hist[,1],type='l',lwd=4,cex=2,col='red',ylim=c(0,1.25), xlab="time",ylab="proportion",cex.lab=2) lines(1:Nts,hist[,2],type='l',lwd=4,cex=2,col='blue') legend("topright",c("Hawk","Dove"),col=c('red','blue'),lwd=4) return(hist) }