ツイッター出題回答
囲碁で相手の石を囲んで取るアルゴリズム

ExcelマクロVBAとエクセル関数についての私的雑感
公開日:2020-08-21 最終更新日:2020-08-21

囲碁で相手の石を囲んで取るアルゴリズム


ツイッターで出したVBAのお題です。
Excel囲碁を作っていて、相手の石を囲んで取れるかどうかの判定、相手の石を取るにはどうしたら良いかというもの。


囲碁で相手の石をとる

VBA マクロ 囲碁 かこまれた石

ここで、8二に黒を打てば、

VBA マクロ 囲碁 かこまれた石

このように囲まれている白が取られます。

お題のツイート

頂いた回答

いくつかお返事をいただきましたが、
基本的には、4方向(上下左右)を見ていき、隣が2であればさらに隣を見ていく、空白(0)が出てくれば終了。
これを再帰で繰り返し行うというものです。

Excel囲碁でもこれで実装しました。

Excel囲碁:万波奈穂先生に捧ぐ
Excelで囲碁を作ってみます。AI搭載とかそんな大層なものではありません。人vs人で対戦できる程度、単純に黒白交互に打っていけるものです。ただし、・相手の石を囲んだら相手の石を取るのは自動にします。・着手禁止点には着手できないようにします。
Excel囲碁:再起動後も続けて打てるように改造
Excelで囲碁を作ってみます。人vs人で対戦できる程度、単純に黒白交互に打っていけるものです。前作ではその場で打てればよいだけで作成しましたが、1日1ツイートで先生とフォロワーで対戦していくことになりました。

Excel囲碁で実装したVBA

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 0 0 1 9 1 0 1 0
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

囲まれている2が9に置換されています。
囲碁としては、この9の位置の石を取れば良いという事です。

このVBAは、一度書いた後、特に見直しもしていませんが、もう少しスマートにできるとは思います。
4回同じような事を書いているので、これを4回ループにすることでコードは短くできますが、単純にそれをやってしまうと、さらに難解にしてしまうだけな気もして、今のところこのままにしています。

突然思いついた処理方法

4方向再帰で書いたVBAが納得がいきませんでした。
もう少し整理した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 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することになるので効率が悪くなります。

両者のパフォーマンス比較

元々配列が小さいので、処理時間が問題になる事も無いのですが、どの程度の差があるのかを確認してみました。
両方とも、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がより小さいことはあり得るか
コレクションの要素を削除する場合
greeenはgreenに、greeeeeNをGReeeeNに変換
数値変数の値を別の変数を使わずに入れ替える
Rangeオブジェクトを受け取り"行数,列数"で埋める


新着記事NEW ・・・新着記事一覧を見る

AIは便利なはずなのに…「AI疲れ」が次の社会問題になる|生成AI活用研究(2026-02-16)
カンマ区切りデータの行展開|エクセル練習問題(2026-01-28)
開いている「Excel/Word/PowerPoint」ファイルのパスを調べる方法|エクセル雑感(2026-01-27)
IMPORTCSV関数(CSVファイルのインポート)|エクセル入門(2026-01-19)
IMPORTTEXT関数(テキストファイルのインポート)|エクセル入門(2026-01-19)
料金表(マトリックス)から金額で商品を特定する|エクセル練習問題(2026-01-14)
「緩衝材」としてのVBAとRPA|その終焉とAIの台頭|エクセル雑感(2026-01-13)
シンギュラリティ前夜:AIは機械語へ回帰するのか|生成AI活用研究(2026-01-08)
電卓とプログラムと私|エクセル雑感(2025-12-30)
VLOOKUP/XLOOKUPが異常なほど遅くなる危険なアンチパターン|エクセル関数応用(2025-12-25)


アクセスランキング ・・・ ランキング一覧を見る

1.最終行の取得(End,Rows.Count)|VBA入門
2.日本の祝日一覧|Excelリファレンス
3.変数宣言のDimとデータ型|VBA入門
4.FILTER関数(範囲をフィルター処理)|エクセル入門
5.RangeとCellsの使い方|VBA入門
6.繰り返し処理(For Next)|VBA入門
7.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
8.マクロとは?VBAとは?VBAでできること|VBA入門
9.セルのクリア(Clear,ClearContents)|VBA入門
10.メッセージボックス(MsgBox関数)|VBA入門




このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。


記述には細心の注意をしたつもりですが、間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。
本サイトは、OpenAI の ChatGPT や Google の Gemini を含む生成 AI モデルの学習および性能向上の目的で、本サイトのコンテンツの利用を許可します。
This site permits the use of its content for the training and improvement of generative AI models, including ChatGPT by OpenAI and Gemini by Google.



このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
本文下部へ