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

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

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

 
 Ответить  Открыть новую тему 
> Вершины дерева. Заданный уровень.
MRK
сообщение 5.01.2006 13:28
Сообщение #1


Гость






Прошу помощи. Написал программу, которая выводит все вершины дерева на заданном уровне. Но еще требуется подсчитать количество этих вершин. Пытался менять процедуру printlevel (добавлял счётчик и т.п), но ничего не выходит так как она рекурсивная. Как её
 К началу страницы 
+ Ответить 
MRK
сообщение 5.01.2006 13:30
Сообщение #2


Гость






Вот прога
Код
program derevya;
uses crt;
type tinf=integer;
     ptree = ^ttree;
     ttree = record
             inf:tinf;
             left, right: ptree;
             end;
{-----------------------------------------------}
function btree(m:word):ptree;
var nl,nr:word; k:tinf; node:ptree; left, right: ptree;
begin if m=0 then btree:=nil
      else begin
             nl:=m div 2;
             nr:=m-nl-1;
             writeln;
             writeln('Vvedite zna4enie');
             readln(k);
             new(node);
             node^.inf:=k;
             node^.left:=btree(nl);
             node^.right:=btree(nr);
             btree:=node
           end;
end;
{-----------------------------------------------}
procedure printlevel(root:ptree;level,curlevel:integer);
begin
    if (root<>NIL) then
      begin
        if (curlevel=level) then write(root^.inf,' | ')
        else
          begin
            printlevel(root^.left,level,curlevel+1);
            printlevel(root^.right,level,curlevel+1);
          end;
      end;
end;
{-------------------------------------------------------------------}
procedure print_tree(p:ptree; level:integer);
var i:integer;
begin
   if p=nil then exit;
   with p^ do
     begin
       print_tree(right,level+1);
       for i:=1 to level do write('   ');
       writeln(inf);
       print_tree(left,level+1);
     end
end;
{-------------------------------------------------------------------}
var m:word; root,p:ptree; level,k,n,current:integer; otvet:char;
begin
textmode(3);
textbackground(1);
repeat
clrscr;
writeln('Zadayte 4islo vershin');
readln(m);
root:=btree(m);
writeln;
writeln('Vvedennoe derevo:');
writeln;
print_tree(root,0);
writeln;
write('Vvedite nomer urovnya dlya pokaza');
writeln;
readln(level);
writeln('Vse vershini na urovne ',level,' : ');
printlevel(root,level,0);
writeln;
writeln('Dlya vihoda nazhmite "y"');
otvet:=readkey;
until otvet='y';
end.
 К началу страницы 
+ Ответить 
volvo
сообщение 5.01.2006 13:56
Сообщение #3


Гость






Цитата
Пытался менять процедуру printlevel (добавлял счётчик и т.п), но ничего не выходит так как она рекурсивная

Ну, и что? В рекурсивной процедуре нельзя менять значение глобального счетчика? blink.gif
var
counter: integer;
{-----------------------------------------------}
procedure printlevel(root:ptree;level,curlevel:integer);
begin
if (root<>NIL) then
begin
if (curlevel=level) then begin
write(root^.inf,' | '); inc(counter);
end
else
begin
printlevel(root^.left,level,curlevel+1);
printlevel(root^.right,level,curlevel+1);
end;
end;
end;

begin { main }
...
write('Vvedite nomer urovnya dlya pokaza');
writeln;
readln(level);
writeln('Vse vershini na urovne ',level,' : ');
counter := 0; printlevel(root,level,0);
writeln('amount = ', counter);
writeln;
...
end.
 К началу страницы 
+ Ответить 
MRK
сообщение 5.01.2006 18:53
Сообщение #4


Гость






Спасибо, я и не думал что всё так просто. good.gif
 К началу страницы 
+ Ответить 

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

 



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