Why I am not right
Posted by
vlad 7 Apr 2005 23:46
{$APPTYPE CONSOLE}
var
n,i,j,p:integer;
c:array[1..2,1..100] of integer;
a:array[1..100,0..100] of integer;
procedure sort(l,r: integer);
var
i,j,x,y: integer;
begin
i:=l; j:=r; x:=c[1,(l+r) DIV 2];
repeat
while X<c[1,i] do i:=i+1;
while x>c[1,j] do j:=j-1;
if i<=j then
begin
y:=c[1,i]; c[1,i]:=c[1,j]; c[1,j]:=y;
y:=c[2,i]; c[2,i]:=c[2,j]; c[2,j]:=y;
i:=i+1; j:=j-1;
end;
until i>j;
if l<j then sort(l,j);
if i<r then sort(i,r);
end;
function count(nom:integer):integer;
var i:integer;
var kol:integer;
begin
if c[1,nom]<> 0 then count:=c[1,nom] else
begin
kol:=0;
inc(kol);
for i:=1 to a[nom,0] do inc(kol,count(a[nom,i]));
c[1,nom]:=kol;
count:=kol;
end;
end;
begin
assign(Input,'input.txt'); assign(Output,'output.txt');
{ reset(Input); rewrite(Output);}
readln(n);
for i:=1 to n do
begin
j:=0;
while not eoln do
begin
inc(j);
read(a[i,j]);
end;
a[i,0]:=j-1;
readln;
end;
for i:=1 to n do
begin
c[1,i]:=count(i);
c[2,i]:=i;
end;
sort(1,n);
for i:=1 to n do write(c[2,i],' ');
writeln;
{close(Input); close(Output);}
end.