Programmer 7500/MAX_PROGRAMMERS.iso/CLIPPER/MISC/AIE8909.ZIP/APPRENTI

Text File | 1989-09-01 | 14.6 KB | 499 lines

MAXITH CODE:


{$R+}    {Range checking off}
{$B+}    {Boolean complete evaluation on}
{$S+}    {Stack checking on}
{$I+}    {I/O checking on}
{$N-}    {No numeric coprocessor}

Program Maxit;
{This demonstrates a straightforward approach to computer game playing: an
 N level search followed by minimax-based back pruning}

{White moves first and horizontal.  Black moves second and vertical.}

Uses
  Dos;

Const

{$I tconh.ins}

  Taken = -100;
  Black = 'B';
  White = 'W';
  Neither = '[';
  Expanded = 1;
  Unexpanded = 2;
  BigWin = 32000;
  BigLoss = -32000;
  UnEvaluated = -Maxint;
  {Change the next two things to alter the dimension of the board}
  BD = 8; {Board Dimension}

Type
     bry = array[1..bd,1..bd] of integer;
     ctype = record
              whosemove:char;         {whose move brought us here}
                                      {It changes on the human side in
 GetInputMove.  The current board is input, and so whosemove shows the
 computer at that point, as the computer got us to the current state.
 Once inside GetInputMove, the board changes and whosemove changes too.}
              icoord:integer;         {current cursor location}
              jcoord:integer;
              bscore:integer;         {black points and white points,}
              wscore:integer;         {both including current item}
              brd: bry;
                                      {-100 indicates taken}
            end;

{$i ttyph.ins}

Var

{$I tvarh.ins}
EmptyCType:                            ctype;
Human, Computer:                       char;
Winner:                                char;
CurrentBoard:                          ctype;
Nlevels:                               Integer; {Number of levels to search}
TreeFull:                              Boolean;
T1,T2:                                 Real; {for timekeeping}

{$I tprch.ins}
{$I time.ins}

Procedure Init(var Board:Ctype);
Var I,J:Integer;
Begin
with board do begin
  {Set up Board}
  for i:=1 to bd do for j:=1 to bd do brd[i,j]:=random(40);
  for i:=1 to bd do for j:=1 to bd do brd[i,j]:=brd[i,j]-20;
  whosemove:=black;{starts off white}
  bscore:=0;wscore:=0;
  icoord:=2;jcoord:=1;
  brd[icoord,jcoord]:=taken;
  Assign(outfile,'');
  Rewrite(outfile);
end;
End;

Function Opposite(Side:char):char;
Begin
  If Side=White then Opposite:=Black
  Else If Side=Black then Opposite:=White
  Else Writeln('OPPOSITE:  Requested opposite for side=',side);
End;

Function Won(TestBoard:Ctype):char;
{Examines board TestBoard to see, given that WhosMove just moved, whether or
 not WhosMove just won.}

Var
  Whosmove:char;
  SoFar : char;
  I,J,K,L,BSum,WSum,DI: Integer;
  CheckedColor:char;
  AllBlocked:               boolean;
Begin
  With TestBoard Do
  Begin
    Whosmove := Whosemove;
    Allblocked:=true;
    If whosemove=black then  {black got us here, so check if white is now
                              blocked}
    begin
      for j:=1 to bd do
      if brd[icoord,j]<>taken then allblocked:=false;
    end else
    if whosemove=white then
    begin
      for i:=1 to bd do
      if brd[i,jcoord]<>taken then allblocked:=false;
    end else
    writeln('WON: side not black or white=',whosemove);

    if not allblocked then won:=neither else
    if bscore > wscore then won:=black else won:=white;
  end;
End; {Procedure}

Procedure Expand(N:integer;OriginalSide:char;var TreeFilled:boolean;
                 Nlevels:integer);

label panic;
{ This expands node N, producing all of its offspring nodes.  Any control
  strategies are implemented here.

  Output is entirely in the tree structure.

  When done, sets node N to "expanded."

  N, upon start of the procedure, is the previous (human) move.

  Generated offspring are set to "unexpanded" unless they are terminal nodes or
  at max depth, in which case they are set to "expanded".
}

