Задача:
uses crt;
type TED = integer;
t =^ top;
top = record
e: TED;
l, r: t;
end;
begin
clrscr;
readkey;
end.
function count(T: дерево; E: ТЭД): integer;
var S: стек;
k: integer;
begin
очистек(S);
k := 0; {число вершин с E}
while T <> nil do begin {T-ссылка на очередную вершину}
if T^.элем = E then k := k+l;
{переход к следующей вершине:}
if T^.лев <> nil then begin {есть ветвь влево}
if T^.прав <> nil then встек(S,T^.прав); {правую ветвь, если есть, - в стек}
T:=T^.лев {идти влево}
end
else if T^.прав<>nil then T:=T^.прав {идти вправо}
else {нет обоих ветвей} begin {взять ветвь из стека и идти по ней}
if пустек(S) then T := nil {конец просмотра}
else изстека(S,T)
end
end;
count := k
end;
Как-то здесь тихо на форуме...
На самом деле задача более чем странная. Обычно дерево строится так, что содержит только разные значения ключей (если нужна возможность хранить одинаковые ключи - в структуру, описывающую узел дерева, добавляется счетчик. При добавлении очередного элемента дерево просматривается, если значение уже хранится в дереве - то счетчик этого узла увеличивается и всё). При этом задача
uses crt;
type TED = integer;
tree =^ top;
top = record
e: TED;
l, r: tree;
end;
var e, n, i, r: integer;
t: tree;
procedure insert(var t: tree; e: integer);
begin
if t = nil then begin
new(t);
t^.e := e;
t^.l := nil;
t^.r := nil
end
else if random(2) = 1 then insert(t^.l,e) else insert(t^.r,e)
end;
procedure show(var t: tree; h: integer);
begin
if t <> nil then begin
show(t^.r,h+1);
write('--':(h-1)*4+6);
writeln(t^.e);
show(t^.l,h+1)
end
end;
function count(t: tree; x: integer): integer;
var n: integer;
begin
n := 0;
if t <> nil then begin
if t^.e = x then inc(n);
n := n + count(t^.l,x);
n := n + count(t^.r,x)
end;
count := n
end;
procedure remove(var t: tree);
begin
if t <> nil then begin
if t^.r <> nil then remove(t^.r);
if t^.l <> nil then remove(t^.l);
dispose(t)
end
end;
begin
clrscr;
write('Количество узлов дерева: ');
readln(n);
randomize;
for i := 1 to n do begin
r := random(100);
insert(t,r)
end;
writeln('Дерево:');
show(t,1);
write('Искомый элемент: ');
readln(e);
writeln('Количество вхождений: ',count(t,e));
remove(t);
readkey
end.
procedure dobavl(var a:derevo;y:integer);
var k,kk: integer;
begin
write('Элемент: ');
readln(k);
if a=nil then
begin new(a);a^.l:=nil;a^.r:=nil;a^.d[l]:=k;a^.d[2]:=y; end;
write('Есть левая ветка? 1 - да, 2 - нет');
read(kk);
if kk=l then begin inc(yl);dobavl(a^.l,yl);end;
write('Есть правая ветка? 1 - да, 2 - нет');
read(kk);
if kk=l then begin inc(yr);dobavl(a^.r,yr);end;
end;
А нету аналогичной процедуры, без использования графики?
Или как ее написать, чтоб корень дерева был в центре строки, а ветки и листья ниже его?
Аналогично моей процедуре show(), только чтоб выводилось не слева на право, а сверху вниз.
Никак не придумаю.
procedure show(var t : tree);
procedure InnerShow(t : tree; X, Y : integer);
begin
if t <> nil then
begin
InnerShow(t^.r, X+((80 div succ(Y)) div 2), Succ(Y));
gotoxy(X, 2*Y); write(t^.e);
InnerShow(t^.l, X-((80 div succ(Y)) div 2), Succ(Y));
end;
end;
begin
InnerShow(t, 40, 2); // Координаты корня - центр второй строки экрана
gotoxy(1, 24); // Чтобы выводимый ПОТОМ текст не накладывался на дерево
end;