Program ural1022;
Const
  maxn=110;
Var
  list,num:array[0..maxn] of longint;
  map:array[0..maxn,0..maxn] of byte;
  i,m,n,ptr,j,c:longint;




Procedure Pre;
Begin
  fillchar(num,sizeof(num),0);
  for i:=1 to n do
    for j:=1 to n do
      if map[j,i]=1 then inc(num[ i ]);
  ptr:=0;
  for i:=1 to n do
    if num[ i ]=0 then
      begin
        inc(ptr);
        list[ptr]:=i
      end
End;



Procedure work;
Begin
  pre;
  while ptr<n do
    begin
      m:=list[ptr];
      for i:=1 to n do
        if map[m,i]=1 then
          begin
            dec(num[ i ]);
            if num[ i ]=0 then
              begin
                inc(ptr);
                list[ptr]:=i
              end
           end
    end
End;



Procedure out;
Begin
  for i:=1 to ptr do
    if i<>ptr then write(list[ i ],' ') else writeln(list[ i ])
End;



Begin
{  assign(input,'input.txt');
  reset(input);}
  readln(n);
  fillchar(map,sizeof(map),0);
  for i:=1 to n do
    begin
      read(c);
      while c<>0 do
        begin
          map[i,c]:=1;
          read(c)
        end;
      readln
    end;
  work;
  out
End.

Hint: Use topological sort.

My prog used topological sort,but I also got TLE.

If you give me your E-mail i will send you some tests.

Edited by author 29.10.2004 20:03

I find error in your algorithm.
Topological sort in your code is wrong:

m:=list[ptr];
for i:=1 to n do
if map[m,i]=1 then
begin
dec(num[ i ]);
if num[ i ]=0 then
begin
inc(ptr);
list[ptr]:=i
end
end

You must check not only last (m) but every vertex in your list.
For example, on this test your program get TLE:
3
3 0
0
0

Answer: 1 2 3
Good luck :)

Thank you.
I've got AC