囲碁で相手の石を囲んで取るアルゴリズム
ツイッターで出したVBAのお題です。
Excel囲碁を作っていて、相手の石を囲んで取れるかどうかの判定、相手の石を取るにはどうしたら良いかというもの。
囲碁で相手の石をとる
お題のツイート
頂いた回答
いくつかお返事をいただきましたが、
基本的には、4方向（上下左右）を見ていき、隣が2であればさらに隣を見ていく、空白(0)が出てくれば終了。
これを再帰で繰り返し行うというものです。
Excel囲碁でもこれで実装しました。
Excel囲碁：万波奈穂先生に捧ぐ
基本的には、4方向（上下左右）を見ていき、隣が2であればさらに隣を見ていく、空白(0)が出てくれば終了。
これを再帰で繰り返し行うというものです。
Excelで囲碁を作ってみます。AI搭載とかそんな大層なものではありません。人vs人で対戦できる程度、単純に黒白交互に打っていけるものです。ただし、・相手の石を囲んだら相手の石を取るのは自動にします。・着手禁止点には着手できないようにします。
Excel囲碁：再起動後も続けて打てるように改造Excelで囲碁を作ってみます。人vs人で対戦できる程度、単純に黒白交互に打っていけるものです。前作ではその場で打てればよいだけで作成しましたが、1日1ツイートで先生とフォロワーで対戦していくことになりました。
Excel囲碁で実装したVBA
黄色の1で、濃い茶色の2は完全に囲まれました。
この囲まれた2を取り出したいという事です。
Sub 囲んでいる相手を取る()
Dim ary, i, j, t, rtn
ary = Range("B2:J10")
i = 1: j = 8:
t = 2 '相手
If i > 1 Then
If ary(i - 1, j) = t Then
rtn = True
再帰4方向 ary, i - 1, j, t, rtn
End If
End If
If i < 9 Then
If ary(i + 1, j) = t Then
rtn = True
再帰4方向 ary, i + 1, j, t, rtn
End If
End If
If j > 1 Then
If ary(i, j - 1) = t Then
rtn = True
再帰4方向 ary, i, j - 1, t, rtn
End If
End If
If j < 9 Then
If ary(i, j + 1) = t Then
rtn = True
再帰4方向 ary, i, j + 1, t, rtn
End If
End If
PrintArray (ary)
End Sub
Sub 再帰4方向(ary, i, j, t, rtn)
If rtn = False Then Exit Sub
ary(i, j) = 9
If i > 1 Then
If ary(i - 1, j) = 0 Then
rtn = False: Exit Sub
ElseIf ary(i - 1, j) = t Then
再帰4方向 ary, i - 1, j, t, rtn
End If
End If
If i < 9 Then
If ary(i + 1, j) = 0 Then
rtn = False: Exit Sub
ElseIf ary(i + 1, j) = t Then
再帰4方向 ary, i + 1, j, t, rtn
End If
End If
If j > 1 Then
If ary(i, j - 1) = 0 Then
rtn = False: Exit Sub
ElseIf ary(i, j - 1) = t Then
再帰4方向 ary, i, j - 1, t, rtn
End If
End If
If j < 9 Then
If ary(i, j + 1) = 0 Then
rtn = False: Exit Sub
ElseIf ary(i, j + 1) = t Then
再帰4方向 ary, i, j + 1, t, rtn
End If
End If
End Sub
Sub PrintArray(ary)
Dim i, j
For i = LBound(ary, 1) To UBound(ary, 1)
For j = LBound(ary, 2) To UBound(ary, 2)
Debug.Print ary(i, j);
Next
Debug.Print
Next
End Sub
何の工夫もなく、単純に4方向を見つつ再帰させています。
結果は、
0 1 1 1 9 9 1 9 1
1 9 9 1 9 9 1 9 1
9 9 1 1 9 9 1 9 1
1 9 1 1 9 9 9 9 9
1 9 9 9 9 1 1 9 9
1 1 1 1 1 2 1 1 1
0 1 2 2 2 2 1 0 0
1 2 0 2 0 2 2 1 1
囲碁としては、この9の位置の石を取れば良いという事です。
4回同じような事を書いているので、これを4回ループにすることでコードは短くできますが、単純にそれをやってしまうと、さらに難解にしてしまうだけな気もして、今のところこのままにしています。
突然思いついた処理方法
4方向再帰で書いたVBAが納得がいきませんでした。
もう少し整理したVBAに出来そうというのもありますが、何より、相手の石をとるのに4方向再帰という難しいロジックが必要なのかという事。
もし。再帰が使えないとしたらどうするのかと、、、
深夜に突然思いつきました。
2に着目して、辿っていき空白(0)が出てくるまで、、、
発想を逆転させて、空白(0)から見ていったらどうだろうかと。
空白の隣の石は取れない、つまり、空白の隣は不要、不要ならばそれを消していけば良いのではないかと。
空白(0)の上下左右の2を0に置換し、置換できなかったら終了しています。
結果は、
0 0 0 1 2 1 0 1 0
0 1 1 1 2 2 1 2 1
1 2 2 1 2 2 1 2 1
2 2 1 1 2 2 1 2 1
1 2 1 1 2 2 2 2 2
1 2 2 2 2 1 1 2 2
1 1 1 1 1 0 1 1 1
0 1 0 0 0 0 1 0 0
1 0 0 0 0 0 0 1 1
対象の2については、囲まれている2だけが残りました。
左上から右下に向かって順にみていき、空白(0)の上下左右の2は0にして消してしまう。
これを繰り返して、残ったものが取られてしまう石(2)ではないかと。
上のVBAでは、効率を考えて、
左上から右下、次は、右下から左上へと、繰り返す度に順番を入れ替えています。
多くの場合は、往復で完了します。
上下左右を消してしまうので、0が次々に伝搬していくので折れ曲がった複雑な形でなければ往復で終了します。
複雑な場合でも最大で2往復だと思います、つまり4回配列を巡回すれば完了するはずです。
上記VBAではflgで判定しましたが、
WorksheetFunction.Sumで配列を合計し、この合計が変わらなかったら終了という判定方法もあります。
ただし、これですと、どうしても1回は余分にLoopすることになるので効率が悪くなります。
もう少し整理したVBAに出来そうというのもありますが、何より、相手の石をとるのに4方向再帰という難しいロジックが必要なのかという事。
もし。再帰が使えないとしたらどうするのかと、、、
2に着目して、辿っていき空白(0)が出てくるまで、、、
発想を逆転させて、空白(0)から見ていったらどうだろうかと。
空白の隣の石は取れない、つまり、空白の隣は不要、不要ならばそれを消していけば良いのではないかと。
Sub 囲んでいる相手を取る()
Dim ary, i, j, t, rtn
ary = Range("B2:J10")
t = 2 '相手
Dim s, e, p, flg
s = 1: e = 9: p = 1
Do
flg = False
For i = s To e Step p
For j = s To e Step p
If ary(i, j) = t Then
If i > 1 Then If ary(i - 1, j) = 0 Then ary(i, j) = 0: flg = True
If i < 9 Then If ary(i + 1, j) = 0 Then ary(i, j) = 0: flg = True
If j > 1 Then If ary(i, j - 1) = 0 Then ary(i, j) = 0: flg = True
If j < 9 Then If ary(i, j + 1) = 0 Then ary(i, j) = 0: flg = True
End If
Next
Next
If Not flg Then Exit Do
If s = 1 Then
s = 9: e = 1: p = -1
Else
s = 1: e = 9: p = 1
End If
Loop
' PrintArray (ary)
End Sub
空白(0)の上下左右の2を0に置換し、置換できなかったら終了しています。
結果は、
0 1 1 1 2 2 1 2 1
1 2 2 1 2 2 1 2 1
2 2 1 1 2 2 1 2 1
1 2 1 1 2 2 2 2 2
1 2 2 2 2 1 1 2 2
1 1 1 1 1 0 1 1 1
0 1 0 0 0 0 1 0 0
1 0 0 0 0 0 0 1 1
これを繰り返して、残ったものが取られてしまう石(2)ではないかと。
上のVBAでは、効率を考えて、
左上から右下、次は、右下から左上へと、繰り返す度に順番を入れ替えています。
多くの場合は、往復で完了します。
上下左右を消してしまうので、0が次々に伝搬していくので折れ曲がった複雑な形でなければ往復で終了します。
複雑な場合でも最大で2往復だと思います、つまり4回配列を巡回すれば完了するはずです。
WorksheetFunction.Sumで配列を合計し、この合計が変わらなかったら終了という判定方法もあります。
ただし、これですと、どうしても1回は余分にLoopすることになるので効率が悪くなります。
両者のパフォーマンス比較
元々配列が小さいので、処理時間が問題になる事も無いのですが、どの程度の差があるのかを確認してみました。
両方とも、Debug.Printを取り除いて、10万回のテストです。
結果は、
4方向再帰が、3～4秒
Do Loopが、5～6秒
倍近い差が出ていますが、むしろこの程度の差しかないというのが不思議なくらいです。
Do Loopでは配列全てを2～4回処理しているのですから、もっと差が出るかと思いました。
恐らく、取る石が多ければ多いほど、Do Loopとの差が縮まるのではないでしょうか。
取る石が少なければ、4方向再帰は直ぐに終りになりますが、Do Loopでは必ず配列全てを往復で見てしまいますので。
両方とも、Debug.Printを取り除いて、10万回のテストです。
Sub sample()
Dim st As Double: st = Timer
Dim i
For i = 1 To 100000
囲んでいる相手を取る
Next
Debug.Print Timer - st
End Sub
結果は、
4方向再帰が、3～4秒
Do Loopが、5～6秒
倍近い差が出ていますが、むしろこの程度の差しかないというのが不思議なくらいです。
Do Loopでは配列全てを2～4回処理しているのですから、もっと差が出るかと思いました。
恐らく、取る石が多ければ多いほど、Do Loopとの差が縮まるのではないでしょうか。
取る石が少なければ、4方向再帰は直ぐに終りになりますが、Do Loopでは必ず配列全てを往復で見てしまいますので。
まとめ
囲碁から始まった問題ですが、問題の本質をもっと良く考えるべきだったと思いました。
囲碁で相手の石を取る → 配列 → 隣を見て同じ数字が連続しているか、、、
考えが固くなっていたようです。
囲碁を考えれば、打った石に注目しなくても、そもそも相手の石に完全に囲まれた状態というのは存在しません。
それらの石は必ず取られてしまうからです。
それが残っているとしたら、取り忘れか着手禁止点に打ち込んでいるかのどちらかです。
今回の場合に、どちらが良いかという事ではなく、もっと柔軟に考えるべきだったと反省しました。
業務でもありがちなことだと思います。
問題解決にあたって、問題を単純化・一般化したつもりが、かえって問題を複雑にしていることもあります。
今回の事で、時には原点に戻って、考え直してみることも必要だと改めて思いました。
囲碁で相手の石を取る → 配列 → 隣を見て同じ数字が連続しているか、、、
考えが固くなっていたようです。
囲碁を考えれば、打った石に注目しなくても、そもそも相手の石に完全に囲まれた状態というのは存在しません。
それらの石は必ず取られてしまうからです。
それが残っているとしたら、取り忘れか着手禁止点に打ち込んでいるかのどちらかです。
問題解決にあたって、問題を単純化・一般化したつもりが、かえって問題を複雑にしていることもあります。
今回の事で、時には原点に戻って、考え直してみることも必要だと改めて思いました。
同じテーマ「エクセル雑感」の記事
100桁の正の整数値の足し算
「VBA Match関数の限界」についての誤解
VBAで数値を漢数字に変換する方法
囲碁で相手の石を囲んで取るアルゴリズム
VBAで「3Lと5Lのバケツで4Lの水を作る」を解く
言語依存の関数を使用できるFormulaLocal
配列のUBoundがLBoundがより小さいことはあり得るか
ショートカット（Ctrl+Shift+n）抜け番ばどれだ
コレクションの要素を削除する場合
入力規則で○△を入れる数を制限する方法
greeenはgreenに、greeeeeNをGReeeeNに変換
新着記事NEW ・・・新着記事一覧を見る
日付型と通貨型のValueとValue2について｜エクセル雑感(2021-06-26)
DXってなんだ? ITと何が違うの?｜エクセル雑感(2021-06-24)
エクセルVBA 段級位 目安｜エクセル雑感(2021-06-21)
ローカル版エクセルが「Office Scripts」に変わる日｜エクセル雑感(2021-06-10)
新関数SORTBYをVBAで利用するラップ関数を作成｜VBA技術解説(2021-06-12)
VBA今日のひとこと on Twitter｜エクセル雑感(2021-06-10)
VBAの演算子まとめ（演算子の優先順位）｜VBA技術解説(2021-06-09)
画像が行列削除についてこない場合の対処｜VBA技術解説(2021-06-04)
エクセル関連で「いいね」の多かったツイート｜エクセル雑感(2021-05-17)
キーボード操作だけで非表示列を表示｜エクセル雑感(2021-05-11)
アクセスランキング ・・・ ランキング一覧を見る
1.最終行の取得（End,Rows.Count）｜VBA入門
2.Excelショートカットキー一覧｜Excelリファレンス
3.変数宣言のDimとデータ型｜VBA入門
4.RangeとCellsの使い方｜VBA入門
5.マクロって何？VBAって何？｜VBA入門
6.繰り返し処理（For Next)｜VBA入門
7.Range以外の指定方法（Cells,Rows,Columns）｜VBA入門
8.セルに文字を入れるとは（Range,Value）｜VBA入門
9.とにかく書いてみよう（Sub,End Sub）｜VBA入門
10.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。