Otherware/Otherware_1_SB_Development.iso/amiga/misc/amoner03.dms/amoner03.adf/Knight.AMOS/Knight.amosSourceCode

AMOS Source Code | 1991-12-15 | 14.2 KB | 487 lines

'  ******************************************************************
'  ***                                                            ***
'  ***                          Knights Tour                      ***
'  ***                By: Scott Bonen & Mike Sheldrake            ***
'  ***                                                            ***
'  ******************************************************************
Break Off
'
'  ******************************
'  ***  Initialize variables  ***
'  ******************************
'
Led Off : Music 1
_COPYRIGHT[75]
Screen Open 1,640,200,16,Hires : Palette ,,,,,,$C4E
Curs Off : Hide : Fix(2) : Gr Writing 0 : Set Paint 1
Screen To Back 1
Screen Open 2,640,200,16,Hires
ITRO=0
BUILD_INTRO
Screen 1
Dim MATRIX(10,64),DR(2,8),WEIGHT(64),SQ(5,64),NM(2,64),CORN(8,4)
Def Fn RC(A,B)=(A-1)*8+B
Def Fn RR(A)=(A-1) mod 8
Def Fn CC(A)=Int((64-A)/8)
XMAX=40 : YMAX=16 : XTOP=157 : YTOP=29
Global MATRIX(),DR(),WEIGHT(),SQ(),NM(),CORN(),XMAX,YMAX,XTOP,YTOP,ANS,ITRO
'
' *******************************
' ***      Find Solution      ***
' *******************************
'
BUILD_MATRIX
FIND:
DISP_BOARD
'
' *******************************
' ***         Main Loop       ***
' *******************************
'
WALKS=0 : PRNES=0 : COUNT=0 : LOMOVE=0 : HIMOVE=64 : MOVE=1
X=ANS : MATRIX(1,X)=MOVE
Ink 4 : Text NM(1,X),NM(2,X),Str$(MATRIX(1,X)) : Shoot
'
Timer=0
Repeat
   M=Mouse Click : If M=2 Then Goto RESET
   FOUND=0
   FX=3
   While FX<=10 and FOUND=0 : Rem        More Links??'
      FL=MATRIX(FX,X) : Rem                Get Forward Link'
      If FL>0 : Rem                        Is Link Seen/Used??'
         MATRIX(FX,X)=-1*FL : Rem           Mark Link as Seen
         If MATRIX(1,FL)=0 : Rem            Is Forward Link Free??
            FOUND=1 : Rem                    Set Found Flag
            FFX=3 : Rem                      Prune out Dead Branches!
            While FFX<=10 and FOUND=1
               FFL=MATRIX(FFX,FL)
               If FFL>0
                  If MATRIX(1,FFL)=0
                     FRE=0
                     FFFX=3
                     While FFFX<=10 and FRE<2
                        FFFL=MATRIX(FFFX,FFL)
                        If FFFL>0
                           If MATRIX(1,FFFL)=0
                              Inc FRE
                           End If
                        End If
                        Inc FFFX
                     Wend
                     If FRE<2 and MOVE<62
                        FOUND=0
                        Inc PRNES
                     End If
                  End If
               End If
               Inc FFX
            Wend
         End If
      End If
      If FOUND=1 : Rem                          Walk Forward
         Inc MOVE : Rem                          Bump Move(Branch Level)
         MATRIX(1,FL)=MOVE : Rem                 Set Move Number
         MATRIX(2,FL)=X : Rem                    Set BackLink
         If MOVE>50 and LOMOVE=0
            LOMOVE=MOVE
         End If
         X=FL : Rem                              Forward Link is New Move
         Ink 6 : Text NM(1,X),NM(2,X),Str$(MATRIX(1,X))
      End If
      Inc FX : Rem                              Bump Link
   Wend
   '
   ' *******************************
   ' ***     Gather Statitics    ***
   ' *******************************
   '
   If MOVE<LOMOVE
      LOMOVE=MOVE
      HIMOVE=MOVE
      COUNT=0
   End If
   If MOVE>HIMOVE
      HIMOVE=MOVE
      COUNT=0
   End If
   Inc WALKS
   Dec COUNT
   If COUNT<=0 or MOVE>=64
      Pen 4 : Paper 0 : Locate 10,22
      ET#=Timer/50.0
      Print Using "Walks=###### ";WALKS;
      Print Using "Prunes=###### ";PRNES;
      Print Using "Move=## ";MOVE;
      Print Using "Low=## ";LOMOVE;
      Print Using "Hi=## ";HIMOVE;
      Print Using "Time=#####.## ";ET#
      COUNT=100
      If MOVE>=64
         Bell
         CIR=0
         For I=3 To 10
            If MATRIX(1,MATRIX(I,X))=1 : Rem      CIRCULAR SOLUTION
               Ink 3 : Text NM(1,X),NM(2,X),Str$(MATRIX(1,X))
               Wait 25
               Boom
               CIR=1
            End If
         Next I
         If CIR=0
            Ink 4 : Text NM(1,X),NM(2,X),Str$(MATRIX(1,X))
         End If
         Pen 5 : Paper 0 : Locate 15,23
         Print "Left Click= Search More, Right Click= New Square"
         Do
            M=Mouse Click
            If M=1
               FOUND=0
               LOMOVE=64
               Timer=0
               Exit
            End If
            If M=2
               Exit
            End If
         Loop
         Pen 0 : Locate 16,23 : Cline : Curs Off
      End If
   End If
   If FOUND=0 : Rem                            Walk Backwards
      If SQ(5,X)=8
         Set Pattern -1
      End If
      Ink SQ(5,X) : Bar SQ(1,X),SQ(2,X) To SQ(3,X),SQ(4,X)
      Set Pattern 0
      MATRIX(1,X)=0 : Rem                       Clear Move Number
      For I=3 To 2+WEIGHT(X)
         MATRIX(I,X)=Abs(MATRIX(I,X)) : Rem       Reset Link Flags
      Next I
      X=MATRIX(2,X) : Rem                       Backup a Branch
      Dec MOVE
   End If
