Cod sursa(job #406158)

Utilizator nickyyLal Daniel Emanuel nickyy Data 1 martie 2010 11:45:39
Problema Flux maxim de cost minim Scor 70
Compilator fpc Status done
Runda Arhiva educationala Marime 3.41 kb
const infile='fmcm.in';
  outfile='fmcm.out';
  maxn=351;
  infinit=maxlongint;
type adresa=^pnod;
  pnod=record  nod:longint; next:adresa; end;
  coada=record prim,ultim:adresa; end;
var a:array[1..maxn]of adresa;
  z,c,f:array[0..maxn,0..maxn]of longint;
  d,h,poz,t:array[0..maxn]of longint;
  Q:coada;
  n,m,s,destin,vf,fluxmax,suma:longint;

 procedure citire;
 var i,j,k,co:longint;
   r:adresa;
 begin
   assign(input,infile); reset(input); readln(n,m,s,destin);
   while(m>0)do begin
     readln(i,j,k,co); dec(m);
     new(r); r^.nod:=j; r^.next:=a[i]; a[i]:=r;
     new(r); r^.nod:=i; r^.next:=a[j]; a[j]:=r;
     c[i,j]:=k; z[i,j]:=co; z[j,i]:=-co;
     end;
   close(input);
 end;

 procedure push(x:longint);
 var r:adresa;
 begin
   new(r); r^.nod:=x; r^.next:=nil;
   if(Q.prim=nil)then begin Q.prim:=r; Q.ultim:=r; end
   else begin Q.ultim^.next:=r; Q.ultim:=r; end;
 end;

 function pop:longint;
 var r:adresa;
 begin
   r:=Q.prim; pop:=r^.nod;
   Q.prim:=r^.next;
   dispose(r);
 end;

 procedure bellmanford;
 var x:longint;
  r:adresa;
 begin
   for x:=1 to n do d[x]:=infinit;
   d[s]:=0; push(s);
   while(Q.prim<>nil)do begin
     x:=pop; r:=a[x];
     while(r<>nil)do begin
       if(c[x,r^.nod]-f[x,r^.nod]>0)and(d[r^.nod]>d[x]+z[x,r^.nod])then begin
         d[r^.nod]:=d[x]+z[x,r^.nod]; push(r^.nod);
         end;
       r:=r^.next;
       end;
     end;
   suma:=d[destin];
 end;

 procedure combina;
 var v,tata,fiu:longint;
 begin
   v:=h[1]; tata:=1; fiu:=2;
   while(fiu<=vf)do begin
     if(fiu<vf)and(d[h[fiu]]>d[h[fiu+1]])then inc(fiu);
     if(d[v]>d[h[fiu]])then begin
       poz[h[fiu]]:=tata; h[tata]:=h[fiu];
       tata:=fiu; fiu:=fiu shl 1;
       end
     else fiu:=vf+1;
     end;
   poz[v]:=tata; h[tata]:=v;
 end;

 procedure insert(i:longint);
 var v,tata,fiu:longint;
 begin
   v:=h[i]; fiu:=i; tata:=i shr 1;
   while(tata<>0)and(d[h[tata]]>d[v])do begin
     poz[h[tata]]:=fiu; h[fiu]:=h[tata];
     fiu:=tata; tata:=tata shr 1;
     end;
   poz[v]:=fiu; h[fiu]:=v;
 end;

 function dijkstra:longint;
 var v,min:longint;
   r:adresa;
 begin
   for v:=1 to n do begin
    r:=a[v];
    while(r<>nil)do begin
      if(d[v]<>infinit)and(d[r^.nod]<>infinit) then
        inc(z[v,r^.nod],d[v]-d[r^.nod]);
      r:=r^.next;
      end;
    end;
   for v:=1 to n do begin
     d[v]:=infinit; h[v]:=v; poz[v]:=v; t[v]:=-1;
     end;
   d[s]:=0;
   h[1]:=s; h[s]:=1; poz[1]:=s; poz[s]:=1;
   vf:=n;
   while(vf>1)and(d[h[1]]<>infinit)do begin
    min:=h[1]; h[1]:=h[vf]; dec(vf); combina;
    r:=a[min];
    while(r<>nil)do begin
      v:=r^.nod;
      if(c[min,v]-f[min,v]>0)and(d[min]+z[min,v]<d[v])then begin
        d[v]:=d[min]+z[min,v]; t[v]:=min; insert(poz[v]);
        end;
      r:=r^.next;
      end;
    end;
   dijkstra:=d[destin]
 end;

 procedure flux;
 var fmin,i:longint;
 begin
   while(dijkstra<>infinit)do begin
     fmin:=infinit; i:=destin;
     while(i<>s)do begin
       if(fmin>c[t[i],i]-f[t[i],i])then fmin:=c[t[i],i]-f[t[i],i];
       i:=t[i];
       end;
     i:=destin;
     while(i<>s)do begin
       inc(f[t[i],i],fmin); dec(f[i,t[i]],fmin);
       i:=t[i];
       end;
     inc(suma,d[destin]);
     inc(fluxmax,fmin*suma);
     end;
 end;

Begin
  citire; fluxmax:=0;
  bellmanford; flux;
  assign(output,outfile); rewrite(output);
  writeln(fluxmax);
  close(output);
end.