ac1275.pas

这是在网络上搜集到的在东京大学的ACM上面解决的一些题目的源码

{$Q-,R-}
program tju1275;
const
  maxn=20;
  states=1048576;
  maxm=100;
var
  e:array[1..maxn]of cardinal;
  time:array[1..maxm]of cardinal;
  mask:array[1..maxm,1..4]of cardinal;
  dist,hp:array[0..states-1]of cardinal;
  h:array[1..states]of cardinal;
  inf,n,m,i,j,k,hsize,t:cardinal;
  c:char;
function pop:cardinal;
  var
    d,p,l,r:cardinal;
  begin
    pop:=h[1];
    dec(hsize);if hsize=0 then exit;
    d:=dist[h[hsize+1]];
    p:=1;l:=2;r:=3;
    while (l<=hsize) do begin
      if (r<=hsize) and (d>dist[h[r]]) and (dist[h[r]]<dist[h[l]]) then begin
        h[p]:=h[r];p:=r;
      end
      else if d>dist[h[l]] then begin
        h[p]:=h[l];p:=l;
      end
      else
        break;
      l:=p*2;r:=l+1;
    end;
    h[p]:=h[hsize+1];hp[h[p]]:=p;
  end;
procedure up(p:longint);
  var
    s,f:longint;
  begin
    s:=h[p];f:=p shr 1;
    while (f>0) and (dist[s]<dist[h[f]]) do begin
      h[p]:=h[f];hp[h[p]]:=p;
      p:=f;f:=p shr 1;
    end;
    h[p]:=s;hp[s]:=p;
  end;
begin
  inf:=maxlongint*2+1;
  e[1]:=1;for i:=2 to maxn do e[i]:=e[i-1]*2;
  repeat
    fillchar(mask,sizeof(mask),0);
    read(n,m);
    for i:=1 to m do begin
      read(time[i],c);
      for j:=1 to n do begin
        read(c);
        if c='+' then inc(mask[i,1],e[j]) else if c='-' then inc(mask[i,2],e[j]);
      end;
      read(c);
      for j:=1 to n do begin
        read(c);
        if c='+' then inc(mask[i,3],e[j]) else if c='-' then inc(mask[i,4],e[j]);
      end;
      mask[i,4]:=not mask[i,4];
    end;

    fillchar(dist,sizeof(dist),255);
    hsize:=1;h[1]:=2**n-1;hp[h[1]]:=1;dist[h[1]]:=0;
    repeat
      j:=pop;
      for i:=1 to m do
        if (j or mask[i,1]=j) and (j and mask[i,2]=0) then begin
          k:=j and mask[i,4] or mask[i,3];
          t:=dist[j]+time[i];
          if t<dist[k] then begin
            if dist[k]=inf then begin inc(hsize);h[hsize]:=k;hp[k]:=hsize;end;
            dist[k]:=t;up(hp[k]);
          end;
        end;
    until (h[1]=0) or (hsize=0);
    if h[1]=0 then writeln(dist[0]) else writeln(-1);
  until seekeof;
end.