DUzun's Web
Programare, proiecte personale, divertisment

Program P133;

 { Arbori de ordinul m }

const m=4;

type Arbore=^Nod;

     Nod=record

               Info : string;

                Dsc : array [1..m] of Arbore

         end;

​

     AdresaCelula=^Celula;

     Celula=record

                  Info : Arbore;

                   Urm : AdresaCelula

            end;

​

var  T : Arbore;       { rădăcina }

   Prim,               { primul element din coadă }

 Ultim : AdresaCelula; { ultimul element din coadă }

​

​

procedure IntroduInCoada(Q : Arbore);

var R : AdresaCelula;

begin

 new(R);

 R^.Info:=Q;

 R^.Urm:=nil;

 if Prim=nil then begin Prim:=R; Ultim:=R end

          else begin Ultim^.Urm:=R; Ultim:=R end;

end; { IntroduInCoada }

​

procedure ExtrageDinCoada(var Q : Arbore);

var R : AdresaCelula;

begin

 if Prim=nil then writeln('Coada este vidă')

          else begin

                 R:=Prim;

                 Q:=R^.Info;

                 Prim:=Prim^.Urm;

                 dispose(R);

               end;

end; { ExtrageDinCoada }

​

procedure CreareArbore(var T : Arbore);

var R, Q : Arbore;

       s : string;

       i : integer;

begin

 T:=nil;                { iniţial arborele este vid }

 Prim:=nil; Ultim:=nil; { iniţial coada este vidă }

 writeln('Daýi rňdňcina: '); readln(s);

 if s<>'' then

    begin

      new(R); { crearea rădăcinii }

      R^.Info:=s;

      T:=R;   { iniţializarea adresei rădăcinii }

      IntroduInCoada(T);

    end;

 while Prim<>nil do  { cît coada nu e vidă }

    begin

      ExtrageDinCoada(R);

      for i:=1 to m do R^.Dsc[i]:=nil;

      writeln('Daţi descendenţii nodului  ', R^.Info);

      i:=1; readln(s);

      while (i<=m) and (s<>'') do

        begin

          new(Q); R^.Dsc[i]:=Q; Q^.Info:=s;

          IntroduInCoada(Q);

          i:=i+1; readln(s);

        end;

 end;

end; { CreareArbore }

​

procedure AfisareArbore(T : Arbore);

var R : Arbore;

    i : integer;

begin

 if T=nil then writeln('Arbore vid')

    else

      begin

        writeln('Arborele este format din:');

        Prim:=nil; Ultim:=nil;

        IntroduInCoada(T);

        while Prim<>nil do

           begin

             ExtrageDinCoada(R);

             writeln('Nodul ', R^.Info);

             write('  descendenţi: ');

             for i:=1 to m do

               if R^.Dsc[i]<>nil then

                  begin

                     write(R^.Dsc[i]^.Info, ' ');

                     IntroduInCoada(R^.Dsc[i]);

                  end; { then }

             writeln;

           end; { while }

      end; { else }

 readln;

end; { AfisareArbore }

​

procedure InLatime(T : Arbore);

var R : Arbore;

    i : integer;

begin

 if T<>nil then

    begin

      Prim:=nil; Ultim:=nil;

      IntroduInCoada(T);

      while Prim<>nil do

        begin

          ExtrageDinCoada(R);

          writeln(R^.Info);

          for i:=1 to m do

            if R^.Dsc[i]<>nil then IntroduInCoada(R^.Dsc[i]);

    end; { while }

      end; { then }

end; { InLatime }

​

procedure InAdincime(T : Arbore);

var i : integer;

begin

 if T<>nil then

    begin

      writeln(T^.Info);

      for i:=1 to m do InAdincime(T^.Dsc[i]);

    end;

end; { InAdincime }

​

begin

 CreareArbore(T);

 AfisareArbore(T);

 writeln('Parcurgerea arborelui în lăţime:');

 InLatime(T);

 readln;

 writeln('Parcurgerea arborelui în adîncime:');

 InAdincime(T);

 readln;

end.

​

​

​