IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> Бинарное дерево-уход в бесконечный циклр, Stack overflow error
сообщение
Сообщение #1





Группа: Пользователи
Сообщений: 2
Пол: Мужской

Репутация: -  0  +


Англо-русский словарь построен как бинарный список (двоичное
дерево).
Каждая компонента содержит английское слово, соответствующее
ему русское слово и счетчик количества обращений к данной компонен-
те.
Первоначально бинарный список был сформирован согласно английс-
кому алфавиту. В процессе эксплуатации словаря при каждом обращении
к компоненте в счетчик обращений добавлялась единица.

Составить программу, которая:
-обеспечивает начальный ввод словаря с конкретными значениями
счетчиков обращений;
-формирует новое представление словаря в виде двоичного дерева
по следующему алгоритму:
а) в старом словаре ищется компонента с наибольшим значением
счетчика обращений;
б) найденная компонента заносится в новый словарь и удаляется
из старого;
в) переход к п. а) до исчерпания исходного словаря.

-производит распечатку исходного и нового словарей.

Указание: использовать динамические структуры.


КОД ПРОГРАММЫ:


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 сам ошибку найти не смог, а прогу позарез к утру сделать нуна.

Очччень нуна помощщщьь

Тегами пользуйся, без них программа нечитаема абсолютно

Сообщение отредактировано: volvo -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов(1 - 3)
сообщение
Сообщение #2


Гость






У тебя в программе 2 проблемы:
1) не совсем корректно находится указатель на элемент, содержащий заданное тобой значение (функция findmax)... Я бы ее переписал вот так:
function findmax(p:pnode; max:word) : pnode;
begin
if p=nil then findmax:=nil
else
if p^.data.num = max then findmax := p
else
if max < p^.data.num then findmax := findmax(p^.left, max)
else findmax := findmax(p^.right, max);
end;

2) более серьезная проблема: на определенном этапе у тебя происходит попытка разыменования nil-а, но ты этого не замечаешь. Смотри:
Цитата
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); { <--- допустим, ты уже выбрал все из словаря, p = nil }
p2:=findmax(p,m); { <--- Тогда и здесь будет p2 = nil }
writeln(p2^.data.eng); { <--- Стоп!!! }
insert(pnew,p2^.data);
del(p,p2^.data.eng);
move(p,pnew);
end;
end;

Тебе ж все равно надо работать до исчерпания исходного словаря? Тогда каким боком там рекурсия: Удаляй по одному элементу из дерева, пока его корень не станет нулевым:
procedure move(p,pnew:pnode);
var m:word;
p2:pnode;
begin
repeat
m:=max(p);
p2:=findmax(p,m);
if p <> nil then begin
writeln(p2^.data.eng);
insert(pnew,p2^.data);
del(p,p2^.data.eng);
end;
until p = nil;
end;

Это все при условии, что удаление/добавление работают правильно, я не проверял их реализацию... Но теперь ты знаешь, в чем проблема и справишься (надеюсь) дальше самостоятельно...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3





Группа: Пользователи
Сообщений: 2
Пол: Мужской

Репутация: -  0  +


спс пошел мучать её дальше.

Добавлено через 6 мин.
Так насчет findmax() не согласен, если учитывать, что дерево создается по data.eng следовательно поиск по data.num может быть ток перебором элементов до первого совпадения

Добавлено через 13 мин.
Не могли бы вы проверить функцию find().
похоже из-за неё возникает зацикливание.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Гость






Возможно, я уже опоздал, но вот что получилось (переписаны все твои функции/процедуры; объяснение, почему удаление элемента желается именно так приведено здесь , там же можешь найти и другую полезную информацию о работе с деревьями):

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
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;

procedure insert(var root: pnode; R: rec);

procedure create_node(var p: pnode);
begin
New(p);
p^.data := R;
p^.Left := nil;
p^.Right := nil
end;

begin
if root = nil then create_node(root)
else
with root^ do begin
if data.eng < R.eng then insert(right, R)
else
if data.eng > R.eng then insert(left, R)
else writeln('takoi element uzhe est"');
end;
end;

procedure remove(var root: pnode; value: integer);

procedure DeleteMin(var Root: pnode; var T: rec);
var WasRoot: pnode;
begin
if Root^.Left = nil then begin
T := Root^.data;
WasRoot := Root;
Root := Root^.Right;
Dispose(WasRoot);
end
else DeleteMin(Root^.Left, T);
end;

var
WasNext: pnode;
R: rec;

begin
if Root <> nil then
if Root^.data.num <> value then begin
Remove(Root^.Left, value); Remove(Root^.right, value);
end
else
if (Root^.Left = nil) and (Root^.Right = nil) then begin
Dispose(Root); Root := nil
end
else
if Root^.Left = nil then begin
WasNext := Root^.Right;
Dispose(Root);
Root := WasNext;
end
else
if Root^.Right = nil then begin
WasNext := Root^.Left;
Dispose(Root);
Root := WasNext;
end
else begin
DeleteMin(Root^.Right, R);
Root^.data := R
end;
end;


function max_value(r: pnode): pnode;
var
found: pnode;

procedure find_max(r: pnode);
begin
if r = nil then exit
else begin
if found^.data.num < r^.data.num then found := r;
find_max(r^.left); find_max(r^.right);
end;
end;

begin
if r = nil then max_value := nil
else begin
found := r;
find_max®;
max_value := found;
end;
end;


procedure move(p,pnew:pnode);
var p_max: pnode;
begin
repeat
p_max := max_value(p);
if p_max <> nil then begin
writeln(p_max^.data.eng);
insert(pnew, p_max^.data);
remove(p, p_max^.data.num);
end;
until p = nil;
end;

var
root, rootnew: pnode;
rec1: rec;

begin
root:=nil; rootnew:=nil;

Assign(F, '15_10_in.txt');
reset(F);
while not eof(F) 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.
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 28.03.2024 17:08
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name