Sortowanie bąbelkowe listy podwójnie wiązanej

SortowanieListy

Program SortowanieListy;

uses CRT, Math;

type
  ElementP = ^Element;

Element = record
  Nr : integer;
  Wartosc : double;
  Nast : ^Element;
  Pop : ^Element;
end;

//Funkcja wypisujaca liste od wskazanego elementu
function wypiszOd(wsk : ElementP) : ElementP;
begin
  if wsk <> NIL then
  begin
    Writeln('Nr: ', wsk^.Nr, '  Warosc: ', wsk^.Wartosc:5:1);
    while wsk^.Nast <> NIL do
    begin
      wsk := wsk^.Nast;
      Writeln('Nr: ', wsk^.Nr, '  Warosc: ', wsk^.Wartosc:5:1);
    end;
  end;
end;

//Funkcja dodajaca element po wskazanym
function dodajPo(var wsk : ElementP) : ElementP;
var nowy : ElementP;
begin
  if wsk = NIL then
  begin
    new(wsk);
    wsk^.Nast := NIL;
    wsk^.Pop := NIL;
    dodajPo := wsk;
  end else
  begin
    new(nowy);
    nowy^.Pop := wsk;
    nowy^.Nast := wsk^.Nast;
    wsk^.Nast := nowy;
    dodajPo := nowy;
  end;
end;

//Funkcja dodajaca element na koncu
function dodajK(var wsk : ElementP) : ElementP;
var pomocniczy : ElementP;
begin
  if wsk = NIL then
  begin
    dodajPo(wsk);
    dodajK := wsk;
  end
  else begin
    //Wskaznik pomocniczy jest nam potrzebny, by nie zmienic ustawienia wskaznika przekazanego do funkcj
    pomocniczy := wsk;

    //Szukamy ostatniego elementu
    while pomocniczy^.Nast <> NIL do
    begin
      pomocniczy := pomocniczy^.Nast;
    end;

    //Dla niego wywolujemy funkcje dodajace element po wskazanym
    pomocniczy := dodajPo(pomocniczy);
    dodajK := pomocniczy;
  end;
end;

//Funkcja sortujaca elementy listy wzgledem pola 'Wartosc' poczynajac od wskazanego elementu
function SortujBL(wsk : ElementP) : ElementP;
var i : integer; pomocniczy, przejscie1, przejscie2, pierwszy, ostatni : ElementP;
begin
  ostatni := NIL;
  pierwszy := wsk;

  while pierwszy <> ostatni do
  begin
    pomocniczy := pierwszy;
    ostatni := pierwszy;
    i := 0;

    while (pomocniczy^.Nast <> NIL) do
    begin
      if pomocniczy^.Nast^.Wartosc < pomocniczy^.Wartosc then
      begin

        if i = 0 then pierwszy := pomocniczy^.Nast;

        //Zamieniamy elementy:

        //Dbamy o elementy dalsze:
        if pomocniczy^.Pop <> NIL then pomocniczy^.Pop^.Nast := pomocniczy^.Nast;
        if pomocniczy^.Nast^.Nast <> NIL then pomocniczy^.Nast^.Nast^.Pop := pomocniczy;

        //Zachowujemy wskaznik do nastepnego elementu:
        przejscie1 := pomocniczy^.Nast;
        //Writeln('Nr: ', pomocniczy^.Nr, '  Warosc: ', pomocniczy^.Wartosc:5:1);

        //Zachowujemy to, co bedziemy zmieniali:
        //przejscie3 := pomocniczy^.Pop;
        przejscie2 := pomocniczy^.Pop;

        pomocniczy^.Pop := pomocniczy^.Nast;
        pomocniczy^.Nast := pomocniczy^.Nast^.Nast;
        //Writeln('Nr: ', pomocniczy^.Nr, '  Warosc: ', pomocniczy^.Wartosc:5:1);

        przejscie1^.Nast := pomocniczy;
        przejscie1^.Pop := przejscie2;
        //Writeln('Nr: ', pomocniczy^.Nr, '  Warosc: ', pomocniczy^.Wartosc:5:1);

        //Tak jakby flaga chyba:
        ostatni := pomocniczy;
      end else if pomocniczy^.Nast <> NIL then pomocniczy := pomocniczy^.Nast;

      Inc(i);
    end;

    {Writeln();
    wypiszOd(pierwszy);
    Writeln('pierwszy--->Nr: ', pierwszy^.Nr, '  Warosc: ', pierwszy^.Wartosc:5:1);
    Writeln('ostatni--->Nr: ', ostatni^.Nr, '  Warosc: ', ostatni^.Wartosc:5:1);
    Readln(i);}
  end;

  sortujBL := pierwszy;
end;


//Funkcja usuwajaca jeden, wskazany element listy


//Funkcja usuwajaca cala liste


var
  i : integer;
  poczatek, pomocniczy : ElementP;

begin
  poczatek := NIL;

  Randomize;

  for i := 0 to 20 do
  begin
    pomocniczy := dodajK(poczatek);
    pomocniczy^.Wartosc := Random(100);
    pomocniczy^.Nr := i;
  end;

  wypiszOd(poczatek);

  poczatek := SortujBL(poczatek);
  Writeln();

  wypiszOd(poczatek);

  Readln(i);
end.