Cod sursa(job #775663)

Utilizator ctlin04UAIC.VlasCatalin ctlin04 Data 8 august 2012 17:24:25
Problema Flux maxim Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 2.87 kb
Program maxflow;
 type lista=^celula;
      celula=record
        nod:integer;
        next:lista;
        end;
      tip=record x,y:integer; end;
var graf,aux:array [1..1000] of lista;
    v:lista;
    b1:array [1..1 shl 10] of char;
    cost:array [1..1001,1..1001] of longint;
    st:array [1..1000] of tip;
    viz:array [1..1000] of boolean;
    n,m,i,flux,x,y,c,val,lev:longint;
    ok,ok1:boolean;
    fi,fo:text;
procedure bfs(nod:longint);
 var v,coada,r,p:lista;
     d:array [1..1000] of longint;
begin
 new(v); for i:=1 to n do begin d[i]:=0; aux[i]:=nil; end;
 d[1]:=1; v^.nod:=1; v^.next:=nil; coada:=v;
 while v<>nil do begin
  p:=graf[v^.nod];
  while p<>nil do begin
   if (d[p^.nod]=0) and (cost[v^.nod,p^.nod]<>0) and (p^.nod<>n) then begin
                               new(r); r^.nod:=p^.nod; r^.next:=aux[v^.nod]; aux[v^.nod]:=r;
                              if d[p^.nod]=0 then begin
                                                   d[p^.nod]:=d[v^.nod]+1;
                                                   new(r); r^.nod:=p^.nod;
                                                   coada^.next:=r; coada:=r;
                                                   end;
                              end;
            p:=p^.next;
     end;
    v:=v^.next;
   end;
 if d[n]<>0 then ok1:=true;
end;

procedure dfs(nod,min:longint);
 var p:lista;
begin
 if aux[nod]=nil then begin
               flux:=flux+min; val:=min; ok:=true;
                end
   else begin
         p:=aux[nod]; viz[nod]:=true;
         while p<>nil do begin
          if (viz[p^.nod]=false) and (ok=false) and (cost[nod,p^.nod]>0) then begin
                                 if cost[nod,p^.nod]<min then min:=cost[nod,p^.nod];
                                  inc(lev); st[lev].x:=nod; st[lev].y:=p^.nod;
                                 dfs(p^.nod,min);
                        if (ok=true) and (lev>0) then begin
                             cost[st[lev].x,st[lev].y]:=cost[st[lev].x,st[lev].y]-val;
                              cost[st[lev].y,st[lev].x]:=cost[st[lev].y,st[lev].x]+val;
                               end;
                           dec(lev);
                                 end;
           p:=p^.next;
         end;
        end;
end;
begin
 assign(fi,'maxflow.in');
  assign(fo,'maxflow.out');
 settextbuf(fi,b1);
 reset(fi); rewrite(fo); readln(fi,n,m);
 for i:=1 to m do begin
    readln(fi,x,y,c);
     new(v); v^.nod:=y; v^.next:=graf[x];
      graf[x]:=v; cost[x,y]:=c;
     new(v); v^.nod:=x; v^.next:=graf[y]; graf[y]:=v;
    end;
 ok1:=true;
  while ok1 do begin
           ok1:=false; bfs(1); ok:=true;
           while ok do begin
                ok:=false;
                 dfs(1,100000000);
                  fillchar(viz,sizeof(viz),0);
                end;
           end;
  write(fo,flux);
 close(fo);
end.