Cod sursa(job #267271)

Utilizator valytgjiu91stancu vlad valytgjiu91 Data 26 februarie 2009 23:29:25
Problema Critice Scor 40
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.23 kb
    const nmax=1024;
   var g,h:text;  
     j,min,flux,x,y,i,n,m,z,flux1,i1,sursa,dest:longint;
     viz,t,c:array[1..nmax] of longint;  
     ct,f:array[1..nmax,1..nmax]of longint;  
     v:array[1..nmax]of record
                       x,y:longint;
                       end;
     a:array[0..nmax]of integer;
    function bf:boolean;
    var p,i,u,x:longint;
    begin
         for i:=1 to n do viz[i]:=0;
         p:=1;
         u:=1;
         viz[1]:=1;
         c[1]:=sursa;
         while p<=u do
                begin
                  x:=c[p];
                  for i:=1 to n do
                     if (ct[x,i]-f[x,i]>0) and (viz[i]=0)then
                         begin
                           u:=u+1;
                           c[u]:=i;
                           viz[i]:=1;
                           t[i]:=x;
                           end;
                     p:=p+1;
                  end;
     if viz[dest]=0 then bf:=false
                    else bf:=true;
   end;
   begin
   assign(h,'critice.in');
   reset(h);
   assign(g,'critice.out');
   rewrite(g);
   readln(h,n,m);
   for i:=1 to m do
      begin
      readln(h,v[i].x,v[i].y,z);
      ct[v[i].x,v[i].y]:=z;
      ct[v[i].y,v[i].x]:=z;
      end;
   sursa:=1;
   dest:=n;
   while bf do
     for i:=1 to n do
        if ct[i,n]-f[i,n]>0 then
          begin
               min:=ct[i,n]-f[i,n];
               j:=i;
               while (j<>1) do begin
                     if (ct[t[j],j]-f[t[j],j])<min then
                        min:=ct[t[j],j]-f[t[j],j];
                     j:=t[j];
                  end;
               j:=i;
               while (j<>1) do
                  begin
                  f[t[j],j]:=f[t[j],j]+min;
                  f[j,t[j]]:=f[j,t[j]]-min;
                  j:=t[j];
                  end;
               f[i,n]:=f[i,n]+min;
               f[n,i]:=f[n,i]-min;
               flux:=flux+min;
               end;

   for i1:=1 to m do
     begin
      ct[v[i1].x,v[i1].y]:=ct[v[i1].x,v[i1].y]+1;
      ct[v[i1].y,v[i1].x]:=ct[v[i1].y,v[i1].x]+1;
      for i:=1 to n do
          for j:=1 to n do
          f[i,j]:=0;
      flux1:=0;
      sursa:=1;
      dest:=n;
      while bf do
         for i:=1 to n do
            if ct[i,n]-f[i,n]>0 then
             begin
               min:=ct[i,n]-f[i,n];
               j:=i;
               while (j<>1) do begin
                     if (ct[t[j],j]-f[t[j],j])<min then
                        min:=ct[t[j],j]-f[t[j],j];
                     j:=t[j];
                  end;
               j:=i;
               while (j<>1) do
                  begin
                  f[t[j],j]:=f[t[j],j]+min;
                  f[j,t[j]]:=f[j,t[j]]-min;
                  j:=t[j];
                  end;
               f[i,n]:=f[i,n]+min;
               f[n,i]:=f[n,i]-min;
               flux1:=flux1+min;
               end;

      if flux1>flux then
          begin
             a[0]:=a[0]+1;
             a[a[0]]:=i1;
          end;
      ct[v[i1].x,v[i1].y]:=ct[v[i1].x,v[i1].y]-1;
      ct[v[i1].y,v[i1].x]:=ct[v[i1].y,v[i1].x]-1;
      end;
      writeln(g,a[0]);
      for i:=1 to a[0]  do
        writeln(g,a[i]);
      close(g);
   end.