« Excelのソルバーを使ったカーブフィッティング 非線形最小二乗法 | トップページ | 書店で『漢文法基礎』(二畳庵主人 著)を見つける »

2010年12月 7日 (火)

簡単なパーコレーションのシミュレーションプログラム Excel VBA

拙著 『よみがえれ!科学者魂』(丸善 2,310円)amazonへのリンクにExcel VBAを使った簡単なパーコレーションのシミュレーションプログラムを掲載したのであるが、今の時代、本に書いてあるプログラムを一文字一文字入力して試す人もいないと思われるので、ここに再録しておきたい。

10×10の二次元正方格子を指定した確率でランダムに塗りつぶして、上下がつながったかどうかを判断するプログラムである。

VBAプログラムは下記の通りで、このプログラムを含むExcelのファイルはこちら"SimplePercolation.xls"をダウンロード   。

Public Sub SimplePercolation()
Dim st(11, 11) As Integer
Dim bango(121) As Integer
prb = 0.5 'ここに占有率を入力(0から1の値)
num = 1
'○と●の配置
For j = 1 To 11: st(1, j) = 0: Next j
For i = 2 To 11: st(i, 1) = 0: Next i
For i = 2 To 11
For j = 2 To 11
z = Rnd()
If z < prb Then
st(i, j) = 1: Cells(i, j) = "●"
Else
st(i, j) = 0: Cells(i, j) = "○"
End If
Next j
Next i
'クラスターごとに番号付け
For i = 1 To 121: bango(i) = i: Next i
For i = 2 To 11
For j = 2 To 11
If st(i, j) = 0 Then GoTo skip
If st(i, j - 1) = 0 And st(i - 1, j) = 0 Then
st(i, j) = num: num = num + 1
End If
If st(i, j - 1) > 0 And st(i - 1, j) = 0 Then
st(i, j) = st(i, j - 1)
End If
If st(i, j - 1) = 0 And st(i - 1, j) > 0 Then
st(i, j) = st(i - 1, j)
End If
If st(i, j - 1) > 0 And st(i - 1, j) > 0 Then
GoSub TheRenumber
End If
skip:
Next j
Next i
'上端と下端がつながったか判断
For i = 2 To 11
For j = 2 To 11
If bango(st(2, i)) = bango(st(11, j)) And st(2, i) <> 0 And st(11, j) <> 0 Then
Cells(1, 1) = "つながった": GoTo TheExit
End If
Next j
Next i
Cells(1, 1) = "つながらず"
TheExit:
Exit Sub
'番号の違うクラスターがつながったときの番号付け替え
TheRenumber:
If bango(st(i, j - 1)) > bango(st(i - 1, j)) Then
a = bango(st(i, j - 1)): b = bango(st(i - 1, j))
Else
a = bango(st(i - 1, j)): b = bango(st(i, j - 1))
End If
st(i, j) = b
For k = 1 To num - 1
If bango(k) = a Then bango(k) = b
Next k
Return
End Sub

Perco1

上記のような10×10の方眼にプログラム内で指示した確率(4行目のprbの値)で、黒丸●を配置する。残りは白丸○とする。上の辺と下の辺が黒丸でつながれば「つながった」、つながらなければ「つながらず」と表示する。つながりは縦と横だけを考え、斜めは考えない。縦横でつながっていれば遠回りしていてもよい。

プログラムを実行するたびに、●と○を再配置して、つながりの有無を判断する。

プログラムの仕組みは以下のとおりである。

1. 乱数を使って、指定された確率prbで、10×10の正方格子にランダムに●と○を配置する。ここは易しい。

2. ●でつながった塊を一つのクラスターと考え、左上から順にクラスターに番号を付ける(同じクラスターに所属する●には同じ番号が付くようにする)。左上の方眼から右へ進み、右端に来たら、改行という順で、次の条件分岐で行う。
① 自分が○なら何もせずに、次のマス目に進む。
② 自分が●で、上と左が○なら、自分に新しいクラスター番号を付ける。
③ 自分が●で、上が●、左が○なら、上の●と同じクラスター番号を自分に付ける。
④ 自分が●で、上が○、左が●なら、左の●と同じクラスター番号を自分に付ける。
⑤ 自分が●で、上が●、左も●で、上と左のクラスター番号が同じなら③④と同様。
⑥ 自分が●で、上が●、左も●で、上と左のクラスター番号が異なる場合(この場合が一番困る)、小さい方のクラスター番号を自分につける。さらにその上で、大きい方のクラスター番号が付いてしまっている●を全て、小さい番号に付け替える。この付け替えをTheRenumberのサブルーチンで行う。

3. 上の辺に存在するクラスター番号と下の辺に存在するクラスター番号で同じ数字があるかどうかを調べる。同じ数字があれば「つながった」となる。

※ プログラム上のテクニックで、11×11の正方格子を作って、上の1行と左の1列には白丸○を配置してある。こうしておくことで、2の①~⑥で、端の場合は、これこれという面倒な別の条件分岐がいらなくなる。

プログラムを書き換えれば、10×10の正方格子で、●の割合(占有率)とつながる確率の関係を出すこともできる。格子のサイズを増やすことも可能である。

本プログラムでは10×10と格子のサイズが小さいので、上の2.の⑥のところでクラスター番号の異なるクラスターがつながったときに、若い方の番号にクラスター内の●を全部付け替えるということを行ったが、大きなサイズになるとこれをやると時間がかかり過ぎるので、もっと洗練されたやり方をするようである。クラスター番号の何番と何番がつながったかというような情報を記録して、最後に整理するやり方である。

|

« Excelのソルバーを使ったカーブフィッティング 非線形最小二乗法 | トップページ | 書店で『漢文法基礎』(二畳庵主人 著)を見つける »

コメント

この記事へのコメントは終了しました。

トラックバック


この記事へのトラックバック一覧です: 簡単なパーコレーションのシミュレーションプログラム Excel VBA:

« Excelのソルバーを使ったカーブフィッティング 非線形最小二乗法 | トップページ | 書店で『漢文法基礎』(二畳庵主人 著)を見つける »