Cod sursa(job #1019431)

Utilizator hungntnktpHungntnktp hungntnktp Data 31 octombrie 2013 06:32:45
Problema Critice Scor 60
Compilator fpc Status done
Runda Arhiva de probleme Marime 4.07 kb
USES math;
CONST
        tfi     ='critice.in';
        tfo     ='critice.out';
        nmax    =1000;
        mmax    =20000;
TYPE
        arr     =array [1..nmax] of longint;
        arr1    =array [-mmax..mmax] of longint;
        arr2    =array [1..nmax,1..nmax] of longint;
        arr3    =array [1..mmax] of boolean;
VAR
        fi,fo   :text;
        head,q,truoc:arr;
        ke,next,ts,c:arr1;
        a,id,vt :arr2;
        n,m,u,r,f,res:longint;
        free    :arr3;
 (*********************************************************************)
Procedure nhap;
      Var
        i,x,y,z :longint;
      Begin
        assign(fi,tfi);reset(fi);
          read(fi,n,m);
          for i:=1 to m do
            begin
              read(fi,x,y,z);
              a[x,y]:=z;
              a[y,x]:=z;
              id[x,y]:=i;
              id[y,x]:=i;
            end;
          m:=0;
        close(fi);
      End;
 (********************************************************************)
Procedure push(x:longint);
      Begin
        inc(r);
        q[r]:=x;
      End;
 (*********************************************************************)
Procedure pop;
      Begin
        u:=q[f];
        inc(f);
      End;
 (**********************************************************************)
Function findpath:boolean;
      Var
        i,j     :longint;
      Begin
        for i:=1 to n do truoc[i]:=0;
        r:=0;f:=1;
        truoc[1]:=-1;
        push(1);
        while f<=r do
          begin
            pop;
            j:=head[u];
            while j<>0 do
              begin
                if (truoc[ke[j]]=0) and (c[j]<ts[j]) then
                  begin
                    truoc[ke[j]]:=j;
                    if ke[j]=n then exit(true);
                    push(ke[j]);
                  end;
                j:=next[j];
              end;
          end;
        exit(false);
      End;
 (**********************************************************************)
Procedure incflow;
      Var
        i,j,d   :longint;
      Begin
        i:=n;d:=maxlongint;
        Repeat
          i:=truoc[i];
          d:=min(d,ts[i]-c[i]);
          i:=ke[-i];
        Until i=1;
        i:=n;
        Repeat
          i:=truoc[i];
          c[i]:=c[i]+d;
          c[-i]:=c[-i]-d;
          i:=ke[-i];
        Until i=1;
      End;
 (**********************************************************************)
Procedure union(x,y,z:longint);
      Begin
        inc(m);
        vt[x,y]:=m;
        ts[m]:=z;
        ke[m]:=y;
        next[m]:=head[x];
        head[x]:=m;
        ke[-m]:=x;
        next[-m]:=head[y];
        head[y]:=-m;
      End;
 (**********************************************************************)
Procedure lam;
      Var
        i,j     :longint;
      Begin
        for i:=1 to n do
          if a[1,i]<>0 then union(1,i,a[1,i]);
        for i:=2 to n do
          if a[i,n]<>0 then union(i,n,a[i,n]);
        for i:=2 to n-1 do
          for j:=2 to n-1 do
            if a[i,j]<>0 then union(i,j,a[i,j]);
        Repeat
          if findpath=false then break;
          incflow;
        Until false;
        for i:=1 to n do
          for j:=i+1 to n do
            if a[i,j]<>0 then
              begin
                inc(ts[vt[i,j]]);
                if vt[j,i]<>0 then inc(ts[vt[j,i]]);
                if findpath then
                  begin
                    free[id[i,j]]:=true;
                    inc(res);
                  end;
                dec(ts[vt[i,j]]);
                if vt[j,i]<>0 then dec(ts[vt[j,i]]);
              end;
      End;
 (************************************************************************)
Procedure inkq;
      Var
        i       :longint;
      Begin
        assign(fo,tfo);rewrite(fo);
          writeln(fo,res);
          for i:=1 to m do
            if free[i] then writeln(fo,i);
        close(fo);
      End;
 (*************************************************************************)
BEGIN
        nhap;
        lam;
        inkq;
End.