дерево).
Каждая компонента содержит английское слово, соответствующее
ему русское слово и счетчик количества обращений к данной компонен-
те.
Первоначально бинарный список был сформирован согласно английс-
кому алфавиту. В процессе эксплуатации словаря при каждом обращении
к компоненте в счетчик обращений добавлялась единица.
Составить программу, которая:
-обеспечивает начальный ввод словаря с конкретными значениями
счетчиков обращений;
-формирует новое представление словаря в виде двоичного дерева
по следующему алгоритму:
а) в старом словаре ищется компонента с наибольшим значением
счетчика обращений;
б) найденная компонента заносится в новый словарь и удаляется
из старого;
в) переход к п. а) до исчерпания исходного словаря.
-производит распечатку исходного и нового словарей.
Указание: использовать динамические структуры.
КОД ПРОГРАММЫ:
program dynamic;
uses crt;
type rec = record
num : word;
eng : string;
rus : string;
end;
pnode = ^node;
node = record
data : rec;
left : pnode;
right: pnode;
end;
var root,rootnew :pnode;
key :string;
option,temp:word;
rec1:rec;
F,Fresult:text;
procedure print_tree(p:pnode);
begin
if p=nil then exit;
with p^ do begin
print_tree(right);
write(data.eng,' ', data.rus,' ', data.num);
writeln;
write(Fresult, data.eng,' ', data.rus,' ', data.num);
writeln(Fresult);
print_tree(left);
end
end;
function find(root:pnode; key:string; var p,parent:pnode): boolean;
begin
p:=root;
while p<>nil do begin
if key=p^.data.eng then
begin find:=true; exit end;
parent:=p;
if key< p^.data.eng
then p:=p^.left
else p:=p^.right;
end;
find:=false;
end;
procedure insert(var root : pnode; rec1:rec);
var p1,parent : pnode;
begin
if find(root, rec1.eng, p1,parent) then begin
writeln('takoi element uzhe est'); exit; end;
new(p1);
p1^.data :=rec1;
p1^.left :=nil;
p1^.right:=nil;
if root = nil then root :=p1
else
if rec1.eng < parent^.data.eng
then parent^.left :=p1
else parent^.right :=p1;
end;
procedure del(var root:pnode;key:string);
var p :pnode;
parent :pnode;
y :pnode;
function descent(p:pnode):pnode;
var y:pnode;
prev:pnode;
begin
y:=p^.right;
if y^.left = nil then y^.left:=p^.left
else begin
repeat
prev:=y;y:=y^.left;
until y^.left =nil;
y^.left:=p^.left;
prev^.left:=y^.right;
y^.right:=p^.right;
end;
descent:=y;
end;
begin
if not find(root, key,p,parent) then begin
writeln('takogo el-ta net'); exit; end;
if p^.left = nil then y:=p^.right
else if p^.right = nil then y:=p^.left
else y:=descent(p);
if p=root then root:=y
else
if key < parent^.data.eng
then parent^.left:=y
else parent^.right:=y;;
dispose(p);
end;
{-------------------------------------}
function max(p:pnode) : word;
var m:word;
begin
if p=nil then begin max:=0; exit end;
if ( max(p^.left) <= max(p^.right)) then
m:=max(p^.right)
else m:=max(p^.left);
if p^.data.num>m then max:=p^.data.num
else max:=m;
end;
{-------------------------------------}
function findmax(p:pnode;max:word) : pnode;
begin
if p=nil then exit;
with p^ do begin
if findmax(left,max) <> nil then
begin findmax:=findmax(left,max); exit end
else if findmax(right,max) <>nil then
begin findmax:=findmax(right,max); exit end
else if data.num=max then
begin findmax:=p; exit end
else findmax:= nil;
end;
end;
{-------------------------------------}
procedure move(p,pnew:pnode);
var m:word;
p2:pnode;
i:integer;
begin
if p=nil then exit;
for i:=1 to 3 do
begin
m:=max(p);
p2:=findmax(p,m);
writeln(p2^.data.eng);
insert(pnew,p2^.data);
del(p,p2^.data.eng);
move(p,pnew);
end;
end;
begin
root:=nil;
rootnew:=nil;
Assign(F, '15_10_in.txt');
reset(F);
while eof(F)=false do begin
with rec1 do begin
readln(F, num);
readln(F, eng);
readln(F, rus);
end;
insert(root, rec1)
end;
close(F);
assign(Fresult, '15_10_out.txt');
rewrite(Fresult);
print_tree(root);
move(root,rootnew);
close(Fresult)
end.
при попытке компиляции выдает Stack overflow error сам ошибку найти не смог, а прогу позарез к утру сделать нуна.
Очччень нуна помощщщьь
Тегами пользуйся, без них программа нечитаема абсолютно