APR, przykłady

Sortowanie szybkie

Poniższa implementacja sortowania szybkiego stosuje najprostszy sposób przekazywania danych między różnymi funkcjami czy między różnymi wywołaniami tej samej funkcji – zmienne globalne. Zmienne te są zdefiniowane na samym początku programu (w poniższym przykładzie jest to tablica A). Uwalnia nas to od konieczności przekazywania tablic jako argumentów funkcji, co może rodzić problemy na wstępnym etapie programowania. Nie jest to sposób uważany dzisiaj w programowaniu za dobry, ale jest proste i na początek nam wystarczy.

program QS;

var A: array[1..1000] of LongInt;

function Pivot(p, r: LongInt): LongInt;
var i,j: LongInt;
    x: LongInt;
    temp: LongInt;
begin
    x := A[r];
    i := p -1;
    for j := p to r-1 do
        if A[j] <= x then
        begin
            i := i + 1;
            temp := A[i];
            A[i] := A[j];
            A[j] := temp;
        end;
    i := i + 1;
    A[r] := A[i];
    A[i] := x;
    Pivot := i;
end;

procedure QuickSort(p, r: LongInt);
var q: LongInt;
begin
    if p < r then
    begin
        q := Pivot(p,r);
        QuickSort(p, q-1);
        QuickSort(q+1, r);
    end;
end;

var
    i,n: LongInt;
begin
    ReadLn(n);
    for i := 1 to n do
        ReadLn(A[i]);
    QuickSort(1, n);
    for i := 1 to n do
        WriteLn(A[i]);
end.

Lista dwukierunkowa

O ile implementacja kolejki czy stosu jest łatwo wykonalna przy użyciu zmiennych globalnych, o tyle sensowna implementacja kolejki wymaga użycia nieznanych nam rekordów i wskaźników.

Rekordy

Rekordy to sposób na łączenie jakichś danych cząstkowych w większe jednostki. Robimy to przez tworzenie nowych typów danych. Dla przykładu punkt na płaszczyźnie ma dwie współrzędne, mimo to myślimy o nim jako o całości, moglibyśmy napisać w Pascalu:

type Point = record
    x: Real;
    y: Real;
end;

var a, b: Point;

Po stworzeniu typu rekordu możemy tworzyć zmienne tego typu oraz stosować ten typ jako typ argumentu procedur i funkcji. Do poszczególnych składowych rekordów – zwanych polami rekordu – odwołujemy się z użyciem kropki:

a.x = 5;
a.y = 10; //definiujemy punkt (5, 10)

Wskaźniki

Znacznie mniej intuicyjne są wskaźniki. Odpowiadają one temu co na rysunkach list czy drzew będziemy oznaczać strzałkami. Wskaźnik pozwala dostać się do obiektu na który wskazuje, ale jednocześnie można go kopiować bez wpływu na obiekt wskazywany.

Ponieważ zmienne przechowywane w pamięci operacyjnej komputera mają adresy będące liczbami, z reguły wskaźniki to po prostu te adresy. Dobrze widać to na ilustracji na WikiBooks.

Każdy wskaźnik musi być zmienną określonego typu wskaźnikowego, abyśmy wiedzieli jakiego typu obiekt dostaniemy, gdy podążymy za wskaźnikiem (dokonamy dereferencji wskaźnika). Typ wskaźnikowy oznaczamy wstawiając ^ przed nazwą typu, dereferencję wskaźnika – umieszczając ^ po nazwie konkretnego wskaźnika.

Operator @ tworzy wskaźnik, który wskazuje na przekazany obiekt/zmienną (jest to tzw. operator pobrania adresu).

Każdy wskaźnik może przyjmować specjalną wartość nil oznaczającą, że na nic nie wskazuje.

var x: LongInt;
    p: ^LongInt;
    // p jest wskaźnikiem na LongInt

begin
    x := 5;
    p := @x;     // Teraz p wskazuje na x.
    WriteLn(p);  // Wypisuje adres zmiennej x.
    WriteLn(p^); // Wypisuje 5.
    p^ := 10;    // Zmieniamy zawartość zmiennej
                 // wskazywanej przez p.
    WriteLn(x);  // Wypisuje 10.
end.

Dynamiczna alokacja pamięci

