fork download
copy 
  1. {$MODE OBJFPC}
  2. PROGRAM MCLEAN;
  3. uses math;
  4. const
  5.     wmax = 21;
  6.     hmax = 21;
  7.     oo = trunc(1e18);
  8.     kx : array[1..4] of integer = (-1,0,1,0);
  9.     ky : array[1..4] of integer = (0,1,0,-1);
  10. type
  11.     point = record
  12.         x,y : integer;
  13.     end;
  14. var
  15.     w,h,n : integer;
  16.     p : array[1..11] of point;
  17.     a : array[1..wmax,1..hmax] of char;
  18.     f : array[1..11,0..1 shl 11] of int64;
  19.     d : array[1..11,1..11] of int64;
  20.     res : int64;
  21. procedure bfs (s : integer);
  22. var
  23.     q : array[1..21] of point;
  24.     l,r : integer;
  25.     free : array[1..wmax,1..hmax] of boolean;
  26.     c : array[1..wmax,1..hmax] of int64;
  27.     u,v,ux,vy : integer;
  28.     k,i : integer;
  29. begin
  30.     fillchar(q,sizeof(q),0);
  31.     fillchar(free,sizeof(free),true);
  32.     l:= 1;
  33.     r:= 1;
  34.     q[1].x:= p[s].x;
  35.     q[1].y:= p[s].y;
  36.     free[p[s].x,p[s].y]:= false;
  37.     fillchar(c,sizeof(c),0);
  38.     while l <= r do
  39.         begin
  40.             u:= q[l].x;
  41.             v:= q[l].y;
  42.             inc(l);
  43.             for k:=1 to 4 do
  44.                 begin
  45.                     ux:= u + kx[k];
  46.                     vy:= v + ky[k];
  47.                     if (ux > 0) and (ux <= h) and (vy > 0) and (vy <= w) and (a[ux][vy] <> 'x') then
  48.                         if (free[ux,vy]) then
  49.                             begin
  50.                                 c[ux,vy]:= c[u,v] + 1;
  51.                                 free[ux,vy]:= false;
  52.                                 inc(r);
  53.                                 q[r].x:= ux;
  54.                                 q[r].y:= vy;
  55.                             end;
  56.                 end;
  57.         end;
  58.     for i:=1 to n do
  59.         begin
  60.             d[s,i]:= c[p[i].x,p[i].y];
  61.             if (i <> s) and (d[s,i] = 0) then d[s,i]:= oo;
  62.         end;
  63. end;
  64. function getbit (x,i : integer) : integer;
  65. begin
  66.     getbit:= (x shr i) and 1;
  67. end;
  68. function turnoff (x,i : integer) : integer;
  69. begin
  70.     turnoff:= x and not (1 shl i);
  71. end;
  72. procedure main;
  73. var
  74.     i,j : integer;
  75.     first,last,st,pres : integer;
  76.     count : integer;
  77.     b : array[1..11] of integer;
  78. begin
  79.     fillchar(p,sizeof(p),0);
  80.     n:= 1;
  81.     for i:=1 to h do
  82.         begin
  83.             readln(a[i]);
  84.             for j:=1 to w do
  85.                 begin
  86.                     if a[i][j] = 'o' then
  87.                         begin
  88.                             p[1].x:= i;
  89.                             p[1].y:= j;
  90.                         end
  91.                     else
  92.                     if a[i][j] = '*' then
  93.                         begin
  94.                             inc(n);
  95.                             p[n].x:= i;
  96.                             p[n].y:= j;
  97.                         end;
  98.                 end;
  99.         end;
  100.     for i:=1 to n do
  101.         bfs(i);
  102.     first:= 1;
  103.     last:= 1 shl n - 1;
  104.     for i:=1 to n do
  105.         for st:= 0 to last do
  106.             f[i,st]:= oo;
  107.     for i:=1 to n do
  108.         f[i,1 shl (i-1)]:= d[1,i];
  109.     for st:= first to last do
  110.         begin
  111.             count:= 0;
  112.             for i:=1 to n do
  113.                 if getbit(st,i-1) = 1 then
  114.                     begin
  115.                         inc(count);
  116.                         b[count]:= i;
  117.                     end;
  118.             for i:=1 to count do
  119.                 begin
  120.                     pres:= turnoff(st,b[i] - 1);
  121.                     for j:=1 to count do
  122.                         if (i <> j) then
  123.                             f[b[i],st]:= min(f[b[i],st],f[b[j],pres] + d[b[i],b[j]]);
  124.                 end;
  125.         end;
  126.     res:= oo;
  127.     for i:=1 to n do
  128.         res:= min(res,f[i,last]);
  129.     writeln(res);
  130. end;
  131. BEGIN
  132.     //assign(input,'input.inp');reset(input);
  133.     //assign(output,'output.out');rewrite(output);
  134.     repeat
  135.         readln(w,h);
  136.         if w*h = 0 then break;
  137.         main;
  138.     until false;
  139. END.
  140.  
  141.  
Success #stdin #stdout 0s 636KB
comments (?)
stdin
copy 
7 5
.......
.o...*.
.......
.*...*.
.......
15 13
.......x.......
...o...x....*..
.......x.......
.......x.......
.......x.......
...............
xxxxx.....xxxxx
...............
.......x.......
.......x.......
.......x.......
..*....x....*..
.......x.......
10 10
..........
..o.......
..........
..........
..........
.....xxxxx
.....x....
.....x.*..
.....x....
.....x....
0 0
stdout
copy 
8
1000000000000000000
1000000000000000000
https://ideone.com/0xSnEP
language:
Pascal (fpc 3.0.4)
created:
7 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!