Cod sursa(job #158523)

Utilizator robert_dDragan Robert robert_d Data 13 martie 2008 17:56:54
Problema Taramul Nicaieri Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.4 kb
program taramul_nicaieri;
var a:array[0..201,0..201]of byte;
    n,i,j,s,d,fl:integer;
    f:text;
    c,t,use:array[0..202]of byte;

procedure flux;
var g:boolean;
    pi,pf,min,p:integer;

begin
g:=true;
fl:=0;
while g do begin
  {determinam drum de crestere - BF}
  for i:=0 to 2*n+1 do use[i]:=0;
  g:=false;
  pi:=1; pf:=1; c[1]:=0; use[0]:=1;
  while (pi<=pf)and(not g) do begin
    for i:=0 to 2*n+1 do
        if (a[c[pi],i]<>0)and(use[i]=0)then begin
                               inc(pf);
                               c[pf]:=i;
                               t[pf]:=pi;
                               use[i]:=1;
                               if i=2*n+1 then begin g:=true; break; end;
                               end;
    inc(pi);
  end;


  if g then begin
    inc(fl);
    {modificam matricea}
    p:=pf;
    while p<>1 do begin
                  dec(a[c[t[p]],c[p]]);
                  inc(a[c[p],c[t[p]]]);
                  p:=t[p];
                  end;
  end;
end;



end;

begin
assign(f,'harta.in'); reset(f);
readln(f,n);
s:=0; d:=2*n+1;
for i:=1 to n do readln(f,a[s,i],a[n+i,d]);
close(f);
{}
for i:=1 to n do
    for j:=n+1 to 2*n do a[i,j]:=1;
for i:=1 to n do a[i,n+i]:=0;
{}
flux;

assign(f,'harta.out'); rewrite(f);
writeln(f,fl);
for i:=1 to n do
    for j:= n+1 to 2*n do
        if a[j,i]=1 then writeln(f,i,' ',j-n);
close(f);
end.