Until MOVE>=64
'
RESET:
For I=1 To 64 : Rem                          Clear Matrix
   MATRIX(1,I)=0
   MATRIX(2,I)=0
   For J=3 To 10
      MATRIX(J,I)=Abs(MATRIX(J,I))
   Next J
Next I
Goto FIND
'
' *******************************************************************
Procedure BUILD_INTRO
   '
   ' *******************************
   ' ***    Build Intro screen   ***
   ' *******************************
   '
   Get Sprite Palette : Curs Off
   Cls 16
   DYTOP=8 : Ink 10,16
   For I=1 To 15
      Read A$
      Text 32,DYTOP,A$
      Add DYTOP,10
   Next I
   Ink 3,16
   Text 200,176,"Click Left or Right Mouse Key"
   Do
      M=Mouse Click
      Exit If M<>0
   Loop
   Cls 16 : DYTOP=8 : Ink 10,16
   For I=1 To 17
      Read A$
      Text 32,DYTOP,A$
      Add DYTOP,10
   Next I
   DYTOP=108 : Ink 6,16
   For I=1 To 6
      Read A$
      Text 32,DYTOP,A$
      Add DYTOP,10
   Next I
   '
   ' *******************************
   ' ***   Start BOB animation   ***
   ' *******************************
   '
   Channel 1 To Bob 1 : Bob 1,610,5,3
   A$="(3,5)(4,5)(5,5)(6,5)(7,5)(8,5)(9,5)(10,5)(11,5)"
   A$=A$+"(12,5)(13,5)(14,5)(15,5)(16,5)(17,5)(18,5)(19,10)L"
   Anim 1,A$
   Anim On
   '
   Data "Knights Tour is a puzzle using a knights movement on a chess board."
   Data "The Knight has to jump to each of the squares on the board, without"
   Data "stepping on the same square twice. Basically, make 63 moves from the"
   Data "starting square and cover all squares."
   Data ""
   Data "We solved this problem by building a table with all possible moves from"
   Data "each square. We then use a tree search method to find the solution."
   Data "After a few very long test runs we determined we needed to implement a"
   Data "quicker solution. So we developed a pruning technique that allowed us"
   Data "to chop off branches from the tree. This vastly increased the search"
   Data "speed. We then implemented a weighted board technique, which causes our"
   Data "program to fill the corners of the board first. As you will see this"
   Data "developed the fastest solution possible. After a few code improvements"
   Data "we had what we felt to be a good program for solutions. "
   Data ""
   Data "The operation of this program is pretty straight forward, just follow"
   Data "the instructions. You can start from any square on the board and find a"
   Data "solution for that square. The longest time we found was about 1 minute."
   Data "If the 64th move # is flashing, this means a circular solution. What this"
   Data "means is that you can jump to the first square from the 64th square."
   Data "Naturally, this would be the fastest solution possible, just set up a"
   Data "matrix that has the circular solution and you could select any square and"
   Data "solve the Tour in 63 steps. But, that would be to easy."
   Data ""
   Data "Now for a brief discription of the status line under the board."
   Data "        This is how many branches of the tree we searched."
   Data "        This is the number of branches we have pruned."
   Data "        This is the current move we are on, between 1-64."
   Data "        This is the lowest level of the tree we are on, 1 is root."
   Data "        This is the highest level of the tree we are on, 64 leaf."
   Data "        This is the time it took to solve the puzzle in seconds."
   Data "All values above will be updated every 100 walks or a new low/high."
   Data "WALKS:","PRUNES:","MOVE:","LOW:","HIGH:","TIME:"
