Cod sursa(job #408041)

Utilizator nickyyLal Daniel Emanuel nickyy Data 2 martie 2010 20:14:23
Problema Cuplaj maxim de cost minim Scor 50
Compilator fpc Status done
Runda Arhiva educationala Marime 2.92 kb
const infile='cmcm.in';
  outfile='cmcm.out';
  maxn=605;
  infinit=maxlongint;
type adresa=^pnod;
  pnod=record  nod,cost:longint; next:adresa; end;
  adr=^point;
  point=record inf:longint; urm:adr; end;
  coada=record  prim,ultim:adr; end;
var a:array[0..maxn]of adresa;
  Q:coada;
  d,t,inQ,muchie:array[0..maxn]of longint;
  c,f,muchi:array[0..maxn,0..maxn]of longint;
  n,m,e:longint;
  sursa,destin,solutie:longint;

 procedure citire;
 var i,j,k,co:longint;
   r:adresa;
 begin
   assign(input,infile); reset(input); readln(n,m,e);
   for k:=1 to e do begin
     readln(i,j,co); inc(j,n); muchi[i,j]:=k; c[i,j]:=1;
     new(r); r^.nod:=j; r^.cost:=co; r^.next:=a[i]; a[i]:=r;
     new(r); r^.nod:=i; r^.cost:=-co; r^.next:=a[j]; a[j]:=r;
     end;
   close(output);
 end;

 procedure push(x:longint);
 var p:adr;
 begin
   new(p); p^.inf:=x; p^.urm:=nil;
   with Q do
     if(prim=nil)then begin prim:=p; ultim:=p; end
     else begin ultim^.urm:=p; ultim:=p; end;
 end;

 procedure pop;
 var p:adr;
 begin
   p:=Q.prim;
   Q.prim:=Q.prim^.urm;
   dispose(p);
 end;

 function bellmanford:longint;
 var u,v,flux:longint;
   r:adresa;
 begin
   for u:=sursa to destin do begin
     d[u]:=infinit; t[u]:=-1; inQ[u]:=0;
     end;
   d[sursa]:=0; inQ[sursa]:=1;
   push(sursa);
   while(Q.prim<>nil)do begin
     u:=Q.prim^.inf; pop; r:=a[u];
     while(r<>nil)do begin
       v:=r^.nod;
       if(c[u,v]-f[u,v]>0)and(d[v]>d[u]+r^.cost)then begin
         d[v]:=d[u]+r^.cost; t[v]:=u;
         if(inQ[v]=0)then begin
           push(v); inQ[v]:=1;
           end;
         end;
       r:=r^.next;
       end;
     inQ[u]:=0;
     end;
  if(d[destin]<infinit)then begin
    u:=destin; flux:=infinit;
    while(u<>sursa)do begin
      if(flux>c[t[u],u]-f[t[u],u])then flux:=c[t[u],u]-f[t[u],u];
      u:=t[u];
      end;
    u:=destin;
    while(u<>sursa)do begin
      inc(f[t[u],u],flux); dec(f[u,t[u]],flux);
      u:=t[u];
      end;
    bellmanford:=flux*d[destin];
    end
  else bellmanford:=0;
 end;

 procedure solve;
 var i,j:longint;
   r:adresa;
 begin
   sursa:=0; destin:=n+m+1;
   for i:=1 to n do begin
     c[sursa,i]:=1;
     new(r); r^.nod:=i; r^.cost:=0; r^.next:=a[sursa]; a[sursa]:=r;
     end;
   for i:=1 to m do begin
     c[i+n,destin]:=1;
     new(r); r^.nod:=destin; r^.cost:=0; r^.next:=a[i+n]; a[i+n]:=r;
     end;
   j:=bellmanford;
   while(j<>0)do begin
     inc(solutie,j); j:=bellmanford;
     end;
 end;

 procedure scrie;
 var i,j,nr:longint;
 begin
   nr:=0;
   assign(output,outfile); rewrite(output);
   for i:=1 to n do
     for j:=n+1 to n+m do
      if(c[i,j]<>0)and(f[i,j]<>0)then begin inc(nr); break; end;
   writeln(nr,' ',solutie);
   for i:=1 to n do
    for j:=n+1 to m+n do
      if(c[i,j]<>0)and(f[i,j]<>0)then begin write(muchi[i,j],' '); break end;
   close(output);
 end;

Begin
 citire; solve; scrie;
End.