詰将棋で勉強するプログラミング2
前回製作したプログラムを復習します。
|
プログラム |
機能 |
|
Sub 駒位置取り込み(原点, BAN(), KY, KX) |
駒の位置を配列BAN()に取り込みます。KY KXは玉の位置。 |
|
Sub 盤面全表示(原点, BAN()) |
駒の位置BAN()を表示します。 |
|
Sub 駒台置取り込み(原点, TMC) |
駒台の駒を文字列TMCに取り込みます。 |
|
Sub 駒台表示(原点, TMC) |
持駒TMCを表示します。 |
|
Sub 金の王手(駒, BAN(), YY, XX, KY, KX, TE(), TEC()) |
金の王手を指し手の候補の配列TE()に出力します。YY XXは金の位置、KY KXは玉の位置。 |
|
Sub 可否判断(駒, BAN(), YY, XX, Dy, Dx, TE(), TEC()) |
現在の駒の位置YY XX 移動距離 DY DXとしたとき、移動可能であれば指し手の候補の配列TE()に出力します。 |
|
Sub 手シート出力(TE(), TEC()) |
指し手の候補の配列TE()を候補シートに出力します。 |
|
Sub 手の表示(原点, TE(), TEC()) |
指し手の候補の配列TE()の新しい位置を盤上に色塗りします。 |
3 飛車の王手
飛車は縦横自在に動きます。王手するにはどうすればいいでしょうか。
金と同じ考え方でうまくいくようです。玉の位置に飛車を置いたとして、効きの範囲を黄色に塗ります。
飛車の効きを青色で塗ります。黄色と青色のぶつかった点、赤色のところに移動すると王手となります。
邪魔ゴマがいると効き範囲が狭まります。
王手がかからなくなります。
縦横を考える前に、横だけについて考えます。
問3-1
下図で黄色部のセルに「原点31」という名前を付けました。
飛車の横の効き範囲に青色を塗って下さい。
データとしても記録するため、配列ban2(8,8)に効きの箇所1を登録して下さい。
ban2(y,x)は、BAN(y,x)と同じように、yは縦方向、xは横方向、y=0,y=0は1一を意味します。
Call 駒位置取り込みシート(原点, BAN(), ky, kx)を使って駒位置をBAN()に取り込みます。
答え
|
Sub テスト31() Dim BAN(8, 8), ban2(8, 8) Call 飛車の横効き表示("原点31", BAN(), ban2()) End Sub
Sub 飛車の横効き表示(原点, BAN(), ban2()) Call 駒位置取り込み(原点, BAN(), ky, kx) Erase ban2 For YY = 0 To 8 For XX = 0 To 8 If Mid(BAN(YY, XX), 1, 2) = "0飛" Then '飛が見つかった Call 飛車移動可能範囲subXa(BAN(), 1, YY, XX, ban2()) '横効き範囲に ban2(,)=1 End If Next XX Next YY Call 効き範囲色塗り(原点, ban2(), 1) End Sub
Sub 効き範囲色塗り(原点, ban2(), 色) '' 色=1のとき青色 色=2のとき 黄色で塗ります ''色=1のとき 画面の色を消去してから表示 Set OUS = ActiveSheet Set GG = OUS.Range(原点) If 色 = 1 Then Set 盤範囲 = GG.Offset(1, -9).Resize(9, 9) 盤範囲.Interior.ColorIndex = xlNone '全体の色塗りを消す End If If 色 = 1 Then col = 15773696 Else col = 65535 '色 青 キイ
For YY = 0 To 8 For XX = 0 To 8 If ban2(YY, XX) <> "" Then GG.Offset(YY + 1, -(XX + 1)).Interior.Color = col '効き範囲色塗り End If Next XX Next YY End Sub
Sub 飛車移動可能範囲subXa(BAN(), 記入, ty, tx, ban2()) ' in BAN() 飛車の位置tytx 記入する値 記入 out ban2() 効き範囲に 記入を記入 ' 飛車から左方向 For X = tx + 1 To 8 Step 1 ban2(ty, X) = 記入 駒1 = BAN(ty, X) If 駒1 <> "" Then Exit For '駒があったら終了 Next X ' 飛車から右方向 For X = tx - 1 To 0 Step -1 ban2(ty, X) = 記入 駒1 = BAN(ty, X) If 駒1 <> "" Then Exit For Next X End Sub |
実行すると下のように表示されます。
ポイントは Sub 飛車移動可能範囲suba(BAN(), 記入, ty, tx, ban2())を作り、効き範囲を ban2()に1 記入しました
その後、ban2()を見て、青色に塗りました。
次に縦の効きにも色を塗ってみましょう。
問3-2
下図で黄色部のセルに「原点32」という名前を付けました。
飛車の横の効き、縦効き範囲に青色を塗って下さい。
データとしても記録するため、上と同じように配列ban2(8,8)に効きの箇所1を登録して下さい。
答え
|
Sub テスト32() Dim BAN(8, 8), ban2(8, 8) Call 飛車の横効き表示2("原点32", BAN(), ban2()) End Sub
Sub 飛車の横効き表示2(原点, BAN(), ban2()) Set OUS = ActiveSheet Set GG = OUS.Range(原点) Set 盤範囲 = GG.Offset(1, -9).Resize(9, 9) 盤範囲.Interior.ColorIndex = xlNone '全体の色塗りを消す Call 駒位置取り込み(原点, BAN(), ky, kx)
Erase ban2 For YY = 0 To 8 For XX = 0 To 8 If Mid(BAN(YY, XX), 1, 2) = "0飛" Then '飛が見つかった Call 飛車移動可能範囲subXa(BAN(), 1, YY, XX, ban2()) '横効き範囲に ban2(,)=1 Call 飛車移動可能範囲subYa(BAN(), 1, YY, XX, ban2()) '縦横効き範囲に ban2(,)=1 End If Next XX Next YY Call 効き範囲色塗り(原点, ban2(), 1) End Sub
Sub 飛車移動可能範囲subYa(BAN(), 記入, ty, tx, ban2()) ' in BAN() 飛車の位置tytx 記入する値 記入 out ban2() 効き範囲に 記入を記入 ' 飛車から左方向 For Y = ty + 1 To 8 Step 1 ban2(Y, tx) = 記入 駒1 = BAN(Y, tx) If 駒1 <> "" Then Exit For '駒があったら終了 Next Y ' 飛車から右方向 For Y = ty - 1 To 0 Step -1 ban2(Y, tx) = 記入 駒1 = BAN(Y, tx) If 駒1 <> "" Then Exit For Next Y End Sub |
実行すると下のように表示されます。
次に、玉の位置に飛車を置いた場合の効きを黄色で表示してみます。
問3-3
下図で黄色部のセルに「原点33」という名前を付けました。
飛車の横の効き、縦効き範囲に青色を塗って下さい。
更に、玉の位置に飛車がいるとして、横の効き、縦効き範囲に黄色を塗って下さい。
データとしても記録するため、上と同じように配列ban3(8,8)に効きの箇所1を登録して下さい。
答え
|
Sub テスト33() Dim BAN(8, 8), ban2(8, 8), ban3(8, 8) Call 飛車の横効き表示3("原点33", BAN(), ban2(), ban3()) Call 効き範囲色塗り("原点33", ban2(), 1) '青色 Call 効き範囲色塗り("原点33", ban3(), 2) '黄色 End Sub
Sub 飛車の横効き表示3(原点, BAN(), ban2(), ban3()) Set OUS = ActiveSheet Set GG = OUS.Range(原点) Set 盤範囲 = GG.Offset(1, -9).Resize(9, 9) 盤範囲.Interior.ColorIndex = xlNone '全体の色塗りを消す Call 駒位置取り込み(原点, BAN(), ky, kx) Erase ban2 For YY = 0 To 8 For XX = 0 To 8 If Mid(BAN(YY, XX), 1, 2) = "0飛" Then '飛が見つかった ty = YY tx = XX End If Next XX Next YY Call 飛車移動可能範囲subXa(BAN(), 1, ky, kx, ban3()) '横効き範囲に ban3(,)=1 Call 飛車移動可能範囲subYa(BAN(), 1, ky, kx, ban3()) '縦横効き範囲に ban3(,)=1
Call 飛車移動可能範囲subXa(BAN(), 1, ty, tx, ban2()) '横効き範囲に ban2(,)=1 Call 飛車移動可能範囲subYa(BAN(), 1, ty, tx, ban2()) '縦横効き範囲に ban2(,)=1
End Sub |
実行すると下のように表示されます。
青と黄色の交点が王手の位置になります。その位置を求めます。
問3-4
下図で黄色部のセルに「原点34」という名前を付けました。
王手する為の移動場所を求め,TE()に出力してください。
またその位置を黄色に塗って下さい。
答え
|
Sub テスト34() Dim BAN(8, 8) Dim TE(20, 50, 4), TEC(50) Set OUS = ActiveSheet Call 駒位置取り込み("原点34", BAN(), ky, kx)
Call 飛車の王手実行(BAN(), ky, kx, TE(), TEC()) Call 手シート出力(TE(), TEC()) Call 手の表示("原点34", TE(), TEC()) 'Call 効き範囲色塗り("原点34", ban2(), 1) '青色 'Call 効き範囲色塗り("原点34", ban3(), 2) '黄色 End Sub
Sub 飛車の王手実行(BAN(), ky, kx, TE(), TEC()) For YY = 0 To 8 For XX = 0 To 8 If Mid(BAN(YY, XX), 1, 2) = "0飛" Then '飛が見つかった ty = YY tx = XX 駒 = BAN(YY, XX) Call 飛車の王手(駒, BAN(), ty, tx, ky, kx, TE(), TEC()) End If Next XX Next YY End Sub
Sub 飛車の王手(駒, BAN(), ty, tx, ky, kx, TE(), TEC()) '' IN 飛車の位置 TY TX OUT TE() Dim ban2(8, 8), ban3(8, 8) '' TY TX 飛車の位置 Call 飛車移動可能範囲subXa(BAN(), 1, ky, kx, ban3()) '横効き範囲に ban3(,)=1 Call 飛車移動可能範囲subYa(BAN(), 1, ky, kx, ban3()) '縦横効き範囲に ban3(,)=1
Call 飛車移動可能範囲subXa(BAN(), 1, ty, tx, ban2()) '横効き範囲に ban2(,)=1 Call 飛車移動可能範囲subYa(BAN(), 1, ty, tx, ban2()) '縦横効き範囲に ban2(,)=1
' 交点を求め 飛 が移動できるかチェック For YY = 0 To 8 For XX = 0 To 8 If ban2(YY, XX) = 1 And ban3(YY, XX) = 1 Then '両方1は交点 Call 可否判断(駒, BAN(), ty, tx, YY - ty, XX - tx, TE(), TEC()) '行先に自分のコマがいたら不可 End If Next XX Next YY End Sub |
まず、飛車の位置を求め、ty txに入れます。
その後、移動範囲を求め、交点を求めます。
sub 可否判断を使って、配列TE()に出力します。
実行すると下のように表示されます。
飛車の王手では他に、守りの駒を取って王手がありますが、
このプログラムで同様に処理できます。
下図にて実行しますと「金」をとる手が出力されます。
飛車の王手は他に空き王手があります。
今回の詰将棋では発生しそうもありませんので省略します。
また、龍の場合も処理の追加が必要ですが、今回の詰将棋には必要なさそうですので省略します。
4 打ち込みによる王手
現在、持駒に桂馬があります。また今後金をとる可能性があります。
桂と金の打ち込みによる王手を検討します。
問4-1
図で黄色部のセルに「原点41」という名前を付けました。
桂馬の打ち込みで王手するにはどこに打てばいいでしょうか。打ち込む場所をTE()に出力してください。
打ち込みでは現在位置がありません。TE()に出力する現在位置は y="" x=-1 とします。
答え
|
Sub テスト41() Dim BAN(8, 8), ban2(8, 8), ban3(8, 8) Dim TE(20, 50, 4), TEC(50) Call 駒位置取り込み("原点41", BAN(), ky, kx) Call 桂馬打込王手("0桂桂", BAN(), ky, kx, TE(), TEC()) 'kykxの玉に桂馬で王手する TE()出力 Call 手シート出力(TE(), TEC()) 'TE()を候補シートに出力 Call 手の表示("原点41", TE(), TEC()) 'TE()の場所を黄色塗り End Sub
Sub 桂馬打込王手(駒, BAN(), ky, kx, TE(), TEC()) 'kykxの玉に桂馬で王手する TE()出力 Call 可否判断打込(駒, BAN(), ky, kx, 2, -1, TE(), TEC()) Call 可否判断打込(駒, BAN(), ky, kx, 2, 1, TE(), TEC()) End Sub
Sub 可否判断打込(駒, BAN(), YY, XX, Dy, Dx, TE(), TEC()) '' 現在の位置 YY XX 移動する量 DY DX '' 盤をはみ出していない 行先に駒がいたら不可 ny = YY + Dy nx = XX + Dx If ny >= 0 And ny <= 8 And nx >= 0 And nx <= 8 Then 駒a = BAN(ny, nx) '行先 If 駒a = "" Then '駒がいないこと TE(手, TEC(手), 0) = 駒 TE(手, TEC(手), 1) = "": TE(手, TEC(手), 2) = -1 TE(手, TEC(手), 3) = ny: TE(手, TEC(手), 4) = nx TEC(手) = TEC(手) + 1 '次の行に移る End If End If End Sub |
桂馬の王手は 玉の位置から dy=2 dx=-1 または dy=2 dx=1の位置で可能。
Call 可否判断打込(駒, BAN(), ky, kx, 2, -1, TE(), TEC())
Call 可否判断打込(駒, BAN(), ky, kx, 2, 1, TE(), TEC())
にて、配列TE()に出力します。
実行すると下のように表示されます。
可否判断打込では その手が可能か判断し、TE()に出力します。
判断のポイントはその場所にすでに駒がいたら不可ということです。
前回製作したSub 可否判断との違いは、1行だけです。
Sub 可否判断打込では If Mid(駒a, 1, 1) = "" Then '駒がいないこと
Sub 可否判断 では If Mid(駒a, 1, 1) <> "0" Then '自分の駒がいないこと
ほとんど同じプログラムを2本持つときの問題点は、修正する場合が発生したとき2か所直さなければならず、特に、2か所デバックしなければならないことです。抜けが発生しやすくなります。
このプログラムの中の同じ機能のところを別のプログラムにすべきです。
問4-2
Sub 可否判断(駒, BAN(), YY, XX, Dy, Dx, TE(), TEC())とSub 可否判断打込(駒, BAN(), YY, XX, Dy, Dx, TE(), TEC())の中に同じ機能が含まれています。
その機能を分離し、別のプログラムとし、このプログラムを作り変えてください。
答え
|
Sub 可否判断2(駒, BAN(), YY, XX, Dy, Dx, TE(), TEC()) '' 現在の位置 yy xx 移動距離 dy dx Call 行けるか判断(YY, XX, Dy, Dx, ny, nx, OK) If OK = 1 Then '行ける 駒a = BAN(ny, nx) '行先 If Mid(駒a, 1, 1) <> "0" Then '自分の駒がいない Call TE出力(駒, YY, XX, ny, nx, TE(), TEC()) End If End If End Sub
Sub 可否判断打込2(駒, BAN(), YY, XX, Dy, Dx, TE(), TEC()) ' 玉の位置 yy xx 玉から打ち込み場所の距離 dy dx Call 行けるか判断(YY, XX, Dy, Dx, ny, nx, OK) If OK = 1 Then '行ける 駒a = BAN(ny, nx) '行先 If 駒a = "" Then '駒がいない Call TE出力(駒, "", -1, ny, nx, TE(), TEC()) End If End If End Sub '------------------------------------------------------------- Sub 行けるか判断(YY, XX, Dy, Dx, ny, nx, OK) '' in 現在の位置 yy xx(打ち込みの場合は玉の位置) 移動量 dy dx out 新しい位置 ny nx ok=1 可 ny = YY + Dy nx = XX + Dx If ny >= 0 And ny <= 8 And nx >= 0 And nx <= 8 Then OK = 1 Else OK = 0 End If End Sub
Sub TE出力(駒, YY, XX, ny, nx, TE(), TEC()) '' 手の候補TE(手,,)に追加出力する 現在TEC(手)件登録済み ' in 前の位置 yy xx 新しい位置 ny nx out TE(), TEC() TE(手, TEC(手), 0) = 駒 TE(手, TEC(手), 1) = YY: TE(手, TEC(手), 2) = XX TE(手, TEC(手), 3) = ny: TE(手, TEC(手), 4) = nx TEC(手) = TEC(手) + 1 End Sub |
共通の機能として、下記2本を作ります。
「Sub 行けるか判断」で 盤をはみ出していないかチェックします
「Sub TE出力」で 指し手の候補の配列TE()に出力します
残った駒の有無の判定のみ 「Sub 可否判断2 Sub 可否判断打込2 で実施します。
金の打ち込み王手も桂馬と同様に製作します。
問4-3
下図で黄色部のセルに「原点43」という名前を付けました。
金の打ち込みで王手するにはどこに打てばいいでしょうか。打ち込む場所をTE()に出力してください。
TE()に登録された王手する箇所に色塗りして下さい。
答え
|
Sub テスト43() Dim BAN(8, 8), ban2(8, 8), ban3(8, 8) Dim TE(20, 50, 4), TEC(50) Call 駒位置取り込み("原点43", BAN(), ky, kx) Call 金打込王手("0金金", BAN(), ky, kx, TE(), TEC()) Call 手シート出力(TE(), TEC()) 'TE()を候補シートに出力 Call 手の表示("原点43", TE(), TEC()) 'TE()の場所を黄色塗り End Sub
Sub 金打込王手(駒, BAN(), ky, kx, TE(), TEC()) Call 可否判断打込2(駒, BAN(), ky, kx, -1, 0, TE(), TEC()) '後ろ Call 可否判断打込2(駒, BAN(), ky, kx, 0, -1, TE(), TEC()) '横 Call 可否判断打込2(駒, BAN(), ky, kx, 0, 1, TE(), TEC()) Call 可否判断打込2(駒, BAN(), ky, kx, 1, -1, TE(), TEC()) '前 Call 可否判断打込(駒, BAN(), ky, kx, 1, 0, TE(), TEC()) Call 可否判断打込(駒, BAN(), ky, kx, 1, 1, TE(), TEC()) End Sub |
駒を打ち込む場合、駒台の駒の中から打ち込みます。
ある駒が何枚もある場合、同じ駒を何回も打つような王手の候補を作成しないよう、重複する駒の削除のプログラムを作ってみましょう。
問4-4
持ち駒が文字列TMCに入っています。重複している駒を削除してください。
例 TMC="銀金銀桂歩歩" ⇒ TMC2="銀金桂歩"
答え
|
Sub テスト44() tmc = "銀金銀桂歩歩" Call 重複持駒削除(tmc, tmc2) MsgBox (tmc2) End Sub
Sub 重複持駒削除(tmc, tmc2) tmc2 = "" For I = 1 To Len(tmc) a = Mid(tmc, I, 1) '1駒取る If InStr(tmc2, a) = 0 Then 'すでに TMC2に登録済みか? tmc2 = tmc2 & a '登録する End If Next I End Sub |
以上で例題の詰将棋を行うすべての王手のプログラムが出来たと思います。
5 王手のまとめ
局面を見て、可能なすべての王手をTE()に出力するプログラムを作ります。
その前に 出力するTE()を消去するプログラムを作成します。
問5-1
現在 何手目かは 変数 手に入っています。
手の候補を登録する配列 TE(手,)を消去してください。
答え
|
Sub 手の候補クリヤ(TE(), TEC()) ''手の候補クリヤ TEC(手) = 0 '登録件数 For j = 0 To UBound(te, 2) '配列の2軸の最大 50 For k = 0 To UBound(te, 3) '配列の3軸の最大 7 TE(手, j, k) = "" Next k Next j End Sub |
UBound(te, 2) 、UBound(te, 3) で配列の大きさを調べ、その範囲を消しています。
またTEC(手) には登録件数が入っていますので、0にしています。
問5-2
下図で黄色部のセルに「原点52」という名前を付けました。
局面を見て、すべての王手を洗い出し、TE()に出力してください。
TE()に登録された王手する箇所に色塗りして下さい。
今まで作った、下記王手のプログラムを使ってください。
Sub 金の王手(駒, BAN(), YY, XX, KY, KX, TE(), TEC())
Sub 飛車の王手(原点, BAN(), ban2(), ban3(), TE(), TEC())
Sub 桂馬打込王手(駒, BAN(), ky, kx, TE(), TEC())
Sub 金打込王手(駒, BAN(), ky, kx, TE(), TEC())
答え
|
Sub テスト52() Dim BAN(8, 8), ban2(8, 8), ban3(8, 8) Dim TE(20, 50, 4), TEC(50) Call 駒位置取り込み("原点52", BAN(), ky, kx) Call 駒台置取り込み("原点52", tmc) Call 全王手検討(BAN(), tmc, TE(), TEC(), ky, kx) Call 手シート出力(TE(), TEC()) 'TE()を候補シートに出力 Call 手の表示("原点52", TE(), TEC()) 'TE()の場所を黄色塗り End Sub
Sub 全王手検討(BAN(), tmc, TE(), TEC(), ky, kx) ''手を記録する配列を消去 Call 手の候補クリヤ(TE(), TEC()) ''盤上の駒で王手 For YY = 0 To 8 For XX = 0 To 8 駒 = BAN(YY, XX) Select Case Mid(BAN(YY, XX), 1, 2) Case "0金" Call 金の王手(駒, BAN(), YY, XX, ky, kx, TE(), TEC()) Case "0飛" Call 飛車の王手(駒, BAN(), YY, XX, ky, kx, TE(), TEC()) Case Else End Select Next XX Next YY ''手持ちの駒で王手 Call 重複持駒削除(tmc, tmc2) For I = 1 To Len(tmc2) 駒a = Mid(tmc2, I, 1) 駒 = "0" & 駒a & 駒a Select Case 駒a Case "桂" Call 桂馬打込王手(駒, BAN(), ky, kx, TE(), TEC()) Case "金" Call 金打込王手(駒, BAN(), ky, kx, TE(), TEC()) End Select Next I End Sub |
実行すると下のように表示されます。
すべての王手の候補の洗い出しが完了しました。
次回は、これを元に、王手を指します。
また、その受け手の候補を作成し、指します。
西八王子教室にて、レベルに応じてやさしく、または詳しく教えております。興味をお持ちの方、ぜひ参加をお願い致します。