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,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 SignKey(A,B: TInf): Boolean;
Begin SignKey:=False;
If A.Num<B.Num then SignKey:=True;
End;
Function FindKey(A,B: TInf): Boolean;
Begin FindKey:=False;
If A.Num=B.Num then FindKey:=True;
End;
Function NewSheet(X:TInf): TTree; {размещение в куче нового элемента}
Var T: TTree;
Begin New (T); T^.Inf:=X; T^.Right:=Nil; T^.Left:=Nil; NewSheet:=T; End;
Procedure AddSheet(Var R: TTree; N: TInf);{размещение нового элемента (листа) в структуре}
Begin
If R<>Nil then begin
If SignKey(R^.Inf,N) then begin
If R^.Left=Nil then R^.Left:=NewSheet(N) else AddSheet(R^.Left,N);
end else begin
If R^.Right=Nil then R^.Right:=NewSheet(N) else AddSheet(R^.Right,N);
end;
end else begin {дерево не создано, создаем его}
R:=NewSheet(N);
end;
End;
Procedure AddTree(Var R: TTree; N: TTree);{размещение нового в структуре}
Begin
If R<>Nil then begin
If N<>Nil then begin
If SignKey(R^.Inf,N^.Inf) then begin
If R^.Left=Nil then R^.Left:=N else AddTree(R^.Left,N);
end else begin
If R^.Right=Nil then R^.Right:=N else AddTree(R^.Right,N);
end;
end;
end else begin {дерево не создано, пытаемся создать его}
R:=N;
end;
End;
Function Find(R: TTree; F: TInf): TTree;{Поиск элемента}
Var t: Ttree;
Begin t:=Nil;
If R<>Nil then begin {Если дерево не пустое}
If FindKey(R^.Inf,F) then begin {Проверяем значение ключевого поля}
t:=R; {Если нашли нужный элемент, запоминаем его значение}
end else begin {если не нашли}
t:=Find(R^.Left,F); {пытаемся найти в других ветвях дерева (сначала слева)}
If t=Nil then t:=Find(R^.Right,F); {Потом справа, если слева ничего не нашли}
end;
end;
Find:=t; {Результат функции - значение временной переменной t}
End;
Procedure ShowTree(R: TTree); {Вывод дерева на экран}
Begin
If R<>Nil then begin {Если ветвь не пуста}
Show(R^.Inf); {выводим информацию}
If R^.Left <> nil then ShowTree(R^.Left); {если слева имеется сук, выводим и его}
If R^.Right <> nil then ShowTree(R^.Right);{тоже самое справа...}
end;
End;
Function DeleteNode(R: TTree;W: TTree):TTree;
Var t: TTree;
Begin t:=Nil;
If R<>Nil then begin {Если ветвь существует}
If W<> Nil then begin
If R^.Left = W then begin
R^.Left:=W^.Left;
t:=W^.Right;
Dispose(W);
end else begin
t:=DeleteNode(R^.Left,W);
end;
If t=Nil Then {Если ничего не нашли в левой ветви, ищем в правой}
If R^.Right = W then begin
R^.Right:=W^.Left;
t:=W^.Right;
Dispose(W);
end else begin
t:=DeleteNode(R^.Right,W);
end;
end;
end;
DeleteNode:=t;
End;
Procedure DeleteTree(Var R: TTree;W: TTree);
Begin
If R=W then begin
R:=W^.Left;
AddTree(R,W^.Right);
Dispose(W);
end else AddTree(R,DeleteNode(R,W));
End;
Procedure Done(R: TTree); {Освобождает в памяти место, занятое деревом R}
begin
If R<> nil then begin
If R^.Left <> nil then Done(R^.Left);
If R^.Right <> nil then Done (R^.Right);
Dispose(R);
End;
End;
Procedure Print(T: TTree; g: integer); {Печать дерева. G-глубина (по лекции)}
Const k=6;
Begin
If T=nil then Writeln ('Дерево пустое') else begin
g:=g+1;
If T^.Right <> nil then
Print (T^.Right, g)
else begin
{Tab(4*(g+1));Writeln('RNil');}
end;
Tab(k*g); Writeln (T^.Inf.Num,' ', T^.Inf.FIO);
If T^.Left <> nil then
Print (T^.Left,g)
else begin
{Tab(4*(g+1));Writeln('LNil');}
end;
g:=g-1;
End;
End;
{-------------------------------------------------------------------------}
Var Root,W: TTree; I: TInf; n: Integer; {Определяем необходимые переменные}
BEGIN ClrScr; {Основная программа}
Randomize;
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;
WriteLn('Введите данные для вставки: ');
Input(I);AddSheet(Root,I);{Добовляем данные}
WriteLn('Результат вставки нового элемента: ');
ShowHeader;ShowTree(Root); WriteLn;
ReadLn;
WriteLn('Отображение в виде дерева:');
Print(Root,0);
ReadLn;
While W=Nil do begin
Write('Введите значение ключа для поиска и удаления элемента: ');ReadLn(I.Num);
W:=Find(Root,I);
If W=Nil Then WriteLn('Элемент не найден. Повторите ввод.');
end;
WriteLn('Найден элемент:');
ShowHeader;Show(W^.Inf); WriteLn;
WriteLn('Удаляем найденный элемент!');
DeleteTree(Root,W);
WriteLn('Дерево после удаления найденного элемента: ');
ShowHeader;ShowTree(Root);
ReadLn;
WriteLn('Отображение в виде дерева:');
Print(Root,0);
ReadLn;
Done(Root);
END.
Построить бинарное дерево A (Pascal)
Каждый студент имеет следующие параметры:
1. Номер по списку
2. ФИО
3. Возраст
4. Рост
5. Вес
6. Набор из пяти оценок за экзамены и средний балл
7. Количество друзей
8. Сумма на банковском счете
9. Знак Зодиака
10. Дата рождения
А. Выбрать характеристику с заданным номером в качестве ключа и построить бинарное дерево из 12 элементов. Предусмотреть подпрограммы для поиска элемента по заданному значению ключа, вставку и удаление элемента.
Вот исходный код с ключем А=1 (Номер по списку) (а мне нужно А=4, т.е. рост)
Код:
Заранее большое спасибо!!!
Begin SignKey:=False;
If [COLOR="Red"]A.stature=B.stature[/COLOR] then SignKey:=True;
End;
Function FindKey(A,B: TInf): Boolean;
Begin FindKey:=False;
If [COLOR="Red"]A.stature=B.stature[/COLOR] then FindKey:=True;
End;
вродь так. остальное менять не нужно. спс за исходник, пригодилсо))
Спасибо за отзыв... НО, при вводе в разброс чисел, чтобы в записе числа совпадали. При удалении возникает проблемма!!! Удаляется не ключ, а вроде номер(((
Програма дает сбой при внесенных изменениях в поиске и удалении!!! Помогите пожалуйста разобраться.
Код:
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,Right: TTree;
end;
Procedure Tab(n: Integer); Begin GoToXY(n,WhereY); End;
Procedure ShowHeader;
Begin
Write('№ ФИО Возраст Рост Вес Друзья Деньги Зодиак Родился');
WriteLn;
End;
Procedure Show(I: TInf);
Begin
Write(I.Num);
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 SignKey(A,B: TInf): Boolean;
Begin SignKey:=False;
If A.Stature<B.Stature then SignKey:=True;
End;
Function FindKey(A,B: TInf): Boolean;
Begin FindKey:=False;
If A.Stature=B.Stature then FindKey:=True;
End;
Function NewSheet(X:TInf): TTree;
Var T: TTree;
Begin New (T); T^.Inf:=X; T^.Right:=Nil; T^.Left:=Nil; NewSheet:=T; End;
Procedure AddSheet(Var R: TTree; N: TInf);
Begin
If R<>Nil then begin
If SignKey(R^.Inf,N) then begin
If R^.Left=Nil then R^.Left:=NewSheet(N) else AddSheet(R^.Left,N);
end else begin
If R^.Right=Nil then R^.Right:=NewSheet(N) else AddSheet(R^.Right,N);
end;
end else begin
R:=NewSheet(N);
end;
End;
Procedure AddTree(Var R: TTree; N: TTree);
Begin
If R<>Nil then begin
If N<>Nil then begin
If SignKey(R^.Inf,N^.Inf) then begin
If R^.Left=Nil then R^.Left:=N else AddTree(R^.Left,N);
end else begin
If R^.Right=Nil then R^.Right:=N else AddTree(R^.Right,N);
end;
end;
end else begin
R:=N;
end;
End;
Function Find(R: TTree; F: TInf): TTree;
Var t: Ttree;
Begin t:=Nil;
If R<>Nil then begin
If FindKey(R^.Inf,F) then begin
t:=R;
end else begin
t:=Find(R^.Left,F);
If t=Nil then t:=Find(R^.Right,F);
end;
end;
Find:=t;
End;
Procedure ShowTree(R: TTree);
Begin
If R<>Nil then begin
Show(R^.Inf);
If R^.Left <> nil then ShowTree(R^.Left);
If R^.Right <> nil then ShowTree(R^.Right);
end;
End;
Function DeleteNode(R: TTree;W: TTree):TTree;
Var t: TTree;
Begin t:=Nil;
If R<>Nil then begin
If W<> Nil then begin
If R^.Left = W then begin
R^.Left:=W^.Left;
t:=W^.Right;
Dispose(W);
end else begin
t:=DeleteNode(R^.Left,W);
end;
If t=Nil Then
If R^.Right = W then begin
R^.Right:=W^.Left;
t:=W^.Right;
Dispose(W);
end else begin
t:=DeleteNode(R^.Right,W);
end;
end;
end;
DeleteNode:=t;
End;
Procedure DeleteTree(Var R: TTree;W: TTree);
Begin
If R=W then begin
R:=W^.Left;
AddTree(R,W^.Right);
Dispose(W);
end else AddTree(R,DeleteNode(R,W));
End;
Procedure Done(R: TTree);
begin
If R<> nil then begin
If R^.Left <> nil then Done(R^.Left);
If R^.Right <> nil then Done (R^.Right);
Dispose(R);
End;
End;
Procedure Print(T: TTree; g: integer);
Const k=6;
Begin
If T=nil then Writeln ('Дерево пустое') else begin
g:=g+1;
If T^.Right <> nil then Print (T^.Right, g);
Tab(k*g); Writeln (T^.Inf.Stature);
If T^.Left <> nil then Print (T^.Left,g);
g:=g-1;
End;
End;
Var Root,W: TTree; I: TInf; n: Integer;
BEGIN ClrScr;
Randomize;
Root:=Nil;
For n:=1 to 5 do begin
WriteLn('-===[запись: ',n,']=====---');
Input(I);
AddSheet(Root,I);
end;
WriteLn;
WriteLn('Введённые данные: ');
ShowHeader;ShowTree(Root); WriteLn;
ReadLn;
WriteLn('Отображение в виде дерева:');
Print(Root,0);
ReadLn;
WriteLn('Введите данные для вставки: ');
Input(I);AddSheet(Root,I);
WriteLn('Результат вставки нового элемента: ');
ShowHeader;ShowTree(Root); WriteLn;
ReadLn;
WriteLn('Отображение в виде дерева:');
Print(Root,0);
ReadLn;
While W=Nil do begin
Write('Введите значение ключа для поиска и удаления элемента: ');ReadLn(I.Num);
W:=Find(Root,I);
If W=Nil Then WriteLn('Элемент не найден. Повторите ввод.');
end;
WriteLn('Найден элемент:');
ShowHeader;Show(W^.Inf); WriteLn;
WriteLn('Удаляем найденный элемент!');
DeleteTree(Root,W);
WriteLn('Дерево после удаления найденного элемента: ');
ShowHeader;ShowTree(Root);
ReadLn;
WriteLn('Отображение в виде дерева:');
Print(Root,0);
ReadLn;
Done(Root);
END.
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,Right: TTree;
end;
Procedure Tab(n: Integer); Begin GoToXY(n,WhereY); End;
Procedure ShowHeader;
Begin
Write('№ ФИО Возраст Рост Вес Друзья Деньги Зодиак Родился');
WriteLn;
End;
Procedure Show(I: TInf);
Begin
Write(I.Num);
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 SignKey(A,B: TInf): Boolean;
Begin SignKey:=False;
If A.Stature<B.Stature then SignKey:=True;
End;
Function FindKey(A,B: TInf): Boolean;
Begin FindKey:=False;
If A.Stature=B.Stature then FindKey:=True;
End;
Function NewSheet(X:TInf): TTree;
Var T: TTree;
Begin New (T); T^.Inf:=X; T^.Right:=Nil; T^.Left:=Nil; NewSheet:=T; End;
Procedure AddSheet(Var R: TTree; N: TInf);
Begin
If R<>Nil then begin
If SignKey(R^.Inf,N) then begin
If R^.Left=Nil then R^.Left:=NewSheet(N) else AddSheet(R^.Left,N);
end else begin
If R^.Right=Nil then R^.Right:=NewSheet(N) else AddSheet(R^.Right,N);
end;
end else begin
R:=NewSheet(N);
end;
End;
Procedure AddTree(Var R: TTree; N: TTree);
Begin
If R<>Nil then begin
If N<>Nil then begin
If SignKey(R^.Inf,N^.Inf) then begin
If R^.Left=Nil then R^.Left:=N else AddTree(R^.Left,N);
end else begin
If R^.Right=Nil then R^.Right:=N else AddTree(R^.Right,N);
end;
end;
end else begin
R:=N;
end;
End;
Function Find(R: TTree; F: TInf): TTree;
Var t: Ttree;
Begin t:=Nil;
If R<>Nil then begin
If FindKey(R^.Inf,F) then begin
t:=R;
end else begin
t:=Find(R^.Left,F);
If t=Nil then t:=Find(R^.Right,F);
end;
end;
Find:=t;
End;
Procedure ShowTree(R: TTree);
Begin
If R<>Nil then begin
Show(R^.Inf);
If R^.Left <> nil then ShowTree(R^.Left);
If R^.Right <> nil then ShowTree(R^.Right);
end;
End;
Function DeleteNode(R: TTree;W: TTree):TTree;
Var t: TTree;
Begin t:=Nil;
If R<>Nil then begin
If W<> Nil then begin
If R^.Left = W then begin
R^.Left:=W^.Left;
t:=W^.Right;
Dispose(W);
end else begin
t:=DeleteNode(R^.Left,W);
end;
If t=Nil Then
If R^.Right = W then begin
R^.Right:=W^.Left;
t:=W^.Right;
Dispose(W);
end else begin
t:=DeleteNode(R^.Right,W);
end;
end;
end;
DeleteNode:=t;
End;
Procedure DeleteTree(Var R: TTree;W: TTree);
Begin
If R=W then begin
R:=W^.Left;
AddTree(R,W^.Right);
Dispose(W);
end else AddTree(R,DeleteNode(R,W));
End;
Procedure Done(R: TTree);
begin
If R<> nil then begin
If R^.Left <> nil then Done(R^.Left);
If R^.Right <> nil then Done (R^.Right);
Dispose(R);
End;
End;
Procedure Print(T: TTree; g: integer);
Const k=6;
Begin
If T=nil then Writeln ('Дерево пустое') else begin
g:=g+1;
If T^.Right <> nil then Print (T^.Right, g);
Tab(k*g); Writeln (T^.Inf.Stature);
If T^.Left <> nil then Print (T^.Left,g);
g:=g-1;
End;
End;
Var Root,W: TTree; I: TInf; n: Integer;
BEGIN ClrScr;
Randomize;
Root:=Nil;
For n:=1 to 5 do begin
WriteLn('-===[запись: ',n,']=====---');
Input(I);
AddSheet(Root,I);
end;
WriteLn;
WriteLn('Введённые данные: ');
ShowHeader;ShowTree(Root); WriteLn;
ReadLn;
WriteLn('Отображение в виде дерева:');
Print(Root,0);
ReadLn;
WriteLn('Введите данные для вставки: ');
Input(I);AddSheet(Root,I);
WriteLn('Результат вставки нового элемента: ');
ShowHeader;ShowTree(Root); WriteLn;
ReadLn;
WriteLn('Отображение в виде дерева:');
Print(Root,0);
ReadLn;
While W=Nil do begin
Write('Введите значение ключа для поиска и удаления элемента: ');ReadLn(I.Num);
W:=Find(Root,I);
If W=Nil Then WriteLn('Элемент не найден. Повторите ввод.');
end;
WriteLn('Найден элемент:');
ShowHeader;Show(W^.Inf); WriteLn;
WriteLn('Удаляем найденный элемент!');
DeleteTree(Root,W);
WriteLn('Дерево после удаления найденного элемента: ');
ShowHeader;ShowTree(Root);
ReadLn;
WriteLn('Отображение в виде дерева:');
Print(Root,0);
ReadLn;
Done(Root);
END.
При вводе следующих данных:
1-я запись
1. Номер по списку 3
2. ФИО 3
3. Возраст 3
4. Рост 3
5. Вес 3
6. 1-й экзамен оценка 3
2-й экзамен оценка 3
3-й экзамен оценка 3
4-й экзамен оценка 3
5-й экзамен оценка 3
Средний бал 3
7. Количество друзей 3
8. Сумма на банковском счете 3
9. Знак Зодиака 3
10. Дата рождения 3
Во второй одни 7, в третьей 1, в четвертой одни 9, в пятой одни 2
Данные при вставке: одни 5
Введите значение ключа для поиска и удаления элемента [COLOR="#ff0000"](ввожу 1, находит 5!!! и удаляет 5, в место 1-го!!!) [/COLOR]
Что нужно изменить, чтобы поиск и удаление работали правильно???
Заранее спасибо!
While W=Nil do begin
Write('Введите значение ключа для поиска и удаления элемента: ');
ReadLn(I.[COLOR="Red"]Stature[/COLOR]); // знач ключа не Num терь)
W:=Find(Root,I);
If W=Nil Then WriteLn('Элемент не найден. Повторите ввод.');
end;
должно быть норм, протестить сор не могу паскаля нету :)