Справочник функций

Ваш аккаунт

Войти через: 
Забыли пароль?
Регистрация
Информацию о новых материалах можно получать и без регистрации:

Почтовая рассылка

Подписчиков: -1
Последний выпуск: 19.06.2015

Построить тернарное дерево С (Pascal)

32K
20 декабря 2007 года
Aнютa
7 / / 20.12.2007
Помогите пожалуйста изменить программу, т.к. даже с пояснениями мне не удается ее выполнить(((

Каждый студент имеет следующие параметры:
1. Номер по списку
2. ФИО
3. Возраст
4. Рост
5. Вес
6. Набор из пяти оценок за экзамены и средний балл
7. Количество друзей
8. Сумма на банковском счете
9. Знак Зодиака
10. Дата рождения

С. Построить тернарное дерево, в котором элементы с одинаковыми значениями ключа располагаются в виде стека, прикрепленного к узлу дерева.

Вот исходный код с ключем С=3 (Возраст) (а мне нужно С=6, т.е. набор из пяти оценок за экзамены и средний балл)

Код:
Uses Crt;
Type TInf=Record
        Num: Integer;
        FIO: String;
        Age: Integer;
        Stature,Weight: Integer;
        O1,O2,O3,O4,O5,OAverage: Integer;
        Friend: Integer;
        Gold: Integer;
        Zodiac: String;
        Birth: String;
     end;
     TTree=^Tree;
     Tree=Record
        Inf:TInf;
        Left,Center,Right: TTree;
     end;

{-------------------------------------------------------------------------}
Procedure Tab(n: Integer); Begin GoToXY(n,WhereY); End; {Процедура установки курсора
                                                         в позицию n текущей строки}
{-------------------------------------------------------------------------}
Procedure ShowHeader;{Отображение заголовка к данным}
Begin
   Write('№  ФИО            Возраст   Рост Вес   Друзья   Деньги   Зодиак   Родился');
   WriteLn;                        {Переводим строку, подготавливаемся к выводу данных...}
End;
Procedure Show(I: TInf);{Отображение данных записи}
Begin
   Write(I.Num);  {Аналогично выводу заголовков только выводим данные из записи T}
   Tab(5);Write(I.FIO);
   Tab(20);Write(I.Age);
   Tab(30);Write(I.Stature);
   Tab(35);Write(I.Weight);
   Tab(40);Write(I.Friend);
   Tab(50);Write(I.Gold);
   Tab(60);Write(I.Zodiac);
   Tab(70);Write(I.Birth);
   WriteLn; {Перевод строки}
End;

Procedure Input(Var I: TInf);{Заполнение записи путём ввода данных с клавиатуры}
Begin
   Write(' 1. номер по списку    : ');ReadLn(I.Num);
   Write(' 2. ФИО                : ');ReadLn(I.FIO);
   Write(' 3. Возраст            : ');ReadLn(I.Age);
   Write(' 4. Рост               : ');ReadLn(I.Stature);
   Write(' 5. Вес                : ');ReadLn(I.Weight);
   Write(' 6. 1-й экзамен оценка : ');ReadLn(I.O1);
   Write('    2-й экзамен оценка : ');ReadLn(I.O2);
   Write('    3-й экзамен оценка : ');ReadLn(I.O3);
   Write('    4-й экзамен оценка : ');ReadLn(I.O4);
   Write('    5-й экзамен оценка : ');ReadLn(I.O5);
   Write('           Средний бал : ');ReadLn(I.OAverage);
   Write(' 7. Количество друзей      : ');ReadLn(I.Friend);
   Write(' 8. Сумма на банковском счете : ');ReadLn(I.Gold);
   Write(' 9. Знак Зодиака              : ');ReadLn(I.Zodiac);
   Write('10. Дата рождения             : ');ReadLn(I.Birth);
End;

{-------------------------------------------------------------------------}

Function NewSheet(X:TInf): TTree; {размещение в куче нового элемента}
Var T: TTree;
Begin New (T); T^.Inf:=X; T^.Left:=Nil;T^.Center:=Nil;T^.Right:=Nil; NewSheet:=T; End;

Procedure AddSheet(Var R: TTree; N: TInf);{размещение нового элемента (листа) в структуре}
Var T: TTree;
Begin
   If R<>Nil then begin
      If N.Age<R^.Inf.Age then
         If R^.Left=Nil then R^.Left:=NewSheet(N) else AddSheet(R^.Left,N);
      If N.Age=R^.Inf.Age then begin {Смысл следующих телодвижений, чтобы удовлетворить условия задания}
         T:=R^.Center;               {Вставку производим как в стэк, хотя смысла в этом нет никакого,}
         R^.Center:=NewSheet(N);     {так как элементы одинаковые... (но ТЗ есть ТЗ...) ;)}
         R^.Center^.Center:=T;       {Обычно же все элементы вставляются как в очередь...}
      end; {}
      If N.Age>R^.Inf.Age then
         If R^.Right=Nil then R^.Right:=NewSheet(N) else AddSheet(R^.Right,N);
   end else begin {дерево не создано, создаем его}
      R:=NewSheet(N);
   end;
End;

Procedure ShowTree(R: TTree); {Вывод дерева на экран}
Begin
   If R<>Nil then begin {Если ветвь не пуста}
      If R^.Left <> nil then ShowTree(R^.Left); {если слева имеется сук, выводим и его}
      If R^.Center <> nil then ShowTree(R^.Center); {выводим серединку...}
      Show(R^.Inf);     {выводим информацию}
      If R^.Right <> nil then ShowTree(R^.Right);{тоже самое справа...}
   end;
End;

Procedure Done(R: TTree); {Освобождает в памяти место, занятое деревом R}
begin
   If R<> nil then begin
      If R^.Left <> nil then Done(R^.Left);
      If R^.Center <> nil then Done(R^.Center);
      If R^.Right <> nil then Done(R^.Right);
      Dispose(R);
   End;
End;

Procedure Print(T: TTree; g: integer); {Печать дерева. G-глубина (по лекции)}
Const k=10;
Begin
   If T=nil then Writeln ('Дерево пустое') else begin
      g:=g+1;
      If T^.Right <> nil then Print (T^.Right, g);
      Tab(k*g); Write(T^.Inf.Age,' ', T^.Inf.FIO);
      If T^.Center = nil then WriteLn;
      If T^.Center <> nil then Print(T^.Center,g);
      If T^.Left <> nil then Print (T^.Left,g);
      g:=g-1;
   End;
End;

{-------------------------------------------------------------------------}

 Var Root,W: TTree; I: TInf; n: Integer; {Определяем необходимые переменные}
BEGIN ClrScr; {Основная программа}
 Root:=Nil; {Начальные условия - пустое дерево}
 For n:=1 to 12 do begin {В цикле вводим записи (5 штук)}
   WriteLn('-===[запись: ',n,']=====---');
    Input(I);
    AddSheet(Root,I);{Добовляем данные}
 end;
 WriteLn;
 WriteLn('Введённые данные: ');
 ShowHeader;ShowTree(Root); WriteLn;
 ReadLn;

 WriteLn('Отображение в виде дерева:');
 Print(Root,0);
 ReadLn;

 Done(Root);
END.


Заранее большое спасибо!!!
Реклама на сайте | Обмен ссылками | Ссылки | Экспорт (RSS) | Контакты
Добавить статью | Добавить исходник | Добавить хостинг-провайдера | Добавить сайт в каталог