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

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

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

 
 Ответить  Открыть новую тему 
> Деревья, поиск по ключу, (переименовано)
сообщение
Сообщение #1





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

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


smile.gifЗдрасьте smile.gif Я у вас тут впервые, очень надеюсь wub.gif
Вот моя задачка: определяет число вхождений ключа x в дерево t.
Задачка вроде несложная, только вот в этих "деревьях" я как-то блукаю. mega_chok.gif
Вот что я сделала:

USES CRT;
type
TKey = integer;
PNode = ^TNode;
TNode = record
key : TKey;
left,right : PNode;
end;
{-------------------------------------------------------------------}
PROCEDURE make(var p : PNode; x : Tkey);
begin
new(p);
p^.key:=x;
p^.left:=nil;
p^.right:=nil;
end;


PROCEDURE insert(var p : PNode; h : integer);
begin
make(p^.left,Random(10){h});
make(p^.right,Random(10){h});
if h > 1 then
begin
insert(p^.left,h-1);
insert(p^.right,h-1);
end;
end;
{--------------------------------------------------------}
PROCEDURE inorder(var p : PNode);

begin
if p<>nil then
begin
inorder(p^.left);
Write(p^.key,' ');
inorder(p^.right);
end;
end;
{-----------------------------------------------------}
PROCEDURE poisk(var p : PNode);
var k : integer; flag : boolean; x : Tkey; tree : PNode;
begin
{******** poisk klutha *******************}
p:=tree;
While (p <> nil) and (p^.key <> x) do
if p < p^.key then begin
p:=p^.left
else p:=p^.right;
end;
end;
flag:=(p <> nil);
{******************************************}
k:=0;
if p^.key = x then
begin
k:=k+1;
end;
end;

{--------------------------------------------------------}
var p : PNode; x : Tkey;
h,k : integer; tree : PNode;
begin
clrscr;
h:=2;
tree:=nil;
make(tree,Random(10){0});
insert(tree,h);
Writeln('obratnij obhod dereva: ');
inorder(tree);

Writeln;
Writeln;
Writeln('vvedite kluth x: ');
Readln(x);

poisk(tree);

Writeln;
Write('thislo vhogdenij klutha x: ',k);

readln;
end.


Но я наверное что-то не так поняла. Помогите blink.gif !!!
Прикрепленный файл  DER.PAS ( 1.55 килобайт ) Кол-во скачиваний: 270


Сообщение отредактировано: volvo -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Гость






Так лучше? smile.gif

USES CRT;
type
TKey = integer;
PNode = ^TNode;
TNode = record
key : TKey;
left,right : PNode;
end;
{-------------------------------------------------------------------}
PROCEDURE make(var p : PNode; x : Tkey);
begin
new(p);
p^.key:=x;
p^.left:=nil;
p^.right:=nil;
end;


PROCEDURE insert(var p : PNode; h : integer);
begin
make(p^.left,Random(10){h});
make(p^.right,Random(10){h});
if h > 1 then
begin
insert(p^.left,h-1);
insert(p^.right,h-1);
end;
end;
{--------------------------------------------------------}
PROCEDURE inorder(var p : PNode);

begin
if p<>nil then
begin
inorder(p^.left);
Write(p^.key,' ');
inorder(p^.right);
end;
end;
{-----------------------------------------------------}

function poisk(p: PNode; X: TKey): integer;
var value: integer;
begin

value := 0;
if p = nil then poisk := 0
else begin

if X = p^.key then value := 1;
poisk := value + poisk(p^.Left, X) + poisk(p^.Right, X);

end;

End;

{--------------------------------------------------------}
var p : PNode; x : Tkey;
h,k : integer; tree : PNode;
begin
clrscr;
h:=2;
tree:=nil;
make(tree,Random(10){0});
insert(tree,h);
Writeln('obratnij obhod dereva: ');
inorder(tree);

Writeln;
Writeln;
Writeln('vvedite kluth x: ');
Readln(x);

k := poisk(tree, x);

Writeln;
Write('thislo vhogdenij klutha x: ',k);

readln;
end.


P.S. В следующий раз давай топику более осмысленное название...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3





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

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


Спасибо большущее VOLVO :give_ro Первый раз решилась вот так по интернету попросить помочь мне и сомневалась, если честно, что кто-то станет помогать! МИР НЕ БЕЗ ДОБРЫХ ЛЮДЕЙ!!!
Очень интересное решение с помощью функции good.gif !!!

А вот ещё решение этой задачи (с процедурой):

USES CRT;
type
TKey = integer;
PNode = ^TNode;
TNode = record
key : TKey;
left,right : PNode;
end;
{-----------------------------------}
PROCEDURE make(var p : PNode; x : Tkey);
begin
new(p);
p^.key:=x;
p^.left:=nil;
p^.right:=nil;
end;


PROCEDURE insert(var p : PNode; h : integer);
begin
make(p^.left,Random(10){h});
make(p^.right,Random(10){h});
if h > 1 then
begin
insert(p^.left,h-1);
insert(p^.right,h-1);
end;
end;
{--------------------------------------------------------}
PROCEDURE inorder(var p : PNode);

begin
if p<>nil then
begin
inorder(p^.left);
Write(p^.key,' ');
inorder(p^.right);
end;
end;
{-----------------------------------------------------}
PROCEDURE poisk(var p : PNode; x : TKey; var k : Integer);
begin
if p<>nil then
begin
if p^.key = x then k:=k+1;
poisk(p^.left,x,k);
poisk(p^.right,x,k);
end;
end;
{******************************************}

{--------------------------------------------------------}
var p : PNode; x : Tkey;
h,kol : integer; tree : PNode;
begin
clrscr;
h:=2;
tree:=nil;
make(tree,Random(10){0});
insert(tree,h);
Writeln('obratnij obhod dereva: ');
inorder(tree);

Writeln;
Writeln;
Writeln('vvedite iskomij kluth : ');
Readln(x);
kol:=0;
poisk(tree,x,kol);

Writeln;
Write('thislo vhogdenij klutha ',x,': ',kol);

readln;
end.
Прикрепленный файл  DER.PAS ( 1.41 килобайт ) Кол-во скачиваний: 279


И ещё раз СПАСИБО wub.gif






 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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

 





- Текстовая версия 2.10.2020 1:37
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name