Двоичные деревья в паскале Опции

[Palpalich]

помогите пожалуйста решить задачу на паскале:
Составить программу вычисления суммы всех ключей дерева.
я прогу написал, чтобы она формировала и выводило дерево, а посчитать ключи на могу...
прога:
program derevo;
uses crt;
Type inform = integer; {тип информационного поля}
ss = ^zveno;
zveno = record
key: integer;
inf: inform;
left, right: ss;
end;
Procedure vstavka(var p: ss; k: integer);

Begin
If p = nil then
Begin
New(p); p^.key:=k; p^.left:=nil; p^.right:=nil;
End
Else
If k < p^.key then vstavka(p^.left, k);
If k > p^.key then vstavka(p^.right, k);
End;
Procedure print(var p: ss; h: integer);
Var i: integer;
Begin
If p <> nil then

Begin
Print(p^.right, h + 4);
For i:=1 to h do write(' ');
Writeln(p^.key);
Print(p^.left, h + 4);
End


End;
Procedure ch( n, s: integer);
Var i: integer; p: ss; d:integer;
Begin
If p <> nil then begin
for i:=1 to n do
s:=p^.inf+s;
writeln(s);
end;end;
var t:ss;n,c,f,i,y:integer;
begin clrscr;
writeln('vvedite kolichestvo kluchey dereva');
readln(n);
writeln('vvedite kluchi dereva');
for i:=1 to n do
begin
read©;
vstavka(t,c);
end;
print(t,c);
ch(f,n);
readkey; end.
подскажите как подсчитать ключи....

[Монца]

Надо реализовать какой нить обход дерева.

[Palpalich]

дак я и не знаю как это организовать...

[Tervyn]

Ты уже сделал обход дерева при выводе ключей Подсчет суммы ведется аналогично. Например так:

Код

function CalcKeySumm(Tree: SS): Integer;
begin
 if Tree = nil then
 begin
   CalcKeySumm := 0;
 end else
 begin
   CalcKeySumm := Tree^.Key + CalcKeySumm(Tree^.Left) + CalcKeySumm(Tree^.Right);
 end;
end;

От того в каком порядке стоят слагаемые обход дерева называется левосторонним, и т.д.

[Palpalich]

спасибо огроменное, всё работает!!! слушай, дак это получается рекурсивная функция, правильно? и конечным результатом будет дерево??(Tree: SS)

[Монца]

Функция рекурсивная, но можно обойтись и без рекурсии.

[Palpalich]

как тогда организовать обход дерева, и что на выходе?

[Dofur]

спасибо  огроменное, всё работает!!! слушай, дак это получается рекурсивная функция, правильно? и конечным результатом будет дерево??(Tree: SS)

Конечным результатом у функции будет целочисленное число - там же указанно

function CalcKeySumm(Tree: SS): Integer;

[Palpalich]

дак (Tree: SS) - это ссылочный тип данных...

Добавлено ([mergetime]1229526216[/mergetime]):
помогите регить ещё одну задачу please:):
Дан текст (в текстовом файле). В дереве, построенном из слов текста определить количество вершин дерева, содержащих слова, являющиеся палиндромами.
Примечание. Тип элемента в узле дерева (String), кроме того, необходимо ввести счетчик числа повторений каждого слова.

[Dofur]

Функция берет дерево - возвращает целое число.Почему результат по твоему должен быть деревом?

[Tervyn]

спасибо  огроменное, всё работает!!! слушай, дак это получается рекурсивная функция, правильно? и конечным результатом будет дерево??(Tree: SS)

Результатом будет число, ведь функция возвращает число. Параметр функции Tree: SS это дерево чьи ключи надо считать, а сам ключ - целое число. Для дерева вида
2
1 3
обход и резултат будет таким:
при вызове с вершиной 2 сумма 2 + результат рекурсии с вершинами 1 и 3
при вызове с вершиной 1 сумма 3 + результат рекурсии с вершинами из вершины 1. Так как таких вершин нет функция вернут 0
Для вершины 3 аналогично.
В итоге получаем сумму 2 + 1 + 0 + 0 + 3 + 0 + 0

