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.