<![CDATA[size : 6940
uploaded_on : Sat Jun 20 00:00:00 1998
modified_on : Wed Dec 8 14:03:35 1999
title : AI: find a way
org_filename : ai_way.pas
author : Wonderboy
authoremail : Page_Wonderboy@hotmail.com
description : A basic form of AI
keywords :
tested : Borland Pascal 7.0
submitted_by : The CKB Crew
submitted_by_email : ckb@netalive.org
uploaded_by : nobody
modified_by : nobody
owner : nobody
lang : pas
file-type : text/plain
category : pascal-alg-maths
__END_OF_HEADER__
{$A+,B-,D-,E-,F-,G+,I+,L-,N+,O-,P-,Q-,R-,S+,T-,V+,X+,Y-}
{This programs shows you how the computer can find the shortest way from one point to
another.
Explantion: create a matrix and choose a starting point:
|--|--|--|
| S| | |
|--|--|--|
| | | |
|--|--|--|
| | | F|
|--|--|--|
Fill every free coordinate with the value -1 and every unpassable coordinate
with the value -2. Give the finish a value 0. The value 0 means:
the distance from that coordinate to the finish is 0.
|--|--|--|
| S|-1|-1|
|--|--|--|
|-1|-2|-1|
|--|--|--|
|-2|-1| 0|
|--|--|--|
Now start from the Finish coordinates and fill in the distances from each coordinate
to the finish:
|--|--|--| |--|--|--| |--|--|--| |--|--|--|
| S|-1|-1| | S|-1| 2| | S| 3| 2| | 4| 3| 2|
|--|--|--| |--|--|--| |--|--|--| |--|--|--|
|-1|-2| 1| -> |-1|-2| 1| -> |-1|-2| 1| -> |-1|-2| 1|
|--|--|--| |--|--|--| |--|--|--| |--|--|--|
|-2| 1| 0| |-2| 1| 0| |-2| 1| 0| |-2| 1| 0|
|--|--|--| |--|--|--| |--|--|--| |--|--|--|
The start coordinate has a value 4, which means the shortest way the the finish
is 4. You can now trace the shortest way from start to finish:
|--|--|--|
| X| X| X|
|--|--|--|
|-1|-2| X|
|--|--|--|
|-2| 1| X|
|--|--|--|
The following example program only looks left, up, right and down for the
shortest way form start to finish}
Program AI_Find_A_Way;
Uses Graph, Crt, Dos;
Const MatrixMinX = 1; {Do not change}
MatrixMinY = 1; {Do not change}
MatrixMaxX = 128; {Matrix size}
MatrixMaxY = 128; {Matrix size}
MaxWay = 500; {Maximum length of the way to find}
Type PointType = Record {Record to store coordinates}
x,y:Byte;
End;
ToDoType = Record
T: Array[1..1000] Of PointType; {1000 is just a value, which should be enough}
End;
Var Graphix :Integer;
PlayField :Array[1..MatrixMaxX] Of Array[1..MatrixMaxY] Of Integer;
ToDoNow, ToDoNextTurn :^ToDoType; {The coordinates to check}
NumberToDoNow,
NumberToDoNextTurn :Integer; {Number of coordinates to check}
tx,ty :Integer;
Start,Finish :PointType;
CurValue :Integer; {The value or distance to fill the next coordinates with}
Procedure CreateMatrix;
Begin
Start.x:=1; {Start coordinate}
Start.y:=1; {Start coordinate}
Finish.x:=MatrixMaxX; {Finish coordinate}
Finish.y:=MatrixMaxY; {Finish coordinate}
Randomize;
For tx:=1 To MatrixMaxX Do {Value -2 is an unpassable coordinate, -1 is an empty coordinate}
For ty:=1 To MatrixMaxY Do
Case Random(8) Of
0: Begin PlayField[tx,ty]:=-2; PutPixel(tx, ty, Red); End;
Else PlayField[tx,ty]:=-1
End;
PlayField[Start.x,Start.y]:=-1; {Ensure the Start coordinates have value -1}
PlayField[Finish.x,Finish.y]:=0; {The distance from the finish coordinates
to the finish is 0}
End;
Procedure FindWay(n:Integer);
Var FoundMyWay:Boolean;
Procedure Check(cx,cy,cn:Integer);
Procedure FillUnder(fx,fy,fn:Integer);
Begin
PlayField[fx,fy]:=fn; {Give a coordinate a distance to to finish}
Inc(NumberToDoNextTurn, 1); {Check in the next Check 1 Coordinate more}
ToDoNextTurn^.T[NumberToDoNextTurn].x:=fx; {Store the coordinate for a next check}
ToDoNextTurn^.T[NumberToDoNextTurn].y:=fy; {Store the coordinate for a next check}
End; {EndFillUnder}
Begin
If (cx > 1) And (PlayField[cx-1,cy]=-1) Then FillUnder(cx-1,cy,cn); {Check left}
If (cy > 1) And (PlayField[cx,cy-1]=-1) Then FillUnder(cx,cy-1,cn); {Check up}
If (cx < MatrixMaxX) And (PlayField[cx+1,cy]=-1) Then FillUnder(cx+1,cy,cn); {Check right}
If (cy < MatrixMaxY) And (PlayField[cx,cy+1]=-1) Then FillUnder(cx,cy+1,cn); {Check down}
End; {End Check}
Begin
FoundMyWay:=False;
NumberToDoNow:=NumberToDoNextTurn;
NumberToDoNextTurn:=0;
Move(ToDoNextTurn^, ToDoNow^, SizeOf(ToDoType)); {Finished checking all the coordinates this
turn. Move all the coordinates to check next
turn to the pointer to check now.
To speed up the process a lot,
use a faster move procedure!}
For tx:=1 To NumberToDoNow Do
Check(ToDoNow^.T[tx].x,ToDoNow^.T[tx].y,n+1);
If n > MaxWay Then Begin Write(#7); Halt; End; {Can't get there in #MaxWay moves!}
If PlayField[Start.x,Start.y]<>-1 Then FoundMyWay:=True; {If the record Start contains
a value other than -1, than
the value it contains is the
shortest way to the finish}
If FoundMyWay=False Then FindWay(n+1);
End; {End FindWay}
Procedure DisplayWay(VanX, VanY, NaarX, NaarY: Integer);
Begin
If Not ((VanX=NaarX) And (VanY=NaarY)) Then
Begin
NumberToDoNextTurn:=1;
ToDoNextTurn^.T[NumberToDoNextTurn].x:=Finish.x;
ToDoNextTurn^.T[NumberToDoNextTurn].y:=Finish.y;
FindWay(0); {Start filling the field with the distances
for the shortests way to to the finish}
CurValue:=PlayField[Start.x,Start.y];
tx:=Start.x;
ty:=Start.y;
Repeat {Check left, up, right and down for the shortest distance to the finish and move to
that position until you have reached the finish}
If (tx > 1) And (PlayField[tx-1,ty]=CurWaarde-1) And (PlayField[tx-1,ty]>-1) Then
Begin tx:=tx-1; PutPixel(tx, ty, Yellow); Dec(CurWaarde) End
Else If (ty > 1) And (PlayField[tx,ty-1]=CurWaarde-1) And (PlayField[tx,ty-1]>-1) Then
Begin ty:=ty-1; PutPixel(tx, ty, Yellow); Dec(CurWaarde) End
Else If (tx < MatrixMaxX) And (PlayField[tx+1,ty]=CurWaarde-1) And (PlayField[tx+1,ty]>-1) Then
Begin tx:=tx+1; PutPixel(tx, ty, Yellow); Dec(CurWaarde) End
Else If (ty < MatrixMaxY) And (PlayField[tx,ty+1]=CurWaarde-1) And (PlayField[tx,ty+1]>-1) Then
Begin ty:=ty+1; PutPixel(tx, ty, Yellow); Dec(CurWaarde) End;
Until (tx=Finish.x) And (ty=Finish.y); {Reached the Finish!}
End;
End; {End
]]>