Поиск паросочетания в графе - Pascal

program Project2;
 
 
uses
  crt;
const
  m = 200;
  n = 200;
 
var
  a: array [1..n, 1..m] of boolean;
  v: array [1..n] of boolean;
  p: array [1..m] of word;
  c, mm, nn: longint;
 
procedure init;
var
  x, y, k, i: longint;
begin
  fillchar(a, sizeof(a), 0);
  fillchar(v, sizeof(v), 0);
  fillchar(p, sizeof(p), 0);
  c := 0;
 
  assign(input, 'matching.in');
  reset(input);
 
  read(nn, mm, k);
 
  for i := 1 to k do
  begin
    read(x, y);
    a[x, y] := true;
  end;
end;
 
function find_pair(k: integer): boolean;
var
  i: integer;
begin
  find_pair := false;
 
  if v[k] then
    exit;
 
  v[k] := true;
 
  for i := 1 to mm do
    if a[k, i] and ( (p[i] = 0) or find_pair(p[i]) ) then
    begin
      find_pair := true;
      p[i] := k;
      exit;
    end;
end;
 
procedure solve;
var
  i: longint;
begin
  for i := 1 to nn do
  begin
    fillchar(v, sizeof(v), false);
    if find_pair(i) then
      inc(c);
  end;
end;
 
procedure done;
var
  i: longint;
begin
  writeln(c);
  for i := 1 to mm do
    if p[i] <> 0 then
      writeln(i, ' ', p[i]);
end;
 
 
begin
  init;
  solve;
  done;
end.
 
нашел но как работает не могу понять. или ето не то?
 
[size="1"][color="grey"][I]Добавлено через 1 минуту[/I][/color][/size]
{Hungarian algorithm - Optimal matching on graph}
const nn=60;
 
var a,b:array[1..nn,1..nn] of integer;
    prev,markx,marky,xdouble,ydouble:array[1..nn] of integer;
    mx,my,mcx,mcy,ysub,xsub,t:array[0..nn] of integer;
    s,bzero:array[1..nn,0..nn] of integer;
    i,j,k,x,y,z,ind,n,m,x0,result:integer;
    f:text;
 
procedure sub;
var i,j:integer;t:boolean;
begin
   ysub[0]:=0;
   for i:=1 to my[0] do
   begin
      t:=true;
      for j:=1 to mcy[0] do
      if (my[i]=mcy[j]) then begin t:=false;break;end;
      if (t=true) then begin ysub[ysub[0]+1]:=my[i];inc(ysub[0]);end;
   end;
end;
 
procedure sub1;
var i,j:integer;t:boolean;
begin
   xsub[0]:=0;
   for i:=1 to mx[0] do
   begin
      t:=true;
      for j:=1 to mcx[0] do
      if (mx[i]=mcx[j]) then begin t:=false;break;end;
      if (t=true) then begin xsub[xsub[0]+1]:=mx[i];inc(xsub[0]);end;
   end;
end;
 
procedure transform;
var i,j,min:integer;
begin
   for i:=1 to n do
   begin
      min:=30000;
      for j:=1 to n do
      if (b[i,j]<min) then min:=b[i,j];
      if (min>0) then
      for j:=1 to n do
      b[i,j]:=b[i,j]-min;
   end;
 
   for i:=1 to n do
   begin
      min:=30000;
      for j:=1 to n do
      if (b[j,i]<min) then min:=b[j,i];
      if (min>0) then
      for j:=1 to n do
      b[j,i]:=b[j,i]-min;
   end;
end;
 
procedure operation;
var i,j,min:integer;
begin
   sub;
   min:=30000;
   for i:=1 to mcx[0] do
   for j:=1 to ysub[0] do
   if (b[mcx[i],ysub[j]]<min) then min:=b[mcx[i],ysub[j]];
 
   for i:=1 to mcx[0] do
   begin
      for j:=1 to ysub[0] do
      b[mcx[i],ysub[j]]:=b[mcx[i],ysub[j]]-min;
   end;
   sub1;
   for i:=1 to xsub[0] do
   begin
      for j:=1 to mcy[0] do
      b[xsub[i],mcy[j]]:=b[xsub[i],mcy[j]]+min;
   end;
end;
 
function start:integer;
begin
   start:=t[t[0]];dec(t[0]);
end;
 
procedure search(x:integer);
begin
   while ((s[x,0]<>0)and(ind=0)) do
   begin
      y:=s[x,s[x,0]];dec(s[x,0]);
      if (marky[y]=0) then
      begin
         marky[y]:=1;prev[y]:=x; mcy[mcy[0]+1]:=y;inc(mcy[0]);
         z:=ydouble[y];
         if (z<>0) then
         begin
            markx[z]:=1;prev[z]:=y; mcx[mcx[0]+1]:=z;inc(mcx[0]);
            search(z);
         end
         else ind:=1;
      end;
   end;
end;
 
begin
   assign(f,'in.txt');
   reset(f);
   readln(f,m,n);
   for i:=1 to m do
   begin
      for j:=1 to n do
      read(f,a[i,j]);
      mx[i]:=i;{my[j]:=j;}
      readln(f);
   end;
   close(f);mx[0]:=n;my[0]:=n;{my:=mx;}
   for i:=m+1 to n do
   begin
      for j:=1 to n do
      a[i,j]:=30000;
      mx[i]:=i;
   end;my:=mx;
 
   b:=a;transform;
   for i:=1 to mx[0] do bzero[mx[i],0]:=0;
   for i:=1 to mx[0] do
   for j:=1 to my[0] do
      if b[mx[i],my[j]]=0 then begin bzero[mx[i],bzero[mx[i],0]+1]:=my[j];inc(bzero[mx[i],0]);end;
   for i:=1 to mx[0] do
   begin
      x0:=mx[i];
      for j:=1 to my[0] do marky[my[j]]:=0;
      for k:=1 to mx[0] do
      begin
         markx[mx[k]]:=0;s[mx[k]]:=bzero[mx[k]];
      end;
      markx[x0]:=1;mcx[1]:=x0;mcx[0]:=1;mcy[0]:=0;
      ind:=0;search(x0);
      if ind=0 then
      repeat
         operation;t[0]:=0;
         for k:=1 to mcx[0] do
         begin
         sub;
         for j:=1 to ysub[0] do
            if b[mcx[k],ysub[j]]=0 then
            begin
               bzero[mcx[k],bzero[mcx[k],0]+1]:=ysub[j];inc(bzero[mcx[k],0]); s[mcx[k],s[mcx[k],0]+1]:=ysub[j];
               inc(s[mcx[k],0]);t[t[0]+1]:=mcx[k];inc(t[0]);
            end;
         end;
         while (t[0]<>0)and(ind=0) do
         begin
            x:=start;search(x);
         end;
      until ind=1;
      x:=prev[y];xdouble[x]:=y;ydouble[y]:=x;
      while x<>x0 do
      begin
         y:=prev[x];x:=prev[y];
         xdouble[x]:=y;ydouble[y]:=x;
      end;
   end;
 
   result:=0;
   for i:=1 to n do
   result:=result+a[i,xdouble[i]];
   assign(f,'out.txt');
   rewrite(f);
   write(f,result);
   close(f);
end.