Функция рекурсивная, но можно обойтись и без рекурсии.

как тогда организовать обход дерева, и что на выходе?

Можно, но в данном случае врядли. Обход дерева подразумевает возможность возврата в предыдущую вершину. То есть для примера выше из 2 мы должны просмотреть ветку начинающуюся с 1, вернуться, затем ветку с 3. Возможность возврата добавляется введением ссылку на вершину выше. Тип узла дерева должен выглядить как-то так:
type
PTree = ^TTree;
TTree = record
Info: Integer;
Left, Right: PTree;
Owner: PTree;
end;
Для примера выше для вершины 2 поле Owner = nil, для вершин 1 и 3 - ссылка на вершину 2

Ну а про палиндромы можно сделать например так:

Код

type
 PTree = ^TTree;
 TTree = record
   Info: string;
   Count: Integer;
   Left,
   Right: PTree;
 end;

{ Функция добавления слова в дерево }
{ Если делать эту функцию рекурсивной и не принять мер }
{ то каждый раз при ее вызове строка будет дублироваться }
{ в стеке и произойдет переполнение стека. Хотя те }
{ компиляторы что поумнее передавать будут не строку, а }
{ указатель на строку. И переполнения не будет. Как }
{ BP не помню:( Ниже три варианта реализации этой функции }

{ Вариант добавления слова в дерево без рекурсии }
procedure AddItem(var ATree: PTree; AInfo: string);
 function MakeItem(AInfo: string): PTree;
 var
   P: PTree;
 begin
   P := nil;
   New(P);
   if P <> nil then
   begin
     P^.Info := AInfo;
     P^.Left := nil;
     P^.Right := nil;
     P^.Count := 1;
     P^.Info := AInfo;
   end;
   MakeItem := P;
 end;
var
 P: PTree;
begin
 if ATree = nil then
 begin
   ATree := MakeItem(AInfo);
   Exit;
 end;
 P := ATree;
 while P <> nil do
 begin
   if AInfo = P^.Info then
   begin
     P^.Count := P^.Count + 1;
     Exit;
   end;
   if AInfo < P^.Info then
   begin
     if P^.Left = nil then
     begin
       P^.Left := MakeItem(AInfo);
       Exit;
     end else
     begin
       P := P^.Left;
       Continue;
     end;
   end;
   if AInfo > P^.Info then
   begin
     if P^.Right = nil then
     begin
       P^.Right := MakeItem(AInfo);
       Exit;
     end else
     begin
       P := P^.Right;
       Continue;
     end;
   end;
 end;
end;

{ Вариант добавления слова в дерево с рекурсией }
{ Внешняя функция является как оболочкой для }
{ реальной функции. Реальная же не передает строку, }
{ а пользуется строкой-параметром оболочки. Сколько }
{ бы раз не вызывалась реальная функция строка не }
{ передается и переполнения стека не будет }
procedure AddItem(var ATree: PTree; AInfo: string);
 procedure Add(var ATree: PTree);
 begin
   if ATree = nil then
   begin
     New(ATree);
     if ATree <> nil then
     begin
       ATree^.Info := AInfo;
       ATree^.Count := 1;
       ATree^.Left := nil;
       ATree^.Count := nil;        
     end;
     Exit;
   end;
   if ATree^.Info = AInfo then
   begin
     ATree^.Count := ATree^.Count + 1;
     Exit;
   end;
   if AInfo < ATree^.Info then
     Add(ATree^.Left)
   else
     Add(ATree^.Right);
 end;
begin
 Add(ATree);
end;

{ Вариант добавления слова в дерево с рекурсией }
{ Самый простой:) В списке параметров перед параметром }
{ AInfo ставим var. Тем самым мы гарантируем что }
{ передаваться будет не строка, а указатель на нее }
{ По крайней мере так задумано... }
procedure AddItem(var ATree: PTree; var AInfo: string);
begin
 if ATree = nil then
 begin
   New(ATree);
   if ATree <> nil then
   begin
     ATree^.Info := AInfo;
     ATree^.Count := 1;
     ATree^.Left := nil;
     ATree^.Count := nil;        
   end;
   Exit;
 end;
 if ATree^.Info = AInfo then
 begin
   ATree^.Count := ATree^.Count + 1;
   Exit;
 end;
 if AInfo < ATree^.Info then
   AddItem(ATree^.Left, AInfo)
 else
   AddItem(ATree^.Right, AInfo);
