ac1148.pas

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

program tju1148;
const
  maxn=20;
var
  w:array[1..maxn,1..maxn]of longint;
  my,lx,ly,slack,src,qx,px,py:array[1..maxn]of longint;
  n,i,j,f,r,last:longint;
procedure find;
  var
    x,y,d:longint;
  begin
    repeat
      inc(f);x:=qx[f];
      for y:=1 to n do begin
        d:=lx[x]+ly[y]-w[x,y];
        if d>0 then begin
          if (py[y]=0) and (d<slack[y]) then begin
            slack[y]:=d;src[y]:=x;
          end
        end
        else if my[y]=0 then begin
          py[y]:=x;last:=y;exit;
        end
        else if px[my[y]]=0 then begin
          inc(r);qx[r]:=my[y];
          py[y]:=x;px[my[y]]:=y;
        end;
      end;
    until f=r;
  end;
procedure modify;
  var
    x,y,d:longint;
  begin
    d:=maxlongint;
    for y:=1 to n do if (py[y]=0) and (slack[y]<d) then d:=slack[y];
    for x:=1 to n do if px[x]<>0 then dec(lx[x],d);
    for y:=1 to n do if py[y]<>0 then inc(ly[y],d) else dec(slack[y],d);
    for y:=1 to n do
      if slack[y]=0 then begin
        slack[y]:=maxlongint;
        if my[y]=0 then begin
          py[y]:=src[y];last:=y;exit;
        end
        else if px[my[y]]=0 then begin
          inc(r);qx[r]:=my[y];
          py[y]:=src[y];px[my[y]]:=y;
        end;
      end;
  end;
procedure aug;
  var
    x,y:longint;
  begin
    y:=last;
    repeat
      x:=py[y];my[y]:=x;y:=px[x];
    until y<0;
  end;
begin
  repeat
    read(n);
    if n=0 then halt;

    fillchar(lx,sizeof(lx),0);
    fillchar(ly,sizeof(ly),0);
    for i:=1 to n do
      for j:=1 to n do begin
        read(w[i,j]);
        if w[i,j]>lx[i] then lx[i]:=w[i,j];
      end;

    for i:=1 to n do begin
      fillchar(slack,sizeof(slack),$7F);
      fillchar(px,sizeof(px),0);
      fillchar(py,sizeof(py),0);
      f:=0;r:=1;qx[1]:=i;px[i]:=-1;
      last:=0;
      repeat
        find;
        if last=0 then modify;
      until last>0;
      aug;
    end;

    j:=0;
    for i:=1 to n do
      inc(j,w[my[i],i]);
    writeln(j);
  until false;
end.