rs965275@longs.LANCE.ColoState.EDU (Robert Simmons) (11/15/90)
Hello,
this is my first attempt at an AI program. I started this with only a
chapter of reading in an CS book that had some AI explanations in it.
Since this school has limited resources in ai stuff, I have posted this
with a request that those who read it will mail me coments on this, my first
attempt, program. If there are any pfessors out there reading this I would
like some coments on some good ai schools (anywhere in the world!!) and some
admission info. I have been programing since I was youns and am very
interested
in the schools that offer good ai programs. I would like to hear about these
professors' schools.
Sincerely
Robert E. Simmons jr.
P.S. Even coments such as "this is an excelent start are solicited". also
if anyone has modifications for the program, Please feel free to make them and
e-mail me the revised code!!
{
***************************************************************************
Program Puzzle Solver
***************************************************************************
}
{
***************************************************************************
Hueristic Problem Solving Demonstration
by Robert Simmons jr.
***************************************************************************
Problem Statement: This Program will implement a heristic
algorithm to solve a 10 x 10 tile puzzle.
The algorithm conststs of evaluating the
possible plays and choosing the best option.
Then the plays are added to the stack so the
puzzle can be backed up and routed on another
option af equal value.
The search tree for the implementation of this
problem without heuristics would be on the
average of 3^n nodes with n being the number
of moves required to solve the puzzle while
this heuristic method employs only one of the
search paths.
The search tree imagined for the prob without
heuristics might be represented as a triangle
as follows:
*
*****
*********
*************
*****************
*********************
**************************
******************************
when expanded out for the problem at hand the
triangle is bound to get big fast. This
program's heuristic cuts the triangle to the
following:
*
-****
---******
----*********
--------*********
---------------******
---------------------*****
----------------------------**
where - is a node not necessary to the solution.
One can rapidly see the advantage of fig2
over fig1.
***************************************************************************
Diagnostics: The program must be given valid input. Since it was not
designed with the general user in mind, it will not accept
bad data and will simply crash.
***************************************************************************
Variable Dictionary
-------------------
Main Program
==== =======
Variable Definition
-------- ----------
Datapoint Type Pointer for the move stack.
Stack Stack containing previous moves
and the flags for when the
options are equally good.
move Field in Stack containing the
previous moves.
flag Flag fo equal options.
next Link in list.
Mattype Puzzle config. matrix.
Top Pointer for the top of the stack.
Last Pointer to the next highest nod in
the stack.
Firstmove Id to not allow exclusion of
previous move.
Upmv Boolean for whether the move
should be executed.
Dwnmv Boolean for whether the move
should be executed.
Lftmv Boolean for whether the move
should be executed.
Rhtmv Boolean for whether the move
should be executed.
Upmove Boolen for whether the move
was excecuted.
Dwnmove Boolean for whether the move
was be executed.
Lftmove Boolean for whether the move
was be executed.
Negup Side, corner delimiter.
Negdown Side, corner delimiter.
Negleft Side, corner delimiter.
Negright Side, corner delimiter.
Setflag Flag for equal options.
Perifery Boolean, for sides.
Corner Boolean for corners.
Rhtmove Boolean for whether the move
was be executed.
Upval Entropy of Option matrix.
Dwnval Entropy of Option matrix.
Lftval Entropy of Option matrix.
Rhtval Entropy of Option matrix.
Prmove Inverse of previous move
excecuted.
Curstate Cuurent array Entropy.
Cblx X cord. for the blank.
Count Generic counter.
Count2 Generic Counter #2.
Cbly Y cord. for the blank.
Curpuzzle Current puzzle format.
Uppuzzle Option puzzle format.
Dwnpuzzle Option puzzle format.
Lftpuzzle Option puzzle format.
Rhtpuzzle Option puzzle format.
***************************************************************************
}
program puzsolve (input,output);
type Datapoint = ^Stack; { type declaration Block }
Stack = record
move : integer;
flag : boolean;
next : Datapoint;
end; { Record Definition }
Mattype = array [1..10,1..10] of integer;
var Top,
Last : Datapoint;
Firstmove,
Upmv,
Dwnmv,
Lftmv,
Rhtmv,
Upmove,
Dwnmove,
Lftmove,
Negup,
Negdown,
Negleft,
Negright,
Setflag,
Perifery,
Corner,
Rhtmove : boolean;
Upval,
Dwnval,
Lftval,
Rhtval,
Prmove,
Curstate,
Cblx,
Count,
Count2,
Cbly : integer;
Curpuzzle,
Uppuzzle,
Dwnpuzzle,
Lftpuzzle,
Rhtpuzzle : Mattype;
{
*************************************************************************
Function to Evaluate the Entropy of an Input Matrix
*************************************************************************
}
function enval ( Current : Mattype): integer;
var Ycor,
Xcor,
Xloc,
Yloc,
Hold,
Homeloc : integer;
{
**********************************************************************
Function to Calculate the Absolute Value of a Number
**********************************************************************
}
function absolute (Argument : integer):integer;
begin { Function }
if Argument < 0
then
absolute := 0 - Argument
else
absolute := Argument;
end; { Function }
{
**********************************************************************
Resume enval
**********************************************************************
}
{
This function calculates the entropy of an input matrix by incrementing
the entropy value for how far each tile is out of position.
}
begin
Hold := 0;
for Ycor := 1 to 10 do
begin
for Xcor := 1 to 10 do
begin { For }
Homeloc := Current[Ycor,Xcor];
Xloc := Homeloc mod 10;
if Xloc = 0
then
Xloc := 10;
Yloc := Homeloc div 10 + 1;
if Yloc = 0
then
Yloc := 1;
if ((Homeloc mod 10) = 0)
then
Yloc := Yloc - 1;
if Homeloc = 0
then
begin
Xloc := Xcor;
Yloc := Ycor;
end;
Hold := Hold + (absolute((Xcor-Xloc)) + absolute(Ycor - Yloc));
end; { For }
end; { For }
enval := Hold;
end; { Procedure }
{
************************************************************************
Procedure To Move the Tile
************************************************************************
}
procedure tilemove (var Tempmat : Mattype; Xblank, Yblank, Comand : integer);
begin
case Comand of
1 : begin {move tile under the blank up}
Tempmat[Yblank,Xblank] := Tempmat[(Yblank + 1),Xblank];
Tempmat[(Yblank + 1),Xblank] := 0;
Yblank := Yblank + 1;
end;
2 : begin {move tile over the blank down}
Tempmat[Yblank,Xblank] := Tempmat[(Yblank - 1),Xblank];
Tempmat[(Yblank - 1),Xblank] := 0;
Yblank := Yblank - 1;
end;
3 : begin {move tile to the left of the blank right}
Tempmat[Yblank,Xblank] := Tempmat[Yblank,(Xblank - 1)];
Tempmat[Yblank,(Xblank - 1)] := 0;
Xblank := Xblank - 1;
end;
4 : begin {move tile to the right of the blank left}
Tempmat[Yblank,Xblank] := Tempmat[Yblank,(Xblank + 1)];
Tempmat[Yblank,(Xblank + 1)] := 0;
Xblank := Xblank + 1;
end
end; { Case }
end; { Procedure }
{
*************************************************************************
Procedure to Backup Matrix to Last Flag
*************************************************************************
}
procedure backtrack (var Newpuzzle:Mattype; Pop : Datapoint;
Xcord, Ycord : integer);
var Previous : Datapoint;
Prmove : integer;
begin
if (not (Pop^.flag))
then
begin
Prmove := Pop^.move;
tilemove(Newpuzzle,Xcord,Ycord,Prmove);
Previous := Pop^.next;
Pop := Previous;
backtrack(Newpuzzle, Pop, Xcord, Ycord);
end
else {execute 1 more time to get position before the flag}
begin
Prmove := Pop^.move;
tilemove(Newpuzzle,Xcord,Ycord,Prmove);
Previous := Pop^.next;
Pop := Previous;
end;
end;
{
************************************************************************
Procedure to Determine X and Y Coordinates of the Blank
************************************************************************
}
procedure determine (var Xloc, Yloc : integer; Newarray : Mattype);
begin
Xloc := 1;
Yloc := 1;
while (Newarray[Yloc,Xloc] <> 0) do
begin
Xloc := Xloc + 1;
if (Xloc > 10)
then
begin
Xloc := 1;
Yloc := Yloc +1;
end;
end; {while}
end; {procedure}
{
*************************************************************************
Read in The Puzzle Configuration
*************************************************************************
}
procedure matread (var Current : Mattype; Xcor, Ycor : integer);
begin
read (Current[Ycor,Xcor]);
Xcor := Xcor + 1;
if (Xcor > 10)
then
begin
Ycor := Ycor + 1;
Xcor := 1;
readln;
end; { Then }
if (Ycor <= 10)
then
matread (Current, Xcor, Ycor);
end;
{
**********************************************************************
Begin Main Loop
**********************************************************************
}
begin { Program }
new (Top);
Top^.next := nil;
Top^.move := 0;
Top^.flag := true;
new (Top);
Top^.next := Last;
Firstmove := true;
Prmove := 0;
matread (Curpuzzle,1,1);
Curstate := enval(Curpuzzle);
determine (Cblx,Cbly,Curpuzzle);
while (Curstate <> 0) do
begin
Uppuzzle := Curpuzzle;
Dwnpuzzle := Curpuzzle;
Lftpuzzle := Curpuzzle;
Rhtpuzzle := Curpuzzle;
if ((Cblx = 1) or (Cblx = 10) or (Cbly = 1) or (Cbly = 10))
then
begin
Perifery := true;
if ((Cblx = 1) or (Cblx = 10) and (Cbly = 1) or (Cbly = 10))
then
Corner := true
else
Corner := false;
end
else
begin
Perifery := false;
Corner := false;
end;
Upmv := false;
Dwnmv := false;
Lftmv := false;
Rhtmv := false;
Negup := false;
Negdown := false;
Negleft := false;
Negright := false;
if (Perifery = true)
then
begin
if (Cblx = 1)
then
begin
Negleft := true;
if Corner = true
then
if Cbly = 10
then
Negup := true
else
if Cbly = 1
then
Negdown := true;
end;
end;
if (Perifery = true)
then
begin
if (Cblx = 10)
then
begin
Negright := true;
if Corner = true
then
if Cbly = 10
then
Negup := true
else
if Cbly = 1
then
Negdown := true;
end;
end;
if (Perifery = true)
then
begin
if (Cbly = 1)
then
begin
Negdown := true;
if Corner = true
then
if Cblx = 1
then
Negleft := true
else
if Cblx = 10
then
Negright := true;
end;
end;
if (Perifery = true)
then
begin
if (Cbly = 10)
then
begin
Negup := true;
if Corner = true
then
if Cblx = 1
then
Negleft := true
else
if Cblx = 10
then
Negright := true;
end;
end;
if (Prmove <> 1)
then
begin
if Negup <> true
then
begin
Upmv := true;
tilemove(Uppuzzle,Cblx,Cbly,1);
Upval := enval(Uppuzzle);
end;
end;
if (Prmove <> 2)
then
begin
if Negdown <> true
then
begin
Dwnmv := true;
tilemove(Dwnpuzzle,Cblx,Cbly,2);
Dwnval := enval(Dwnpuzzle);
end;
end;
if (Prmove <> 3)
then
begin
if Negleft <> true
then
begin
Lftmv := true;
tilemove(Lftpuzzle,Cblx,Cbly,3);
Lftval := enval(Lftpuzzle);
end;
end;
if (Prmove <> 4)
then
begin
if Negright <> true
then
begin
Rhtmv := true;
tilemove(Rhtpuzzle,Cblx,Cbly,4);
Rhtval := enval(Rhtpuzzle);
end;
end;
Upmove := false;
Dwnmove := false;
Lftmove := false;
Rhtmove := false;
if (Firstmove = true)
then
Firstmove := false;
if Upmv = true
then
if Upval < Curstate
then
Upmove := true
else
Upmove := false;
if Dwnmv = true
then
if Dwnval < Curstate
then
Dwnmove := true
else
Dwnmove := false;
if Lftmv = true
then
if Lftval < Curstate
then
Lftmove := true
else
Lftmove := false;
if Rhtmv = true
then
if Rhtval < Curstate
then
Rhtmove := true
else
Rhtmove := false;;
if (((Upmove = true) or (Dwnmove = true) or
(Lftmove = true) or (Rhtmove = true)) and
((Upmove = true) or (Dwnmove = true) or
(Lftmove = true) or (Rhtmove = true)))
then
Setflag := true;
if Upmove = true
then
begin
{ Add to stack }
Top^.move := 2;
if Setflag = true
then
Top^.flag := true
else
Top^.flag := false;
Curpuzzle := Uppuzzle;
Last := Top;
new (Top);
Prmove := 2;
new (Top);
Top^.next := Last;
end
else
if Dwnmove = true
then
begin
{ Add to stack }
Top^.move := 1;
if Setflag = true
then
Top^.flag := true
else
Top^.flag := false;
Curpuzzle := Dwnpuzzle;
Last := Top;
Prmove := 1;
new (Top);
Top^.next := Last;
end
else
if Lftmove = true
then
begin
{ Add to stack }
Top^.move := 4;
if Setflag = true
then
Top^.flag := true
else
Top^.flag := false;
Curpuzzle := Lftpuzzle;
Last := Top;
Prmove := 4;
new (Top);
Top^.next := Last;
end
else
if Rhtmove = true
then
begin
{ Add to stack }
Top^.move := 3;
if Setflag = true
then
Top^.flag := true
else
Top^.flag := false;
Curpuzzle := Rhtpuzzle;
Last := Top;
Prmove := 3;
new (Top);
Top^.next := Last;
end
else
{ if all options fail then
backtrack to the Last flag }
backtrack(Curpuzzle,Top,Cblx,Cbly);
determine (Cblx,Cbly,Curpuzzle);
Curstate := enval(Curpuzzle);
end; { while loop }
{ Print Out the Final Matrix }
for Count := 1 to 10 do
begin
for Count2 := 1 to 10 do
write (Curpuzzle[Count,Count2]:3);
writeln
end;
end. { Program }