347 lines
12 KiB
Plaintext
347 lines
12 KiB
Plaintext
program maze;
|
|
|
|
const small_maze =
|
|
'25' + #10 +
|
|
'13' + #10 +
|
|
'0000000000000000000000000'+ #10 +
|
|
'0301111101111110001000110'+ #10 +
|
|
'0101010101000011111110100'+ #10 +
|
|
'0111110101011010100010100'+ #10 +
|
|
'0100011101010010111011111'+ #10 +
|
|
'0101010001011010000010001'+ #10 +
|
|
'0111011101001110110010101'+ #10 +
|
|
'0010110101011000101110101'+ #10 +
|
|
'0111100101010010101001101'+ #10 +
|
|
'0100101111011111111001001'+ #10 +
|
|
'0111101001000000011111001'+ #10 +
|
|
'0010011111111111100000004'+ #10 +
|
|
'0000000000000000000000000'+ #10 ;
|
|
|
|
const medium_maze ='61' + #10 +
|
|
'61' + #10 +
|
|
'0000000000000000000000000000000000000000000000000000000000000' + #10 +
|
|
'0111111111111100111111111111111111111111111111111111111110000' + #10 +
|
|
'0101000000000000100000000001000000000000000000000000000010000' + #10 +
|
|
'0101000000000000100100000001000111110000000000000000000010000' + #10 +
|
|
'0101000111111111100100000001000100000011111111111111110010000' + #10 +
|
|
'0101011101000100000111110001000100000010000000000000010010000' + #10 +
|
|
'0101010001000100000000010001000100000010000000000000010010000' + #10 +
|
|
'0101010001000100111111110001111111111110011100000000010010000' + #10 +
|
|
'0101011101011100000000010000000000000000000100000000010010000' + #10 +
|
|
'0101000001000000000000010011111111111111100111111100010010000' + #10 +
|
|
'0101111111111111111100010010000000000000000100000100010010000' + #10 +
|
|
'0100010000000000000100010011111111111111111100000100010011110' + #10 +
|
|
'0100011110000001000101110010000000000000000000000100010000010' + #10 +
|
|
'0100010010100001000101010010000000000000000000000100010000010' + #10 +
|
|
'0100010010111111111101010010011111111111111111111100010100010' + #10 +
|
|
'0111010000000001000101010010010000000001000010000111110100010' + #10 +
|
|
'0000011111100001000101011110010010000001000010000000000100010' + #10 +
|
|
'0000010000001111000101010000010010000001001010111111111100010' + #10 +
|
|
'3111111110100000000101010100010010000001001010100000000000010' + #10 +
|
|
'0000000010101111111101010100011111100001111010100000111110010' + #10 +
|
|
'0111111010101000001001010100010000100100000010100000100011110' + #10 +
|
|
'0100001010101000001001010100010000100100000010100000100000000' + #10 +
|
|
'0101101010101001001111010100010011100111110010100111100000000' + #10 +
|
|
'0100101010101001001000010111110000000100000010100000100000100' + #10 +
|
|
'0100101010101001001000010000100000000100000010100000100000100' + #10 +
|
|
'0100101010101001111001110000100011111100111110100000111111100' + #10 +
|
|
'0100111010101000001001000000100010000100100010100000100000000' + #10 +
|
|
'0100000010101111101001000000100010000100100010111111100000000' + #10 +
|
|
'0100000010100000101001001111100010000100100010000000100000000' + #10 +
|
|
'0111111111100000101001001000100000000100000010000000100000000' + #10 +
|
|
'0010100001000000101001001000111111111111111111111111111111114' + #10 +
|
|
'0010100001000100101001001000100000000000001001010010000000000' + #10 +
|
|
'0010111101010100101000001000100000000000001001010010000000000' + #10 +
|
|
'0010000101010100101111101000100011111111101001010011111110000' + #10 +
|
|
'0010000101010111101000101000100010000000001001010000000010000' + #10 +
|
|
'0111110101010000001000101000100010011111001001011111110010000' + #10 +
|
|
'0100000101011111111000100000100010010000001001000000010011110' + #10 +
|
|
'0100111101000000001000000000100010111111111001000000010000010' + #10 +
|
|
'0100000001111111111111111111111110100000000001110000010000010' + #10 +
|
|
'0100000000000000000000000000000000100011110100011110010000010' + #10 +
|
|
'0101111111111111111111111101111111100010000100010010010000010' + #10 +
|
|
'0101000000000000000000000101000000100010010100010010010000010' + #10 +
|
|
'0101000000111111111111100101100000100010010100010010010111110' + #10 +
|
|
'0101000000100000000000100100111110111110010100010010010100000' + #10 +
|
|
'0101000000100000000000100100000010101000010111110010010100000' + #10 +
|
|
'0101011111111111111100100101111110101000010000000010010101110' + #10 +
|
|
'0101010000000010000100100100000000101000010000000000010101010' + #10 +
|
|
'0101010111111010000110100111111111101011111111111111110101010' + #10 +
|
|
'0101010100001010000010100000000000001000100000000000000101010' + #10 +
|
|
'0101010111101010000010100000000000001000100000000000000101010' + #10 +
|
|
'0101010000101010000010100000111100001010111111111111111101010' + #10 +
|
|
'0101011111101011111010100000100100101110100000000000000101010' + #10 +
|
|
'0101000000001010001010111111100100100000100011111111100101010' + #10 +
|
|
'0101111111111010101010100000000100100000100010000000000101010' + #10 +
|
|
'0100000000000010101010100000000100100000100010000000000101010' + #10 +
|
|
'0111111111111110101010100000000000101111100010000000000101010' + #10 +
|
|
'0100000000000000101010100001111111100000100010111111111101010' + #10 +
|
|
'0100111111111111101010100001000000000000100011100000100000010' + #10 +
|
|
'0100100000000000001010111111111000000000100000000000100000010' + #10 +
|
|
'0110111111111111111010000000001111111111101111111111111111110' + #10 +
|
|
'0000000000000000000000000000000000000000000000000000000000000' + #10 ;
|
|
|
|
type TboolGrid = array of array of boolean;
|
|
|
|
function readLine(raw: string; var off: integer): string;
|
|
begin
|
|
result:= '';
|
|
while raw[off] <> #10 do
|
|
begin
|
|
result:= result + raw[off];
|
|
off:= off + 1;
|
|
end;
|
|
off:= off + 1;
|
|
end;
|
|
|
|
|
|
function ParseMaze(raw: string; var start, finish: TPoint): TboolGrid;
|
|
var
|
|
tiles: TboolGrid;
|
|
c: char;
|
|
i,w,h,x,y: integer;
|
|
begin
|
|
writeln(raw);
|
|
writeln('Parsing...');
|
|
i:= 1;
|
|
w:= strtoint(readLine(raw,i));
|
|
h:= strtoint(readLine(raw,i));
|
|
SetLength(tiles,w);
|
|
for x:= 0 to w - 1 do
|
|
SetLength(tiles[x],h);
|
|
x:= 0;
|
|
y:= 0;
|
|
writeln('W:' + inttostr(w) + ' H:' + inttostr(h));
|
|
while y < h do
|
|
begin
|
|
c:= raw[i];
|
|
i:= i + 1;
|
|
case c of
|
|
'0': begin
|
|
tiles[x][y]:= false;
|
|
x:= x + 1;
|
|
end;
|
|
'1': begin
|
|
tiles[x][y]:= true;
|
|
x:= x + 1;
|
|
end;
|
|
'3': begin
|
|
Writeln('found start!');
|
|
start.x:= x;
|
|
start.y:= y;
|
|
tiles[x][y]:= true;
|
|
x:= x + 1;
|
|
end;
|
|
'4': begin
|
|
Writeln('found finish!');
|
|
finish.x:= x;
|
|
finish.y:= y;
|
|
tiles[x][y]:= true;
|
|
x:= x + 1;
|
|
end;
|
|
end;
|
|
if x = w then begin x:= 0; y:= y + 1; end;
|
|
end;
|
|
result:= tiles;
|
|
writeln('Start = (' + inttostr(start.x) + ',' + inttostr(start.y) + ')');
|
|
writeln('Finish = (' + inttostr(finish.x) + ',' + inttostr(finish.y) + ')');
|
|
//writeln('a1:'+inttostr(length(tiles)));
|
|
//writeln('a2:'+inttostr(length(tiles[0])));
|
|
//writeln('b1:'+inttostr(length(result)));
|
|
//writeln('b2:'+inttostr(length(result[0])));
|
|
end;
|
|
|
|
|
|
function notPassed(var passed: TpointArray; x,y: integer): boolean;
|
|
var
|
|
i: integer;
|
|
begin
|
|
result:= true;
|
|
for i:= length(passed) - 1 downto 0 do
|
|
if (passed[i].x = x) and (passed[i].y = y) then begin result:= false; exit; end;
|
|
end;
|
|
|
|
type TghettoStack = record
|
|
passed,my_path: TpointArray;
|
|
x,y: integer;
|
|
end;
|
|
|
|
function point(x,y:integer):TPoint;
|
|
begin
|
|
result.x:= x;
|
|
result.y:= y;
|
|
end;
|
|
|
|
function flood(var input: array of array of boolean; sx,sy,dx,dy,w,h: integer): array of TpointArray;
|
|
var
|
|
i,off,len,top,scrat:integer;
|
|
stack: array of TghettoStack;
|
|
my_path,passed: TpointArray;
|
|
x,y: integer;
|
|
begin
|
|
len:= 1000;
|
|
SetLength(stack,len);
|
|
SetLength(stack[0].passed,0);
|
|
stack[0].x:= sx;
|
|
stack[0].y:= sy;
|
|
writeln('pushing start: (' + inttostr(sx) + ',' + inttostr(sy) + ')');
|
|
off:= 0;
|
|
top:= 1;
|
|
while top > 0 do
|
|
begin
|
|
if top+4 > len then
|
|
begin
|
|
writeln('Growing!');
|
|
len:= len + 1000;
|
|
SetLength(stack,len);
|
|
end;
|
|
top:= top - 1;
|
|
passed:= stack[top].passed;
|
|
x:= stack[top].x;
|
|
y:= stack[top].y;
|
|
SetLength(my_path,Length(passed)+1);
|
|
//writeln('following (' + inttostr(x) + ',' + inttostr(y) + ') ' + inttostr(length(my_path)));
|
|
for i:= 0 to Length(passed) - 1 do
|
|
begin
|
|
my_path[i]:= passed[i];
|
|
end;
|
|
my_path[Length(passed)]:= point(x,y);
|
|
if (x = dx) and (y = dy) then
|
|
begin
|
|
writeln('found path! ' + inttostr(off));
|
|
SetLength(result,off+1);
|
|
result[off]:= my_path;
|
|
off:= off + 1;
|
|
//writeln('continuing search');
|
|
end;
|
|
if (y-1 >= 0) then if input[x][y-1] then if notPassed(my_path,x,y-1) then
|
|
begin
|
|
stack[top].passed:= my_path;
|
|
stack[top].x:= x;
|
|
stack[top].y:= y-1;
|
|
top:= top + 1;
|
|
end;
|
|
if (y+1 < h) then if input[x][y+1] then if notPassed(my_path,x,y+1) then
|
|
begin
|
|
stack[top].passed:= my_path;
|
|
stack[top].x:= x;
|
|
stack[top].y:= y+1;
|
|
top:= top + 1;
|
|
end;
|
|
if (x-1 >= 0) then if input[x-1][y] then if notPassed(my_path,x-1,y) then
|
|
begin
|
|
stack[top].passed:= my_path;
|
|
stack[top].x:= x-1;
|
|
stack[top].y:= y;
|
|
top:= top + 1;
|
|
end;
|
|
if (x+1 < w) then if input[x+1][y] then if notPassed(my_path,x+1,y) then
|
|
begin
|
|
stack[top].passed:= my_path;
|
|
stack[top].x:= x+1;
|
|
stack[top].y:= y;
|
|
top:= top + 1;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure prune(var input: array of array of boolean; x,y,w,h: integer);
|
|
var
|
|
nx,ny,c: integer;
|
|
begin
|
|
nx:= x;
|
|
ny:= y;
|
|
repeat
|
|
x:= nx;
|
|
y:= ny;
|
|
input[x][y]:= false;
|
|
c:= 0;
|
|
if (y-1 >= 0) then if input[x][y-1] then
|
|
begin
|
|
c:= c + 1;
|
|
ny:= y - 1;
|
|
end;
|
|
if (y+1 < h) then if input[x][y+1] then
|
|
begin
|
|
c:= c + 1;
|
|
ny:= y + 1;
|
|
end;
|
|
if (x-1 >= 0) then if input[x-1][y] then
|
|
begin
|
|
c:= c + 1;
|
|
nx:= x - 1;
|
|
end;
|
|
if (x+1 < w) then if input[x+1][y] then
|
|
begin
|
|
c:= c + 1;
|
|
nx:= x + 1;
|
|
end;
|
|
until c <> 1;
|
|
input[x][y]:= true;
|
|
end;
|
|
|
|
procedure thin(var input: array of array of boolean; sx,sy,fx,fy,w,h: integer);
|
|
var
|
|
x,y,c: integer;
|
|
begin
|
|
//writeln('examining maze');
|
|
for x:= 0 to w-1 do
|
|
for y:= 0 to h-1 do
|
|
if input[x][y] then
|
|
begin
|
|
c:= 0;
|
|
if (y-1 >= 0) then if input[x][y-1] then c:= c + 1;
|
|
if (y+1 < h) then if input[x][y+1] then c:= c + 1;
|
|
if (x-1 >= 0) then if input[x-1][y] then c:= c + 1;
|
|
if (x+1 < w) then if input[x+1][y] then c:= c + 1;
|
|
if c <= 1 then if ((x<>sx) or (y<>sy)) and ((x<>fx) or (y<>fy)) then prune(input,x,y,w,h);
|
|
end;
|
|
end;
|
|
|
|
procedure benland100_solver(var jacks_path: TPointArray; var jills_routes: Integer; input: array of array of Boolean; start, finish: TPoint);
|
|
var
|
|
all_paths: array of TpointArray;
|
|
i,max_pos,max_len: integer;
|
|
begin
|
|
//writeln('d1:'+inttostr(length(maze)));
|
|
//writeln('d2:'+inttostr(length(maze[0])));
|
|
writeln('preparing to solve maze');
|
|
thin(input,start.x,start.y,finish.x,finish.y,length(input),length(input[0]));
|
|
writeln('thinned the maze');
|
|
//writeln('start: (' + inttostr(start.x) + ',' + inttostr(start.y) + ') finish: (' + inttostr(finish.x) + ',' + inttostr(finish.y) + ')');
|
|
all_paths:= flood(input,start.x,start.y,finish.x,finish.y,length(input),length(input[0]));
|
|
writeln('found all possible paths');
|
|
jills_routes:= Length(all_paths) - 1;
|
|
max_pos:= 0;
|
|
max_len:= length(all_paths[0]);
|
|
writeln('Finding longest...');
|
|
for i:= 1 to jills_routes do
|
|
begin
|
|
if length(all_paths[i]) > max_len then
|
|
begin
|
|
max_len:= length(all_paths[i]);
|
|
max_pos:= i;
|
|
end;
|
|
end;
|
|
jacks_path:= all_paths[max_pos];
|
|
end;
|
|
|
|
var
|
|
//maze: array of array of boolean;
|
|
start,finish: TPoint;
|
|
jack: TPointArray;
|
|
i,jills,t: integer;
|
|
begin
|
|
writeln('Solving maze...');
|
|
//writeln('c1:'+inttostr(length(maze)));
|
|
//writeln('c2:'+inttostr(length(maze[0])));
|
|
//t:= GetSystemTime();
|
|
//writeln('start: (' + inttostr(start.x) + ',' + inttostr(start.y) + ') finish: (' + inttostr(finish.x) + ',' + inttostr(finish.y) + ')');
|
|
benland100_solver(jack,jills,ParseMaze(small_maze,start,finish),start,finish);
|
|
//t:= GetSystemTime() - t;
|
|
//writeln('Took ' + realtostr(t / 1000.0) + ' seconds');
|
|
writeln('Longest Path: ' + inttostr(length(jack)));
|
|
writeln('#Other Paths: ' + inttostr(jills));
|
|
end.
|