End Proc
Procedure BUILD_MATRIX
   '
   ' *******************************
   ' ***      Build Matrix       ***
   ' *******************************
   '
   Def Fn RC(A,B)=(A-1)*8+B
   Def Fn RR(A)=(A-1) mod 8
   Def Fn CC(A)=Int((64-A)/8)
   '
   ' *******************************
   ' ***     Number of Links     ***
   ' ***       per square        ***
   ' *******************************
   '
   Data 2,3,4,4,4,4,3,2
   Data 3,4,6,6,6,6,4,3
   Data 4,6,8,8,8,8,6,4
   Data 4,6,8,8,8,8,6,4
   Data 4,6,8,8,8,8,6,4
   Data 4,6,8,8,8,8,6,4
   Data 3,4,6,6,6,6,4,3
   Data 2,3,4,4,4,4,3,2
   For I=1 To 64
      Read WEIGHT(I)
   Next I
   '
   ' *******************************
   ' ***    Corner Weighting     ***
   ' *******************************
   '
   Data 1,3,2,5,4,7,6,8
   Data 8,6,7,4,5,2,3,1
   Data 4,2,6,1,8,3,7,5
   Data 5,7,3,8,1,6,2,4
   For I=1 To 4
      For J=1 To 8
         Read CORN(J,I)
      Next J
   Next I
   '
   ' *******************************
   ' ***        Directions       ***
   ' *******************************
   '
   Data -2,-1,-2,1,-1,-2,-1,2,1,-2,1,2,2,-1,2,1
   For I=1 To 8
      Read DR(1,I),DR(2,I)
   Next I
   '
   For R=1 To 8
      For C=1 To 8
         X=3
         Y= Fn RC(R,C)
         If((Y-1) mod 8<4) and Y<=32
            CN=1
         End If
         If((Y-1) mod 8>=4) and Y>32
            CN=2
         End If
         If((Y-1) mod 8>=4) and Y<=32
            CN=3
         End If
         If((Y-1) mod 8<4) and Y>32
            CN=4
         End If
         For D=1 To 8
            DRR=DR(1,CORN(D,CN)) : DRC=DR(2,CORN(D,CN))
            If R+DRR>0 and R+DRR<9
               If C+DRC>0 and C+DRC<9
                  MATRIX(X,Y)= Fn RC(R+DRR,C+DRC)
                  X=X+1
               End If
            End If
         Next D
         '
         FOUND=1
         While FOUND=1
            A=3
            B=4
            FOUND=0
            While B<=10
               If MATRIX(B,Y)>0
                  If WEIGHT(MATRIX(A,Y))>WEIGHT(MATRIX(B,Y))
                     FOUND=1
                     Swap MATRIX(A,Y),MATRIX(B,Y)
                  End If
               End If
               Inc A
               Inc B
            Wend
         Wend
         '
         ' *******************************
         ' ***   build box locations   ***
         ' ***           and           ***
         ' ***    number placements    ***
         ' *******************************
         '
         NM(1,Y)= Fn RR(Y)*XMAX+XTOP+XMAX/2-14
         NM(2,Y)= Fn CC(Y)*YMAX+YTOP+YMAX/2+3
         SQ(1,Y)= Fn RR(Y)*XMAX+XTOP
         SQ(2,Y)= Fn CC(Y)*YMAX+YTOP
         SQ(3,Y)=SQ(1,Y)+XMAX
         SQ(4,Y)=SQ(2,Y)+YMAX
         If Fn CC(Y) mod 2=0
            C1=2 : C2=8
         Else
            C1=8 : C2=2
         End If
         If Fn RR(Y) mod 2=0
            SQ(5,Y)=C1
         Else
            SQ(5,Y)=C2
         End If
         '
      Next C
   Next R
