バグ修正、そして、その先にあるもの

 以前『人工知能もどき開発事情』(2018年11月19日)で述べたHTMLアプリケーションのプログラム(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

という変更です。珍しいことに、たった1行の修正でこの件は直りました。
 今回はさらにもう一つ、バグ(不具合)を見つけてしまいました。たまたま見つけたのですが、ゲームの終盤で、最後の1マスに白黒どちらの石も置けないケースが起きました。そこでは、白黒双方の石数を明示して終局する(ゲームを終了する)のが普通です。ところが、今回のプログラムReversi V1.55.htaでは、そのケースに限って、白黒どちらも相手に手を譲ってしまい、永遠に終局しないということが起こりました。
 言いわけがましいとは思いますが、私としては、プログラムができた時点で正常に終局するように処理を入れたつもりでした。しかし、プログラム公開後も、コンピュータと何度も対戦してテストしていました。そのうちに上手くいかないケースに遭遇して、初めてそのバグ(不具合)に気がついたのです。作ったプログラムがモジュール構造化していたために、修正箇所を一つの関数内に絞ることができました。

ゲーム終局の条件をチェックする関数(EndChecking()関数)
   A.盤上のすべてのマス目が石で埋まった。
   B.盤上の石が黒石だけ、あるいは、白石だけになった。
   C.盤上に石の置いていないマス目があっても、黒石も白石も置くことができない。

 元のプログラムでは、Cの条件で処理が複雑化していて、余計な条件文が入っていました。それを取り除いても、プログラムの正しい動作に支障がないことが、別の動作テストで確かめられました。もちろん、問題のケース(最後の1マスに白黒どちらの石も置けないケース)でも、正しく終局することができるようになりました。よって、最小限のプログラム修正で、このバグ(不具合)についても直すことができました。
 このようなバグ(不具合)修正をしながら、私には思うことがありました。以下に、そのことを述べてみましょう。コンピュータをプログラミングすることを趣味として始めて以来、私がいつも使っている方法は、いわゆるThink&Make(ティンク・アンド・メイク)という方法です。つまり、処理を思いついたら、そのままコンピュータのキーボードでプログラムを打ちこむペーパーレスな(紙を使わない)方法です。今の若い人たちにとっては、普通の方法かもしれません。
 でも、私がプログラマの仕事をしていた時は、指示書や仕様書などの文書を大量に読み書きして、その後でやっとコンピュータのキーボードでプログラムを打ちこむ(コーディングをする)作業に移るという段取りでした。当時は、コンピュータ・システム本体(ハードウェア側)が高価だったので、それと比較して安価だった紙と鉛筆と労働者(ソフトウェア側)を十二分に活用する方法がとられていました。プログラムを作るのも、修正するのも、バグ(不具合)を無くすのも、まずはすべて紙の上で作業させられました。言い換えると、プログラムの形がある程度出来上がるまで、マシン(コンピュータ・システム)に一切触(さわ)らせてもらえませんでした。コンピュータの画面をじっと見て、一瞬でも考え込んでいると、その姿を先輩に見つけられて、叱られることがしばしばありました。「マシンの前に座ってボーっと考え込んでいないで、紙の上(あるいは、机上で)でコンピュータを動かしてみろ。」などと、とんでもないことを言われて、いつも厳しく教え込まれました。
 机上デバッグといって、コンピュータの実機が動作テストで動かなくなると、そのテストをしていた先輩が「黒田ぁ、コンピュータが動かないぞぉ。」「すいません。」「謝っていないで、早く動くようにしろよ。」と、しばしば仕事上で脅されたことを思い出します。プリント専用紙に打ち出されたプログラムリストを、作業テーブルの上に広げて、紙の上でコンピュータの動きを追いかける(トレースする)地道な仕事でした。プログラムが動かない原因を、紙の上だけで読み書きして探し出すのが、この『机上デバッグ』という作業でした。紙に赤ペンなどを入れて、修正箇所を直す段になって初めて、マシン(プログラム編集用のパソコン)に触(ふ)れることが許されました。
 この「紙の上でコンピュータを動かす」という旧式な方法は、プログラムのドキュメンテーション(Documentation 文書化)という方法と結びついて、バグの修正や、プログラムを開発する上で有効な手段の一つでした。
 確かに現代のIT技術は、ペーパーレスの方向に進んでいるとは思います。その是非はともかくとして、その結果の事実として、人間が紙の上で文字を使って思考する、ということが下手になっている感じがします。今回のバグ(不具合)についても、いろんなケースを考えて、私はパソコン上でプログラミングをしたつもりだったのですが、(些細なこととはいえ)基本的なことがなおざりにされてしまった感じがします。
 プログラムのドキュメンテーション(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>