Автор: striker 10.06.2007 23:21
Был алгоритм построения дерева и всех с ним связанных процедур (поиск, удаление ...)
Мне нужно его переделать под тип записей и мой список.
Я начал, немного переделал, а дальше трудности.
Исходный алгоритм:
Код
type
T = Integer;
TTree = ^TNode;
TNode = record
value: T;
Left, Right: TTree;
end;
var
i: Integer;
procedure PrintDown(Root: TTree);
begin
if Root = nil then exit;
with Root^ do begin
Writeln(value, '':2);
PrintDown(Left);
PrintDown(Right)
end
end;
procedure Insert(var Root,T: TTree; X: T);
procedure CreateNode(var p,T: TTree; n: T);
begin
New(p);
p^.value := n;
p^.Left := nil;
p^.Right := nil
end;
begin
if Root = nil Then CreateNode(Root, X)
else
with Root^ do begin
if value < X then Insert(Right, X)
else
if value > X Then Insert(Left, X)
else
end;
end;
function GetNode(Root: TTree): T;
begin
if Root = nil then WriteLn('„ҐаҐў® Їгбв®!')
else
GetNode:=Root^.value
end;
function Find(Root: TTree; X: T): TTree;
begin
if Root = nil then Find := nil
else
if X = Root^.value then Find := Root
else
if X < Root^.value then Find := Find(Root^.Left, X)
else Find := Find(Root^.Right, X);
end;
function DeleteMin(var Root: TTree): T;
begin
if Root^.Left = nil then begin
DeleteMin := Root^.value;
Root := Root^.Right;
end
else
DeleteMin := DeleteMin(Root^.Left);
end;
procedure Remove(var Root: TTree; X: T);
begin
if Root <> nil then
if X < Root^.value then Remove(Root^.Left, X)
else
if X > Root^.value then Remove(Root^.Right, X)
else
if (Root^.Left = nil) and (Root^.Right = nil) then
Root := nil
else
if Root^.Left = nil then Root := Root^.Right
else
if Root^.Right = nil then Root := Root^.Left
else
Root^.value := DeleteMin(Root^.Right);
Procedure Delete(T: TTree);
Begin
If T = nil Then Exit;
Delete(T^.Right);
Delete(T^.Left);
Dispose(T)
end;
И мой полупеределанный :Код
program tree;
type
TTree = ^TNode;
t=record
n:integer;
c,d,fam:string[25];
end;
TNode = record
value: T;
Left, Right: TTree;
end;
var
i: Integer;
first: TTree;
F:file of t;
procedure PrintDown(Root: TTree);
var p:TTree;
begin
if Root = nil then exit;
with Root^ do begin
Writeln(p^.value.fam);
PrintDown(Left);
PrintDown(Right)
end
end;
procedure Insert(var Root: TTree; X: T);
procedure CreateNode(var p: TTree; n: T);
begin
New(p);
p^.value := n;
p^.Left := nil;
p^.Right := nil
end;
begin
if Root = nil Then CreateNode(Root, X)
else
with Root^ do begin
if value <= X then Insert(Right, X)
else
if value > X Then Insert(Left, X)
else
{ „Ґ©бвўЁп, Їа®Ё§ў®¤Ё¬лҐ ў б«гз Ґ Ї®ўв®а®Ј®
ўҐбҐЁп §«-в®ў ў ¤ҐаҐў®}
end;
end;
function GetNode(Root: TTree): T;
begin
if Root = nil then WriteLn('„ҐаҐў® Їгбв®!')
else
GetNode:=Root^.value
end;
function Find(Root: TTree; X: T): TTree;
begin
if Root = nil then Find := nil
else
if X = Root^.value then Find := Root
else
if X < Root^.value then Find := Find(Root^.Left, X)
else Find := Find(Root^.Right, X);
end;
function DeleteMin(var Root: TTree): T;
begin
if Root^.Left = nil then begin
DeleteMin := Root^.value;
Root := Root^.Right;
end
else {㧥« Root Ё¬ҐҐв «Ґўл© Ї®¤§«-в}
DeleteMin := DeleteMin(Root^.Left);
end;
procedure Remove(var Root: TTree; X: T);
begin
if Root <> nil then
if X < Root^.value then Remove(Root^.Left, X)
else
if X > Root^.value then Remove(Root^.Right, X)
else
if (Root^.Left = nil) and (Root^.Right = nil) then
{ЌҐв Ї®¤н«-в®ў, г¤ «пҐвбп 㧥«, Є®в®ал© гЄ §лў Ґв Root }
Root := nil
else
if Root^.Left = nil then Root := Root^.Right
else
if Root^.Right = nil then Root := Root^.Left
else {г г¤ «пҐ¬®Ј® н«-в Ґбвм ®Ў Ї®¤н«-в }
Root^.value := DeleteMin(Root^.Right); end;
Procedure Delete(T: TTree);
begin
If T = nil Then Exit;
Delete(T^.Right);
Delete(T^.Left);
Dispose(T)
end;
procedure Trees;
var
i:integer;
begin
Assign(F,'data');
Reset(F);
for i:=0 to FileSize(F)-1 do begin
Read(F,tek1^.dat.fam);
CreateNode(First);
end;
PrintDown;
ReadLn;
end;
Как переделать процедуру Printdown(если нужно) и GetNode
В файле мой список
Прикрепленные файлы
SPISOK.TXT ( 3.74 килобайт )
Кол-во скачиваний: 256