DUzun's Web
Programare, proiecte personale, divertisment

{

  Scrieti o procedura nerecursiva care construieste arbori binari in ordinea:

  nodul-radacina, subarborele stang, subarborele drept (RSD - preordine).

}

​

Program Tema_2_7_Probl_9;

uses crt;

type Arbore = ^Nod;   {Adresa nodului}

     Stiva = ^Celula; {Adresa celulei}

​

     Nod = record     {Un nod}

       Info: string;

       Stg, Dr: Arbore;

     end;

​

     Celula = record

       A: Arbore;

       P: Stiva;

     end;

​

var T: Arbore;

    S: Stiva;

    niv: integer; {Indica numarul de elemente din stiva}

​

{Introducerea unui element in stiva}

procedure Push(N: Arbore);

var R: Stiva;

begin

   New(R);       {Alocarea memoriei pentru noul element}

   R^.A := N;    {Adaugarea informatiei}

   R^.P := S;    {Crearea legaturii cu elementul precedent}

   S := R;       {Actualizarea adresei stivei}

   inc(niv);     {A mai fost adaugat un element in stiva}

end;

​

{Extragerea unui element din stiva}

function Pop: Arbore;

var R: Stiva;

begin

   if S = nil then Pop := nil

   else begin

     R   := S;       {Extragerea elementului din stiva}

     Pop := R^.A;    {Citirea informatiei}

     S   := R^.P;    {Eliminarea din stiva}

     Dispose(R);     {Distrugerea elementului extras}

     dec(niv);       {A fost exclus un element din stiva}

   end;

end;

​

{Crearea unui nod cun Info}

function CreateNode(Info: String): Arbore;

var N: Arbore;

begin

  if Info <> '' then {Daca informatia nu lipseste}

  begin

    New(N);          {Alocarea memoriei pentru nod (din Heap)}

    N^.Info := Info; {Asocierea informatiei nodului}

  end else

    N := nil;        {Nodul nu a fost creat}

  CreateNode := N;

end;

​

{Crearea arborelui in preordine (RSD), iterativ}

procedure ArbIterativ;

var Q: Arbore;

    inf: String;

begin

  T := nil;

  Writeln('Radacina:');

  Readln(inf);

  T := CreateNode(inf);

  if T = nil then Exit;

  Q := T; {Nodul curent este radacina}

  repeat

​

    repeat {Subarborele stang; adaugarea in stiva}

      writeln('Dati nodul Stang al ', Q^.Info, ':');

      readln(inf);

      Q^.Stg := CreateNode(inf); {Se creaza nodul stang}

      if Q^.Stg <> nil then      {Daca nodul a fost creat}

      begin

        Push(Q);                 {Trimitem nodul curent in stiva}

        Q := Q^.Stg;             {Trecem la nodul stang}

      end;

    until inf = '';              {Pana cand nu se va mai crea nodul stang}

​

    repeat {Subarborele drept; excluderea din stiva}

      writeln('Dati nodul Drept al ', Q^.Info, ':');

      readln(inf);

      Q^.Dr := CreateNode(inf);        {Se creaza nodul drept}

      if Q^.Dr <> nil then Q := Q^.Dr  {Daca nodul drept a fost creat, trecem la el}

                      else Q := Pop;   {altfel, extragem un nod din stiva}

    until (inf<>'') or (Q = nil);      {Pana cand se va crea nodul drept sau stiva va fi vida}

​

  until Q = nil; {Pana cand stiva va fi vida}

end;

​

{Formeaza un string din N string-uri C}

function Dup_SI(C: String; N: Integer): String;

var s: string;

begin

  s := '';

  while N > 0 do begin

    s := s + C;

    dec(N);

  end;

  Dup_SI := s;

end;

​

{Afisarea arborelui}

procedure AfisArbIterativ; {Preordine}

const sep = '- ';  {Separatorul nivelelor}

var   Q: Arbore;

begin

  if T = nil then begin

    writeln('Arborele este vid!');

    Exit;

  end;

  Q := T; {Nodul curent este radacina}

  repeat

    {Q a fost afisat, iar Q^.Stg si Q^.Dr inca nu}

    repeat

      Writeln(Dup_SI(sep, niv), Q^.Info);  {Afisarea informatiei}

      Push(Q);                             {Trimitem nodul in stiva, ca mai apoi sa afisam Q^.Dr}

      Q := Q^.Stg;                         {Trecem la nodul stang}

    until Q = nil;

    {Toate nodurile din stiva au fost afisate impreuna cu descendentii stangi}

​

    repeat

      Q := Pop;                            {Extragem nodul din stiva, pentru a afisa nodul drept}

      dec(niv);                            {Am urcat un nivel}

      if Q = nil then Break                {Daca stiva e goala, se incheie toate iteratiile}

                 else Q := Q^.Dr;          {Trecem la nodul drept}

    until Q <> nil;

​

  until (Q = nil); {Pana cand stiva va fi vida}

end;

​

begin

  clrscr;

  S := nil;  {Initial stiva e vida}

  niv := 0;

  T := nil;

​

  ArbIterativ;

​

  clrscr;

  AfisArbIterativ;

​

  readkey;

end.

​

​