371 lines
6.9 KiB
Plaintext
371 lines
6.9 KiB
Plaintext
! Backtracking Algorithm for solving a Solitaire game
|
|
! Author Joachim Fritschi
|
|
|
|
let
|
|
!game table constants
|
|
const INVALID ~ 2;
|
|
const OCCUPIED ~ 1;
|
|
const FREE ~ 0;
|
|
const free ~ ' ';
|
|
const occupied ~ 'O';
|
|
const invalid ~ 'X';
|
|
!solution constants
|
|
const NORTH ~ 0;
|
|
const EAST ~ 1;
|
|
const SOUTH ~ 2;
|
|
const WEST ~ 3;
|
|
!Array representation of the game table
|
|
type row ~ record
|
|
column: array 11 of Integer,
|
|
length: Integer
|
|
end;
|
|
var table: array 11 of row;
|
|
var foundSolution: Boolean;
|
|
|
|
!Array representation of the game solution
|
|
!The Records a steps containing the position x,y of the stone to move and the direction
|
|
type step ~ record
|
|
column: array 3 of Integer,
|
|
length: Integer
|
|
end;
|
|
var solution: array 32 of row;
|
|
|
|
|
|
proc initTable() ~
|
|
let
|
|
var x: Integer;
|
|
var y: Integer
|
|
in begin
|
|
x := 0;
|
|
while( x < 11) do
|
|
begin
|
|
! putint(x);
|
|
y := 0;
|
|
while( y < 11) do
|
|
begin
|
|
! putint(y);
|
|
table[y].column[x] := INVALID;
|
|
y := y + 1
|
|
end;
|
|
x := x + 1;
|
|
end;
|
|
|
|
x := 2;
|
|
while(x < 9) do
|
|
begin
|
|
table[4].column[x] := OCCUPIED;
|
|
table[5].column[x] := OCCUPIED;
|
|
table[6].column[x] := OCCUPIED;
|
|
table[x].column[4] := OCCUPIED;
|
|
table[x].column[5] := OCCUPIED;
|
|
table[x].column[6] := OCCUPIED;
|
|
x := x + 1;
|
|
end;
|
|
table[5].column[5] := FREE;
|
|
end;
|
|
|
|
! Intitalize the solution Array
|
|
proc initSolution() ~
|
|
let
|
|
var x: Integer;
|
|
var y: Integer
|
|
in begin
|
|
x := 0;
|
|
y := 0;
|
|
while( x < 32) do
|
|
begin
|
|
y := 0;
|
|
while( y < 3) do
|
|
begin
|
|
solution[x].column[y] := 0;
|
|
y := y + 1
|
|
end;
|
|
x := x + 1;
|
|
end;
|
|
end;
|
|
|
|
! Print the game table
|
|
proc printTable() ~
|
|
let
|
|
var x: Integer;
|
|
var y: Integer
|
|
in begin
|
|
y := 10;
|
|
while( y >= 0) do
|
|
begin
|
|
x := 0;
|
|
while( x < 11) do
|
|
begin
|
|
if table[y].column[x] = INVALID then
|
|
put(invalid)
|
|
else
|
|
if table[y].column[x] = FREE then
|
|
put(free)
|
|
else
|
|
put(occupied);
|
|
|
|
x := x + 1;
|
|
end;
|
|
puteol();
|
|
y := y - 1;
|
|
end;
|
|
puteol();
|
|
|
|
end;
|
|
|
|
! execute a Move on the game table
|
|
proc makeMove(x: Integer,y : Integer,dir : Integer) ~
|
|
begin
|
|
if dir = NORTH then
|
|
begin
|
|
table[y].column[x] := FREE;
|
|
table[y + 1].column[x] := FREE;
|
|
table[y + 2].column[x] := OCCUPIED;
|
|
end
|
|
else
|
|
begin
|
|
if dir = EAST then
|
|
begin
|
|
table[y].column[x] := FREE;
|
|
table[y].column[x+1] := FREE;
|
|
table[y].column[x+2] := OCCUPIED;
|
|
end
|
|
else
|
|
begin
|
|
if dir = SOUTH then
|
|
begin
|
|
table[y].column[x] := FREE;
|
|
table[y - 1].column[x] := FREE;
|
|
table[y - 2].column[x] := OCCUPIED;
|
|
end
|
|
else
|
|
begin
|
|
if dir = WEST then
|
|
begin
|
|
table[y].column[x] := FREE;
|
|
table[y].column[x-1] := FREE;
|
|
table[y].column[x-2] := OCCUPIED;
|
|
end
|
|
else
|
|
begin
|
|
end
|
|
end
|
|
end
|
|
end;
|
|
end;
|
|
|
|
! undo a move on the game table
|
|
proc undoMove(x: Integer,y : Integer,dir : Integer) ~
|
|
begin
|
|
if dir = NORTH then
|
|
begin
|
|
table[y].column[x] := OCCUPIED;
|
|
table[y + 1].column[x] := OCCUPIED;
|
|
table[y + 2].column[x] := FREE;
|
|
end
|
|
else
|
|
begin
|
|
if dir = EAST then
|
|
begin
|
|
table[y].column[x] := OCCUPIED;
|
|
table[y].column[x+1] := OCCUPIED;
|
|
table[y].column[x+2] := FREE;
|
|
end
|
|
else
|
|
begin
|
|
if dir = SOUTH then
|
|
begin
|
|
table[y].column[x] := OCCUPIED;
|
|
table[y - 1].column[x] := OCCUPIED;
|
|
table[y - 2].column[x] := FREE;
|
|
end
|
|
else
|
|
begin
|
|
if dir = WEST then
|
|
begin
|
|
table[y].column[x] := OCCUPIED;
|
|
table[y].column[x-1] := OCCUPIED;
|
|
table[y].column[x-2] := FREE;
|
|
end
|
|
else
|
|
begin
|
|
end
|
|
end
|
|
end
|
|
end
|
|
end;
|
|
|
|
!save a move in the solution array
|
|
proc saveSolution(stepNr: Integer,x : Integer,y : Integer, dir : Integer) ~
|
|
begin
|
|
solution[stepNr].column[0] := x;
|
|
solution[stepNr].column[1] := y;
|
|
solution[stepNr].column[2] := dir;
|
|
end;
|
|
|
|
!rekursive solution of the game with a backtracking algorithm
|
|
proc calcSolution(stepNr: Integer,var status: Boolean)~
|
|
begin
|
|
if (stepNr = 31) /\ (table[5].column[5] = OCCUPIED) then
|
|
status := true
|
|
else
|
|
let
|
|
var x: Integer;
|
|
var y: Integer
|
|
in begin
|
|
x := 2;
|
|
while ( x < 9) do
|
|
begin
|
|
y := 2;
|
|
while ( y < 9) do
|
|
begin
|
|
if(table[y].column[x] = OCCUPIED) /\ (table[y+1].column[x] = OCCUPIED ) /\ (table[y + 2].column[x] = FREE ) /\ \status then
|
|
begin
|
|
makeMove(x,y,NORTH);
|
|
calcSolution(stepNr + 1, var status);
|
|
if status = true then
|
|
begin
|
|
saveSolution(stepNr,x,y,NORTH);
|
|
end
|
|
else
|
|
begin
|
|
undoMove(x,y,NORTH);
|
|
end
|
|
end
|
|
else
|
|
begin
|
|
end;
|
|
|
|
|
|
if(table[y].column[x] = OCCUPIED) /\ (table[y-1].column[x] = OCCUPIED ) /\ (table[y - 2].column[x] = FREE ) /\ \status then
|
|
begin
|
|
makeMove(x,y,SOUTH);
|
|
calcSolution(stepNr + 1, var status);
|
|
if status = true then
|
|
begin
|
|
saveSolution(stepNr,x,y,SOUTH);
|
|
end
|
|
else
|
|
begin
|
|
undoMove(x,y,SOUTH);
|
|
end
|
|
end
|
|
else
|
|
begin
|
|
end;
|
|
|
|
if(table[y].column[x] = OCCUPIED) /\ (table[y].column[x+1] = OCCUPIED ) /\ (table[y].column[x + 2] = FREE ) /\ \status then
|
|
begin
|
|
makeMove(x,y,EAST);
|
|
calcSolution(stepNr + 1, var status);
|
|
if status = true then
|
|
begin
|
|
saveSolution(stepNr,x,y,EAST);
|
|
end
|
|
else
|
|
begin
|
|
undoMove(x,y,EAST);
|
|
end
|
|
end
|
|
else
|
|
begin
|
|
end;
|
|
|
|
if(table[y].column[x] = OCCUPIED) /\ (table[y].column[x-1] = OCCUPIED ) /\ (table[y].column[x - 2] = FREE ) /\ \status then
|
|
begin
|
|
makeMove(x,y,WEST);
|
|
calcSolution(stepNr + 1, var status);
|
|
if status = true then
|
|
begin
|
|
saveSolution(stepNr,x,y,WEST);
|
|
end
|
|
else
|
|
begin
|
|
undoMove(x,y,WEST);
|
|
end
|
|
end
|
|
else
|
|
begin
|
|
end;
|
|
y := y + 1
|
|
end;
|
|
x := x + 1
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
!little helper funktion to write the directions human readable
|
|
proc writeDirection(dir: Integer) ~
|
|
begin
|
|
if dir = NORTH then
|
|
begin
|
|
put('N');
|
|
put('O');
|
|
put('R');
|
|
put('T');
|
|
put('H');
|
|
end
|
|
else
|
|
if dir = EAST then
|
|
begin
|
|
put('E');
|
|
put('A');
|
|
put('S');
|
|
put('T');
|
|
end
|
|
else
|
|
if dir = SOUTH then
|
|
begin
|
|
put('S');
|
|
put('O');
|
|
put('U');
|
|
put('T');
|
|
put('H');
|
|
end
|
|
else
|
|
if dir = WEST then
|
|
begin
|
|
put('W');
|
|
put('E');
|
|
put('S');
|
|
put('T');
|
|
end
|
|
else
|
|
end;
|
|
|
|
!print the solution on the stout
|
|
proc printSolution() ~
|
|
let
|
|
var count: Integer
|
|
in begin
|
|
initTable();
|
|
puteol();
|
|
printTable();
|
|
count := 0;
|
|
while count < 31 do
|
|
begin
|
|
putint(count + 1);
|
|
put(' ');
|
|
put('[');
|
|
putint(solution[count].column[0]);
|
|
put(',');
|
|
putint(solution[count].column[1]);
|
|
put(']');
|
|
put(' ');
|
|
writeDirection(solution[count].column[2]);
|
|
puteol();
|
|
makeMove(solution[count].column[0],solution[count].column[1],solution[count].column[2]);
|
|
printTable();
|
|
count := count + 1
|
|
end
|
|
end
|
|
|
|
|
|
in begin
|
|
foundSolution := false;
|
|
initTable();
|
|
initSolution();
|
|
calcSolution(0,var foundSolution);
|
|
printSolution();
|
|
|
|
end |