Задача:


Все что пока есть:

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;

Это то что мне нужно, не?
Стек - список?

Сообщение отредактировано: AlexSun - 26.11.2011 22:33

Как-то здесь тихо на форуме...

На самом деле задача более чем странная. Обычно дерево строится так, что содержит только разные значения ключей (если нужна возможность хранить одинаковые ключи - в структуру, описывающую узел дерева, добавляется счетчик. При добавлении очередного элемента дерево просматривается, если значение уже хранится в дереве - то счетчик этого узла увеличивается и всё). При этом задача теряет смысл. Если счетчика нет - то достаточно просмотреть дерево, и проверить, есть там искомый элемент, или нет.

Ну я бы сказал тупая

Ключи могут быть одинаковыми и они могут повторяться

Мой новый, рабочий код:

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.

Добавлено через 4 мин.
Все хорошо, но приказали переделать ввод элементов и рисование полученного дерева.
Как-то так:

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;

Это я нашел в чужой работе. Что на это скажешь?



Добавлено через 3 мин.
Нашел здесь твою функцию рисования дерева в графическом режиме.
Ты не мог бы ее прикрутить к моей программе? Или объясни где и как правильно инициализировать графику, чтоб она работала.
Или может у тебя есть своя программа, где она используется, выложи пожалуйста код.

Сообщение отредактировано: AlexSun - 1.12.2011 20:33

Бред. Но если условие стоит так, что в дереве могут быть одинаковые ключи и они могут повторяться (хотя тогда совершенно непонятно, на кой черт кому-нибудь понадобится такое дерево? Поиск в нем будет неэффективным, ибо узлы разбросаны бессистемно, зачем его использовать?), то можно и так...

Вот тут выкладывался рабочий код с этой процедурой: Фамильное представление ДЕРЕВА

А нету аналогичной процедуры, без использования графики?
Или как ее написать, чтоб корень дерева был в центре строки, а ветки и листья ниже его?
Аналогично моей процедуре 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;

, и что? Попробуй напечатать дерево из 10 элементов, и разобраться, кто чей левый потомок, а кто - правый...

Да это уже не мои проблемы - в универе приходится делать то что говорят

Спасибо огромное