Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум программистов > Центр помощи > [Delphi] Работа с деревьями


Автор: iriss 17.12.2006, 14:13
[delphi] Работа с деревьями
программа должна создавать дерево, выводить дерево на экран, считать количество элемента в дереве,сумму элементов дерева, максимальную глубину и сохранять дерево в файл. у меня не работают процедуры подсчета максимальной глубины дерева и суммы элементов дерева. никак не могу найти ошибку, помогите, пожалуйста smile 
Код

program Project72;

{$APPTYPE CONSOLE}

uses
  SysUtils;
type

ref=^node;
node=record
key:integer;
left,right:ref;
end;
mm=array of integer;
var
//head:ref;
nn:ref;
n,y,s,j,l:integer;
f:text;
r:mm;
//s:mm;
//q,h:integer;

function Creat_tree(n:integer):ref;
 var
 newnode:ref;
 x,nl,nr:integer;
 begin
 if n=0 then Creat_tree:=nil
 else
 begin
 nl:=n div 2;
 nr:=n-nl-1;
 x:=random(99)+1;
 new(Newnode);
 with newnode^ do
 begin
 key:=x;
 left:=Creat_tree(nl);
 right:= Creat_tree(nr);
 end;
 creat_tree:=newnode;
 end;
 end;

function Creat(n:integer):ref;
  var
  newnode:ref;
    x:integer;
    nl,nr:integer;
    begin
    if n=0 then Creat:=nil
    else
    begin
    nl:= n div 2;
    nr:= n - nl -1;
  new(Newnode);
    with newnode^ do
    begin
    writeln('vvedite chislo');
  readln(key);
       left:=creat(nl);
       right:=creat(nr);
    end;
  creat:=newnode;
  end;
  end;

procedure Prn_tree(t:ref; k:integer);
 var
  i:integer;
 begin
 { TODO -oUser -cConsole Main : Insert code here }
  if t<>nil then
    with t^ do
     begin
     Prn_tree(left,k+1);
      for i:=1 to k do
       write('****');
       writeln(key:5);
      Prn_tree(right,k+1);
     end;
   end;

   procedure sravnenie(m:array {[1..i]} of integer;i:integer);
  var z,n,a:integer;
 begin
 z:=1;
 a:=m[1];
 //z:=1;
 if z<=i then begin
 if m[z]>a then begin
 a:=m[z];
 end;
 z:=z+1;
 end;
 writeln(a);
 readln;
 end;



 procedure glybina(t:ref; k:integer);
 var
  i:integer;
  m:array of integer;
 begin
 { TODO -oUser -cConsole Main : Insert code here }
  if t<>nil then
    with t^ do
     begin
     Prn_tree(left,k+1);
      m[i]:=k;
      i:=i+1;
       writeln(key:5);
      Prn_tree(right,k+1);
     end;
    sravnenie(m,i);
   end;

procedure summ2(r:array of integer;j:integer);
 var w:integer;
 begin
 s:=0;
 //w:=1;
 for w:=1 to j do
 begin
 s:=s+r[w];
 end;
 writeln('summ');
 writeln(s);
 end;

 procedure summ(var t:ref; m:integer);
 {var
 r:array of integer;
 j:integer; }
 begin
 if t <> nil then {with t^ do} begin
  summ(t^.left,m+1);
  l:=t^.key;
  r[j]:=l;
  j:=j+1;
  summ(t^.right,m+1);
  end;
 summ2(r,j);
 end;
{procedure infix(t:ref);
var o,a,k,i:integer;
begin
if t<>nil then
    with t^ do
     begin
     Prn_tree(left,k+1);
      for i:=1 to k do
       write('****');
       writeln(key:5);
       a:=a+1;
      Prn_tree(right,k+1);
      writeln(a);
     end;
     end;}

procedure poisc(var t:ref;m:integer; c:integer);

begin

