Ведомость студентов

const
  maxCount = 100; 
 
type
  TSurname = string[30]; 
  mas = array[0..maxCount] of TSurname; 
var
  a: mas; }
 
procedure sort(var a: mas; count: integer);
 
 
procedure DownHeap(index, Count: integer; Current: TSurname);
  { Функция пробегает по пирамиде восстанавливая ее
    Также используется для изначального создания пирамиды
    Использование: Передать номер следующего элемента в index
    Процедура пробежит по всем потомкам и найдет нужное место для следующего элемента}
  var
    Child: Integer;
  begin
    {Начиная от индекса index ищем место для вставки нового элемента}
    while index < Count div 2 do begin
      {Берем первый индекс потомка от узла с индексом в массиве index}
      Child := (index+1)*2-1;
      {Берем индекс наибольшего из потомков для index}
      if (Child < Count-1) and (a[Child] < a[Child+1]) then
        Child:=Child+1;
      {Если элемент для вставки больше двух потомков для узла с номером в массиве index,
        то выходим и вставляем его на это место}
      if Current >= a[Child] then
        break;
      {Ставим на место index максимального из потомков}
      a[index] := a[Child];
      {Далее пытаемся вставлять в индекс index}
      index := Child;
    end;
    {Здесь мы оказываемся если Current >= a[index*2+1] и Current >= a[index*2+2]
      либо index >= Count div 2 что означает что на данном месте в массиве находится лист дерева}
    a[index] := Current;
  end;
 
 
{Основная функция}
var
  i: integer;
  Current: TSurname;
begin
  {Собираем пирамиду}
  { Начиная от предков листов вставляем элементы в дерево тем самым получаем
    сначала сортирующие деревья состоящие из корня и не одного или двух потомков
    далее сортирующие деревья высоты 3 и т.д. и при вставке последнего элемента
    a[0] получаем сортирующее дерево}
  for i := (Count div 2)-1 downto 0 do
    DownHeap(i, Count, a[i]);
  {Пирамида собрана. Теперь сортируем}
  for i := Count-1 downto 0 do
  begin
    { перемещаем верхушку в начало отсортированного списка
      т.к. в корне дерева находится максимальный элемент }
    Current := a[i];
    a[i] := a[0];
    { вставляем элемент с a[i] в дерево получая сортирующее дерево
      с общим числом узлов i штук}
    DownHeap(0, i, Current);
  end;
end;
 
{ Создание рассписания для группы с именем s }
procedure CreateTimetable(s: string);
var
  count: integer; 
  i: integer;
  sub: string; 
  s2: string; 
begin
  writeln;writeln;writeln;
  writeln('Zapolnenie rasspisania dlia gruppi ', s);
  write('Vvedite nazvanie predmeta: ');
  readln(sub);
  write('Vvedite tip otchetnosti (examen, zachet): ');
  readln(s2);
  while (s2 <> 'examen') and (s2 <> 'zachet') do
  begin
    writeln('Vvedeno ne dopustimoe znachenie');
    write('Vvedite tip otchetnosti (examen, zachet): ');
    readln(s2);
  end;
  write('Vvedite kolichestvo chelovek v gruppe: ');
  readln(count);
  while count <= 0 do
  begin
    writeln('Kolichestvo chelovek v gruppe dolzno bit > 0'); 
    write('Vvedite kolichestvo chelovek v gruppe: ');
    readln(count);
  end;
    for i := 0 to count - 1 do
  begin
    writeln;
    write('Vvedite familiu studenta nomer ', i+1, ': ');
    readln(a[i]);
  end;
  {Сортировка массива файмилий}
  sort(a, count);
  writeln;writeln;writeln;
  writeln('Gruppa ', s);
  writeln('Predmet: ', sub);
  writeln('Otchetnost: ', s2);
  writeln('Spisok studentov gruppi: ', s);
  writeln;
 
  for i := 0 to count - 1 do
    writeln(a[i]); 
end;
 
 
begin
  CreateTimetable('1 kurs - ZhurFak 1 -5-09');
  CreateTimetable('2 kurs - ZhurFak 2 -5-08');
  CreateTimetable('3 kurs - ZhurFak 3 -5-07');
  readln;
end.