IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code].
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> Деревья, проверка на равенство с одним из эл-тов дерева
Hunt666
сообщение 20.05.2007 22:15
Сообщение #1


Пионер
**

Группа: Пользователи
Сообщений: 50
Пол: Мужской
Реальное имя: Павел

Репутация: -  0  +


Задача:
Определить есть ли в дереве хотя бы 2 одинаковых элемента.

вот что я нарешал, но не работает

program tree2;
uses crt;
type PTree = ^TTree;
TTree = record
info:integer;
left,right:PTree;
end;
var tree,root,p,parent:PTree;
selekt,g,key:integer;
k,i:byte;

function getint(ident:string):integer;
var s:byte;
begin
randomize;
write('BBEDUTE ', ident,' = ');
readln(s);
getint:=s ;
end;

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

procedure addelem(var root:PTree;info:integer);
var elem:PTree;
begin

if (root=NIL) then {ECJIU DEPEBO nYCTOE , TO }
begin
new(elem);
elem^.left:=nil;
elem^.right:=nil;
elem^.info:=info;
root:=elem;
if find(root , key , p , parent) then
begin
writeln('TAKOU ELEM EGE ECTb');
inc(g);
writeln('ELEM ',p^.info,'POVTORUJIC9I', g,' PA3');

end
else
begin
if (info<root^.info) then
addelem(root^.left,info)
else
addelem(root^.right,info);
end;
end;
end;
begin
clrscr;

tree:=nil ;
writeln('1- Do6aBuTb EJIEM B DEPEBO') ;
readln(selekt);
case selekt of
1:begin
writeln('CkoJIbko EJIEM HYGHO BBECTU');
readln(k);
g:=0;
for i:=1 to k do

begin
addelem(tree,getint ('EJIMEHT DJI9I DO6ABJIEHU9I'));
end;
end;
end;
readln;
END.


не получается проверка на равенство и вывод результата на экран
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 



- Текстовая версия 20.07.2025 14:01
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"