Cod sursa(job #85143)

Utilizator gurneySachelarie Bogdan gurney Data 20 septembrie 2007 14:52:04
Problema Traseu Scor 30
Compilator fpc Status done
Runda Arhiva de probleme Marime 4.33 kb
program renovare;
  const
    fin='traseu.in';
    fout='traseu.out';
    inf=maxlongint shr 2;
    nmax=70;
    mmax=10000;
var
  start,target,prev,cost:array[0..mmax] of longint;
  pred,last,pret:array[0..nmax] of longint;
  adj:array[1..nmax,1..nmax] of boolean;
  d:array[0..nmax,0..nmax] of longint;
  delta,capa,flow:array[0..mmax] of longint;
  sink,srs:longint;
  ok:boolean;
  list:array[0..nmax] of longint;
  este:array[0..nmax] of boolean;
  pop,push:longint;
  iin,iout:array[1..nmax] of longint;
  m,n,xflow,crt,tcost,a,b,c,cst,i,j,k,x,y,nedge,tflow:longint;

function op(x:longint):longint;
  begin
    if x and 1=1 then
      op:=x+1
    else
      op:=x-1;
  end;

procedure insert(a,b,cap,cst:longint);
  begin
    inc(nedge);
    start[nedge]:=a;target[nedge]:=b;
    cost[nedge]:=cst;
    capa[nedge]:=cap;
    flow[nedge]:=0;
    prev[nedge]:=last[a];
    last[a]:=nedge;
    inc(nedge);
    start[nedge]:=b;target[nedge]:=a;
    cost[nedge]:=cst;
    capa[nedge]:=0;
    flow[nedge]:=0;
    prev[nedge]:=last[b];
    last[b]:=nedge;
  end;

begin
  assign(input,fin);
    reset(input);
    readln(n,m);
    fillchar(last,sizeof(last),0);
    nedge:=0;
    tcost:=0;
    for i:=1 to n do
      for j:=1 to n do
        d[i,j]:=inf;
    for i:=1 to m do
      begin
        readln(a,b,cst);
        d[a,b]:=cst;
        adj[a,b]:=true;
        inc(iin[b]);inc(iout[a]);
        inc(tcost,cst);
      end;
    sink:=nmax;
    srs:=0;
    for i:=1 to n do
      d[i,i]:=0;
    for i:=1 to n do
      for j:=1 to n do
        for k:=1 to n do
          if d[i,j]>d[i,k]+d[k,j] then
            d[i,j]:=d[i,k]+d[k,j];
    for i:=1 to n do
      if iin[i]>iout[i] then
        begin
          insert(srs,i,iin[i]-iout[i],0);
        end
      else if iout[i]>iin[i] then
        begin
          insert(i,sink,iout[i]-iin[i],0);
        end;
    for i:=1 to n do
      if iin[i]>iout[i] then
        for j:=1 to n do
          if iout[j]>iin[j] then
            insert(i,j,inf,d[i,j]);
    ok:=false;
    while not(ok) do
      begin
        for i:=1 to n+1 do
          pret[i]:=inf;
        pop:=1;push:=2;
        fillchar(este,sizeof(este),false);
        fillchar(delta,sizeof(delta),0);
        fillchar(pred,sizeof(pred),0);
        list[pop]:=srs;
        pret[srs]:=0;
        for i:=1 to n do
          pret[i]:=inf;
        pret[sink]:=inf;
        delta[srs]:=inf;
        este[srs]:=true;
        pred[srs]:=0;
        while pop<>push do
          begin
            crt:=last[list[pop]];
            if start[crt]<>sink then
            if pret[list[pop]]<pret[sink] then
            while crt>0 do
               begin
                if capa[crt]-flow[crt]>0 then
                  begin
                    if delta[list[pop]]<capa[crt]-flow[crt] then
                      x:=delta[list[pop]]
                    else
                      x:=capa[crt]-flow[crt];
                    if pret[start[crt]]+cost[crt]<pret[target[crt]] then
                      begin
                        if este[target[crt]]=false then
                          begin
                            list[push]:=target[crt];
                            inc(push);
                            if push=nmax+1 then
                              push:=1;
                            este[target[crt]]:=true;
                          end;
                        pred[target[crt]]:=crt;
                        delta[target[crt]]:=x;
                        pret[target[crt]]:=pret[start[crt]]+cost[crt];
                      end;
                  end;
                crt:=prev[crt];
              end;
            este[list[pop]]:=false;
            inc(pop);
            if pop=nmax+1 then
              pop:=1;
          end;
        if delta[sink]<>0 then
          begin
            inc(tflow,delta[sink]);
            x:=pred[sink];
            while x>0 do
              begin
                inc(flow[x],delta[sink]);
                flow[op(x)]:=-flow[x];
                x:=pred[start[x]];
              end;
          end
        else
          ok:=true;
      end;
  close(input);
  assign(output,fout);
    rewrite(output);
    for i:=1 to nedge do
      if flow[i]>0 then
        inc(tcost,flow[i]*cost[i]);
    writeln(tcost);
  close(output);
end.