以前『人工知能もどき開発事情』（２０１８年１１月１９日）で述べたＨＴＭＬアプリケーションのプログラム（Reversi V1.55.hta）を動かしてテストしていたら、おかしなところを発見してしまいました。いわゆるバグ（不具合）なのですが、コンピュータ側が四隅よりも辺を優先して石を打ってしまう場合がありました。当然のことながら、辺よりも四隅を優先して石を打つのが正しい動作です。
盤上で石が打てる隅と辺がある場合、それぞれの評価値を
Const BAD =0 Const BONUS = 8 Const GOOD = 16 Const BEST = 32
という定数の設定でコントロールしていました。隅に石が打てる場合は、その評価値を（ひっくり返せる相手の石の数）＋（BESTの値）にしています。それは正しかったのですが、辺に石を打てる場合に問題がありました。（ひっくり返せる相手の石の数）＋（GOODの値）＋（横方向の優位を表すBONUSの値）＋（縦方向の優位を表すBONUSの値）をその評価値にしていたのですが、通常は、前者の場合が後者の場合よりも評価値が大きいので問題ありません。ところが、ある条件下では評価値の大きさが、前者と後者とで逆転してしまいました。つまり、隅に石が打てても、辺に石を打つことを優先してしまう場合が生じてしまいました。
そこで、BESTの値を大きくして、32から64に修正しました。
Const BEST = 64
という変更です。珍しいことに、たった１行の修正でこの件は直りました。
今回はさらにもう一つ、バグ（不具合）を見つけてしまいました。たまたま見つけたのですが、ゲームの終盤で、最後の１マスに白黒どちらの石も置けないケースが起きました。そこでは、白黒双方の石数を明示して終局する（ゲームを終了する）のが普通です。ところが、今回のプログラムReversi V1.55.htaでは、そのケースに限って、白黒どちらも相手に手を譲ってしまい、永遠に終局しないということが起こりました。
言いわけがましいとは思いますが、私としては、プログラムができた時点で正常に終局するように処理を入れたつもりでした。しかし、プログラム公開後も、コンピュータと何度も対戦してテストしていました。そのうちに上手くいかないケースに遭遇して、初めてそのバグ（不具合）に気がついたのです。作ったプログラムがモジュール構造化していたために、修正箇所を一つの関数内に絞ることができました。
ゲーム終局の条件をチェックする関数（EndChecking()関数）
Ａ．盤上のすべてのマス目が石で埋まった。
Ｂ．盤上の石が黒石だけ、あるいは、白石だけになった。
Ｃ．盤上に石の置いていないマス目があっても、黒石も白石も置くことができない。
元のプログラムでは、Ｃの条件で処理が複雑化していて、余計な条件文が入っていました。それを取り除いても、プログラムの正しい動作に支障がないことが、別の動作テストで確かめられました。もちろん、問題のケース（最後の１マスに白黒どちらの石も置けないケース）でも、正しく終局することができるようになりました。よって、最小限のプログラム修正で、このバグ（不具合）についても直すことができました。
このようなバグ（不具合）修正をしながら、私には思うことがありました。以下に、そのことを述べてみましょう。コンピュータをプログラミングすることを趣味として始めて以来、私がいつも使っている方法は、いわゆるThink&Make（ティンク・アンド・メイク）という方法です。つまり、処理を思いついたら、そのままコンピュータのキーボードでプログラムを打ちこむペーパーレスな（紙を使わない）方法です。今の若い人たちにとっては、普通の方法かもしれません。
でも、私がプログラマの仕事をしていた時は、指示書や仕様書などの文書を大量に読み書きして、その後でやっとコンピュータのキーボードでプログラムを打ちこむ（コーディングをする）作業に移るという段取りでした。当時は、コンピュータ・システム本体（ハードウェア側）が高価だったので、それと比較して安価だった紙と鉛筆と労働者（ソフトウェア側）を十二分に活用する方法がとられていました。プログラムを作るのも、修正するのも、バグ（不具合）を無くすのも、まずはすべて紙の上で作業させられました。言い換えると、プログラムの形がある程度出来上がるまで、マシン（コンピュータ・システム）に一切触（さわ）らせてもらえませんでした。コンピュータの画面をじっと見て、一瞬でも考え込んでいると、その姿を先輩に見つけられて、叱られることがしばしばありました。「マシンの前に座ってボーっと考え込んでいないで、紙の上（あるいは、机上で）でコンピュータを動かしてみろ。」などと、とんでもないことを言われて、いつも厳しく教え込まれました。
机上デバッグといって、コンピュータの実機が動作テストで動かなくなると、そのテストをしていた先輩が「黒田ぁ、コンピュータが動かないぞぉ。」「すいません。」「謝っていないで、早く動くようにしろよ。」と、しばしば仕事上で脅されたことを思い出します。プリント専用紙に打ち出されたプログラムリストを、作業テーブルの上に広げて、紙の上でコンピュータの動きを追いかける（トレースする）地道な仕事でした。プログラムが動かない原因を、紙の上だけで読み書きして探し出すのが、この『机上デバッグ』という作業でした。紙に赤ペンなどを入れて、修正箇所を直す段になって初めて、マシン（プログラム編集用のパソコン）に触（ふ）れることが許されました。
この「紙の上でコンピュータを動かす」という旧式な方法は、プログラムのドキュメンテーション（Documentation 文書化）という方法と結びついて、バグの修正や、プログラムを開発する上で有効な手段の一つでした。
確かに現代のＩＴ技術は、ペーパーレスの方向に進んでいるとは思います。その是非はともかくとして、その結果の事実として、人間が紙の上で文字を使って思考する、ということが下手になっている感じがします。今回のバグ（不具合）についても、いろんなケースを考えて、私はパソコン上でプログラミングをしたつもりだったのですが、（些細なこととはいえ）基本的なことがなおざりにされてしまった感じがします。
プログラムのドキュメンテーション（Documentation 文書化）にしても、その手段は、作業の効率化や経費の削減という現代の流れには沿わないものなのかもしれません。しかし、プログラムが誤動作する（あるいは、思うように動かなくなる）ことへの危機管理になることに変わりはありません。プログラムが複雑化して内容がわからなくなった時に、その文書化が役立つことがしばしばあります。
文書化というと、「俺は文章を書くのが苦手だから（できない）」と主張する理系肌の人も多かったと思います。身の丈以上のことをやろうとするから、無理だと考えてしまうわけです。一度プログラムを作ってしまえば、それに関する様々な仕様書など何の役にも立たないし不要になってしまうだろう、と考えるのは自然なことです。そんなことに労力を使うくらいならば、新たなプログラムを開発したほうが生産的で効率的と言えるじゃないか、と考えるのももっともなことです。
でも、プログラム処理のとりうるケースが多くなったり複雑化したりすると、そのプログラムの筋道（ロジック）を整理しないといけなくなります。複雑化したプログラムが何らかの問題で動かなくなると、それを簡単に直せなくなって大変なことになります。そのような複雑化したプログラムの内容をスッキリと整理することが、それを文書化する真の目的なのです。急がば回れ、ということなのです。
私がEndChecking()関数を修正した例で示したように、プログラムを部分的あるいは断片的に文書化してもバグ（不具合）修正には役立ちます。コンピュータのプログラムは、いつでも修正変更が多いものです。だから、作ったプログラム全てを文書化する（ドキュメントを作る）必要はないのです。
さらに私は、新たなプログラムの変更を考えるようになりました。これまでのプログラム（Reversi V1.55.hta）では、バグとまでは言えなくても、何か使いにくい感じがしました。ゲームの盤面をじっと見ていないと、コンピュータが、知らない間に手を打ってしまうことがあるのです。どこに石を置いたか、どの石がひっくり返されたのかを人間の側が確認できません。かといって、人間が盤面に集中し続けると、スマホを見続けるのと同じで、目が疲れるしストレスがたまります。
それにまた、ただ思考して、ただ石を置いて、ただ石をひっくり返すというシーケンス（段取り）を、そのままコンピュータにやらせることは、対戦する人間の側からみて何かそっけない感じがしました。機械的な冷たさをも感じさせます。そこで、いくつかの視覚的な効果をプログラムに入れてみました。対戦する人間の側が、いかにも『人工知能』あるいは『人工頭脳』を相手にしているかのような、そのように錯覚させるか、あるいは、それを実感できるような工夫をしてみました。それを、どのようなプログラムの仕掛けで実現したのかの、その説明は次回に譲りたいと思います。差し当たり、そうした修正変更をふくめて、バージョンアップしたプログラムを以下に付録として掲載しておきます。
今回の付録
Reversi V1.58.hta
<STYLE TYPE="text/css">
BODY { font-size:16pt; background-color:rgb(20%,60%,20%); scroll:no; }
.scaleW { font-size:16pt; font-family:"MS ゴシック"; text-align:center; }
.scaleH { font-size:16pt; font-family:"MS ゴシック"; text-align:left;
line-height:18pt; position:relative; top:-220pt; }
.banmen { font-size:16pt; font-family:"MS ゴシック"; text-align:center;
border:1pt solid black; padding:5pt; margin:10pt 20pt;
cursor:default; }
.message { font-size:12pt; font-family:"MS ゴシック"; text-align:center;
padding:5pt; margin:10pt 5pt; }
#fakebtn { font-size:12pt; font-family:"MS ゴシック"; background-color:white;
border-style:outset; padding:5pt; margin:10pt 5pt;
cursor:default; display:none; }
</STYLE>
<HTA:Application Id=oHTA Border=dialog Scroll=no MaximizeButton=no Contextmenu=no />
<SCRIPT language="VBScript">
Option Explicit
Randomize
Const BLACK = "●"
Const WHITE = "○"
Const BLANK = "＋"
Const BAD = 0
Const BONUS = 8
Const GOOD = 16
Const BEST = 64
Dim WSHShell
Set WSHShell = CreateObject("WScript.Shell")
Dim Q(7,7), R(63), vx(7), vy(7)
Dim PointJustNow, ThinkingTime, RecoveringTime, bm, wb, cp
Dim ManMove, ComMove, LargeMode, SaveMes, Selflag
Call ResizeTo(280, 390)
Document.Title = "Reversi V1.58"
Set wb = New WatchingBoardSpace
Set cp = New CornerProcessingList
Set bm = New BoardMarkingAction
Sub Window_Onload
Dim yy, xx, idx
ManMove = BLACK
ComMove = WHITE
LargeMode = False
idx = 0
For yy = 0 to 7
For xx = 0 to 7
Set R(idx) = Document.all.tags("SPAN")(idx)
Set Q(yy, xx) = R(idx)
idx = idx + 1
Next
Next
vy(0) = -1 : vy(1) = -1 : vy(2) = -1 : vy(3) = 0 : vy(4) = 0
vy(5) = 1 : vy(6) = 1 : vy(7) = 1
vx(0) = -1 : vx(1) = 0 : vx(2) = 1 : vx(3) = -1 : vx(4) = 1
vx(5) = -1 : vx(6) = 0 : vx(7) = 1
Call InitBan()
End Sub
Sub InitBan()
Dim idx
For idx = 0 to 63
R(idx).InnerText = BLANK
Next
P33.InnerText = WHITE
P34.InnerText = BLACK
P43.InnerText = BLACK
P44.InnerText = WHITE
PointJustNow = ""
ThinkingTime = False
RecoveringTime = False
Call wb.Clear()
fakebtn.style.display = "none"
mouth.InnerText = "さあ、始めましょう！"
Call SelectStones()
End Sub
Private Sub SelectStones()
Selflag = True
TurnB.InnerHTML = "黒番？" : BStones.InnerHTML = " それとも、"
TurnW.InnerHTML = "白番？" : WStones.InnerHTML = ""
TurnB.style.cursor = "help"
TurnW.style.cursor = "help"
End Sub
Class WatchingBoardSpace
Private List(59), Lptr
Public Sub Clear()
Lptr = 0
End Sub
Public Property Let Watch(tid)
If Not Found(tid) Then
List(Lptr) = tid
Lptr = Lptr + 1
End If
End Property
Private Function Found(id)
Dim idx, rfg
rfg = False
For idx = 0 to Lptr - 1
If List(idx) = id Then
rfg = True
Exit For
End If
Next
Found = rfg
End Function
Public Function AnyMore()
Dim Empties
Empties = GetBlanks()
If (Lptr = 0) Or (Lptr < Empties) Then
AnyMore = True
Else
AnyMore = False
End If
End Function
Private Function GetBlanks()
Dim idx, cnt
cnt = 0
For idx = 0 to 63
If R(idx).InnerText = BLANK Then
cnt = cnt + 1
End If
Next
GetBlanks = cnt
End Function
End Class
'
' Event Driven Routines
'
' On mouse over, On mouse out --- for user interface
' On click -- for user interface and the trigger on computer thinking
' On key press -- Monotor switch on/off
'
Sub Document_Onmouseover
Dim target
If ThinkingTime Then Exit Sub
Set target = Window.event.srcElement
If Selflag Then
If target.tagname = "SPAN" Then
If Left(target.id, 4) = "Turn" Then
With target.style
.color = "white"
.backgroundcolor = "rgb(10%,10%,10%)"
End With
End If
End If
Exit Sub
End If
If target.tagname = "SPAN" Then
If Left(target.id, 1) = "P" Then
If target.InnerText = BLANK Then
wb.Watch = target.id
If CountEnemy(target.id, ManMove, ComMove) > 0 Then
With target.style
.backgroundcolor = "rgb(50%,80%,50%)"
.cursor = "help"
End With
PointJustNow = target.id
Call wb.Clear()
Else
If Not wb.AnyMore() Then
Call bm.ClearBlink()
mouth.InnerText = "打てませんね ．．．思考中"
ThinkingTime = True
Call setTimeout("NowThinking()", 2000)
End If
End If
End If
End If
End If
End Sub
Sub Document_Onmouseout
Dim target
If ThinkingTime Then Exit Sub
Set target = Window.event.srcElement
If Selflag Then
If target.tagname = "SPAN" Then
If Left(target.id, 4) = "Turn" Then
With target.style
.color = "black"
.backgroundcolor = "rgb(20%,60%,20%)"
End With
End If
End If
Exit Sub
End If
If target.tagname = "SPAN" Then
If Left(target.id, 1) = "P" Then
If target.innerText = BLANK Then
With target.style
.backgroundcolor = ""
.cursor = "default"
End With
PointJustNow = ""
End If
End If
End If
End Sub
Sub Document_Onclick
Dim target, yy, xx
If ThinkingTime Then Exit Sub
Set target = Window.event.srcElement
If target.id = "" Then Exit Sub
If Selflag Then
If Left(target.id, 4) = "Turn" Then
With target.style
.color = "black"
.backgroundcolor = "rgb(20%,60%,20%)"
End With
TurnB.style.cursor = "default"
TurnW.style.cursor = "default"
Call FixTurn(target.InnerText)
Selflag = False
If ComMove = BLACK Then
mouth.InnerText = "思考中 ．．．"
ThinkingTime = True
Call setTimeout("NowThinking()", 2000)
End If
End If
Exit Sub
End If
If Left(target.id, 1) <> "P" Then Exit Sub
If PointJustNow <> "" Then
Call bm.ClearBlink()
yy = Mid(target.id, 2, 1)
xx = Mid(target.id, 3, 1)
Q(yy, xx).InnerText = ManMove
With target.style
.backgroundcolor = ""
.cursor = "default"
End With
PointJustNow = ""
Call ReverseEnemy(ManMove, yy, xx, ComMove)
If Not EndChecking(ManMove) Then
mouth.InnerText = "思考中 ．．．"
ThinkingTime = True
Call setTimeout("NowThinking()", 2000)
End If
End If
End Sub
Private Sub FixTurn(sterm)
Dim st, dstr
If sterm = "黒番？" Then
st = BLACK
ElseIf sterm = "白番？" Then
st = WHITE
Else
msgbox"Illegally selected [" & sterm & "]"
End If
If ManMove <> st Then
ComMove = ManMove : ManMove = st
End If
TurnB.InnerText = "黒"
TurnW.InnerText = "白"
dstr = "（あなた）"
If ManMove = BLACK Then
TurnB.InnerText = TurnB.InnerText & dstr
Else
TurnW.InnerText = TurnW.InnerText & dstr
End If
BStones.innerText = " 2 個 "
WStones.innerText = " 2 個"
End Sub
Private Sub NowThinking()
If Not TurnToComputer() Then
If Not EndChecking(ComMove) Then
mouth.InnerText = "打つ手がありません。"
End If
ThinkingTime = False
End If
End Sub
Public Function EndChecking(mside)
Dim bcnt, wcnt, mes
bcnt = CalcStones(BLACK)
wcnt = CalcStones(WHITE)
BStones.innerText = " " & bcnt & " 個 "
WStones.innerText = " " & wcnt & " 個"
If isFinish(bcnt, wcnt) Then
If bcnt = wcnt Then
mes = "引き分けです。"
ElseIf bcnt > wcnt Then
mes = "黒の勝ちです。"
Else
mes = "白の勝ちです。"
End If
Else
If bcnt = 0 Then
mes = "白の勝ちです。"
ElseIf wcnt = 0 Then
mes = "黒の勝ちです。"
Else
EndChecking = False
Exit Function
End If
End If
If mside = ComMove Then
Call bm.ClearBlink()
End If
fakebtn.style.display = "inline"
mouth.InnerText = mes
EndChecking = True
End Function
Private Function isFinish(bcnt, wcnt)
Dim flg
If bcnt + wcnt = 64 Then
flg = True
Else
If Not wb.AnyMore() Then
flg = True
Else
flg = False
End If
End If
isFinish = flg
End Function
Private Function CalcStones(side)
Dim idx, cnt
cnt = 0
For idx = 0 to 63
If R(idx).InnerText = side Then
cnt = cnt + 1
End If
Next
CalcStones = cnt
End Function
Sub Document_OnKeyPress()
Dim tk, kc
If ThinkingTime Then Exit Sub
If RecoveringTime Then Exit Sub
If fakebtn.style.display = "inline" Then Exit Sub
tk = Window.event.keyCode
kc = Chr(tk)
RecoveringTime = True
If kc = "l" Or kc = "L" Then
LargeMode = Not LargeMode
Call ChangeScale()
Else
RecoveringTime = False
End If
End Sub
Private Sub ChangeScale()
Dim mes
If LargeMode Then
mes = "盤を拡大サイズにします。"
Else
mes = "盤を通常サイズにします。"
End If
SaveMes = mouth.InnerText
mouth.InnerText = mes
Call setTimeout("RecoverMessage2()", 2000)
End Sub
Private Sub RecoverMessage2()
If LargeMode Then
Call ChangeScale2(420, 600, 22, 28, 24, 4, 31, -358, 24)
Else
Call ChangeScale2(280, 390, 12, 16, 16, 1, 18, -220, 12)
End If
RecoveringTime = False
End Sub
Private Sub ChangeScale2(sx, sy, fontSiz1, fontSiz2, fontSiz3, bSiz, Lh, topos, btnSiz)
Dim obj, idx, cnm, styp
Call ResizeTo(sx, sy)
For idx = 0 to document.all.length - 1
Set obj = document.all(idx)
If obj.tagName = "DIV" Then
cnm = obj.className
Set styp = obj.style
If cnm = "message" Then
styp.fontSize = fontSiz1 & "pt"
ElseIf cnm = "banmen" Then
styp.fontSize = fontSiz2 & "pt"
styp.border = bSiz & "pt solid black"
Else
styp.fontSize = fontSiz3 & "pt"
If cnm = "scaleH" Then
styp.lineHeight = Lh & "pt"
styp.position = "relative"
styp.top = topos & "pt"
End If
End If
ElseIf obj.id = "fakebtn" Then
obj.style.fontSize = btnSiz & "pt"
Else
End If
Next
mouth.InnerText = SaveMes
End Sub
'
' Heuristic AI Thinking subroutines
'
'
Function TurnToComputer()
Dim tId(), tCnt1(), tCnt2(), tLast
tLast = ListingHands(ComMove, ManMove, tId, tCnt1)
If tLast = -1 Then
TurnToComputer = False
Exit Function
End If
Call bm.BuildMarking(tId, tLast)
Call bm.ColorMarking("rgb(80%,50%,50%)")
Call CopyTable(tCnt1, tCnt2, tLast)
bm.DelayPoint = EvaluateMax(tId, tCnt2, tLast)
Call setTimeout("bm.ClearMarking()", 1000)
TurnToComputer = True
End Function
Class BoardMarkingAction
Private tny, tnx, svLast
Private DelayIndex, svyy, svxx
Private Bnkflag, BListy, BListx, BLastIdx, bflag
Private Sub Class_Initialize
Bnkflag = False
BLastIdx = -1
bflag = False
End Sub
Public Sub BuildMarking(tId, tLast)
Dim idx
DelayIndex = -1
svLast = tLast
ReDim tny(svLast), tnx(svLast)
For idx = 0 to svLast
tny(idx) = Mid(tId(idx), 2, 1)
tnx(idx) = Mid(tId(idx), 3, 1)
Next
End Sub
Public Sub ColorMarking(col)
Dim idx, p
For idx = 0 to svLast
Set p = Q(tny(idx), tnx(idx))
p.style.backgroundcolor = col
Next
End Sub
Property Let DelayPoint(Index)
DelayIndex = Index
svyy = tny(DelayIndex)
svxx = tnx(DelayIndex)
End Property
Public Sub ClearMarking()
Dim idx, p
For idx = 0 to svLast
If idx <> DelayIndex Then
Set p = Q(tny(idx), tnx(idx))
p.style.backgroundcolor = ""
End If
Next
If DelayIndex > -1 Then
Call setTimeout("bm.ClearMark1()", 1000)
End If
End Sub
Public Sub ClearMark1()
Q(svyy, svxx).InnerText = ComMove
Q(svyy, svxx).style.backgroundcolor = ""
mouth.InnerText = "操作中です。"
Call setTimeout("bm.DoReverse()", 500)
End Sub
Public Sub DoReverse()
Call ReverseEnemy(ComMove, svyy, svxx, ManMove)
Call wb.Clear()
If Not EndChecking(ComMove) Then
mouth.InnerText = "あなたの手番です。"
Bnkflag = True
Call setTimeout("bm.Blinkon()", 5000)
End If
ThinkingTime = False
End Sub
Public Sub Blinkon()
If bnkflag Then
Q(svyy, svxx).style.backgroundcolor = "rgb(80%,50%,50%)"
Call setTimeout("bm.Blinkon2()", 400)
End If
End Sub
Public Sub Blinkon2()
Dim idx, yy, xx
If bnkflag Then
For idx = 0 to BLastIdx
yy = BListy(idx)
xx = BListx(idx)
Q(yy, xx).style.backgroundcolor = "rgb(80%,50%,50%)"
Next
Call setTimeout("bm.Blinkoff()", 800)
End If
End Sub
Public Sub Blinkoff()
Call ClearbgColor()
If bnkflag Then
Call setTimeout("bm.Blinkon()", 4000)
End If
End Sub
Public Sub ClearBlink()
If Bnkflag Then
Bnkflag = False
Call ClearbgColor()
End If
End Sub
Private Sub ClearbgColor()
Dim idx, yy, xx
For idx = 0 to BLastIdx
yy = BListy(idx)
xx = BListx(idx)
Q(yy, xx).style.backgroundcolor = ""
Next
Q(svyy, svxx).style.backgroundcolor = ""
End Sub
Public Sub RecordReset(mside)
If mside = ManMove Then
bflag = False
Else
ReDim BListy(0)
ReDim BListx(0)
BLastIdx = -1
bflag = True
End If
End Sub
Public Sub Record(ay, ax)
If bflag Then
BLastIdx = BLastIdx + 1
ReDim Preserve BListy(BLastIdx)
ReDim Preserve BListx(BLastIdx)
BListy(BLastIdx) = ay
BListx(BLastIdx) = ax
End If
End Sub
End Class
Private Function ListingHands(fside, eside, tI, tC)
Dim idx, cnt, tL
tL = -1
For idx = 0 to 63
If R(idx).InnerText = BLANK Then
cnt = CountEnemy(R(idx).id, fside, eside)
If cnt > 0 Then
tL = tL + 1
ReDim Preserve tI(tL), tC(tL)
tI(tL) = R(idx).id
tC(tL) = cnt
End If
End If
Next
ListingHands = tL
End Function
Private Sub CopyTable(tC1, tC2, tL)
Dim idx
ReDim tC2(tL)
For idx = 0 to tL
tC2(idx) = tC1(idx)
Next
End Sub
Function EvaluateMax(tI, tC, tL)
Dim idx, py, px, any
For idx = 0 to tL
py = Mid(tI(idx), 2, 1)
px = Mid(tI(idx), 3, 1)
If cp.RealCorner(py, px) Then
tC(idx) = tC(idx) + BEST
Else
If CornerPriority(py, px) Then
any = OtherPriority(py, px, tC(idx))
If tC(idx) <> any Then
tC(idx) = any
End If
Else
tC(idx) = BAD
End If
End If
Next
EvaluateMax = GetMaxIndex(tC, tL)
End Function
Private Function GetMaxIndex(tC, tL)
Dim idx, retidx, maxcnt, Lst(), Lsts
maxcnt = BAD - 1
For idx = 0 to tL
If tC(idx) > maxcnt Then
maxcnt = tC(idx)
retidx = idx
End If
Next
Lsts = -1
For idx = 0 to tL
If maxcnt = tC(idx) Then
Lsts = Lsts + 1
ReDim Preserve Lst(Lsts)
Lst(Lsts) = idx
End If
Next
If Lsts > 0 Then
idx = Int(Rnd * (Lsts + 1))
retidx = Lst(idx)
End If
GetMaxIndex =retidx
End Function
Private Function CornerPriority(ay, ax)
Dim pos
If cp.CornerTL(ay, ax) Then
pos = 0
ElseIf cp.CornerBL(ay, ax) Then
pos = 1
ElseIf cp.CornerTR(ay, ax) Then
pos = 2
ElseIf cp.CornerBR(ay, ax) Then
pos = 3
Else
CornerPriority = True
Exit Function
End If
CornerPriority = cp.AroundCorner(ay, ax, pos)
End Function
Private Function OtherPriority(ay, ax, NowCnt)
Dim ret
If (ay = 0) Or (ay = 7) Then
ret = OtherEvaluation(0, ay, ax, NowCnt)
ElseIf (ax = 0) Or (ax = 7) Then
ret = OtherEvaluation(1, ay, ax, NowCnt)
ElseIf ComSide(0, 0) Or ComSide(7, 7) Then
If cp.DiagonalTLBR(ay, ax) Then
ret = OtherEvaluation(2, ay, ax, NowCnt)
Else
ret = NowCnt
End If
ElseIf ComSide(7, 0) Or ComSide(0, 7) Then
If cp.DiagonalBLTR(ay, ax) Then
ret = OtherEvaluation(3, ay, ax, NowCnt)
Else
ret = NowCnt
End If
Else
ret = NowCnt
End If
OtherPriority = ret
End Function
Private Function ComSide(ay, ax)
If Q(ay, ax).InnerText = ComMove Then
ComSide = True
Else
ComSide = False
End If
End Function
Class SideStatus
Public bfg, tfg, gfg
Private py, px, swch, mSideCorner
Private Sub Class_Initialize
bfg = False
tfg = False
gfg = False
End Sub
Public Sub PositionSet(sw, ay, ax)
swch = sw
py = ay
px = ax
End Sub
Public Sub Checking(sdt, edt, vect)
Dim idx, it
If swch = 2 Then py = sdt
If swch = 3 Then py = 7 - sdt
For idx = sdt to edt step vect
If swch = 1 Then
it = Q(idx, px).InnerText
Else
it = Q(py, idx).InnerText
End If
If it = BLANK Then
bfg = True
Exit For
End If
If it = ManMove Then
tfg = True
Else
If idx = edt Then gfg = True
If tfg Then tfg = False
End If
If swch = 2 Then py = py + vect
If swch = 3 Then py = py - vect
Next
End Sub
Public Property Get AddBonus()
If gfg Then
AddBonus = BONUS
Else
AddBonus = 0
End If
End Property
End Class
Private Function OtherEvaluation(sw, ay, ax, Ncnt)
Dim o1, o2
Set o1 = New SideStatus
Set o2 = New SideStatus
Call o1.PositionSet(sw, ay, ax)
Call o2.PositionSet(sw, ay, ax)
If sw = 1 Then
Call o1.Checking(ay+1, 7, +1)
Call o2.Checking(ay-1, 0, -1)
Else
Call o1.Checking(ax+1, 7, +1)
Call o2.Checking(ax-1, 0, -1)
End If
If OtherJudgement(o1, o2) Then
OtherEvaluation = GOOD + Ncnt + o1.AddBonus + o2.AddBonus
Else
OtherEvaluation = BAD
End If
Set o1 = Nothing
Set o2 = Nothing
End Function
Private Function OtherJudgement(o1, o2)
Dim rfg
If o1.bfg And o2.bfg Then
If Not o1.tfg And Not o2.tfg Then
rfg = True
Else
rfg = False
End If
ElseIf o1.bfg Or o2.bfg Then
If (Not o2.bfg And o2.tfg) Or (Not o1.bfg And o1.tfg) Then
rfg = False
Else
rfg = True
End If
Else
rfg = True
End If
OtherJudgement = rfg
End Function
Class CornerProcessingList
Private cny, cnx
Private scy, scx
Private cny0, cnx0
Private cny1, cnx1, cny2, cnx2, cny3, cnx3
Private last
Private dgy0, dgx0, dgy1, dgx1
Private Sub Class_Initialize
Dim idx
cny = array(0, 7, 0, 7)
cnx = array(0, 0, 7, 7)
scy = array(1, 6, 1, 6)
scx = array(1, 1, 6, 6)
cny0 = array(0, 0, 1, 2)
cnx0 = array(1, 2, 0, 0)
last = UBound(cny0)
ReDim cny1(last), cny2(last), cny3(last)
ReDim cnx1(last), cnx2(last), cnx3(last)
For idx = 0 to last
cny1(idx) = 7 - cny0(idx)
cnx1(idx) = cnx0(idx)
cny2(idx) = cny0(idx)
cnx2(idx) = 7 - cnx0(idx)
cny3(idx) = 7 - cny0(idx)
cnx3(idx) = 7 - cnx0(idx)
Next
dgy0 = array(1, 2, 5, 6)
dgx0 = array(1, 2, 5, 6)
dgy1 = array(1, 2, 5, 6)
dgx1 = array(6, 5, 2, 1)
End Sub
Public Function RealCorner(dy, dx)
RealCorner = CornerCheck(dy, dx, cny, cnx)
End Function
Public Function CornerTL(dy, dx)
CornerTL = CornerCheck(dy, dx, cny0, cnx0)
End Function
Public Function CornerBL(dy, dx)
CornerBL = CornerCheck(dy, dx, cny1, cnx1)
End Function
Public Function CornerTR(dy, dx)
CornerTR = CornerCheck(dy, dx, cny2, cnx2)
End Function
Public Function CornerBR(dy, dx)
CornerBR = CornerCheck(dy, dx, cny3, cnx3)
End Function
Public Function DiagonalTLBR(dy, dx)
DiagonalTLBR = CornerCheck(dy, dx, dgy0, dgx0)
End Function
Public Function DiagonalBLTR(dy, dx)
DiagonalBLTR = CornerCheck(dy, dx, dgy1, dgx1)
End Function
Private Function CornerCheck(ay, ax, cnyy, cnxx)
Dim rfg, idx, iy, ix
rfg = False
iy = CInt(ay)
ix = CInt(ax)
For idx = 0 to last
If (cnyy(idx) = iy) And (cnxx(idx) = ix) Then
rfg = True
Exit For
End If
Next
CornerCheck = rfg
End Function
Public Function AroundCorner(ay, ax, Index)
Dim rfg, what, posy, posx, alty, altx
rfg = True
posy = cny(Index)
posx = cnx(Index)
what = Q(posy, posx).InnerText
If what = BLANK Then
posy = scy(Index)
posx = scx(Index)
what = Q(posy, posx).InnerText
If what = ManMove Then
alty = posy + posy - ay
altx = posx + posx - ax
what = Q(alty, altx).InnerText
If what = ComMove Then
rfg = False
End If
End If
End If
AroundCorner = rfg
End Function
End Class
'
' Common Subroutines
'
'
Function CountEnemy(tgid, mside, yside)
Dim cnt, yy, xx, idx, nyy, nxx, vc(7)
yy = Mid(tgid, 2, 1)
xx = Mid(tgid, 3, 1)
For idx = 0 to 7
vc(idx) = 0
If Not OutOfRange(yy, xx, idx) Then
nyy = yy + vy(idx)
nxx = xx + vx(idx)
If Q(nyy, nxx).InnerText = yside Then
vc(idx) = FriendsExist(mside, nyy, nxx, idx)
End If
End If
Next
cnt = 0
For idx = 0 to 7
cnt = cnt + vc(idx)
Next
CountEnemy = cnt
End Function
Function FriendsExist(mm, dy, dx, d)
Dim y, x, ret, fr, it
y = dy
x = dx
ret = 0
fr = False
Do
it = Q(y, x).InnerText
If it = mm Then
fr = True
ElseIf it = BLANK then
Exit Do
Else
ret = ret + 1
If OutOfRange(y, x, d) Then
Exit Do
Else
y = y + vy(d)
x = x + vx(d)
End If
End If
Loop Until it = mm
If Not fr Then
ret = 0
End If
FriendsExist = ret
End Function
Function OutOfRange(y, x, d)
If (y = 0 And vy(d) = -1) Or (y = 7 And vy(d) = 1) Or _
(x = 0 And vx(d) = -1) Or (x = 7 And vx(d) = 1) Then
OutOfRange = True
Else
OutOfRange = False
End If
End Function
Sub ReverseEnemy(mside, yy, xx, yside)
Dim idx, nyy, nxx
Call bm.RecordReset(mside)
For idx = 0 to 7
If Not OutOfRange(yy, xx, idx) Then
nyy = yy + vy(idx)
nxx = xx + vx(idx)
If Q(nyy, nxx).InnerText = yside Then
Call ChangeToFriends(mside, nyy, nxx, idx)
End If
End If
Next
End Sub
Sub ChangeToFriends(mm, dy, dx, d)
Dim y, x, it, mside
y = dy
x = dx
mside = False
Do
it = Q(y, x).InnerText
If it = mm Then
mside = True
ElseIf it = BLANK then
Exit Do
Else
If OutOfRange(y, x, d) Then
Exit Do
Else
y = y + vy(d)
x = x + vx(d)
End If
End If
Loop Until it = mm
If mside Then
Call ChangeToMySide(mm, dy, dx, d)
End If
End Sub
Sub ChangeToMySide(mm, dy, dx, d)
Dim y, x, it
y = dy
x = dx
Do
it = Q(y, x).InnerText
If it <> mm Then
Q(y, x).InnerText = mm
Call bm.Record(y, x)
y = y + vy(d)
x = x + vx(d)
End If
Loop Until it = mm
Call bm.Record(y, x)
End Sub
</SCRIPT>
<BODY>
<DIV class=scaleW >a b c d e f g h</DIV>
<DIV class=banmen >
<SPAN id=P00 ></SPAN> <SPAN id=P01 ></SPAN>
<SPAN id=P02 ></SPAN> <SPAN id=P03 ></SPAN>
<SPAN id=P04 ></SPAN> <SPAN id=P05 ></SPAN>
<SPAN id=P06 ></SPAN> <SPAN id=P07 ></SPAN><BR>
<SPAN id=P10 ></SPAN> <SPAN id=P11 ></SPAN>
<SPAN id=P12 ></SPAN> <SPAN id=P13 ></SPAN>
<SPAN id=P14 ></SPAN> <SPAN id=P15 ></SPAN>
<SPAN id=P16 ></SPAN> <SPAN id=P17 ></SPAN><BR>
<SPAN id=P20 ></SPAN> <SPAN id=P21 ></SPAN>
<SPAN id=P22 ></SPAN> <SPAN id=P23 ></SPAN>
<SPAN id=P24 ></SPAN> <SPAN id=P25 ></SPAN>
<SPAN id=P26 ></SPAN> <SPAN id=P27 ></SPAN><BR>
<SPAN id=P30 ></SPAN> <SPAN id=P31 ></SPAN>
<SPAN id=P32 ></SPAN> <SPAN id=P33 ></SPAN>
<SPAN id=P34 ></SPAN> <SPAN id=P35 ></SPAN>
<SPAN id=P36 ></SPAN> <SPAN id=P37 ></SPAN><BR>
<SPAN id=P40 ></SPAN> <SPAN id=P41 ></SPAN>
<SPAN id=P42 ></SPAN> <SPAN id=P43 ></SPAN>
<SPAN id=P44 ></SPAN> <SPAN id=P45 ></SPAN>
<SPAN id=P46 ></SPAN> <SPAN id=P47 ></SPAN><BR>
<SPAN id=P50 ></SPAN> <SPAN id=P51 ></SPAN>
<SPAN id=P52 ></SPAN> <SPAN id=P53 ></SPAN>
<SPAN id=P54 ></SPAN> <SPAN id=P55 ></SPAN>
<SPAN id=P56 ></SPAN> <SPAN id=P57 ></SPAN><BR>
<SPAN id=P60 ></SPAN> <SPAN id=P61 ></SPAN>
<SPAN id=P62 ></SPAN> <SPAN id=P63 ></SPAN>
<SPAN id=P64 ></SPAN> <SPAN id=P65 ></SPAN>
<SPAN id=P66 ></SPAN> <SPAN id=P67 ></SPAN><BR>
<SPAN id=P70 ></SPAN> <SPAN id=P71 ></SPAN>
<SPAN id=P72 ></SPAN> <SPAN id=P73 ></SPAN>
<SPAN id=P74 ></SPAN> <SPAN id=P75 ></SPAN>
<SPAN id=P76 ></SPAN> <SPAN id=P77 ></SPAN>
</DIV>
<DIV Class=message >
<SPAN id=TurnB></SPAN><SPAN id=BStones></SPAN>
<SPAN id=TurnW></SPAN><SPAN id=WStones></SPAN><BR><BR>
<SPAN id=Mouth></SPAN>
<SPAN id=fakebtn OnClick="InitBan()" >最初から</SPAN>
</DIV>
<DIV class=scaleH >1<BR>2<BR>3<BR>4<BR>5<BR>6<BR>7<BR>8</DIV>
</BODY>
