DUzun's Web
Programare, proiecte personale, divertisment

{

  Parcurgerea arborilor binari prin algoritmi iterativi

}

Program Tema_2_7_Probl_9;

uses crt, strings;

​

const sep = '- ';  {Separatorul nivelelor}

​

type Arbore = ^Nod;   {Adresa nodului}

​

     Nod = record     {Un nod}

       Info: string;

       Stg, Dr: Arbore;

     end;

​

     PCelula = ^Celula; {Adresa celulei}

     Celula = record

       A: Pointer;

       P: PCelula;

     end;

​

     Stiva = PCelula;

     Coada = PCelula;

​

var T: Arbore;    {Radacina arborelui}

    nivel: word;

    P, N: Arbore; {Nodul parinte P al nodului curent N}

    C: ^Arbore;   {Adresa nodului curent (insusi nodul poate fi vid)}

    S, D: Stiva;  {Doua stive: stanga si dreapta}

​

    Inf: String;

    PC: PChar;

​

{Introducerea unui element in stiva}

procedure Push(N: Pointer; var S: PCelula);

var R: PCelula;

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}

end;

​

{Extragerea unui element din stiva}

function Pop(var S: PCelula): Pointer;

var R: PCelula;

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}

   end;

end;

​

function Shift(var S: PCelula): Pointer;

var P: ^PCelula;

begin

  if S = nil then Shift := nil else   {Coada este vida}

  begin

    P := @S;                          {Adresa elementului curent}

    while P^^.P <> nil do             {Cautam prima celula din coada}

      P := @P^^.P;

    Shift := P^^.A;                   {Prima celula}

    Dispose(P^);                      {Eliberarea memoriei primei celule}

    P^ := nil;                        {Excluderea din coada}

  end;

end;

​

{Numarul de elemente din stiva S}

function Count(S: PCelula): word;

var n: word;

begin

  n := 0;

  while S <> nil do begin

    inc(n);

    S := S^.P;

  end;

  Count := n;

end;

​

{Eliberarea memoriei ocupade de stiva S}

procedure Free(Var S: PCelula);

var R: PCelula;

begin

  while S <> nil do begin

    R := S;

    S := S^.P;

    Dispose(R);

  end;

end;

​

{

 Tipuri de parcurgere a arborilor binari:

   PreOrdine:  RSD

   InOrdine:   SRD

   PostOrdine: SDR

   (R = Radacina, S = Stangul, D = Dreptul)

}

​

{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}

    N^.Stg := nil;

    N^.Dr  := nil;

  end else

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

  CreateNode := N;

end;

​

{Pune in stiva stanga adresa membrului stang,

 iar in stiva dreapta - adresa membrului drept al N}

procedure PushSD(N: Arbore);

begin

  if N = nil then Exit;

  Push(N, S);

  Push(N, D);

end;

​

function NextRSD: Pointer;

var C: ^Arbore;

begin

   if T = nil then begin

     C := @T;

     P := nil;

   end else   {Daca radacina lipseste, se foloseste adresa ei}

   begin

     P := Pop(S);                   {Se ia din stiva stanga}

     if P <> nil then C := @P^.Stg

     else begin

       P := Pop(D);                 {daca stiva stanga e vida, se ia din dreapta}

       if P <> nil then C := @P^.Dr

                   else C := nil;

     end;

   end;

   NextRSD := C;                  {Adresa nodului curent}

end;

​

function ReadRSD: Pointer;

begin

  if T = nil then begin

    P := nil;

    N := nil;

    nivel := 0; 

  end else

  begin

    if N <> nil then P := N;

    N := Pop(S);

    if N <> nil then begin

       if N^.Dr  <> nil then Push(N^.Dr,  S);

       if N^.Stg <> nil then Push(N^.Stg, S);

    end;

  end;

  ReadRSD := N;

end;

​

{Crearea arborelui in preordine (RSD), iterativ}

procedure ArbRSD;

var inf: String;

begin

  T := nil;

  repeat

    C  := NextRSD;

    if C = nil then Exit;

    if P = nil then

       Writeln('Radacina:')

    else

       writeln('Dati descendentul nodului |', P^.Info, '|:');

    Readln(inf);

    C^ := CreateNode(inf);

    PushSD(C^);                    {Punem in stiva descendentii}

  until C = nil;

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 in preordine (RSD), Preordine}

procedure AfisArbRSD;

begin

  if T = nil then Exit;

  Push(T, S);

  P  := ReadRSD;

  while P <> nil do begin

    Writeln(Dup_SI(sep, Count(S)), P^.Info);

    P  := ReadRSD;

  end;

end;

​

begin

  S := nil;  {Initial stiva e vida}

  D := nil;

{

  repeat

    readln(inf);

    getmem(PC, length(inf)+1);

    strpcopy(pc, inf);

    push(PC, S);

  until inf = '';

  writeln(#10, Count(S), #10);

  repeat

    pc := shift(S);

    if pc = nil then Break;

    writeln(strpas(pc));

    freemem(pc, strlen(pc)+1);

  until PC = nil;

  writeln(#10, Count(S), #10);

  readkey;

  exit;

}

​

  clrscr;

  ArbRSD;

​

  Free(S);

  Free(D);

​

  clrscr;

  AfisArbRSD;

​

  Free(S);

  Free(D);

​

  readkey;

end.

​

​