Wskaźniki są istotne, ponieważ pozwalają na tworzenie obiektów w czasie pracy programu, kiedy te stają się potrzebne. Służy do tego procedura New. Przy każdym wywołaniu New zostanie przydzielony naszemu programowi nowy fragment pamięci będący w stanie pomieścić obiekt odpowiedniego typu i wskaźnik do tej pamięci zostanie zapisany w przekazanym wskaźniku.

Co do zasady, każdy tak przydzielony fragment pamięci powinien zostać zwolniony kiedy przestaje być potrzebny. Służy do tego tego procedura Dispose. zwraca ona pamięć wskazywaną przez przekazany do niej wskaźnik. Dobrą praktyką jest przypisać następnie temu wskaźnikowi wartość nil, pokazując, że nie ma on już sensownej wartości.

Dynamiczne zarządzanie pamięcią jest trudne i bynajmniej dwa zdania tego tematu nie wyczerpują. Powyższe ma służyć zasygnalizowaniu problemu.

Implementacja listy dwukierunkowej

Każdy węzeł listy (Node) będzie rekordem posiadającym trzy pola:

  • key – przechowywaną wartość liczbową
  • prev – wskaźnik na poprzedni element listy
  • next – wskaźnik na następny element listy

Oprócz tego w programie mamy także wskaźnik head wskazujący na pierwszy element listy.

Implementacja listy i trzech przykładowych operacji mogłaby wygląda następująco:

program Lista;

type Node = record
       key: LongInt;
       prev: ^Node;
       next: ^Node;
     end;

var head: ^Node = nil;
    // Wartość początkowa wskaźnika to nil.

// Pomocnicza procedura
// wyświetlająca podany komunikat
// i kończąca działanie porgramu.
procedure ERROR(msg: String);
begin
    WriteLn('ERROR');
    WriteLn(msg);
    Halt;
end;

// Procedura tworzy nowy węzeł listy
// zawierający przekazaną wartość
// i dodaje go na początek listy.
procedure InsertHead(x: LongInt);
var t: ^Node;
begin
    New(t);
    t^.key := x;
    t^.prev := nil;
    t^.next := head;
    if head <> nil then
        head^.prev := t;
    head := t;
end;

// Funkcja usuwa pierwszy element listy
// i zwraca przechowywaną w nim wartość.
function DeleteHead(): LongInt;
var t: ^Node;
begin
    if head <> nil then
    begin
        DeleteHead := head^.key;
        t := head^.next;
        Dispose(head);
        head := t;
        head^.prev := nil;
    end
    else
        ERROR('Pusta lista');
end;

// Funkcja wypisuje wartości
// przechowywane w elementach listy
// zaczynając od head.
procedure Traverse();
var t: ^Node;
begin
    t := head;
    while t <> nil do
    begin
        WriteLn(t^.key);
        t := t^.next;
    end;
end;

begin
    InsertHead(1);
    InsertHead(2);
    InsertHead(3);
    Traverse;
    WriteLn(DeleteHead());
    InsertHead(7);
    Traverse;
end.

Drzewa wyszukiwań binarnych

Poniższy kod przechowuje drzewo przy użyciu czterech tablic o takim samym rozmiarze. Elementy pod takim samym indeksem (np. p[1], key[1], left[1] i right[1]) kodują odpowienie pola jednego węzła drzewa BST (rodzic, klucz, potomkowie). Korzeń drzewa przechowywany jest w zmiennej root. Wolne indeksy w tablicach są przechowywane w dodatkowej liście (o głowie przechowywanej w zmiennej free), elementy tej listy są powiązane przez wartości przechowywane w tablicy p (indeksy na liście nie są węzłami drzewa, więc odpowednie wartości w tablicy p można zmienić bez szkody dla drzewa).

program Tree;

{$mode objfpc}
uses sysutils;

const
    N = 1000;

var p:     array[1..N] of Integer;
    left:  array[1..N] of Integer;
    right: array[1..N] of Integer;
    key:   array[1..N] of LongInt;
    root: Integer;
    free: Integer;

// Pomocnicza procedura
// wyświetlająca podany komunikat
// i kończąca działanie porgramu.
procedure ERROR(msg: String);
begin
    WriteLn('ERROR');
    WriteLn(msg);
    Halt;
end;

