Бинарные Деревья Паскаль

[mishammm]

Здраствуйте, помогите пожалуйста с таким условием. Нужно в дереве подсчитать количество узлов по пути от корня дерева до узла значение которых введено с клавиатуры, если таких узлов несколько выбрать любой из них.
может кто наведите на что то похожее? ничего толком не могу найти по даной процедуре, плиз
С вводом, выводдом проблем не возникло, только с условием непонятки:

Нарыл что то в этом роде в интернете

type
tRefBinTree = ^tBinTree;
tBinTree = record
info : integer;
left : tRefBinTree;
right : tRefBinTree;
end;

function Nodes (inRefRoot : tRefBinBauTree) : integer;
begin
if (inRefRoot <> nil) then
    Nodes := 1 + Nodes(inrefRoot^.left) + Nodes(inrefRoot^.right)
else
    Nodes := 0;
end;

будет ли это правильным? если нет прошу напраьте меня на что то похожее. Спасибо

[mishammm]

ну хоть кто то. не прошу писать программу же, прошу только направить на путь истинный )

[BDA]

function PathLength(const Root : tRefBinTree; value : integer) : integer;
begin
  if Root = nil then
    result := 0
  else if Root^.info = value then
    result := 1 //0 - если не нужно считать сам узел
  else if value > Root^.info then
    result := 1 + PathLength(Root^.right, value)
  else
    result := 1 + PathLength(Root^.left, value);
end;

[mishammm]

Сообщение от BDA

function PathLength(const Root : tRefBinTree; value : integer) : integer;
begin
  if Root = nil then
    result := 0
  else if Root^.info = value then
    result := 1 //0 - если не нужно считать сам узел
  else if value > Root^.info then
    result := 1 + PathLength(Root^.right, value)
  else
    result := 1 + PathLength(Root^.left, value);
end;

спасибо

[BDA]

Не за что, так как я соврал
Эта функция выдаст число узлов, даже если не найдет нужное значение, а лишь опустится до листов дерева.

[mishammm]

Сообщение от BDA

Не за что, так как я соврал
Эта функция выдаст число узлов, даже если не найдет нужное значение, а лишь опустится до листов дерева.

вот блин ) не заметил даже, ну а если серьезно??

[mishammm]

procedure CountLevel(level: integer; root: ttree;
          const to_count: integer; var Counter: integer);
begin
  if (root = nil) or (level > to_count) then exit;
 
  if level = to_count then inc(Counter)
  else begin
    CountLevel(level + 1, root^.right, to_print, Counter);
    CountLevel(level + 1, root^.left, to_print, Counter);
  end;
end;
, вот так вызывать:
  for i := 0 to Pred(GetHeight(root)) do begin
    amount := 0;
    CountLevel(0, root, i, amount);
    Writeln(i:2, ' -> ', amount);
  end;

такое пойдет?
или например такая процедура подсчёта?

PROCEDURE LEAFS_COUNT( Q : ND; VAR K : INTEGER );
            BEGIN
                IF Q <> NIL THEN
                    BEGIN
                        LEAFS_COUNT( Q^.LEFT, K );
                        IF (Q^.LEFT = NIL) AND (Q^.RIGHT = NIL) THEN  K := K +1;
                        LEAFS_COUNT( Q^.RIGHT, K );
                    END;
            END;

[BDA]

Не проверял на компилируемость.

function PathLength(const Root : tRefBinTree; value : integer) : integer;
begin
  if Root = nil then
    result := 0
  else if Root^.info = value then
    result := 1
  else begin
    if value > Root^.info then
      result := PathLength(Root^.right, value)
    else
      result := PathLength(Root^.left, value);
    if result > 0 then inc(result);
  end;
end;

[mishammm]

вроде скомпилилось, а какая примерно должна быть основная программа?

[mishammm]

program BinaryTree;
uses crt;
type
    pnode = ^node;
    node = record
    data:integer;
    left:pnode;
    right:pnode;
    end;
var
   root:pnode;
   choice,key,sum,num:integer;
  

procedure print_tree(p:pnode;level:integer);
var
   i:integer;
begin
if p = nil then exit;
with p^ do begin
print_tree(right,level+1);
for i:=1 to level do write('    ');
writeln(data);
print_tree(left,level+1);
end;
end;

function find(root:pnode;key:integer;var p,parent:pnode):boolean;
begin
p:=root;
while p <> nil do begin
if key = p^.data then
begin find:=true; exit end;
parent:=p;
if key < p^.data
then p:=p^.left
else p:=p^.right;
end;
find:=false;
end;


procedure insert(var root:pnode;key:integer);
var
   p,parent:pnode;
begin
if find(root,key,p,parent) then begin
writeln('This element already exists ');exit; end;
new(p);
p^.data:=key;
p^.left:=nil;
p^.right:=nil;
if root = nil then root:=p
else
if key < parent^.data
then parent^.left:=p
else parent^.right:=p;
end;

procedure del(var root:pnode;key:integer);
var
   p,parent,y:pnode;
function descent(p:pnode):pnode;
var
   y,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('This element does not exist'); 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
then parent^.left:=y
else parent^.right:=y;
dispose(p);
end;


begin
sum:=0;
num:=0;
root:=nil;
while true do begin
writeln('Add element - 1');
writeln('Delete element - 2');
writeln('Print - 3');
writeln('Sum - 4');
writeln('Exit - 5');
write('Your choice: ');
read(choice);
case choice of
1:
begin
writeln('Enter element: ');
readln(key);
insert(root,key);
sum:=sum+key;
num:=1;
end;
2:
begin
writeln('Enter element what need delete: ');
readln(key);
del(root,key);
end;
3:
begin
clrscr;
if root = nil then writeln('Tree empty')
else print_tree(root,0);
end;
4:writeln('Sum: ',sum/num);
5:exit;
end;
writeln;
end

end.

вот написал но оно сичтает сразу всю сумму всех елементов, а нужно от корня к заданому узлу