Cod sursa(job #308628)

Utilizator stan_catalinUTCN-STAN-CATALIN-GABRIEL stan_catalin Data 27 aprilie 2009 23:41:42
Problema Sortare topologica Scor 10
Compilator fpc Status done
Runda Arhiva educationala Marime 2.01 kb
program topological_sort;

type nmax=0..50000;
     mmax=0..100000;

var f,g:text;
    v,s:array[nmax] of nmax;
    i,n,x,y,nr:nmax;
    m,m1:mmax;
    ok:boolean;

begin
   assign(f,'sortaret.in'); reset(f);
   assign(g,'sortaret.out'); rewrite(g);
   read(f,n,m);

   read(f,x,y);
   v[x]:=1;
   v[y]:=2;
   s[1]:=x;
   s[2]:=y;
   nr:=2;

   for m1:=2 to m do
      begin

         read(f,x,y);
         ok:=true;

         if (v[x]=0) and (v[y]=0) then
            begin

               v[x]:=nr+1;
               v[y]:=nr+2;
               nr:=nr+2;
               s[v[x]]:=x;
               s[v[y]]:=y;
               ok:=false;

            end;

         if (v[x]=0) and (v[y]<>0) and (ok) then
            begin

               for i:=nr+1 downto v[y]+1 do
                  begin
                     s[i]:=s[i-1];
                     v[s[i]]:=i;
                  end;

               v[x]:=v[y]-1;
               s[v[x]]:=x;
               nr:=nr+1;
               ok:=false;

            end;

         if (v[y]=0) and (v[x]<>0) and (ok) then
            begin

               for i:=nr+1 downto v[x]+2 do
                  begin
                     s[i]:=s[i-1];
                     v[s[i]]:=i;
                  end;

               v[y]:=v[x]+1;
               s[v[y]]:=y;
               nr:=nr+1;
               ok:=false;

            end;

         if (v[x]<>0) and (v[y]<>0) and (ok) then
            if v[x]>v[y] then
               begin

                  for i:=v[x] downto v[y]+1 do
                     begin
                        s[i]:=s[i-1];
                        v[s[i]]:=i;
                     end;

                  v[x]:=i-1;
                  s[v[x]]:=x;
               end;
      end;

   if nr<n then
   for i:=1 to n do
      if v[i]=0 then
         begin
            nr:=nr+1;
            v[i]:=nr;
            s[nr]:=i;
         end;

   for i:=1 to n do
      write(g,s[i],' ');

   close(f);
   close(g);
end.