Var
   Od,Nw:Ctype;  {parent and child states}
   brdnow,newbrd: bry;
   whonow,WhoWon:char;
   junk,inow,jnow,bnow,wnow,i0,j0,k,i,j,di,dj,NN:integer;
   WinFlag:boolean;

begin
  TreeFilled:=False;
  Characteristic(N,Od);
  With Od do
  begin  brdnow:=Od.Brd; whonow:=Opposite(Od.whosemove);
         inow:=Od.icoord; jnow:=Od.jcoord;bnow:=Od.Bscore;wnow:=Od.Wscore;
  end;
  {Preliminary setups for Nw, new state}
  {Remember that if we're about to move for black, Whosemove is white.}
  Nw:=Od;
  Nw.Whosemove:=whonow;
  if whonow=white then begin di:=0; dj:=1; i0:=inow; j0:=0; end;
  if whonow=black then begin di:=1; dj:=0; i0:=0; j0:=jnow; end;
  {scan the row/column}
  For k:=1 to bd do
  begin      {For each possible move on this level}
    i:=i0+k*di; j:= j0+k*dj;
    {check to see if it's available}
    if brdnow[i,j]<>taken then
    begin  {this block creates a new node}
      {first create the new space}
      Nw.Brd:=brdnow;
      if whonow=white then Nw.wscore:=Od.wscore+brdnow[i,j]
                      else Nw.bscore:=Od.bscore+brdnow[i,j];
      Nw.Brd[i,j]:=taken;Nw.icoord:=i;Nw.jcoord:=j;
      {now create the node}
      CreateNode(N,Nw,NN);
      If (NN=null) then
      begin
        if (debug[2] or debug[3])then
                 writeln('EXPAND: Tree space filled!');
        TreeFilled:=True;
        goto panic;
      {Is it a win?}
      end;
      WhoWon:=Won(Nw);
      WinFlag:=(WhoWon<>Neither);
      {If a win, it's expanded and evaluated}
      If WinFlag Then
      begin   {handle game over position}
        If WhoWon=OriginalSide Then
        SetGValue(NN,BigWin) Else SetGValue(NN,BigLoss);
        SetValue(NN,Expanded);
      end     {handle game over position}
      else
      begin   {this block handles terminal or normal node}
        {if terminal, expanded/unevaluated}
        if (Depth(NN)>=Nlevels) Then
        Begin
          SetGValue(NN,UnEvaluated); SetValue(NN,Expanded);
        end else
        Begin {this block handles normal nodes--unevaluated, unexpanded}
          SetGValue(NN,UnEvaluated);SetValue(NN,UnExpanded);
        End   {this block handles normal nodes}
      end     {this block handles terminal or normal node}
    end {this block creates a new node}
  end;
  {Now that we've generated all offspring, set parent to Expanded}
  panic:
  SetValue(N,Expanded);
End;

Procedure ShowBoard(Board:Ctype);
Var I,J:Integer;
{Prints out the selected board string}
Begin
  with board do
  begin
    for i:=1 to bd do
    begin
      for j:=1 to bd do
      if ((i=icoord) and (j=jcoord)) then write(outfile,'*':4)
      else if (brd[i,j]=taken) then write(outfile,'X':4)
      else write(outfile,brd[i,j]:4);
      writeln(outfile);
    end;
    Write('Player that lead to this move:',whosemove);
    Writeln(' White Score: ',wscore,' Black Score: ',bscore);
  end;
  writeln;
End;


Procedure ChooseColor;
Var Answer:char;
Begin
  Write('Would you like to go first? ');
  Readln(Answer);Answer:=UpCase(Answer);
  If Answer='Y' then Begin
                       Human:=White;
                       Computer:=Black;
                     End Else
                     Begin
                       Human:=Black;
                       Computer:=White;
                     End;
End;


Function Evaluate(Tester:ctype;OriginalSide:char):Integer;
{Returns the integer evaluation function value for a given board position
 and a given side.}
Var
  Enemy:                 char;
  Us,Them,I:               Integer;
  Board:bry;
Begin
  Board:=Tester.Brd;
  if OriginalSide=white then evaluate:=tester.wscore-tester.bscore
  else if OriginalSide=black then evaluate:=tester.bscore-tester.wscore
  else writeln('EVALUATE: Side not black or white found.  OriginalSide=',
                OriginalSide);
end;


Procedure FindFirst(Var N:integer);
Var
  M:         Integer;
  Alldone:   Boolean;
{ Locates first unexpanded node.  This version uses a depth-first search.}
Begin
  M:=Root;
  Alldone:=False;
  While not Alldone do
  Begin
    If M=Null then Alldone:=True else
    Begin
      If NodeValue(M) = Unexpanded then Alldone:=True else M:=NextNode(M);
    End;
  End;
  N:=M;
End;

Procedure Gentree(var Nlevels:Integer;var CurrentBoard:Ctype);
{Generates a game move tree Nlevels deep from state CurrentBoard}
{Is allowed to modify Nlevels and inform Minimax if necessary}
Var
  N:Integer;
  CompleteTree,AllDone,TreeFilled:Boolean;

Begin
  CompleteTree:=False;
  While Not CompleteTree do
  begin
    Inittree;
    SetCharacteristic(Root,CurrentBoard);
    SetValue(Root,Unexpanded);
    SetGValue(Root,Unevaluated);
    Alldone:=False;
    While not Alldone Do
    Begin
      {Find first unexpanded node.}
      FindFirst(N);
      IF N=Null then Alldone:=True Else
      Expand(N,Opposite(CurrentBoard.WhoseMove),TreeFilled,Nlevels);
      if TreeFilled Then
      begin
        Nlevels:=Nlevels-1;
        writeln('GENTREE:Tree was filled.  Only ',nlevels,
        ' plies will be examined.');
        CompleteTree:=False;
        Alldone:=true;
      end else CompleteTree:=true;
    end;
  End;
End;


Procedure GetInputMove(var Current:ctype);
{Gets latest move from human player.  Checks for validity of moves}
{ASSUMES that the current board is passed in, new board returned}
Var Valid:boolean;
    inval,Row1,Col1:Integer;
    EN:                       Integer;
Begin
  EN := 0; {No errors to start}
  Current.Whosemove:=Opposite(Current.Whosemove); {Next side moves now}
  Repeat
    Valid:=True;     {if white, we're moving horizontal}
    Write(current.whosemove,', which ');
    If Current.Whosemove=black then Write('row to take? ')
                               else Write('column to take? ');
    Readln(inval);
    if Current.Whosemove=black then
    begin
      Row1:=inval; Col1:=Current.Jcoord;
    end else
    begin
      Row1:=Current.Icoord; Col1:=inval;
    end;
    if Current.Brd[Row1,Col1]=Taken Then
    begin
      Writeln('That''s already taken.');
      Valid:=false;
    end;
  Until Valid;
  Writeln('Valid Move.');
  With Current Do
  begin
    icoord:=Row1;
    jcoord:=Col1;
    if whosemove=white then wscore:=wscore+brd[Row1,Col1] else
                            bscore:=bscore+brd[Row1,Col1];
    brd[Row1,Col1]:=Taken;
  End;
End; {Procedure}

Procedure Minimax(Var Board:ctype;OriginalSide:char;BottomLevel:Integer);
Const

  Maximum = 10;
  Minimum = 11;

Var
  N,Lev,F,NN:          Integer;
  Temp:                ctype;
  movesfound:          boolean;

  Procedure FindOptOffspr(Node:Integer;Var BestValue,BestNode:Integer;
                          Direction:Integer);
  {Searches all offspring of node Node to find optimal (minimum or maximum)
   G values.  Best G value and node where it was found are stored in BestValue
   and BestNode.  Direction indicates whether to find minimum or maximum.}
  Var
    N,X,BestSoFar,BestNodeSoFar,Factor:            Integer;
  Begin
    N:=FirstOffspring(Node);
    If Direction=Maximum Then BestSoFar :=-Maxint Else BestSoFar := Maxint;
    BestNodeSoFar := Null;
    While N<>Null Do    {Search all offspring}
    Begin
      X := GValue(N) ;
      If ((X > BestSoFar) and (Direction=Maximum)) Or ((X < BestSoFar) and
                                        (Direction=Minimum)) Then
      Begin
        BestSoFar := X;
        BestNodeSoFar := N;
      End;
      N:=RSibling(N);
    End; {Search all offspring}
    BestNode := BestNodeSoFar;
    BestValue := BestSoFar;
    If BestNode = Null then Writeln('FINDOPTOFFSPR: Warning: No moves found.');
  End; {Procedure}

Begin
  Board := emptyctype;
  movesfound:=false;
  {First, evaluate the bottom level}
  N := FirLevel(BottomLevel);
  If N=Null Then Writeln('MINIMAX:No bottom level (',bottomlevel,') found in ',
                          'Minimax.');
  While N<>Null Do
  Begin
    If GValue(N)=Unevaluated Then
    begin
      Characteristic(N,Temp);
      SetGValue(N,Evaluate(Temp,OriginalSide));
    end;
    N := NNTL(N);
  End;
  {Now do the folding/pruning process}
  Lev := Bottomlevel - 1;
  While Lev >= 0 Do
  Begin
    {For each node on this level that is not already evaluated (nonterminal
     nodes), fold the offspring values into the node.}
    N := FirLevel(Lev);
    While N<>Null Do
    Begin
      If Gvalue(N)=Unevaluated Then
      Begin
        {Alternate looking for maxima and minima}
        If Odd(Lev) Then FindOptOffspr(N,F,NN,Minimum)
                    Else FindOptOffspr(N,F,NN,Maximum);
        {In case this isn't clear, recall (for instance) that the root is
         at depth = 0.  Here, we examine the descendants of the root and
         look for the maximum.}
        SetGValue(N,F);
        {If level = 0, this is the final pass.  Save the result.}
        If Lev=0 Then begin Characteristic(NN,Board); movesfound:=true;end;
      End;
      N:=NNTL(N); {Get next node on this level}
    End;          {Until finished with this level}
    Lev := Lev - 1;
  End; {Get next level}
  If not movesfound then writeln('No move found in Minimax.');
End; {Procedure}


Procedure ComputeAMove(var Board:ctype;Nlevels:integer);
Begin
  T1 := Time;
  Gentree(Nlevels,CurrentBoard); {Generates move tree}
                                 {May modify Nlevels temporarily,
                                  but that will not affect the actual
                                  Nlevels}
  Minimax(Board,Opposite(CurrentBoard.WhoseMove),Nlevels);
  {Returns new board position, modifies CurrentBoard}
  T2 := Time;
  Writeln('Computed value of move: ',GValue(Root),'.  ',NNodes,
  ' examined.  Required ',(t2-t1):7:2,' seconds.');
End;

Procedure MoveSide(var CurrentBoard:Ctype;Nlevels:integer;var Winner:char);
Var
  NewBoard:                    ctype;
  Side:                        char;

Begin
  Side:=opposite(currentboard.whosemove);
  If Human=Side then
  Begin
    NewBoard:=CurrentBoard;
    GetInputMove(NewBoard);
    CurrentBoard := NewBoard;
  End
   Else
  Begin
    NewBoard:=CurrentBoard;
    ComputeAMove(NewBoard,Nlevels);
    CurrentBoard := NewBoard;
  End;
  Winner:= Won(CurrentBoard);
End;


Begin
  debug[1]:=false;debug[2]:=false;debug[3]:=false;
  Init(CurrentBoard);  {sets up CurrentBoard}
  Write('How many plies to examine? ');Readln(Nlevels);
  ChooseColor;  {Play white or black?}
  ShowBoard(CurrentBoard);
  Repeat
    MoveSide(CurrentBoard,Nlevels,Winner);  {Changes CurrentBoard}
    if CurrentBoard.Whosemove=Computer Then Writeln('>> Computer Move:');
    ShowBoard(CurrentBoard);
  Until Winner<>Neither;
  If Winner=Computer then Writeln('I have won.')
                 else Writeln('You have won.');
End.








her;
  If Winner=Computer th