Cod sursa(job #288104)

Utilizator punkistBarbulescu Dan punkist Data 25 martie 2009 15:59:54
Problema Sortare topologica Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.78 kb
type Lista=^Element;
     Element=record
              nr:longint;
              leg:Lista;
             end;

var n,m,s,k:longint;
    vecini:array[1..100000] of record
                                first,last:Lista;
                               end;
    solutie:record
                             first,last:Lista;
                            end;
    viz:array[1..50000] of boolean;

procedure Citeste;
var f:text;
    i:longint;
    l,test:Lista;
    a,b:longint;
 begin
  assign(f,'sortaret.in');
  reset(f);
  readln(f,n,m);
  for i:=1 to n do
   begin
    New(l);
    l^.nr:=0;
    l^.leg:=nil;
    vecini[i].first:=l;
    vecini[i].last:=l;
   end;
  New(l);
  l^.nr:=0;
  l^.leg:=nil;
  solutie.first:=l;
  solutie.last:=l;
  for i:=1 to n do viz[i]:=false;
  for i:=1 to m do
   begin
    readln(f,a,b);
    New(l);
    l^.nr:=b;
    l^.leg:=nil;
    vecini[a].last^.leg:=l;
    vecini[a].last:=l;
   end;
  close(f);
 end;

procedure Parcurge(x,gr:longint);
 var l:Lista;
     vecin:longint;
 begin
    viz[x]:=true;
    New(l);
    l^.nr:=x;
    l^.leg:=nil;
    solutie.last^.leg:=l;
    solutie.last:=l;
    l:=vecini[x].first;
    repeat
     begin
      vecin:=l^.nr;
      if vecin<>0 then
        if not viz[vecin] then
         begin
          viz[vecin]:=true;
          Parcurge(vecin,gr+1);
         end;
      l:=l^.leg;
     end;
    until l=nil;
  end;


procedure Scrie;
var f:text;
    i,nod:longint;
    l:Lista;
begin
 assign(f,'sortaret.out');
 rewrite(f);
 l:=solutie.first;
 repeat
  begin
   nod:=l^.nr;
   if nod<>0 then write(f,nod,' ');
   l:=l^.leg;
  end;
 until l=nil;
 close(f);
end;

begin
Citeste;
for k:=1 to n do
 begin
  if not viz[k] then Parcurge(k,1);
 end;
Scrie;
end.