end;

{ Функция проверки является ли слово палиндромом }
{ Палиндром это ведь когда слово читается слева }
{ направо так же как справа налево? }
function IsPalindrom(AWord: string): Boolean;
var
 I: Integer;
begin
 for I := 1 to Length(AWord) div 2 do
   if AWord[i] <> AWord[Length(AWord) - I + 1] then
   begin
     IsPalindrom := False;
     Exit;
   end;
 IsPalindrom := True;
end;

{ Собственно подсчет палиндромов }
function CalcPalindromCount(ATree: Ptree): Integer;
var
 N: Integer;
begin
 if ATree = nil then
 begin
   CalcPalindromCount := 0;
   Exit;
 end;
 if IsPalindrom(ATree^.Info) then
   N := ATree^.Count { если копии палиндромов не считать то N := 1 }
 else
   N := 0;
 CalcPalindromCount := N + CalcPalindromCount(ATree^.Left)
                         + CalcPalindromCount(ATree^.Right);
end;

{ Очистка дерева }
procedure Clear(var ATree: PTree);
begin
 if ATree <> nil then
 begin
   Clear(ATree^.Left);
   Clear(ATree^.Right);
   Delete(ATree);
   ATree := nil;
 end;
end;

Смысл такой - в записи вводим поле для подсчета дублей слов. Это поле меняется при добавлении слова. Рекурсивный вызов функции с параметром строкой потенциально может вызвать ошибку переполнения стека, предложил три варианта решения этой проблемы. Перед началом работы переменную-указатель на дерево надо выставить в nil. После все работы с деревом вызвать Clear с аргументом переменной-указателем на дерево. Количество палиндромов выдает функция CalcPalindromCount:
X := CalcPalindromCount(Tree);
Чтение слов из файла сделай сам - я просто не очень хорошо помню как работают Read, ReadLn при работе с текстовым файла, а Паскаля у меня не стоит (все писал в блокноте)

[Gloin]

Это где так людей калечат, заставляют на паскале деревья писать?

[Гость_Aнгeл_*]

А чем дерево на Паскале хуже деревьев на других языках? И почему калечат?

[Gloin]

Собственно я привык считать паскаль языком для первокурсников, а там только вводят в суть программирования, деревья появляются на втором курсе уже на C/C++, у нас начали со второго, но это лирическое отступление к деревьям отношения не имеющее, мне только интересно: это Вас на первом курсе заставляют писать деревья, или же вы до 2-го паскаль учите, вряд ли тут просят выполнить задание не для ВУЗа.
Ну с технической стороны отличается конечно цель, мне она непонятна, неужели надо написать дерево хоть как-нибудь, это похвально, но зачем?

[gamecreator]

Глоин, оказывается есть другой, нормальный паскаль. Вот про него Ангел и говорит

[gilex]

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

[Gloin]

Мне тут за некомпетентность минус влепили, хочется сатисфакции и срача.
Расскажите, пожалуйста, какую глупость я сказал.

[Монца]

за пост 12.
Написание деревьев на паскале не более сложная задача, чем написание деревьев на C
Что Ангел уже и сказал

[Gloin]

Не спорю, я с паскалем во втором семестре завязал, наоборот, говорю, что калечат, раз заставляют писать на этом языке, или я не понимаю задачи, о чем тоже написал.
И Ангел про сложность ничего не писал, удивился только тому что "калечат".

[Гость_Aнгeл_*]

На Паскале писать ничуть не сложнее. Наоборот, чётче, стабильнее, яснее. То есть ваш ответ сугубо индивидуален.