DUzun's Web
Programare, proiecte personale, divertisment

{Elaborati o procedura care skimba cu locul doua elemente din lista.}

Program Tema_2_3_Probl_4;

​

type Lista = ^Celula;

     Celula = record  {O celula din lista}

       Info: String;  {Continutul celulei}

       Urm:  Lista;  {Adresa urmatoarei celule}

     end;

​

var L: Lista;   {L - baza listei}

    a, b: word; {Indicii elementelor care trebuiesc skimbate cu locul}

​

function Schimba(a, b: word): boolean;

var La, Lb, P: Lista;

    C: Celula;

    i: word;

begin

  if a<>b then begin  {Nu are rost sa se skimbe cu locul un element cu sine insusi}

    Schimba := false; {Inca nu se stie daca exista celulele nr a si b in lista}

    if L = nil then Exit;     {Lista nu poate fi goala}

    C.Urm := L;       {Mai adaugam un element la baza listei}

    P := @C;          {Baza listei}

    if a > b then begin {a trebuie sa fie mai mic ca b}

      i := a; a := b; b := i;  {Skimbul cu locul a valorilor a si b}

    end;

    {Cautam celula nr a-1 din lista}

    i := a;

    while i > 0 do begin

      if P = nil then Exit; {a este mai mare decat lungimea listei}

      P := P^.Urm;   {Trecem la urmatorul element}

      dec(i);

    end;

    La := P; {Celula imediat inaintea celulei nr a}

    {Cautam celula nr b-1 din lista}

    i := b-a; {P reprezinta celula nr a-1 din lista}

    while i > 0 do begin

      if P = nil then Exit; {b este mai mare decat lungimea listei}

      P := P^.Urm;   {Trecem la urmatorul element}

      dec(i);

    end;

    Lb := P; {Celula imediat inaintea celulei nr b}

    {Skimbul cu locul al elementelor nr a si b}

    P := La^.Urm;

    La^.Urm := Lb^.Urm;

    Lb^.Urm := P;

    P := La^.Urm^.Urm;

    La^.Urm^.Urm := Lb^.Urm^.Urm;

    Lb^.Urm^.Urm := P;

    {Daca a fost deplasata baza listei, noua adresa trebuie scrisa in L}

    if Lb^.Urm = L then L := La^.Urm;

  end;

  Schimba := true;    {Schimbarea a avut loc cu succes}

end;

​

function Citeste: word;

var P: Lista;

    n: word;

begin

  n:=0;   {Contor pentru numarul de celule din lista}

  new(L);

  P := L;

  writeln('Scrie un text:');

  writeln;

  repeat

    readln(P^.Info);  {Popularea celulei cu informatie citita de la tastiera}

    if P^.Info = '' then {Au fost introduse date}

    begin

       P^.Urm := nil;   {Marcam sfarsitul listei}

       Break;           {Cresterea listei continua pana cand utilizatorul introduce date}

    end else begin

      new(P^.Urm);      {Alocarea memoriei pentru urmatoarea celula}

      P := P^.Urm;      {Trecerea la urmatoarea celula}

      inc(n);           {A mai fost adaugata o celula}

    end;

  until false;

  Citeste := n;

end;

​

procedure Scrie;  {Afisarea listei}

var P: Lista;

begin

  P := L;  {Inceputul listei}

  while P <> nil do  {Pana nu se ajunge la sfarsitul listei}

    with P^ do begin

      Writeln(Info); {Afisarea informatiei din celula}

      P := Urm;      {Trecerea la urmatorul element}

    end;

end;

​

procedure Distruge;  {Distrugerea listei}

var P: Lista;

begin

  while L <> nil do

    with L^ do begin

      P := Urm;   {Salvarea adresei celulei urmatoare}

      Dispose(L); {Eliberarea memoriei ocupate de celula curenta}

      L := P;     {Trecerea la urmatoarea celula}

    end;

end;

​

begin

  L := nil; {Baza listei}

  writeln;  writeln;

  a := Citeste;

  writeln;  writeln;

  writeln('Care celule sa le skimb cu locul? (doua nr de la 0 la ', a-1, ')');

  readln(a, b);

  writeln('----------------------------------');

  if Schimba(a, b) then Scrie

                   else Writeln('Nu au putut fi skimbate cu locul celulele ', a, ' si ', b);

​

  Distruge;

​

  readln;

end.

​

​