ENG  RUSTimus Online Judge
Online Judge
Задачи
Авторы
Соревнования
О системе
Часто задаваемые вопросы
Новости сайта
Форум
Ссылки
Архив задач
Отправить на проверку
Состояние проверки
Руководство
Регистрация
Исправить данные
Рейтинг авторов
Текущее соревнование
Расписание
Прошедшие соревнования
Правила
вернуться в форум

Обсуждение задачи 1022. Генеалогическое дерево

Why I am not right
Послано vlad 7 апр 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.
write your email and I shall send corrected your code +++++++
Послано Виктор Крупко 8 апр 2005 00:14
ACM
Послано vlad 9 апр 2005 19:04
E-mail:tiger88@mail.ru