if t<> nil then with t^ do begin
 poisc(left,m+1,c);
 if key=c then begin
 y:=y+1;
 end;
 poisc(right,m+1,c);
 end;
 end;

procedure saveall(t:ref);
 begin
 if t^.left<>nil then saveall(t^.left);
 writeln(f,t^.key);
 if t^.right<>nil then saveall(t^.right);
 end;

procedure savefile(t:ref);
 var e:string;
 begin
  writeln('vvedite imya faila:');
  readln(e);
  assignfile(f,e);
  rewrite(f);
  saveall(nn);
  closefile(f);
end;



procedure count(t:ref; k:integer);
var m:array of integer;
i:integer;
 begin
 if t^.right<>nil then begin
  k:=k+1;
  count (t^.right,k);
  end
  else begin
  m[i]:=k;
  i:=i+1;
  k:=k-1;
  end;
  if t^.left<>nil then begin
  count (t^.left,k);
  k:=k+1;
  m[i]:=k;
  i:=i+1;
  end;
  sravnenie(m,i);
  end;

{procedure sravnenie(m:array [1..i] of integer;y:integer);
  var z,n:integer;
 begin
 n:=1;
 if z+n<=i then begin
 if m[z]<m[z+n] then begin
 n:=n+1;
 m[z]:=m[z+n];
 end
 else begin
 m[z+n]:=m[z+n+1];
 n:=n+1;
 end;
 end
 else
 writeln();
 end;}

procedure done (var t:ref);
 begin
 if t<>nil then
  begin
   with t^ do begin
    done(left);
    done(right);
   end;
  dispose(t);
 end;
end;

var q,d,c,h:integer; t:ref;
begin

{ref:=nil;
write('vvedite imya faila:');
readln(e);
assignfile(f,e);
reset(f);
while not eof(f) do
begin
  readln(e);
  addnewr(ref,e);
  end;
  closefile(f);}

repeat
writeln('*********************************************');
writeln('menu');
writeln('1. sozdanie dereva');
writeln('2. kolichestvo elementa v dereve');
writeln('3. summa elementov dereva');
writeln('4. srednee arifmeticheskoe elementov dereva');
writeln('5. max glybina dereva');
writeln('6. vivod dereva');
writeln('7. soxranit v fail');
writeln('8. zavershenie raboti');
writeln('9. vixod');
writeln('*********************************************');
writeln; readln(q);
case q of
1:
begin
writeln('vvodim sami ili po randomy?');
writeln('1-sami');
writeln('2-po randomy');
writeln('vash vibor');
readln(h);
if h=1 then
begin
writeln('vvedite colichestvo yzlov dereva');
 readln(n);
 nn:=Creat(n);
 writeln('derevo sozdano');
 end
else
begin
 writeln('vvedite colichestvo yzlov dereva');
 readln(n);
 nn:=Creat_tree(n);

 writeln('derevo sozdano');
  end;
 readln;
 end;

2:begin
y:=0;
writeln('vvedite chislo');
readln(c);

poisc(nn,0,c);
writeln('colichestvo');
writeln(y);
readln;
end;

3:
begin
j:=1;
summ(nn,0);
//writeln(s);
end;

5:
begin
//glybina(nn,0);
count(nn,0);
writeln('max glybina');
//writeln(a);
readln;
end;

6:
begin
writeln('tree':10);
  prn_tree(nn,0);
end;
7:

savefile(nn);

8:
begin
done(nn);
writeln('derevo ynichtojeno');
end;

end;
until  q=9;
end.



M
alexeis1
Модератор: выбирайте тип подсветки. Если что не ясно, то почитайте здесь как это делать http://forum.vingrad.ru/index.php?showtopic=126445

Автор: brodaga163 14.6.2008, 13:30
ребята, пожалуйста помогите сделать один пункт в создании дерева...надо  написать процедуру удаления всего под деревом- если это лист-удалить лист, уесли целая ветка-удалить целиком всю 
 плиз отправьте что получилось на [email protected] буду очень признателен 

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)