uva1601题解,pascal留守儿童的血泪

据说，noip到2019年，我高一时，就要禁止pascal了。
据说，C++有set，有map,有priority_queue,pascal只有math,有的oj还不让用。
据说，A*算法，不宜用pascal来写。
但做为pascal党，我还是写了这题，而且似乎比某些C++还短（我要手写堆啊）。
感慨了这么多，切入正题。
这题可以用A*做，启发函数为max(从当前小鬼('a','b','c',)出发，忽视其他小鬼，到目标点的距离)。
然后还有个小优化：因为每2*2个格子至少有一个#,所以可以提前建图，而不是每次临时判定是否可行。
几个注意点：
1.虽然黑皮书说去重宜用二叉排序树，但hash效率更高（我被坑了许久）；
2.A*很耗内存，我一个堆元素就要20字节，我一个完美hash表要80000000字节（不完美的常数更比log大，因为要取模）
uses math;
const maxi=1 shl 30;
const f1:array[1..4] of longint=(0,1,0,-1);
const f2:array[1..4] of longint=(-1,0,1,0);
type
 arr=array['a'..'c'] of integer;
 ys=record
  data,step:longint;
  x,y:arr
 end;
 bi=record
  x,y,next:longint
 end;
 fun=array[1..16,1..16] of longint;
var
 a:array[0..40000000] of integer;
 d:array[0..1000000] of ys;
 e:array[1..2000] of bi;
 h:fun;
 dis:array['a'..'c'] of fun;
 n,xb,i,j,head,w,ans,ww,hh,xx,nx,ny,k,l,s:longint;
 u:ys;
 ax,ay,x,y:arr;
 c:array[1..16,1..16] of char;
operator >(a,b:ys)c:boolean;
begin
 c:=(a.data>b.data)or(a.data=b.data)and(a.step<b.step)
end;
operator =(a,b:arr)c:boolean;
var
 i:char;
begin
 c:=true;
 for i:='a' to chr(n+96) do if a[i]<>b[i] then c:=false
end;
procedure swap(var x,y:ys);
var
 t:ys;
begin
 t:=x;
 x:=y;
 y:=t
end;
procedure pop;
var
 i:longint;
begin
 d[1]:=d[w];
 d[w].data:=maxi;
 dec(w);
 i:=1;
 while ((d[i]>d[i shl 1])or(d[i]>d[i shl 1 or 1]))and(i shl 1<=w) do
  if d[i shl 1]>d[i shl 1 or 1] then
  begin
   swap(d[i shl 1 or 1],d[i]);
   i:=i shl 1 or 1
  end else
  begin
   swap(d[i shl 1],d[i]);
   i:=i shl 1
  end
end;
procedure push;
var
 i:longint;
begin
 i:=w;
 while (d[i shr 1]>d[i])and(i>1) do
 begin
  swap(d[i],d[i shr 1]);
  i:=i shr 1
 end
end;
function pin(var x,y,z:longint):boolean;
begin
 readln(x,y,z);
 if (x=0)or(y=0)or(z=0) then exit(false)
  else exit(true)
end;
function tryinsert(var x,y:arr;z:longint):boolean;//程序模块化好处很多
var
 t,u:longint;
begin
 t:=(x['a'] shl 20)or(x['b'] shl 16)or(x['c'] shl 12)or(y['a'] shl 8)or(y['b'] shl 4)or y['c'];
 u:=a[t];
 if (u>=0)and(u<=z) then exit(false);
 a[t]:=z;
 exit(true)
end;
procedure adde(a,b,c,d:longint);
begin
 inc(xx);
 e[xx].x:=c;
 e[xx].y:=d;
 e[xx].next:=h[a,b];
 h[a,b]:=xx
end;
procedure exp(t:longint);//expand，我是递归地扩展节点，便于编写代码
var
 i:longint;
 s:char;
begin
 if t=n+1 then
 begin
  for i:=1 to n-1 do
   for j:=i+1 to n do
    if (x[chr(i+96)]=x[chr(j+96)])and(y[chr(i+96)]=y[chr(j+96)])
     or(u.x[chr(i+96)]=x[chr(j+96)])and(u.y[chr(i+96)]=y[chr(j+96)])and(u.x[chr(j+96)]=x[chr(i+96)])
      and(u.y[chr(j+96)]=y[chr(i+96)]) then exit;
  if tryinsert(x,y,u.step+1) then
  begin
   inc(w);
   d[w].step:=u.step+1;
   i:=0;
   for s:='a' to chr(n+96) do
    i:=max(i,dis[s,x[s],y[s]]);
   d[w].data:=d[w].step+i;
   d[w].x:=x;
   d[w].y:=y;
   if (x=ax)and(y=ay) then
    if u.step+1<ans then ans:=u.step+1;
   push
  end;
  exit
 end;
 s:=chr(t+96);
 i:=h[u.x[s],u.y[s]];
 while i>0 do
 begin
  x[s]:=e[i].x;
  y[s]:=e[i].y;
  exp(t+1);
  i:=e[i].next
 end
end;
procedure bfs(c:char;var a:fun);
var
 qx,qy,qs:array[1..300] of longint;
 t,w,i,x,y,s:longint;
begin
 t:=0;
 w:=1;
 qx[1]:=ax[c];
 qy[1]:=ay[c];
 qs[1]:=0;
 while t<w do
 begin
  inc(t);
  x:=qx[t];
  y:=qy[t];
  s:=qs[t];
  i:=h[x,y];
  while i>0 do
  begin
   if a[e[i].x,e[i].y]>s+1 then
   begin
    a[e[i].x,e[i].y]:=s+1;
    inc(w);
    qx[w]:=e[i].x;
    qy[w]:=e[i].y;
    qs[w]:=s+1
   end;
   i:=e[i].next
  end
 end
end;
begin
 //assign(input,'a.txt');reset(input);
 while pin(ww,hh,n) do
 begin
  d[1].step:=0;
  for i:=1 to 1 shl 25 do a[i]:=-1;
  fillchar(h,sizeof(h),0);
  fillchar(e,sizeof(e),0);
  xb:=0;
  xx:=0;
  w:=1;
  head:=0;
  for i:=1 to hh do
  begin
   for j:=1 to ww do
   begin
    read(c[i,j]);
    if c[i,j] in ['a'..'z'] then
    begin
     d[1].x[c[i,j]]:=i;
     d[1].y[c[i,j]]:=j
    end;
    if c[i,j] in ['A'..'Z'] then
    begin
     ax[chr(ord(c[i,j])+32)]:=i;
     ay[chr(ord(c[i,j])+32)]:=j
    end
   end;
   readln
  end;

  for i:=1 to hh do
   for j:=1 to ww do
    if c[i,j]<>'#' then
    begin
     for k:=1 to 4 do
     begin
      nx:=i+f1[k];
      ny:=j+f2[k];
      if (nx in [1..hh])and(ny in [1..ww])and(c[nx,ny]<>'#') then adde(i,j,nx,ny)
     end;
     adde(i,j,i,j)
    end;
  filldword(dis,sizeof(dis) shr 2,maxi);
  for i:=1 to n do bfs(chr(i+96),dis[chr(i+96)]);
  tryinsert(d[1].x,d[1].y,0);
  ans:=maxi;
  while w>0 do
  begin
   u:=d[1];
   if u.step>=ans-1 then break;
   pop;
   exp(1)
  end;
  writeln(ans)
 end
end.
另：https://www.luogu.org/problem/show?pid=1778#sub上我的代码过不了，但暴力宽搜能过。