// Funkcja zwraca pierwszy wolny
// indeks z listy wolnych indeksów,
// i usuwa go z tej listy.
function AllocateNode: Integer;
begin
    if free = 0 then
        ERROR('Brak miejsca');
    Result := free;
    free := p[free];
    p[Result] := 0;
end;

// Funkcja dodaje indeks do listy
// wolnych indeksów.
procedure FreeNode(x: Integer);
begin
    if x <> 0 then
    begin
        p[x] := free;
        key[x] := 0;
        left[x] := 0;
        right[x] := 0;
        free := x;
    end;
end;

// Procedura inicjuje drzewo
// (w zasadzie głównie listę
// wolnych indeksów).
procedure BST_Init;
var
    i: integer;
begin
    root := 0;
    free := 1;
    for i := 1 to N-1 do
        p[i] := i+1;
end;

// Poniższa procedura wstawia węzeł
// o indeksie x do drzewa BST.
// Zakładamy, że x nie jest elementem drzewa,
// ma wpisany odpowiedni klucz
// i wskaźniki ustawione wstępnie na 0.
procedure BST_Insert(x: Integer);
var
    y, z: Integer;
begin
    z := 0;
    y := root;
    while y <> 0 do
    begin
        z := y;
        if key[x] < key[y] then
            y := left[y]
        else
            y := right[y];
    end;
    p[x] := z;
    if z = 0 then
        root := x
    else
        if key[x] < key[z] then
            left[z] := x
        else
            right[z] := x;
end;

// Procedura "przekleja" zastępuje
// drzewo binarne o korzeniu x
// drzewem binarnym o korzeniu y.
procedure BST_Transplant(x, y: Integer);
begin
    if p[x] = 0 then
        root := y
    else
        if x = left[p[x]] then
            left[p[x]] := y
        else
            right[p[x]] := y;
    if y <> 0 then
        p[y] := p[x];
end;

// Funkcja znajduje element o najmniejszym kluczu
// w drzewie BST o korzeniu x.
function BST_Minimum(x: Integer): Integer;
begin
    Result := x;
    while left[Result] <> 0 do
        Result := left[Result];
end;

// Procedura usuwa z drzewa BST element
// o indeksie x.
// Zakładamy, że x jest rzeczywiście
// elementem drzewa.
procedure BST_Delete(x: Integer);
var
    y: Integer;
begin
    if left[x] = 0 then
    begin
        BST_Transplant(x, right[x]);
    end
    else if right[x] = 0 then
    begin
        BST_Transplant(x, left[x]);
    end
    else
    begin
        y := BST_Minimum(right[x]);
        if p[y] <> x then
        begin
            BST_Transplant(y, right[y]);
            right[y] := right[x];
            p[right[y]] := y;
        end;
        BST_Transplant(x, y);
        left[y] := left[x];
        p[left[y]] := y;
    end;
    FreeNode(x);
end;

// Pomocnicza procedura, wypisuje
// zawartośc wszystkich istotnych zmiennych.
procedure WriteTree;
var i: Integer;
begin
    Write('Tree root: ');
    Write(root);
    Write('   Free list head: ');
    WriteLn(free);
    Write('Parent: ');
    for i := 1 to N do
        Write(Format('%3d', [p[i]]));
    WriteLn;
    Write('Key:    ');
    for i := 1 to N do
        Write(Format('%3d', [key[i]]));
    WriteLn;
    Write('Left:   ');
    for i := 1 to N do
        Write(Format('%3d', [left[i]]));
    WriteLn;
    Write('Right:  ');
    for i := 1 to N do
        Write(Format('%3d', [right[i]]));
    WriteLn;
end;

var i, t: integer;
    x: LongInt;
begin
    BST_Init(); // Inicjujemy drzewo
    Randomize;
    for i := 1 to 10 do
    begin // dodajemy 10 losowych wartości
        WriteLn('Adding random node');
        t := AllocateNode();
        key[t] := Random(99)+1;
        BST_Insert(t);
        WriteTree;
    end;
    for i := 1 to 5 do
    begin // 5 razy usuwamy korzeń
        WriteLn('Deleting root node');
        BST_Delete(root);
        WriteTree;
    end;
    for i := 1 to 5 do
    begin // 5 razy dodajemy losową wartość
        WriteLn('Adding random node');
        t := AllocateNode();
        key[t] := Random(99)+1;
        BST_Insert(t);
        WriteTree;
    end;
end.