End Proc
Procedure DISP_BOARD
   '
   ' *******************************
   ' ***      Display Board      ***
   ' *******************************
   '
   Def Fn RC(A,B)=(A-1)*8+B
   Def Fn RR(A)=(A-1) mod 8
   Def Fn CC(A)=Int((64-A)/8)
   '
   Cls 16
   Set Pattern 32
   Ink 13,,2 : Bar XTOP-XMAX/2-9,YTOP-YMAX/2-6 To 8.7*XMAX+XTOP,8.9*YMAX+YTOP
   Set Pattern 0
   Ink 2 : Text XTOP+(8*XMAX/2)-82,YTOP-5," *- Knight's Tour -* "
   P$="Program By: Scott Bonen & Mike Sheldrake"
   Ink 2 : Text XTOP,YTOP+(YMAX*8.7),P$
   For I=1 To 64
      If SQ(5,I)=8
         Set Pattern -1
      End If
      Ink SQ(5,I),,16 : Bar SQ(1,I),SQ(2,I) To SQ(3,I),SQ(4,I)
      Set Pattern 0
   Next I
   '
   Change Mouse 2
   Limit Mouse X Hard(XTOP),Y Hard(YTOP) To X Hard(XMAX*8+XTOP),Y Hard(YMAX*8+YTOP)
   X Mouse=X Hard(XTOP+XMAX/2) : Y Mouse=Y Hard(YTOP+YMAX*8-YMAX/2)
   Pen 5 : Paper 0 : Locate 17,23
   Print "Left Click= Starting Square, Right Click= EXIT"
   '
   ' *******************************
   ' ***      Let User Know      ***
   ' *******************************
   '
   If ITRO=0
      Screen 2 : Curs Off
      Bob Off 1 : Anim Off 1
      Ink 3,16
      Text 490,187,"Click a Button"
      Do
         M=Mouse Click
         Exit If M<>0
      Loop
      Text 490,187,"              "
      Fade 10 : Wait 150
      Bank Swap 11,3
      Music 1 : Tempo 18
      Auto View Off
      Screen 1 : Screen To Front 1
      For Y=1 To Screen Height/2
         Screen Display 1,,50+Screen Height/2-Y,,Y*2
         View : Wait Vbl
      Next
      Auto View On
      ITRO=1
   End If
   Show
   '
   ' *******************************
   ' ***   Get Starting Square   ***
   ' *******************************
   '
   Do
      M=Mouse Click
      If M=1
         XX=X Screen(1,X Mouse) : YY=Y Screen(1,Y Mouse)
         XX=Int((XX-XTOP)/XMAX)+1 : YY=8-Int((YY-YTOP-1)/YMAX)
         ANS= Fn RC(YY,XX)
         Exit
      End If
      If M=2
         Bank Swap 11,3
         Default
         Limit Mouse
         Led On
         Run "Amoner003:Autoexec.Amos"
         '   End
      End If
   Loop
   Hide
   Locate 17,23 : Cline
   Pen 5 : Paper 0 : Locate 28,23
   Print "Right Click= Stop Search"
   '
End Proc
Procedure _COPYRIGHT[YDISPLAY]
   '
   ' *******************************
   ' ***    Display Copyright    ***
   ' *******************************
   '
   Auto View Off : Curs Off : Hide
   Unpack 10 To 7
   '
   For Y=2 To Screen Height/2 Step 2
      Screen Display 7,,YDISPLAY+Screen Height/2-Y,,Y*2
      Screen Offset 7,,Screen Height/2-Y
      View
      Wait Vbl
   Next
   '
   Wait 200
   '
   For Y=Screen Height/2 To 0 Step -8
      Screen Display 7,,YDISPLAY+Screen Height/2-Y,,Y*2
      Screen Offset 7,,Screen Height/2-Y
      View
      Wait Vbl
   Next
   '
   Screen Close 7
   Auto View On : Curs On : Show
   '
End Proc