fork download
copy 
  1. {$M 40000000}
  2. const maxm = 1000;
  3.       maxn = 1000;
  4.       maxq = 10000000;
  5.       oo = 100000000;
  6. type o = record
  7.            x,y:word;
  8.          end;
  9.      tqueue = record
  10.                 front,rear: longint;
  11.                 item: array[0..maxq-1] of o;
  12.               end;
  13. var n,m,sx,sy,fx,fy:word;
  14.     a: array[0..maxm+1,0..maxn+1] of longint;
  15.     queue: tqueue;
  16. procedure initq;
  17. begin
  18.   with queue do
  19.   begin
  20.     front:=0;
  21.     rear:=1;
  22.   end;
  23. end;
  24. function qempty:boolean;
  25. begin
  26.   with queue do
  27.   qempty:=(rear>front);
  28. end;
  29. procedure push(x,y:word);
  30. begin
  31.   with queue do
  32.   begin
  33.     front:=(front+1) mod maxq;
  34.     item[front].x:=x;
  35.     item[front].y:=y;
  36.   end;
  37. end;
  38. function pop:o;
  39. begin
  40.   with queue do
  41.   begin
  42.     pop:=item[rear];
  43.     rear:=(rear+1) mod maxq;
  44.   end;
  45. end;
  46. procedure enter;
  47. var i,j:word;
  48. begin
  49.   initq;
  50.   readln(n,m);
  51.   for i:=1 to n do
  52.   begin
  53.     for j:=1 to m do
  54.     begin
  55.       read(a[i,j]);
  56.       if a[i,j]=0 then push(i,j)
  57.       else a[i,j]:=oo;
  58.     end;
  59.     readln;
  60.   end;
  61.   readln(sx,sy,fx,fy);
  62. end;
  63. procedure printa;
  64. var i,j:word;
  65. begin
  66.   for i:=1 to n do
  67.   begin
  68.     for j:=1 to m do
  69.     write(a[i,j],' ');
  70.     writeln;
  71.   end;
  72.   writeln;
  73. end;
  74. procedure qhd;
  75. var p:o;
  76. begin
  77.   while not qempty do
  78.   begin
  79.     p:=pop;
  80.     with p do
  81.     begin
  82.       if (x<n) and (a[x+1,y]>a[x,y]+1) then
  83.       begin
  84.         a[x+1,y]:=a[x,y]+1;
  85.         push(x+1,y);
  86.       end;
  87.       if (x>1) and (a[x-1,y]>a[x,y]+1) then
  88.       begin
  89.         a[x-1,y]:=a[x,y]+1;
  90.         push(x-1,y);
  91.       end;
  92.       if (y<m) and (a[x,y+1]>a[x,y]+1) then
  93.       begin
  94.         a[x,y+1]:=a[x,y]+1;
  95.         push(x,y+1);
  96.       end;
  97.       if (y>1) and (a[x,y-1]>a[x,y]+1) then
  98.       begin
  99.         a[x,y-1]:=a[x,y]+1;
  100.         push(x,y-1);
  101.       end;
  102.     end;
  103.   end;
  104. end;
  105. procedure tknp;
  106. var dau,cuoi,giua,i,j:longint;
  107.     visit: array[1..maxn,1..maxm] of boolean;
  108.   function dfs(x,y:longint):boolean;
  109.   var f:boolean;
  110.   begin
  111.     if not visit[x,y] then visit[x,y]:=true
  112.     else
  113.     begin
  114.       dfs:=false;
  115.       exit;
  116.     end;
  117.     f:=false;
  118.     if a[x,y]>giua then
  119.     begin
  120.       dfs:=false;
  121.       exit;
  122.     end
  123.     else
  124.     if (x=fx) and (y=fy) then f:=true
  125.     else
  126.     begin
  127.       if (not f) and (x<n) then f:=dfs(x+1,y);
  128.       if (not f) and (x>1) then f:=dfs(x-1,y);
  129.       if (not f) and (y<m) then f:=dfs(x,y+1);
  130.       if (not f) and (y>1) then f:=dfs(x,y-1);
  131.     end;
  132.     dfs:=f;
  133.   end;
  134. begin
  135.   dau:=0;
  136.   cuoi:=m*n;
  137.   repeat
  138.     for i:=1 to n do
  139.     for j:=1 to m do
  140.     visit[i,j]:=false;
  141.     giua:=(dau+cuoi) div 2;
  142.     if dfs(sx,sy) then
  143.     cuoi:=giua-1
  144.     else
  145.     dau:=giua+1;
  146.   until dau>cuoi;
  147.   writeln(dau);
  148. end;
  149. begin
  150.   enter;
  151.   qhd;
  152.   tknp;
  153. end.
  154.  
  155.  
Success #stdin #stdout 0s 44112KB
comments (?)
stdin
copy 
5 7
0 1 1 1 1 1 0
1 1 1 1 1 1 1
1 1 1 0 1 1 1
1 1 1 1 1 1 1
0 1 1 1 1 1 0
1 1 3 4
stdout
copy 
2
https://ideone.com/wts2r6
language:
Pascal (fpc 3.0.4)
created:
8 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!