■google

■最近のコメント
■最近のトラックバック
■最近の記事
■月別アーカイブ
■ブログランキング
■ブログ検索

■ブロとも申請フォーム
■リンク
■RSSフィード
スポンサーサイト
上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。


スポンサー広告 | --:--:--
RでABSの真似事
先日,ゼミ合宿に行って参りました.
1年生ということもあって,卒論,修論はなく,
気楽に発表できる立場だったので,
「Rでエージェントベースシミュレーションができるのか.」
をやってみました.

端っこはループしていなかったり
様々な問題は抱えていますが,
プログラムとその結果だけ載せておきます.

まず,プログラムの概要を簡単に説明します.

■エージェント

エージェントは50×50の2次元の格子状に配置.
それぞれに一様乱数Uを持っている.
(Uは買う,買わないの閾値となる)

■ルール
・エージェントの購入確率Pは
 広告と周囲の人が製品を買うことの影響を受けて決まる.

・直接隣接している人との関係をStrong tie,
 一人を介してつながっている人をWeak tieとして,
 それらから受ける影響力をそれぞれ,Bs,Bwとする.
 また,広告の影響をaとすると,購入確率Pは
 P=(1-(1-a)((1-bw)^i)((1-bs)^j))で決まる.
 ただし,iはWeak tieのうち購入した人数,
 jはStorng tieのうち購入した人数.

・2倍の影響力を持つオピニオンリーダーがいる.
 リーダーをランダムに配置.


このようなエージェント,ルールを設定して,
引数にa(広告の影響力),
bw(weak tieの影響力),
bs(Strong tieの影響力),
n.leader(リーダーの人数)
を指定するプログラムはこのようになります.
 



***********************
buzz<-function(a,bw,bs,n.leader){
x<-matrix(0:0,50,50) #50×50を用意.初期値は0
for(l in 1:n.leader){
leader<-round(runif(2,3,48),0)
x[leader[1],leader[2]]<-2}

U<-matrix(runif(2500),50,50) #一様乱数でUを与える.
pt<-matrix(0:0,50,50) #pの初期値は0にする.50×50のマトリクス.
w.t<-0 #weak tieの初期値0
s.t<-0 #strong tieの初期値0
r<-0 #繰り返し数rの準備
result<-0 #結果を格納する変数.

while(r <= 25){ #繰り返しは25回
for(i in 3:48){ #3行から48行まで
for(j in 3:48){ #3列から48列まで

count1<-0
for(k in -2:2){
count1<-count1+x[i-2,j-k]}

count2<-0
for(k in -2:2){
count2<-count2+x[i+2,j-k]}

count3<-0
for(k in -1:1){
count3<-count3+x[i-k,j-2]}

count4<-0
for(k in -1:1){
count4<-count4+x[i-k,j+2]}

w.t<-sum(count1,count2,count3,count4) #weak tieの数を計算

count5<-0
for(k in -1:1){
count5<-count5+x[i-1,j-k]}

count6<-0
for(k in -1:1){
count6<-count6+x[i+1,j-k]}


s.t<-sum(count5,count6,x[i,j-1],x[i,j+1]) #strong tieの数を計算
pt[i,j]<-(1-(1-a)*((1-bw)^w.t)*((1-bs)^s.t)) #Pの計算.モデルに代入.
if(U[i,j]x[i,j]<-1}
else{x[i,j]<-x[i,j]} #UよりもPが小さければそのまま.
}
}
result[r]<-sum(x) #購入した人数が期毎に入力される.
r<-r+1 #繰り返しの数.25になったらストップ.
}
result<-c(0,result)
return(result) #期毎に入力した購入人数のベクトル.
}

**************************
返値は期毎の購入したエージェントの数です.


次に,パラメータをいくつか指定して,
グラフを描画して比較できるようなプログラムを紹介します.

まず,bwとbsを2通り用意します.

#パラメータ
bw<-c(0.02,0.02,0.06,0.06)
bs<-c(0.1,0.3,0.1,0.3)

この条件において次のプログラムを動かします.
(a,n.leaderを引数とします)

*************************
change<-function(a,n.leader){
par(mfrow=c(2,2)) #画面を4分割
for(iii in 1:4){ #設定するパラメータをiiiで変化.
for(jjj in 1:20){ #20回ずつシミュレーションを行う.
result<-buzz(a,bw[iii],bs[iii],n.leader) #buzz関数で計算
plot(result,ylim=c(0,2500),type="l",xlab="期",ylab="購入人数")
#プロット.ylimでy軸範囲指定.type"l"は折れ線,xlab,ylabはそれぞれ軸名.
par(new=T) #重ねがき許可
}
mtext(paste("weak=",bw[iii],"strong=",bs[iii]))}#図の上にどのパラメータかを表記.
}
***************************

これらのプログラムを使って,
リーダーの存在の有無で比較しました.

結果その1(a=0.005,n.leader=0)
change<-function(0.005,0)

(a=0.005,n.leader=0)


結果その2(a=0.005,n.leader=62)
change<-function(0.005,62)
※62人は全体の2.5%に相当

(a=0.005,n.leader=62)


オレンジの線は,リーダー無しの概略です.
リーダーがいると,Weak tieの効果が強まっています.
(この比較だけでは断定できませんが)


ついでに,エージェントの広がりを
視覚的に観察しましょう.

これはimage()をつかいます.
グラフ作成のプログラムの
最後の部分をplotでなくimageにしたり
して描けます.

クチコミの広がり






スポンサーサイト
シミュレーション | 22:09:33 | Trackback(0) | Comments(0)

FC2Ad

上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。