Алгоритмы на графах

const max=100;{размер большего из двух множеств}

var new: array[0..max] of boolean;

  res, min, u, v: array[0..max] of integer;

  n, i, j, del: integer;

  f: boolean;

function a(i,j:integer):integer;

begin

  a:=c[j,i];{транспонированная матрица исходных данных}

end;

function dfs(i: integer): boolean;

{пытается найти вершине j пару}

var j: integer;

begin

  if new[i] then {j в текущем паросочетании уже просмотрена}

    begin dfs:= false; exit end;

  new[i]:= true;

  for j:= 1 to n do

    if a(i, j)-u[i]-v[j]=0 then

      if (res[j] = 0) or dfs(res[j]) then

        begin

          dfs:=true; res[j]:=i;  exit

        end

      else

    else

      if ((res[j] = 0) or (not new[res[j]])) and

         (a(i, j)-u[i]-v[j] < min[j]) then begin

        min[j]:=a(i, j)-u[i]-v[j];

        if del>min[j] then del:=min[j];

      end;

  dfs:=false;

end;

begin {Main}

  fillchar(res,sizeof(res),0);

  fillchar(u,sizeof(v),0);

  fillchar(v,sizeof(v),0);

  n :=100;

  for i:= 1 to n do begin

  {каждой вершине одного из множеств находим назначение}

    for j:=1 to n do min[j]:=maxint;

    repeat

      del:=maxint;

      fillchar(new,sizeof(new),false);

      f := dfs(i);{в эффективной программе заменяется на перестройку цепочки}

      if not f then begin

        for j:=1 to n do

          if (res[j]>0)and new[res[j]] then begin

             v[j]:=v[j]-del;

             u[res[j]]:=u[res[j]]+del

          end;

        u[i]:=u[i]+del;{в этой строке результата нет, но она помечена!!!}

      end;

    until f;

  end;

  for j:= 1 to n do

    writeln(j,' ',res[j])

end.