fork download
copy 
  1. uses math;
  2. const maxn = 100;
  3.       maxq = 100001;
  4.       oo = 10000000;
  5.       fi = '';
  6.       fo = '';
  7. type tqueue = record
  8.                 front, rear, nitem: longint;
  9.                 ix: array[0..maxq-1] of shortint;
  10.                 iy: array[0..maxq-1] of shortint;
  11.               end;
  12. var m,n:byte;
  13.     sx,sy,fx,fy: shortint;
  14.     a,dp: array[0..maxn+1,0..maxn+1] of byte;
  15.     queue: tqueue;
  16. procedure enter;
  17. var i,j:byte;
  18.     p: char;
  19. begin
  20.   assign(input,fi);
  21.   reset(input);
  22.   readln(m,n);
  23.   for i:=1 to m do
  24.   begin
  25.     for j:=1 to n do
  26.     begin
  27.       read(p);
  28.       case p of
  29.         'B':
  30.         begin
  31.           sx:=i;
  32.           sy:=j;
  33.           a[i,j]:=1;
  34.         end;
  35.         'C':
  36.         begin
  37.           fx:=i;
  38.           fy:=j;
  39.           a[i,j]:=1;
  40.         end;
  41.         '*': a[i,j]:=0;
  42.         '.': a[i,j]:=1;
  43.       end;
  44.     end;
  45.     readln;
  46.   end;
  47.   close(input);
  48. end;
  49. procedure init;
  50. begin
  51.   with queue do
  52.   begin
  53.     front:=0;
  54.     rear:=1;
  55.     nitem:=0;
  56.   end;
  57. end;
  58. procedure push(x,y:shortint);
  59. begin
  60.   with queue do
  61.   begin
  62.     inc(nitem);
  63.     front:=(front+1) mod maxq;
  64.     ix[front]:=x;
  65.     iy[front]:=y;
  66.   end;
  67. end;
  68. procedure pop(var x,y:shortint);
  69. begin
  70.   with queue do
  71.   begin
  72.     dec(nitem);
  73.     x:=ix[rear];
  74.     y:=iy[rear];
  75.     rear:=(rear+1) mod maxq;
  76.   end;
  77. end;
  78. function empty:boolean;
  79. begin
  80.   with queue do
  81.   empty:=(nitem=0);
  82. end;
  83. function kc(x1,y1,x2,y2:shortint):byte;
  84. begin
  85.   kc:=abs(x1-x2)+abs(y1-y2);
  86. end;
  87. procedure printa;
  88. var i,j:byte;
  89. begin
  90.   for i:=1 to m do
  91.   begin
  92.     for j:=1 to n do
  93.     write(dp[i,j]:3,' ');
  94.     writeln;
  95.   end;
  96.   writeln;
  97. end;
  98. procedure solve;
  99. var x,y,i,j:byte;
  100.     d: array[0..maxn+1,0..maxn+1] of longint;
  101.     free: array[0..maxn+1,0..maxn+1] of boolean;
  102.     minkc:byte;
  103.   procedure printa;
  104.   var i,j:byte;
  105.   begin
  106.     for i:=1 to m do
  107.     begin
  108.       for j:=1 to n do
  109.       write(d[i,j]:15,' ');
  110.       writeln;
  111.     end;
  112.     writeln;
  113.   end;
  114. begin
  115.   assign(output,fo);
  116.   rewrite(output);
  117.   for i:=1 to m do
  118.   for j:=1 to n do
  119.   d[i,j]:=oo;
  120.   d[sx,sy]:=0;
  121.   fillchar(free,sizeof(free),true);
  122.   repeat
  123.     x:=0;
  124.     y:=0;
  125.     for i:=1 to m do
  126.     for j:=1 to n do
  127.     if free[i,j] and ((d[i,j]<d[x,y]) or ((x=0) and (y=0))) and (a[i,j]=1) then
  128.     begin
  129.       x:=i;
  130.       y:=j;
  131.     end;
  132.     free[x,y]:=false;
  133.     if ((x=0) and (y=0)) or ((x=fx) and (y=fy)) then break;
  134.     if (x>1) and (a[x-1,y]=1) and (d[x,y]+1<d[x-1,y]) then d[x-1,y]:=d[x,y]+1;
  135.     if (x<m) and (a[x+1,y]=1) and (d[x,y]+1<d[x+1,y]) then d[x+1,y]:=d[x,y]+1;
  136.     if (y>1) and (a[x,y-1]=1) and (d[x,y]+1<d[x,y-1]) then d[x,y-1]:=d[x,y]+1;
  137.     if (y<n) and (a[x,y+1]=1) and (d[x,y]+1<d[x,y+1]) then d[x,y+1]:=d[x,y]+1;
  138.   until false;
  139.   writeln(d[fx,fy]);
  140.   close(output);
  141. end;
  142. begin
  143.   enter;
  144.   solve;
  145. end.
  146.  
Success #stdin #stdout 0s 664KB
comments (?)
stdin
copy 
5 6
B...*.
..*...
.**.*.
..***.
*..*.C
stdout
copy 
9
https://ideone.com/6Db0cJ
language:
Pascal (fpc 3.0.4)
created:
9 years ago
visibility:
secret

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!