1. Заголовок темы должен быть информативным. В противном случае тема удаляется ... 2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения. 3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали! 4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора). 5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM! 6. Одна тема - один вопрос (задача) 7.Проверяйте программы перед тем, как разместить их на форуме!!! 8.Спрашивайте и отвечайте четко и по существу!!!
Число вхождений элемента E в дерево T, Описать процедуру или функцию, которая его определяет
type TED = <любой тип>; дерево =^ верхушка; верхушка = record элемент: TED; левая, правая: дерево; end; Описать процедуру или функцию, которая определяет число вхождений элемента E в дерево T.
Все что пока есть:
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;
На самом деле задача более чем странная. Обычно дерево строится так, что содержит только разные значения ключей (если нужна возможность хранить одинаковые ключи - в структуру, описывающую узел дерева, добавляется счетчик. При добавлении очередного элемента дерево просматривается, если значение уже хранится в дереве - то счетчик этого узла увеличивается и всё). При этом задача
Цитата
Описать процедуру или функцию, которая определяет число вхождений элемента E в дерево T.
теряет смысл. Если счетчика нет - то достаточно просмотреть дерево, и проверить, есть там искомый элемент, или нет.
Обычно дерево строится так, что содержит только разные значения ключей (если нужна возможность хранить одинаковые ключи - в структуру, описывающую узел дерева, добавляется счетчик. При добавлении очередного элемента дерево просматривается, если значение уже хранится в дереве - то счетчик этого узла увеличивается и всё).
Ключи могут быть одинаковыми и они могут повторяться
Мой новый, рабочий код:
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 15:22)
Или объясни где и как правильно инициализировать графику, чтоб она работала. Или может у тебя есть своя программа, где она используется, выложи пожалуйста код.
А нету аналогичной процедуры, без использования графики? Или как ее написать, чтоб корень дерева был в центре строки, а ветки и листья ниже его? Аналогично моей процедуре 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 элементов, и разобраться, кто чей левый потомок, а кто - правый...