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

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のお題です。数の単位に「無量大数」というものがあります。VBAでこの無量大数の足し算をするにはどうしたら良いでしょうか。そこで、100桁の正の整数の足し算をVBAで実現してみましょう。
「VBA Match関数の限界」についての誤解
ツイッターで出したVBAのお題です。発端はエゴサーチからです。(笑) 「教えて!goo」で引用されていたのを見つけました。あちこちで引用されているのは見かけることはあるのですが、以下ではよく言うディスられているような文章を見かけました。
VBAで数値を漢数字に変換する方法
ツイッターで出したVBAのお題です。算用数字を漢数字に変換するVBAです。滅多に必要になるものではないのに、なぜこんな問題を出したかと言うと、最近シリーズで書き始めた「Excel将棋」で必要になったからです。
囲碁で相手の石を囲んで取るアルゴリズム
VBAで「3Lと5Lのバケツで4Lの水を作る」を解く
ツイッターでVBAのお題として出したものです。昔からよくある問題です。「3Lと5Lのバケツで4Lの水を作る」これをVBAを使って自動で求めてみようという事です。VBA問題:ツイートの記録 【VBA問題】 「3Lと5Lのバケツで4Lの水を作る」・2つの容器サイズは変えられるように引数で受け取る (3,5,
言語依存の関数を使用できるFormulaLocal
ツイッターでVBAのお題として出したものです。複数セルに一括で数式を入れるバ宇井の記述と、言語環境に依存する関数をセルに設定する場合のFormulaプロパティの使い方についての問題です。問題を出したツイート A1:A10セルに半角の英数文字が入っているので、これを全角で表示するためにB1:B10セルに数式をVBAで…
配列のUBoundがLBoundがより小さいことはあり得るか
ツイッターでVBAのお題として出したものです。配列の下限が上限より大きくなるような配列は存在するかの問題です。LBound(ary)>UBound(ary) この条件を満たすような配列は存在するか? 問題を出したツイート 配列の下限と上限を調べるにはLBound関数とUBound関数を使います。
コレクションの要素を削除する場合
ツイッターで出したVBAのお題(投票)です。Collectionから要素を順に削除するVBAの正誤問題です。問題を出したツイート 【VBA問題】 DimcAsNewCollection Dimi Fori=1To100 c.Addi,CStr(i) Next Fori=1To100 c.Remove□ Next 四…
greeenはgreenに、greeeeeNをGReeeeNに変換
ツイッターで出したエクセルの入力規則のお題です。「greeenはgreenに、greeeeeNやGReeeeeenはGReeeeNに直す」文字列操作のVBA問題です。問題を出したツイート 【VBA問題】 greenは緑です。
数値変数の値を別の変数を使わずに入れ替える
ツイッターで出したエクセルVBAのお題です。数値が入っている3つの変数を、他の変数を使わずに値を入れ替えるという問題です。問題を出したツイート 【VBA問題】 変数a,b,cに整数値が入っています。これをa>b>cとなるように値を入れ替えてください。
Rangeオブジェクトを受け取り"行数,列数"で埋める
ツイッターで出したエクセルVBAのお題です。Rangeオブジェクトを受け取り、"行数,列数"の値(数式ではなく値)で埋めるVBAを書く問題です。問題を出したツイート 【VBAお題】 Rangeオブジェクトを受け取り、添付のように"行数,列数"の値(数式ではなく値)で埋めてくだ…


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

無効な前方参照か、コンパイルされていない種類への参照です。|エクセル雑感(2024-02-17)
初級脱出10問パック|VBA練習問題(2024-01-24)
累計を求める数式あれこれ|エクセル関数応用(2024-01-22)
複数の文字列を検索して置換するSUBSTITUTE|エクセル入門(2024-01-03)
いくつかの数式の計算中にリソース不足になりました。|エクセル雑感(2023-12-28)
VBAでクリップボードへ文字列を送信・取得する3つの方法|VBA技術解説(2023-12-07)
難しい数式とは何か?|エクセル雑感(2023-12-07)
スピらない スピル数式 スピらせる|エクセル雑感(2023-12-06)
イータ縮小ラムダ(eta reduced lambda)|エクセル入門(2023-11-20)
PIVOTBY関数(縦軸と横軸でグループ化して集計)|エクセル入門(2023-11-19)


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

1.最終行の取得(End,Rows.Count)|VBA入門
2.RangeとCellsの使い方|VBA入門
3.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
4.繰り返し処理(For Next)|VBA入門
5.変数宣言のDimとデータ型|VBA入門
6.ブックを閉じる・保存(Close,Save,SaveAs)|VBA入門
7.並べ替え(Sort)|VBA入門
8.条件分岐(IF)|VBA入門
9.マクロとは?VBAとは?VBAでできること|VBA入門
10.セルのクリア(Clear,ClearContents)|VBA入門




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


記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。



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