"Drzewa" i "las"

[gaweł]

Drzewa binarne

Chcąc ocalić od zapomnienia. Garść dywagacji na temat drzew binarnych.https://www.youtube.com/watch?v=2oANV6SQhwI

Jest taki wynalazek, który nazywa się drzewa binarne. Przymiotnik „binarne” symbolizuje to, że każdy element drzewa ma dwóch potomków (synów czy córek). To dosyć wygodna struktura pozwalająca na usystematyzowanie (uporządkowanie) czegoś. Oczywiście zastosowań tego algorytmu można zaproponować całe multum. Bazując na tym algorytmie realizowałem pierwsze rozwiązania z tematu baz danych. Jednak zanim zagłębię się w to zagadnienie, w pierwszej kolejności przedstawię kilka dywagacji i rozważań na temat algorytmu. Te eksperymenty będą oparte o zmienne wskaźnikowe lokowane w pamięci programu. Struktura elementu drzewa (Node) w najprostszym rozwiązaniu pokazana jest na rysunku:

tree01-01.png

gdzie:

• Klucz – jest porządkowaną informacją, w przykładach jest to liczba, w ogólnym przypadku może być to dowolna informacja, dla której można określić funkcję komparującą, funkcję do porównywania treści kluczy, która daje wynik: równy, mniejszy lub większy.
• Link w lewo – jest wskazaniem na kolejny element drzewa, który zawiera klucze mniejsze od aktualnego (zawartego w określonym elemencie drzewa),
• Link w prawo – jest wskazaniem do kolejny element drzewa, który zawiera klucze większe od aktualnego.

W prezentacji będą używane liczby jako klucze, dla których prosto realizuje się funkcję porządkującą: liczba może być mniejsza od innej, większa od innej lub równa. Równie dobrze w roli klucza można zastosować dowolne łańcuchy znaków, dla których można zaproponować funkcję porządkującą odzwierciedlającą kolejność alfabetyczną.
Z drzewem związany jest element będący szczytem (początkiem) drzewa. Czasem można napotkać określenie: korzeń. To trochę przypomina dywagację filozoficzną, gdyż korzeń to z reguły rośnie w ziemi a szczyt drzewa ucieka „do nieba” w kosmos. Jakkolwiek by to nazywać, znaczenie tego jest takie, że wskazuje na pierwszy element struktury drzewa.
Program ilustrujący jest w Lazarus (Pascal).
Rozpatrzmy taki typ:

Kod: Zaznacz cały

type
  NodeRecordTypePtr     = ^ NodeRecordType ;
  NodeRecordType        = record
                            Key               : integer ;
                            LeftLink          : NodeRecordTypePtr ;
                            RightLink         : NodeRecordTypePtr ;
                          end (* record *) ;

i zmienną:

Kod: Zaznacz cały

var
  TopTree               : NodeRecordTypePtr ;     

Podstawienie:

Kod: Zaznacz cały

 TopTree := nil ;

oznacza, że drzewo symbolizowane zmienną TopTree jest puste (nie zawiera żadnego elementu). Wszelkie operacje na drzewach najprościej implementują się w oparciu o algorytmy rekurencyjne. Rozpatrzmy procedurę budującą drzewo:

Kod: Zaznacz cały

procedure AddKey (     Key       : integer ;
                   var NodeEntry : NodeRecordTypePtr ) ;
begin (* AddKey *)
  if NodeEntry = nil then
  begin (* 1 *)
    New ( NodeEntry ) ;
    NodeEntry ^ . Key := Key ;
    NodeEntry ^ . LeftLink := nil ;
    NodeEntry ^ . RightLink := nil ;
  end (* 1 *)
  else
    if Key < NodeEntry ^ . Key then
      AddKey ( Key , NodeEntry ^ . LeftLink )
    else
      AddKey ( Key , NodeEntry ^ . RightLink )
end (* AddKey *) ;

Procedura dodaje nowy klucz (reprezentowany przez parametr Key) do drzewa (reprezentowanego przez parametr NodeEntry). Istotnym elementem jest to, że wskaźnik do drzewa musi być parametrem z zaklęciem var, procedura dodania elementu drzewa dodając modyfikuje wskaźniki, które muszą być „widoczne” na zewnątrz. Algorytm jest rekurencyjny a jego realizacja jest operacją poszukiwania z ewentualnym wstawieniem nowego elementu. Nowy element zawsze doda się na końcu gałęzi drzewa, czyli rekurencyjnie należy dokręcić się do takiego miejsca, gdzie bieżący wskaźnik elementu drzewa jest nil. Jeżeli bieżący element istnieje (jest różny od nil), to należy odpowiednio (w ogólnym przypadku w wyniku zastosowania funkcji porządkującej) przeszukać lewe (reprezentowane przez dziecko LeftLink) lub prawe (reprezentowane przez dziecko RightLink) poddrzewo. Tu, dla uproszczenia nie jest rozpatrywana kwestia duplikatów, dodania elementu już istniejącego (gdzie funkcja porządkująca da wynik: równy, o czym będzie później).
Rozpatrzmy ciąg wywołań:

Kod: Zaznacz cały

  TopTree := nil ;
  AddKey ( 8 , TopTree ) ;
  AddKey ( 4 , TopTree ) ;
  AddKey ( 12 , TopTree ) ;
  AddKey ( 2 , TopTree ) ;
  AddKey ( 6 , TopTree ) ;
  AddKey ( 10 , TopTree ) ;
  AddKey ( 14 , TopTree ) ;
  AddKey ( 1 , TopTree ) ;
  AddKey ( 3 , TopTree ) ;
  AddKey ( 5 , TopTree ) ;
  AddKey ( 7 , TopTree ) ;
  AddKey ( 9 , TopTree ) ;
  AddKey ( 11 , TopTree ) ;
  AddKey ( 13 , TopTree ) ;
  AddKey ( 15 , TopTree ) ;

Po wstępnym podstawieniu TopTree:=nil drzewo jest puste i pierwsze rekurencyjne wywołanie AddKey ( 8 , TopTree ) ; utworzy element. Utworzony element „doczepi się” do zmiennej TopTree (parametr w wywołaniu funkcji dodania klucza jest typu var).Po pierwszym wywołaniu będzie:

tree01-02.png

Kolejne wywołanie: AddKey ( 4 , TopTree ) ; zauważy, że nowododawany klucz (4) jest mniejszy od aktualnego (8), więc dojdzie do rekurencyjnego wywołania z potomkiem LeftLink. Ponieważ ten jest równy nil, utworzy się nowy element, który doczepi się jako potomek LeftLink. Po akcji będzie:

tree01-03.png

Po kolejnej akcji, drzewo przyjmie postać:

tree01-04.png

Po kolejnej serii wywołań:

Kod: Zaznacz cały

  AddKey ( 2 , TopTree ) ;
  AddKey ( 6 , TopTree ) ;
  AddKey ( 10 , TopTree ) ;
  AddKey ( 14 , TopTree ) ;

Drzewo wygląda następująco:

tree01-05.png

Ostatecznie:

tree01-06.png

Tu muszę się przyznać, że przykład dobrany jest tendencyjnie, by wszystko wyszło „ładnie”. Niestety nie zawsze jest tak pięknie i cudownie, co wymaga trochę trudu by doprowadzić do takiego stanu (będzie o tym dalej).
Rozpatrzmy inny ciąg wywołań procedur realizujących budowanie drzewa.

Kod: Zaznacz cały

  TopTree := nil ;
  AddKey ( 7 , TopTree ) ;
  AddKey ( 6 , TopTree ) ;
  AddKey ( 5 , TopTree ) ;
  AddKey ( 4 , TopTree ) ;
  AddKey ( 3 , TopTree ) ;
  AddKey ( 2 , TopTree ) ;
  AddKey ( 1 , TopTree ) ;

Doprowadzi on do następującego efektu:

tree01-07.png

W tym wypadku doświadczymy pewnej przykrości: drzewo binarne zredukowało się do listy liniowej. Ma to dosyć istotny wpływ na optymalność rozwiązania pod każdym względem:

• algorytm musi się głębiej wkręcać rekurencyjnie, co odbija się na wielkości wymaganego stosu,
• koszt poszukiwania elementu jest proporcjonalny do liczby elementów (w przypadku „pięknego drzewa”, koszt jest proporcjonalny do logarytmu przy podstawie 2 z liczby elementów).

Jednak nie ma co płakać nad rozlanym mlekiem. Na każdą koncepcję można zaproponować anykoncepcję. Również w tym przypadku da się coś zaradzić na tą przypadłość (ale to w dalszej części). Bez względu na optymalność ostatecznej postaci drzewa, która rzutuje jedynie na koszty operacyjne, podstawowe akcje są następujące:
Poszukiwanie elementu w drzewie:

Kod: Zaznacz cały

function SearchKey ( Key       : integer ;
                     NodeEntry : NodeRecordTypePtr ) : NodeRecordTypePtr ;
begin (* SearchKey *)
  if NodeEntry = nil then
    SearchKey := nil
  else
    if NodeEntry ^ . Key = Key then
      SearchKey := NodeEntry
    else
      if Key < NodeEntry ^ . Key then
        SearchKey := SearchKey ( Key , NodeEntry ^ . LeftLink )
      else
        SearchKey := SearchKey ( Key , NodeEntry ^ . RightLink )
end (* SearchKey *) ;

Funkcja poszukująca zwraca wskaźnik do znalezionego elementu (jeżeli został znaleziony). Jeżeli aktualny wskaźnik jest pusty (NodeEntry = nil), to oznacza, że poszukiwany element nie występuje w drzewie (dotarliśmy do granic galaktyki i nie natrafiliśmy na poszukiwany element). W przeciwnym wypadku (element drzewa istnieje), to są dwa wyjścia: albo został znaleziony (to zwracany jest jako wynik funkcji wskaźnik do tego elementu) albo nie: należy odpowiednio przeszukać lewe lub prawe poddrzewo. Zagadnienie ma charakter fraktalny: z każdego punktu widzenia wygląda identycznie.
Równie prosto jest realizowana operacja usunięcia całego drzewa.

Kod: Zaznacz cały

procedure DisposeTree ( var NodeEntry : NodeRecordTypePtr ) ;
begin (* DisposeTree *)
  if NodeEntry <> nil then
  begin (* 1 *)
    DisposeTree ( NodeEntry ^ . LeftLink ) ;
    DisposeTree ( NodeEntry ^ . RightLink ) ;
    Dispose ( NodeEntry ) ;
  end (* 1 *)
end (* DisposeTree *) ;

Rekurencyjny algorytm, z każdego punktu można interpretować następująco: usuń lewe poddrzewo, usuń prawe poddrzewo i usuń się sam.
Wydruk całego drzewa: nic prostszego:

Kod: Zaznacz cały

procedure PrintContent ( NodeEntry : NodeRecordTypePtr ) ;
begin (* PrintContent *)
  if NodeEntry <> nil then
  begin (* 1 *)
    PrintContent ( NodeEntry ^ . LeftLink ) ;
    Line := 'Klucz: ' + IntToStr ( NodeEntry ^ . Key ) ; <---- w znaczeniu
    Memo . Lines . Add ( Line ) ;                        <---- drukuj siebie
    PrintContent ( NodeEntry ^ . RightLink ) ;
  end (* 1 *) ;
end (* PrintContent *) ;

sprowadza się do: wydrukuj lewe poddrzewo (elementy uporządkowane młodsze), wydrukuj siebie i wydrukuj prawe poddrzewo (elementy uporządkowane starsze). W wyniku mamy uporządkowany ciąg elementów bez względu na kolejność wkładania. Wkładanie to ważna rzecz: w różny sposób tworzą się dzieci (jak było widać wyżej). Tu taka ciekawostka, zamieniamy kolejność rekurencyjnych wywołań: w pierwszej kolejności link w prawo, na koniec rekurencyjne wywołanie z linkiem w lewo. Uzyskamy wynik uporządkowany w przeciwną stronę: jak niewielka zmiana w algorytmie może mieć daleko idące skutki finalne.

Kod: Zaznacz cały

procedure PrintContent ( NodeEntry : NodeRecordTypePtr ) ;
begin (* PrintContent *)
  if NodeEntry <> nil then
  begin (* 1 *)
    PrintContent ( NodeEntry ^ . RightLink ) ;
    Line := 'Klucz: ' + IntToStr ( NodeEntry ^ . Key ) ;
    Memo . Lines . Add ( Line ) ;
    PrintContent ( NodeEntry ^ . LeftLink ) ;
  end (* 1 *) ;
end (* PrintContent *) ;

Z podstawowych operacji pozostało usunięcie określonego elementu z drzewa, ale to już w innym odcinku.
Dla tropicieli (Lazarus):

BinaryTree_01.7z

[j23]

Pięknie wytłumaczone... Ciekawe,bo dzisiaj akurat rozważałem zaprojektowanie kilka algorytmów do bardziej efektywnej komunikacji (dla ATTiny), które bazują niejako na wykorzystaniu drzewa binarnego. Niejako,no bo nie tylko na tym.
Bardzo spodobało mi się to wytłumaczenie,więc cierpliwie poczekam na dalszy ciąg tego tutoriala (algorytm usuwania WYBRANYCH węzłów drzewa), bo wtedy posiada się prawie gotową, bardzo wydajną metodologię postępowań do już praktycznego wykorzystania tego w/w wspaniałego algorytmu. A jest z czego korzystać... Znajomość postępowania z drzewami binarnymi bardzo przydaje się wraz z algorytmem kodowania Huffman'a,czy tzw.kodem liczbowym Gray'a, które to algorytmy mają już praktyczne, wymierne przełożenie na efektywność jakiegoś algorytmu do komunikacji. Np. żeby ograniczyć liczbę znaków alfanunerycznych, które to z kolei kodują rozkazy wykorzystane we wspomnianym przeze mnie algorytmie komunikacyjnym, (np.SND, RCV, ACK... etc.) można -wg metodologii postępowania z kodem Huffman'a- pogrupować te rozkazy w hierarchii od najczęściej do najrzadziej używanych, a żeby zwiększyć efektywność inkrementacji/dekrementacji przy odliczaniu zastosować kod Gray'a.
Kibicuję i czekam niecierpliwie na dalszą część tego tutoriala!
Pozdrawiam! J23

[gaweł]

Kibicuję i czekam niecierpliwie na dalszą część tego tutoriala!

No wiesz Jarku, robię co mogę. Trochę trzeba uzbroić się w cierpliwość, najwięcej czasu zajmują mi rysunki

[dambo]

a te rysunki w jakimś graficznym narzędziu, czy "nakodzone" w dot?

[gaweł]

a te rysunki w jakimś graficznym narzędziu, czy "nakodzone" w dot?

Wygooglaj sobie "Inkscape".

[gaweł]

Usuwanie elementów z drzewa binarnego

Nutahttps://www.youtube.com/watch?v=pjyFydbgBG4

O ile dodawanie elementów do drzewa jest dosyć prostą operacją, o tyle usunięcie już takie nie jest. W sytuacjach bardziej złożonych trzeba się trochę natrudzić. Wymaga to rozpatrzenia dwóch wariantów: gdzie element drzewa ma dwóch potomków oraz gdzie element ma jednego potomka (wariant braku jakiegokolwiek potomka można rozpatrywać jako przypadek szczególny jednego potomka). Zacznijmy od wariantu prostego (by nie rzec trywialnego): usuwany element drzewa nie ma żadnego potomka. Usuwamy końcowy element w gałęzi (przykładowo usuwamy klucz 5).

tree02-01.png

W elemencie nadrzędnym w odpowiednim linku wstawiamy nil, przez co usuwany element przestaje być elementem drzewa (nikt na niego nie wskazuje). Po odwiązaniu go od struktury drzewa można go fizycznie unicestwić. Zagadnienie jest symetryczne (w znaczeniu link w lewo lub w prawo).

tree02-02.png

Również mało skomplikowanie jest realizowana operacja usunięcia w przypadku, gdy element ma jednego potomka. Potomek usuwanego elementu zastąpi sam element, który w ten sposób staje się elementem spoza struktury.

tree02-03.png

Zagadnienie jest lustrzano-symetryczne.

tree02-04.png

Znacząco bardziej skomplikowane jest usunięcie elementu z dwoma potomkami.

tree02-05.png

Pozbądźmy się przykładowo elementu 4. W takim przypadku należy usuwany element niejako zastąpić innym. Tego innego, rzecz jasna należy odpowiednio znaleźć. Można (patrząc na drzewo z punktu widzenia usuwanego elementu) odnaleźć element, który nie ma prawego potomka zaczynając od lewej gałęzi. Sprowadza się to do pójścia prawą krawędzią do odpowiedniego elementu, ale pierwszy krok jest w lewo (w tym przypadku znaleźć element 3).

tree02-06.png

Przepisać dane użytkowe (w tym przypadku jedynie klucz).

tree02-07.png

Przepisać lewego potomka do elementu nadrzędnego (pamiętamy, że znaleziony element nie ma prawego potomka).

tree02-08.png

W elemencie 3 również jest brak lewego potomka. Jednak w sytuacji, gdyby on istniał, zostanie zachowany jako dziecko innego rodzica. Po wykonanych roszadach, do fizycznego uwalenia jest inny element niż się spodziewaliśmy. Teraz do utłuczenia jest element, z którego zostały „odessane” dane.

tree02-09.png

Kontynuując rozważania w zakresie struktur danych, procedura usuwania wygląda następująco:

Kod: Zaznacz cały

procedure DelKey (     Key       : integer ;
                   var NodeEntry : NodeRecordTypePtr ) ;
  var
    TempEntry           : NodeRecordTypePtr ;
  procedure RebuildTree ( var Ref : NodeRecordTypePtr ) ;
  begin (* RebuildTree *)
    if Ref ^ . RightLink <> nil then
      RebuildTree ( Ref ^ . RightLink )
    else
    begin (* 1 *)
      TempEntry ^ . Key := Ref ^ . Key ;
      TempEntry := Ref ;
      Ref := Ref ^ . LeftLink ;
    end (* 1 *) ;
  end (* RebuildTree *) ;

begin (* DelKey *)
  if NodeEntry <> nil then
    if Key < NodeEntry ^ . Key then
      DelKey ( Key , NodeEntry ^ . LeftLink )
    else
      if Key > NodeEntry ^ . Key then
        DelKey ( Key , NodeEntry ^ . RightLink )
      else
      begin (* 1 *)
        TempEntry := NodeEntry ;
        if NodeEntry ^ . RightLink = nil then
          NodeEntry := TempEntry ^ . LeftLink
        else
          if NodeEntry ^ . LeftLink = nil then
            NodeEntry := TempEntry ^ . RightLink
          else
            RebuildTree ( TempEntry ^ . LeftLink ) ;
        Dispose ( TempEntry ) ;
      end (* 1 *) ;
end (* DelKey *) ;

Algorytm, jest jak można się spodziewać, realizacją rekurencyjną. W klasyczny sposób poszukiwany jest element do usunięcia. Po jego znalezieniu rozpatrywane są konieczne warianty: czy usuwany element ma dwoje dzieci czy mniej. Jeżeli występują dwa potomki, to uruchamiana jest pomocnicza procedura do przebudowy drzewa (również rekurencyjna).
Jakby nad tym wszystkim trochę pomyśleć, to można zauważyć, że zastosowany sposób przebudowy drzewa wynikający z usunięcia elementu z dwoma potomkami nie jest jedynym rozwiązaniem. Równie skutecznym może być wariant, gdzie poszukuje się elementu nie mającego lewego potomka, jednak pierwszy krok jest zrealizowany w prawą stronę. Zagadnienie jest lustrzane. Rozpatrując to z innej strony, przy usuwaniu elementu 4 z drzewa, zostałby on zastąpiony elementem 5. Różnica, poza faktem migracji innych elementów, nie ma żadnego znaczenia.
Program ćwiczebny ma możliwość wydrukowania postaci drzewa. Wyżej opisany bardziej złożony wariant w wynikach generowanych przez program wygląda następująco:

tree02-10.png

Z pięknego drzewa (z czerwonymi linkami), usuwany jest element 4. Zaszła tu reorganizacja struktury i przetasowania. Wyniki prezentuje fragment z niebieskimi linkami.
W operacjach usuwania elementów drzewa występuje pewne zjawisko, które najprościej ujmując można określić jako migracja: czasami element zmienia miejsce „zamieszkania” (jak było widać w przypadku elementu 4). W pewnych specyficznych zastosowaniach ta cecha może okazać się niepożądaną, w innych może nie mieć znaczenia. To wszystko zależy od zastosowania.
Dla tropicieli:

BinaryTree_02.7z

[gaweł]

Drzewa binarne równoważone

Nutahttps://www.youtube.com/watch?v=EHhnD6QZUi0

Jak dało się wyżej zauważyć, normalne drzewa binarne mają jedną istotna wadę: w niekorzystnych przypadkach redukują się do listy liniowej. Na taka przypadłość jest odpowiednie lekarstwo: równoważenie drzewa binarnego. Drzewo jest traktowane za zrównoważone, jeżeli z każdego jego węzła długość lewej i prawej gałęzi nie różni się więcej niż o 1. To zmusza do przechowywania w każdym jego węźle aktualnego stanu zrównoważenia i po każdej akcji, która może doprowadzić do destabilizacji drzewa (każde dodanie lub usunięcie elementu) odpalana jest akcja łapania równowagi. To oznacza, że struktura węzła musi zostać rozbudowana:

Kod: Zaznacz cały

type
  BalanceState          = ( State1 , State2 , State3 ) ;
  NodeRecordTypePtr     = ^ NodeRecordType ;
  NodeRecordType        = record
                            Key               : integer ;
                            Balance           : BalanceState ;
                            LeftLink          : NodeRecordTypePtr ;
                            RightLink         : NodeRecordTypePtr ;
                          end (* record *) ;

Status niezrównoważenia jest informacją trzywartościową określającą stan równowagi przed operacją wstawienia. Na ilustracjach będzie symbolizowany przez:

• = (State1) → poprzednie niezrównoważenie zostało usunięte,
• < (State2) → środek ciężkości został przesunięty,
• ! (State3) → wymagane jest ponowne równoważenie.

Rozpatrzmy przypadek drzewa pustego, do którego dodany zostaje element 1.

tree03-01.png

Zostaje dodany element 2.

tree03-01a.png

Jest to drzewo zrównoważone. Z punktu widzenia elementu 2 obie gałęzie są tej samej długości (zerowej → równej). Z punktu widzenia elementu 1, drzewo jest również zrównoważone, gdyż długość lewej gałęzi (=0) nie różni się od długości prawej gałęzi (=1) o więcej niż 1. „Normalne” dodanie kolejnego elementu do drzewa doprowadzi do stanu drzewa niezrównoważonego. Stan przed akcją równoważenia pokazuje rysunek.

tree03-02.png

Operacja równoważenia polega na przeniesieniu środka ciężkości gałęzi, taki specyficzny obrót. Po dodaniu elementu 3 (z punktu widzenia elementu 2) zmieniły się długości gałęzi. Wycofując się z rekurencji, algorytm dojdzie do elementu 1. Ponieważ zmieniła się długość drzewa, oraz wskaźnik zrównoważenia jest ! → zostaje uruchomiona dla tego elementu akcja równoważenia.

tree03-03.png

Odpowiednie wskaźniki ulegają zmianie.

tree03-04.png

tree03-05.png

Ostatecznie:

tree03-06.png

Algorytm dodania elementu z kluczem do drzewa wraz z równoważeniem jest następujący:

Kod: Zaznacz cały

procedure AddKey (     Key           : integer ;
                   var NodeEntry     : NodeRecordTypePtr ;
                   var ChangedLength : boolean ) ;
  var
    Node1               : NodeRecordTypePtr ;
    Node2               : NodeRecordTypePtr ;
begin (* AddKey *)
  if NodeEntry = nil then
  begin (* 1 *)
    New ( NodeEntry ) ;
    ChangedLength := true ;
    NodeEntry ^ . Key := Key ;
    NodeEntry ^ . Balance := State2 ;
    NodeEntry ^ . LeftLink := nil ;
    NodeEntry ^ . RightLink := nil ;
  end (* 1 *)
  else
    if Key < NodeEntry ^ . Key then
    begin (* 1 *)
      AddKey ( Key , NodeEntry ^ . LeftLink , ChangedLength ) ;
      if ChangedLength then
        case NodeEntry ^ . Balance of
        State3 :
          begin (* 2 *)
            NodeEntry ^ . Balance := State2 ;
            ChangedLength := false ;
          end (* 2 *) ;
        State2 :
          NodeEntry ^ . Balance := State1 ;
        State1 :
          begin (* 2 *)
            Node1 := NodeEntry ^ . LeftLink ;
            if Node1 ^ . Balance = State1 then
            begin (* 3 *)
              NodeEntry ^ . LeftLink := Node1 ^ . RightLink ;
              Node1 ^ . RightLink := NodeEntry ;
              NodeEntry ^ . Balance := State2 ;
              NodeEntry := Node1 ;
            end (* 3 *)
            else
            begin (* 3 *)
              Node2 := Node1 ^ . RightLink ;
              Node1 ^ . RightLink := Node2 ^ . LeftLink ;
              Node2 ^ . LeftLink := Node1 ;
              NodeEntry ^ . LeftLink := Node2 ^ . RightLink ;
              Node2 ^ . RightLink := NodeEntry ;
              if Node2 ^ . Balance = State1 then
                NodeEntry ^ . Balance := State3
              else
                NodeEntry ^ . Balance := State2 ;
              if Node2 ^ . Balance = State3 then
                Node1 ^ . Balance := State1
              else
                Node1 ^ . Balance := State2 ;
              NodeEntry := Node2 ;
            end (* 3 *) ;
            NodeEntry ^ . Balance := State2 ;
            ChangedLength := false ;
          end (* 2 *) ;
        end (* case *) ;
    end (* 1 *)
    else
      if Key > NodeEntry ^ . Key then
      begin (* 1 *)
        AddKey ( Key , NodeEntry ^ . RightLink , ChangedLength ) ;
        if ChangedLength then
          case NodeEntry ^ . Balance of
          State1 :
            begin (* 2 *)
              NodeEntry ^ . Balance := State2 ;
              ChangedLength := false ;
            end (* 2 *) ;
          State2 :
            NodeEntry ^ . Balance := State3 ;
          State3 :
            begin (* 2 *)
              Node1 := NodeEntry ^ . RightLink ;
              if Node1 ^ . Balance = State3 then
              begin (* 3 *)
                NodeEntry ^ . RightLink := Node1 ^ . LeftLink ;
                Node1 ^ . LeftLink := NodeEntry ;
                NodeEntry ^ . Balance := State2 ;
                NodeEntry := Node1 ;
              end (* 3 *)
              else
              begin (* 3 *)
                Node2 := Node1 ^ . LeftLink ;
                Node1 ^ . LeftLink := Node2 ^ . RightLink ;
                Node2 ^ . RightLink := Node1 ;
                NodeEntry ^ . RightLink := Node2 ^ . LeftLink ;
                Node2 ^ . LeftLink := NodeEntry ;
                if Node2 ^ . Balance = State3 then
                  NodeEntry ^ . Balance := State1
                else
                  NodeEntry ^ . Balance := State2 ;
                if Node2 ^ . Balance = State1 then
                  Node1 ^ . Balance := State3
                else
                  Node1 ^ . Balance := State2 ;
                NodeEntry := Node2 ;
              end (* 3 *) ;
              NodeEntry ^ . Balance := State2 ;
              ChangedLength := false ;
            end (* 2 *) ;
          end (* case *) ;
      end (* 1 *)
      else
      begin (* 1 *)
        ChangedLength := false ;
      end (* 1 *) ;
end (* AddKey *) ;

Dotychczasowy najbardziej upierdliwy przypadek (dodanie kluczy już uporządkowanych), przy zastosowaniu algorytmu równoważenia wychodzi najbardziej cudownie.

tree03-07.png

Pozostałe operacje (poszukiwanie, usunięcie całego drzewa) są identyczne. Usuwanie pojedynczego elementu, jak można się spodziewać, również jest bardziej złożone, ale o tym później.

[gaweł]

Trochę testów RANDOM

Z nutąhttps://www.youtube.com/watch?v=FF1mh1wqFwg

Często tak się zdarza, że "ładnie" dobrane dane nie są w stanie zmusić program by przeszedł każdą swoją ścieżkę. Bo przykładowo, dodawanie kluczy już uporządkowanych w sposób monotoniczny, zmusza program do błądzenia ciągle po tych samych ścieżkach programu. By doświadczyć każdej możliwej drogi, to dobrym rozwiązaniem jest wygenerowanie danych w "losowej" kolejności. Napisałem "losowej" z uszkami, bo sama losowość jest w dużym stopniu również iluzoryczna. Nie miej potraktujmy, że poniższa sekwencja dodawania kluczy do drzewa jest losowa.

Kod: Zaznacz cały

procedure TBalancedTreeForm.CreateButtonClick ( Sender : TObject ) ;
  var
    ChangedLength       : boolean ;
  procedure AddOp ( Key : integer ) ;
    var
      Str               : String ;
  begin (* AddOp *)
    Str := 'Dodanie elementu: ' + IntToStr ( Key ) ;
    Memo . Lines . Add ( Str ) ;
    ChangedLength := false ;
    AddKey ( Key , TopTree , ChangedLength ) ;
    PrintButtonClick ( Sender ) ;
    SaveButtonClick ( Sender ) ;
  end  (* AddOp *) ;
begin (* TBalancedTreeForm.CreateButtonClick *)
  DisposeTree ( TopTree ) ;
  AddOp ( 7 ) ;
  AddOp ( 22 ) ;
  AddOp ( 35 ) ;
  AddOp ( 60 ) ;
  AddOp ( 34 ) ;
  AddOp ( 10 ) ;
  AddOp ( 24 ) ;
  AddOp ( 61 ) ;
  AddOp ( 39) ;
  AddOp ( 25 ) ;
  AddOp ( 41 ) ;
  AddOp ( 54 ) ;
  AddOp ( 46 ) ;
  AddOp ( 49) ;
  AddOp ( 11 ) ;
  AddOp ( 1 ) ;
  AddOp ( 28 ) ;
  AddOp ( 59) ;
  AddOp ( 13 ) ;
  AddOp ( 30 ) ;
  AddOp ( 14 ) ;
  AddOp ( 50 ) ;
  AddOp ( 32 ) ;
  AddOp ( 52 ) ;
  AddOp ( 2 ) ;
  AddOp ( 16 ) ;
  AddOp ( 56 ) ;
  AddOp ( 37 ) ;
  AddOp ( 4 ) ;
  AddOp ( 18 ) ;
  AddOp ( 42 ) ;
  AddOp ( 63 ) ;
  AddOp ( 3 ) ;
  AddOp ( 21 ) ;
  AddOp ( 29) ;
  AddOp ( 47 ) ;
  AddOp ( 31 ) ;
  AddOp ( 20 ) ;
  AddOp ( 58 ) ;
  AddOp ( 23 ) ;
  AddOp ( 62 ) ;
  AddOp ( 26 ) ;
  AddOp ( 27 ) ;
  AddOp ( 57 ) ;
  AddOp ( 5 ) ;
  AddOp ( 55 ) ;
  AddOp ( 6 ) ;
  AddOp ( 38 ) ;
  AddOp ( 8 ) ;
  AddOp ( 48 ) ;
  AddOp ( 9) ;
  AddOp ( 45 ) ;
  AddOp ( 53 ) ;
  AddOp ( 12 ) ;
  AddOp ( 19) ;
  AddOp ( 51 ) ;
  AddOp ( 15 ) ;
  AddOp ( 43 ) ;
  AddOp ( 44 ) ;
  AddOp ( 36 ) ;
  AddOp ( 17 ) ;
  AddOp ( 33 ) ;
  AddOp ( 40 ) ;
end (* TBalancedTreeForm.CreateButtonClick *) ;


Po każdej operacji dodania "drukowałem" do pliku postać drzewa. Nie ma sensu przeglądać wszystkich stanów pośrednich, niemniej warto przyjrzeć się efektowi końcowemu. Po dodaniu 63 kluczy w kolejności "losowej" drzewo wygląda... jak wygląda. Cóż, rysunek siłą rzeczy musi być szeroki.

tree04-01.png

Rozpatrując jego fragmenty zawsze można dostrzec, że jest zrównoważone. Wszędzie w obrębie jakiegokolwiek prostokąta długość lewej i prawej gałęzi nie różni się więcej niż o 1.

tree04-02.png

tree04-03.png

[gaweł]

Usuwanie elementów z drzewa wyważonego

Szczyty górhttps://www.youtube.com/watch?v=QFlcs8vwLK4

W swej podstawowej formie usuwanie elementów z drzewa wyważonego nie różni się od usuwania z drzewa nierównoważonego. Przypadek usunięcia elementu końcowego (który nie ma już potomków) podobnie jak w drzewie nierównoważonym jest trywialny. Po usunięciu elementu długość gałęzi ulega zmianie, co czasami rodzi potrzebę przerównoważenia całej reszty. Identycznie realizowane jest usunięcie elementy mającego jednego potomka. Jeden potomek tworzy lokalną listę liniową (minimum 2-elementową), więc usunięcie nie należy do operacji zbyt skomplikowanych. Również zmianie ulega długość gałęzi drzewa, więc ten fakt może być wyzwalaczem do akcji, której zadaniem jest przeniesienie środka ciężkości całego poddrzewa. Najbardziej złożony przypadek, w którym usuwany element ma dwóch potomków realizowany jest podobnie jak w drzewie nierównoważonym. Akcja polega na wyszukaniu elementu w poddrzewie, które przypięte jest do usuwanego elementu, który nie ma dwóch potomków. Po znalezieniu takiego elementu następuje akcja zamiany miejsc odpowiednich elementów, taka akcja migracyjna.
Mając to na uwadze, szczegóły koncepcyjne zostały już opisane wyżej: zarówno proces usuwania jak i równoważenia polegający na specyficznym rodzaju obrotu. Naturalnie ten obrót może nastąpić w lewą lub w prawą stronę w zależności od aktualnego rozkładu „masy drzewa”.

Kod: Zaznacz cały

procedure DelKey (     Key           : integer ;
                   var NodeEntry     : NodeRecordTypePtr ;
                   var ChangedLength : boolean ) ;
var
  TempEntry             : NodeRecordTypePtr ;

  procedure ReBalance1 ( var NodeEntry     : NodeRecordTypePtr ;
                         var ChangedLength : boolean ) ;
    var
      Node1             : NodeRecordTypePtr ;
      Node2             : NodeRecordTypePtr ;
      Balance1          : BalanceState ;
      Balance2          : BalanceState ;

  begin (* ReBalance1 *)
    case NodeEntry ^ . Balance of
      State1 :
       NodeEntry ^ . Balance := State2 ;
      State2 :
        begin (* 1 *)
          NodeEntry ^ . Balance := State3 ;
          ChangedLength := false ;
        end (* 1 *) ;
      State3 :
        begin (* 1 *)
          Node1 := NodeEntry ^ . RightLink ;
          Balance1 := Node1 ^ . Balance ;
          if ( Balance1 = State2 ) or ( Balance1 = State3 ) then
          begin (* 2 *)
            NodeEntry ^ . RightLink := Node1 ^ . LeftLink ;
            Node1 ^ . LeftLink := NodeEntry ;
            if Balance1 = State2 then
            begin (* 3 *)
              NodeEntry ^ . Balance := State3 ;
              Node1 ^ . Balance := State1 ;
              ChangedLength := false ;
            end (* 3 *)
            else
            begin (* 3 *)
              NodeEntry ^ . Balance := State2 ;
              Node1 ^ . Balance := State2 ;
            end (* 3 *) ;
            NodeEntry := Node1 ;
          end (* 2 *)
          else
          begin (* 2 *)
            Node2 := Node1 ^ . LeftLink ;
            Balance2 := Node2 ^ . Balance ;
            Node1 ^ . LeftLink := Node2 ^ . RightLink ;
            Node2 ^ . RightLink := Node1 ;
            NodeEntry ^ . RightLink := Node2 ^ . LeftLink ;
            Node2 ^ . LeftLink := NodeEntry ;
            if Balance2 = State3 then
              NodeEntry ^ . Balance := State1
            else
              NodeEntry ^ . Balance := State2 ;
            if Balance2 = State1 then
              Node1 ^ . Balance := State3
            else
              Node1 ^ . Balance := State2 ;
            NodeEntry := Node2 ;
            Node2 ^ . Balance := State2 ;
          end (* 2 *) ;
        end (* 1 *) ;
    end (* case *) ;
  end (* ReBalance1 *) ;

  procedure ReBalance2 ( var NodeEntry     : NodeRecordTypePtr ;
                         var ChangedLength : boolean ) ;
    var
      Node1             : NodeRecordTypePtr ;
      Node2             : NodeRecordTypePtr ;
      Balance1          : BalanceState ;
      Balance2          : BalanceState ;
  begin (* ReBalance2 *)
    case NodeEntry ^ . Balance of
      State3 :
        NodeEntry ^ . Balance := State2 ;
      State2 :
        begin (* 1 *)
          NodeEntry ^ . Balance := State1 ;
          ChangedLength := false ;
        end (* 1 *) ;
      State1 :
        begin (* 1 *)
          Node1 := NodeEntry ^ . LeftLink ;
          Balance1 := Node1 ^ . Balance ;
          if ( Balance1 = State1 ) or ( Balance1 = State2 ) then
          begin (* 2 *)
            NodeEntry ^ . LeftLink := Node1 ^ . RightLink ;
            Node1 ^ . RightLink := NodeEntry ;
            if Balance1 = State2 then
            begin (* 3 *)
              NodeEntry ^ . Balance := State1 ;
              Node1 ^ . Balance := State3 ;
              ChangedLength := false ;
            end (* 3 *)
            else
            begin (* 3 *)
              NodeEntry ^ . Balance := State2 ;
              Node1 ^ . Balance := State2 ;
            end (* 3 *) ;
            NodeEntry := Node1 ;
          end (* 2 *)
          else
          begin (* 2 *)
            Node2 := Node1 ^ . RightLink ;
            Balance2 := Node2 ^ . Balance ;
            Node1 ^ . RightLink := Node2 ^ . LeftLink ;
            Node2 ^ . LeftLink := Node1 ;
            NodeEntry ^ . LeftLink := Node2 ^ . RightLink ;
            Node2 ^ . RightLink := NodeEntry ;
            if Balance2 = State1 then
              NodeEntry ^ . Balance := State3
            else
              NodeEntry ^ . Balance := State2 ;
            if Balance2 = State3 then
              Node1 ^ . Balance := State1
            else
              Node1 ^ . Balance := State2 ;
            NodeEntry := Node2 ;
            Node2 ^ . Balance := State2 ;
          end (* 2 *) ;
        end (* 1 *) ;
    end (* case *) ;
  end (* ReBalance2 *) ;

  procedure RebuildTree ( var RefNode       : NodeRecordTypePtr ;
                          var ChangedLength : boolean ) ;
  begin (* RebuildTree *)
    if RefNode ^ . RightLink <> nil then
    begin (* 1 *)
      RebuildTree ( RefNode ^ . RightLink , ChangedLength ) ;
      if ChangedLength then
        ReBalance2 ( RefNode , ChangedLength ) ;
    end (* 1 *)
    else
    begin (* 1 *)
      TempEntry ^ . Key := RefNode ^ . Key ;
      TempEntry := RefNode ;
      RefNode := RefNode ^ . LeftLink ;
      ChangedLength := true ;
    end (* 1 *) ;
  end (* RebuildTree *) ;

begin (* DelKey *)
  if NodeEntry = nil then
    ChangedLength := false
  else
    if Key < NodeEntry ^ . Key then
    begin (* 1 *)
      DelKey ( Key , NodeEntry ^ . LeftLink , ChangedLength ) ;
      if ChangedLength then
        ReBalance1 ( NodeEntry , ChangedLength ) ;
    end (* 1 *)
    else
      if Key > NodeEntry ^ . Key then
      begin (* 1 *)
        DelKey ( Key , NodeEntry ^ . RightLink , ChangedLength ) ;
        if ChangedLength then
          ReBalance2 ( NodeEntry , ChangedLength ) ;
      end (* 1 *)
      else
      begin (* 1 *)
        TempEntry := NodeEntry ;
        if TempEntry ^ . RightLink = nil then
        begin (* 2 *)
          NodeEntry := TempEntry ^ . LeftLink ;
          ChangedLength := true ;
        end (* 2 *)
        else
          if TempEntry ^ . LeftLink = nil then
          begin (* 2 *)
            NodeEntry := TempEntry ^ . RightLink ;
            ChangedLength := true ;
          end (* 2 *)
          else
          begin (* 2 *)
            RebuildTree ( TempEntry ^ . LeftLink , ChangedLength ) ;
            if ChangedLength then
              ReBalance1 ( NodeEntry , ChangedLength ) ;
          end (* 2 *) ;
        Dispose ( TempEntry ) ;
      end (* 1 *) ;
end (* DelKey *) ;

Ilustracją działania powyższego algorytmu może być poniższy rysunek. Zrealizowane działania są dziełem programu.

tree05-01.png

Dla tropicieli:

BalanceTree_05.7z

[gaweł]

Problem duplikatów - zastosowanie drzewa

W dotychczasowych rozważaniach nie była poruszana kwestia duplikatów. Tak nazywam operację związaną z akcją programu w sytuacji, gdy w dodając nowy element do drzewa okazuje się, że taki już istnieje. Konkretne rozwiązanie zależy od zastosowania. Przykładowo, w problemie zasygnalizowanym przez J23 wystarczyłoby (tak sądzę) jedynie posiadanie w elemencie struktury drzewa pola o charakterze licznika, który w przypadku znalezienia duplikatu byłby inkrementowany. O ile dobrze zrozumiałem jego zagadnienie, problem polega na zliczeniu wystąpień określonych znaków.
Rozpatrzmy jako przykład zagadnienie bardziej złożone, które polega na zgromadzeniu informacji o każdym wystąpieniu elementu „godnego uwagi” w jakimś pliku tekstowym. Do interesujących elementów zaliczam słowa, liczby oraz napisy (ciągi znaków ujęte w apostrofy). Pozostałe element składniowe, jakie mogą wystąpić w pliku nie zaprzątają mojej uwagi (znaki interpunkcyjne, plusiki, minusiki itp.). Interesuje mnie każde wystąpienie wymienionych elementów. Jak wiadomo, liczba możliwych elementów → nieznana. Liczba wystąpień każdego elementu → nieznana. Do „pamiętania” zostanie zaprzęgnięte drzewo binarne. Ten algorytm pozwala szybko lokalizować elementy będące w obszarze mego zainteresowania. Dodatkowo, końcowy wynik, jest uporządkowany alfabetycznie → nie będzie wymagał sortowania.
To wymaganie (notowania każdego wystąpienia) sugeruje, że do każdego elementu drzewa musi zostać podczepiona lista wskaźnikowa wystąpień. Strukturę elementu drzewa pokazuje rysunek:

tree06-01.png

Ze względu na zastosowanie drzew równoważonych w strukturze występuje wskaźnik zrównoważenia. Klucz Key jest stringiem 20-znakowym (dotychczas były ćwiczone liczby). Wskaźniki w lewo i w prawo mają typowe znaczenie. Dochodzi pole przeznaczone na „katalog biblioteczny” → wskazania, gdzie dany element występuje w pliku. Liczba wystąpień jest nieokreślona, więc całość będzie przechowywana jako lista liniowa. Taka lista zawiera ważne dane oraz wskazanie na kolejny element zawierający zgromadzone informacje. Komentarze i ich zawartość jest pomijana.
Program ilustrujący rozwiązanie jest... jaki jest. Zdaję sobie sprawę, że ma wady, ale nie to jest obecnie najważniejszym celem. Celem jest pokazanie sposobu rozwiązania. Na końcu dołączam aktualną postać programu, jak ktoś ma ochotę, może pójść moimi śladami i pociągnąć sprawę dalej.
Reasumując, struktury danych są następujące:

Kod: Zaznacz cały

const
  Space                 = ' ' ;
  KeyLength             = 16 ;

type
  ReferencePointer      = ^ ReferenceRecord ;
  ReferenceRecord       = record
                            LineNo         : integer ;
                            FwdLink        : ReferencePointer ;
                          end (* record *) ;

  BalanceState          = ( State1 , State2 , State3 ) ;
  Ident                 = array [ 0 .. KeyLength - 1 ] of char ;
  NodeRecordTypePtr     = ^ NodeRecordType ;
  NodeRecordType        = record
                            Key               : Ident ;
                            Balance           : BalanceState ;
                            ReferenceEntry    : ReferencePointer ;
                            LeftLink          : NodeRecordTypePtr ;
                            RightLink         : NodeRecordTypePtr ;
                          end (* record *) ;

Szczyt drzewa jest reprezentowany przez:

Kod: Zaznacz cały

var
  TopCrossTree          : NodeRecordTypePtr ;

Dodanie elementu ulega pewnej modyfikacji związanej z realizowaną funkcją

Kod: Zaznacz cały

procedure AddKey (     Key           : Ident ;
                       LineNo        : integer ;
                   var NodeEntry     : NodeRecordTypePtr ;
                   var ChangedLength : boolean ) ;
  var
    Node1               : NodeRecordTypePtr ;
    Node2               : NodeRecordTypePtr ;
    ReferenceElement    : ReferencePointer ;

begin (* AddKey *)
  if NodeEntry = nil then
  begin (* 1 *)
    New ( NodeEntry ) ;
    New ( ReferenceElement ) ;
    ChangedLength := true ;
    NodeEntry ^ . Key := Key ;
    NodeEntry ^ . Balance := State2 ;
    NodeEntry ^ . LeftLink := nil ;
    NodeEntry ^ . RightLink := nil ;
    NodeEntry ^ . ReferenceEntry := ReferenceElement ;
    ReferenceElement ^ . LineNo := LineNo ;
    ReferenceElement ^ . FwdLink := nil ;
  end (* 1 *)
  else

(. . .)

      begin (* 1 *)
        New ( ReferenceElement ) ;
        ReferenceElement ^ . LineNo := LineNo ;
        ReferenceElement ^ . FwdLink := NodeEntry ^ . ReferenceEntry ;
        NodeEntry ^ . ReferenceEntry := ReferenceElement ;
        ChangedLength := false ;
      end (* 1 *) ;
end (* AddKey *) ;


Pierwsze wystąpienie elementu drzewa (przypadek: NodeEntry = nil) tworzy element drzewa oraz odnotowuje lokalizację gdzie określony element się znajduje. Kolejne wystąpienie (ostatni wariant ciągu if … else) to jedynie podczepienie kolejnego wystąpienia do istniejącej już listy.
Z punktu widzenia rozważań drzewiastych, siłą rzeczy rozbudowie musi ulec również operacja zwolnienia całego drzewa. Ze względu na obciążenie każdego elementu drzewa listą liniową, przed dezintegracją każdego elementu, konieczne staje się usunięcie całej listy. Ta operacja występuje zarówno w przypadku usunięcia całego drzewa, jak i pojedynczego jego elementu (przed „ubiciem” elementu węzła drzewa, należy usunąć listę liniową, jak się o tym zapomni, to zostaną bezpowrotnie stracone [dla programu] obszary pamięci).
Pozostałe operacje typowe dla rozwiązań drzewiastych nie ulegają zmianie. Wszelkie zachodzące modyfikacje właściwie należy interpretować jako „coś odnoszące się do siebie”. Przykładowo, przed akcją „usuń siebie” jest wykonana akcja „usuń listę wystąpień”.

Kod: Zaznacz cały

procedure DisposeTree ( var NodeEntry : NodeRecordTypePtr ) ;

  procedure DisposeReference ( RefEntry : ReferencePointer ) ;
    var
      NextEntry         : ReferencePointer ;
  begin (* DisposeReference *)
    while RefEntry <> nil do
    begin (* 1 *)
      NextEntry := RefEntry ^ . FwdLink ;
      Dispose ( RefEntry ) ;
      RefEntry := NextEntry ;
    end (* 1 *) ;
  end (* DisposeReference *) ;

begin (* DisposeTree *)
  if NodeEntry <> nil then
  begin (* 1 *)
    DisposeTree ( NodeEntry ^ . LeftLink ) ;
    DisposeReference ( NodeEntry ^ . ReferenceEntry ) ;
    DisposeTree ( NodeEntry ^ . RightLink ) ;
    Dispose ( NodeEntry ) ;
    NodeEntry := nil ;
  end (* 1 *) ;
end (* DisposeTree *) ;

Podobnie ma się sprawa dotycząca wydrukowania zawartości drzewa. Algorytm jest rekurencyjny, jak w dotychczasowych rozwiązaniach. Natomiast akcja, którą można określić jako „drukuj siebie” jest nieco rozbudowana.

Kod: Zaznacz cały

  var
    Str                 : string ;

  procedure PrintContent ( NodeEntry : NodeRecordTypePtr ) ;

    var
      Counter           : integer ;
      RefElem           : ReferencePointer ;

  begin (* PrintContent *)
    if NodeEntry <> nil then
    begin (* 1 *)
      PrintContent ( NodeEntry ^ . LeftLink ) ;
      Str := NodeEntry ^ . Key + ' ' ;
      Counter := 0 ;
      RefElem := NodeEntry ^ . ReferenceEntry ;
      repeat
        Str := Str + LineNumberCnv ( RefElem ^ . LineNo ) + ' ' ;
        RefElem := RefElem ^ . FwdLink ;
        Counter := Counter + 1 ;
        if Counter > 20 then
        begin (* 2 *)
          Memo . Lines . Add ( Str ) ;
          Str := '' ;
          for Counter := 0 to KeyLength do
            Str := Str + ' ' ;
          Counter := 0 ;
        end (* 2 *) ;
      until RefElem = nil ;
      if Counter <> 0 then
        Memo . Lines . Add ( Str ) ;
      PrintContent ( NodeEntry ^ . RightLink ) ;
    end (* 1 *) ;
  end (* PrintContent *) ;

Eksperymentując na sobie (program przetworzył sam siebie), uzyskuje się następujący wynik (plik zawiera ponumerowane wiersze tekstu wejściowego oraz na końcu ma załączony „alfabetyczny” zestaw wystąpień). Napisałem „alfabetyczny” bo nie jest to do końca prawdą (przykładowo litera 'a' jest alfabetycznie starsza od litery 'A'). Problem rozbija się w realizacji instrukcji porównania kluczy:

Kod: Zaznacz cały

    if Key < NodeEntry ^ . Key then
( . . . )
      if Key > NodeEntry ^ . Key then

ta realizacja nie bierze pod uwagę pisowni małymi i wielkimi literami. Inny problem to nie do końca poprawnie rozwiązane przetwarzanie napisów (znany problem apostrofa w apostrofach: w pascalu zapisuje się to Ch := '''' ;(4 znaki '), co program rozpozna jako dwa puste napisy). Również w ogóle nie rozpatruje liczb zmiennoprzecinkowych. To nie było moim celem, jak ktoś ma ochotę, … zapraszam do rozwinięcia tematu. Z tego może powstać całkiem interesujące narzędzie pomocne w analizie cudzych programów.

Kod: Zaznacz cały

   1.
   2. unit CrossRefUnit;
   3.
   4. {$mode objfpc}{$H+}
   5.
   6. interface
   7.
   8. uses
   9.   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls;
  10.
  11. const
  12.   Space                 = ' ' ;
  13.   KeyLength             = 16 ;
  14.
  15. type
  16.   ReferencePointer      = ^ ReferenceRecord ;
  17.   ReferenceRecord       = record
  18.                             LineNo         : integer ;
  19.                             FwdLink        : ReferencePointer ;
  20.                           end (* record *) ;
  21.
  22.   BalanceState          = ( State1 , State2 , State3 ) ;
  23.   Ident                 = array [ 0 .. KeyLength - 1 ] of char ;
  24.   NodeRecordTypePtr     = ^ NodeRecordType ;
  25.   NodeRecordType        = record
  26.                             Key               : Ident ;
  27.                             Balance           : BalanceState ;
  28.                             ReferenceEntry    : ReferencePointer ;
  29.                             LeftLink          : NodeRecordTypePtr ;
  30.                             RightLink         : NodeRecordTypePtr ;
  31.                           end (* record *) ;
  32.
  33. //{ TCrossRefForm }
  34.
  35.   { TCrossRefForm }
  36.
  37.   TCrossRefForm = class(TForm)
  38.     OpenFileButton         : TButton ;
  39.     SaveButton             : TButton ;
  40.     Memo                   : TMemo ;
  41.     InputFileMemo          : TMemo ;
  42.     OpenFileDialog         : TOpenDialog ;
  43.     procedure FormCreate ( Sender : TObject ) ;
  44.     procedure OpenFileButtonClick ( Sender : TObject ) ;
  45.     procedure SaveButtonClick ( Sender : TObject ) ;
  46.     procedure RunProcess ;
  47.     procedure PrintCross ;
  48.   private
  49.     FileFileName        : string ;
  50.     { private declarations }
  51.   public
  52.     { public declarations }
  53.   end;
  54.
  55.
  56. var
  57.   CrossRefForm          : TCrossRefForm ;
  58.   TopCrossTree          : NodeRecordTypePtr ;
  59.
  60. implementation
  61.
  62. {$R *.lfm}
  63.
  64. { TCrossRefForm }
  65.
  66. procedure DisposeTree ( var NodeEntry : NodeRecordTypePtr ) ;
  67.
  68.   procedure DisposeReference ( RefEntry : ReferencePointer ) ;
  69.     var
  70.       NextEntry         : ReferencePointer ;
  71.   begin (* DisposeReference *)
  72.     while RefEntry <> nil do
  73.     begin (* 1 *)
  74.       NextEntry := RefEntry ^ . FwdLink ;
  75.       Dispose ( RefEntry ) ;
  76.       RefEntry := NextEntry ;
  77.     end (* 1 *) ;
  78.   end (* DisposeReference *) ;
  79.
  80. begin (* DisposeTree *)
  81.   if NodeEntry <> nil then
  82.   begin (* 1 *)
  83.     DisposeTree ( NodeEntry ^ . LeftLink ) ;
  84.     DisposeReference ( NodeEntry ^ . ReferenceEntry ) ;
  85.     DisposeTree ( NodeEntry ^ . RightLink ) ;
  86.     Dispose ( NodeEntry ) ;
  87.     NodeEntry := nil ;
  88.   end (* 1 *) ;
  89. end (* DisposeTree *) ;
  90.
  91.
  92. procedure AddKey (     Key           : Ident ;
  93.                        LineNo        : integer ;
  94.                    var NodeEntry     : NodeRecordTypePtr ;
  95.                    var ChangedLength : boolean ) ;
  96.   var
  97.     Node1               : NodeRecordTypePtr ;
  98.     Node2               : NodeRecordTypePtr ;
  99.     ReferenceElement    : ReferencePointer ;
 100.
 101. begin (* AddKey *)
 102.   if NodeEntry = nil then
 103.   begin (* 1 *)
 104.     New ( NodeEntry ) ;
 105.     New ( ReferenceElement ) ;
 106.     ChangedLength := true ;
 107.     NodeEntry ^ . Key := Key ;
 108.     NodeEntry ^ . Balance := State2 ;
 109.     NodeEntry ^ . LeftLink := nil ;
 110.     NodeEntry ^ . RightLink := nil ;
 111.     NodeEntry ^ . ReferenceEntry := ReferenceElement ;
 112.     ReferenceElement ^ . LineNo := LineNo ;
 113.     ReferenceElement ^ . FwdLink := nil ;
 114.   end (* 1 *)
 115.   else
 116.     if Key < NodeEntry ^ . Key then
 117.     begin (* 1 *)
 118.       AddKey ( Key , LineNo , NodeEntry ^ . LeftLink , ChangedLength ) ;
 119.       if ChangedLength then
 120.         case NodeEntry ^ . Balance of
 121.         State3 :
 122.           begin (* 2 *)
 123.             NodeEntry ^ . Balance := State2 ;
 124.             ChangedLength := false ;
 125.           end (* 2 *) ;
 126.         State2 :
 127.           NodeEntry ^ . Balance := State1 ;
 128.         State1 :
 129.           begin (* 2 *)
 130.             Node1 := NodeEntry ^ . LeftLink ;
 131.             if Node1 ^ . Balance = State1 then
 132.             begin (* 3 *)
 133.               NodeEntry ^ . LeftLink := Node1 ^ . RightLink ;
 134.               Node1 ^ . RightLink := NodeEntry ;
 135.               NodeEntry ^ . Balance := State2 ;
 136.               NodeEntry := Node1 ;
 137.             end (* 3 *)
 138.             else
 139.             begin (* 3 *)
 140.               Node2 := Node1 ^ . RightLink ;
 141.               Node1 ^ . RightLink := Node2 ^ . LeftLink ;
 142.               Node2 ^ . LeftLink := Node1 ;
 143.               NodeEntry ^ . LeftLink := Node2 ^ . RightLink ;
 144.               Node2 ^ . RightLink := NodeEntry ;
 145.               if Node2 ^ . Balance = State1 then
 146.                 NodeEntry ^ . Balance := State3
 147.               else
 148.                 NodeEntry ^ . Balance := State2 ;
 149.               if Node2 ^ . Balance = State3 then
 150.                 Node1 ^ . Balance := State1
 151.               else
 152.                 Node1 ^ . Balance := State2 ;
 153.               NodeEntry := Node2 ;
 154.             end (* 3 *) ;
 155.             NodeEntry ^ . Balance := State2 ;
 156.             ChangedLength := false ;
 157.           end (* 2 *) ;
 158.         end (* case *) ;
 159.     end (* 1 *)
 160.     else
 161.       if Key > NodeEntry ^ . Key then
 162.       begin (* 1 *)
 163.         AddKey ( Key , LineNo , NodeEntry ^ . RightLink , ChangedLength ) ;
 164.         if ChangedLength then
 165.           case NodeEntry ^ . Balance of
 166.           State1 :
 167.             begin (* 2 *)
 168.               NodeEntry ^ . Balance := State2 ;
 169.               ChangedLength := false ;
 170.             end (* 2 *) ;
 171.           State2 :
 172.             NodeEntry ^ . Balance := State3 ;
 173.           State3 :
 174.             begin (* 2 *)
 175.               Node1 := NodeEntry ^ . RightLink ;
 176.               if Node1 ^ . Balance = State3 then
 177.               begin (* 3 *)
 178.                 NodeEntry ^ . RightLink := Node1 ^ . LeftLink ;
 179.                 Node1 ^ . LeftLink := NodeEntry ;
 180.                 NodeEntry ^ . Balance := State2 ;
 181.                 NodeEntry := Node1 ;
 182.               end (* 3 *)
 183.               else
 184.               begin (* 3 *)
 185.                 Node2 := Node1 ^ . LeftLink ;
 186.                 Node1 ^ . LeftLink := Node2 ^ . RightLink ;
 187.                 Node2 ^ . RightLink := Node1 ;
 188.                 NodeEntry ^ . RightLink := Node2 ^ . LeftLink ;
 189.                 Node2 ^ . LeftLink := NodeEntry ;
 190.                 if Node2 ^ . Balance = State3 then
 191.                   NodeEntry ^ . Balance := State1
 192.                 else
 193.                   NodeEntry ^ . Balance := State2 ;
 194.                 if Node2 ^ . Balance = State1 then
 195.                   Node1 ^ . Balance := State3
 196.                 else
 197.                   Node1 ^ . Balance := State2 ;
 198.                 NodeEntry := Node2 ;
 199.               end (* 3 *) ;
 200.               NodeEntry ^ . Balance := State2 ;
 201.               ChangedLength := false ;
 202.             end (* 2 *) ;
 203.           end (* case *) ;
 204.       end (* 1 *)
 205.       else
 206.       begin (* 1 *)
 207.         New ( ReferenceElement ) ;
 208.         ReferenceElement ^ . LineNo := LineNo ;
 209.         ReferenceElement ^ . FwdLink := NodeEntry ^ . ReferenceEntry ;
 210.         NodeEntry ^ . ReferenceEntry := ReferenceElement ;
 211.         ChangedLength := false ;
 212.       end (* 1 *) ;
 213. end (* AddKey *) ;
 214.
 215.
 216. procedure ReverseLinks ( NodeEntry : NodeRecordTypePtr ) ;
 217.
 218.   var
 219.     RefElem1            : ReferencePointer ;
 220.     RefElem2            : ReferencePointer ;
 221.
 222. begin (* ReverseLinks *)
 223.   if NodeEntry <> nil then
 224.   begin (* 1 *)
 225.     ReverseLinks ( NodeEntry ^ . LeftLink ) ;
 226.     ReverseLinks ( NodeEntry ^ . RightLink ) ;
 227.     RefElem1 := NodeEntry ^ . ReferenceEntry ;
 228.     NodeEntry ^ . ReferenceEntry := nil ;
 229.     while RefElem1 <> nil do
 230.     begin (* 2 *)
 231.       RefElem2 := RefElem1 ;
 232.       RefElem1 := RefElem1 ^ . FwdLink ;
 233.       RefElem2 ^ . FwdLink := NodeEntry ^ . ReferenceEntry ;
 234.       NodeEntry ^ . ReferenceEntry := RefElem2 ;
 235.     end (* 2 *) ;
 236.   end (* 1 *) ;
 237. end (* ReverseLinks *) ;
 238.
 239.
 240. function LineNumberCnv ( Number : integer ) : string ;
 241.
 242.   var
 243.     CnvStr              : string ;
 244.
 245. begin (* LineNumberCnv *)
 246.   if Number < 10 then
 247.     CnvStr := '   '
 248.   else
 249.     if Number < 100 then
 250.       CnvStr := '  '
 251.     else
 252.       if Number < 1000 then
 253.         CnvStr := ' '
 254.       else
 255.         CnvStr := '' ;
 256.   CnvStr := CnvStr + IntToStr ( Number ) ;
 257.   LineNumberCnv := CnvStr ;
 258. end (* LineNumberCnv *) ;
 259.
 260.
 261. procedure TCrossRefForm.RunProcess ;
 262.
 263.   var
 264.     LineNumber          : integer ;
 265.     TotalLines          : integer ;
 266.     ActualLineSize      : integer ;
 267.     CharPosition        : integer ;
 268.     CurrentLine         : string ;
 269.     Spelling            : Ident ;
 270.     SpellingInx         : integer ;
 271.     EndOfFile           : boolean ;
 272.     ChangedLength       : boolean ;
 273.
 274.   procedure ClearSpelling ;
 275.
 276.     var
 277.       Loop              : integer ;
 278.
 279.   begin (* ClearSpelling *)
 280.     for Loop := 0 to KeyLength - 1 do
 281.       Spelling [ Loop ] := Space ;
 282.     SpellingInx := 0 ;
 283.   end (* ClearSpelling *) ;
 284.
 285.   procedure AddToSpelling ( Ch : char ) ;
 286.   begin (* AddToSpelling *)
 287.     if SpellingInx < KeyLength then
 288.       Spelling [ SpellingInx ] := Ch ;
 289.     SpellingInx := SpellingInx + 1 ;
 290.   end (* AddToSpelling *) ;
 291.
 292.   procedure GetSourceLine ;
 293.   begin (* GetSourceLine *)
 294.     if EndOfFile then
 295.       CurrentLine := ''
 296.     else
 297.     begin (* 1 *)
 298.       CurrentLine := InputFileMemo . Lines . Strings [ LineNumber ] ;
 299.       LineNumber := LineNumber + 1 ;
 300.       Memo . Lines . Add ( LineNumberCnv ( LineNumber ) + '. ' + CurrentLine ) ;
 301.       ActualLineSize := Length ( CurrentLine ) ;
 302.       CharPosition := 0 ;
 303.       if LineNumber > TotalLines then
 304.         EndOfFile := true ;
 305.     end (* 1 *) ;
 306.   end (* GetSourceLine *) ;
 307.
 308.   function NextChar : char ;
 309.
 310.     var
 311.       Wch               : char ;
 312.
 313.   begin (* NextChar *)
 314.     CharPosition := CharPosition + 1 ;
 315.     if CharPosition <= ActualLineSize then
 316.       begin (* 1 *)
 317.         Wch := CurrentLine [ CharPosition ] ;
 318.         if Wch < ' ' then
 319.           Wch := ' ' ;
 320.         NextChar := Wch ;
 321.       end (* 1 *)
 322.     else
 323.       NextChar := chr ( 0 ) ;
 324.   end (* NextChar *) ;
 325.
 326.   function Digit ( Ch : char ) : boolean ;
 327.   begin (* Digit *)
 328.     Digit := ( Ch >= '0' ) and ( Ch <= '9' ) ;
 329.   end (* Digit *) ;
 330.
 331.   function HexDigit ( Ch : char ) : boolean ;
 332.   begin (* HexDigit *)
 333.     Ch := UpCase ( Ch ) ;
 334.     if Digit ( Ch ) then
 335.       HexDigit := true
 336.     else
 337.       if ( Ch >= 'A' ) and ( Ch <= 'F' ) then
 338.         HexDigit := true
 339.       else
 340.         HexDigit := false ;
 341.   end (* HexDigit *) ;
 342.
 343.   function AlfaChar ( Ch : char ) : boolean ;
 344.   begin (* AlfaChar *)
 345.     Ch := UpCase ( Ch ) ;
 346.     if Digit ( Ch ) then
 347.       AlfaChar := true
 348.     else
 349.       if ( ( Ch >= 'A' ) and ( Ch <= 'Z' ) ) or ( Ch = '_' ) then
 350.         AlfaChar := true
 351.       else
 352.         AlfaChar := false ;
 353.   end (* AlfaChar *) ;
 354.
 355.   function ReadSymbol : boolean ;
 356.
 357.     var
 358.       Ch                : char ;
 359.
 360.     procedure GetNumber ( Ch : char ) ;
 361.     begin (* GetNumber *)
 362.       while Digit ( Ch ) do
 363.       begin (* 3 *)
 364.         AddToSpelling ( Ch ) ;
 365.         Ch := NextChar ;
 366.       end (* 3 *) ;
 367.     end (* GetNumber *) ;
 368.
 369.   procedure SkipComment ;
 370.
 371.     var
 372.       Ch                : char ;
 373.
 374.   begin (* SkipComment *)
 375.     repeat
 376.       Ch := NextChar ;
 377.       if Ch = chr ( 0 ) then
 378.       begin (* 1 *)
 379.         GetSourceLine ;
 380.         if EndOfFile then
 381.           exit ;
 382.       end (* 1 *)
 383.       else
 384.         if Ch = '*' then
 385.           begin (* 1 *)
 386.             Ch := NextChar ;
 387.             if Ch = ')' then
 388.               exit ;
 389.           end (* 1 *) ;
 390.     until false ;
 391.   end (* SkipComment *) ;
 392.
 393.   begin (* ReadSymbol *)
 394.     ClearSpelling ;
 395.     Ch := NextChar ;
 396.     if Ch = chr ( 0 ) then
 397.       ReadSymbol := false
 398.     else
 399.     begin (* 1 *)
 400.       while ( Ch = Space ) and ( CharPosition <= ActualLineSize ) do
 401.         Ch := NextChar ;
 402.       case Ch of
 403.         '$' :
 404.           begin (* 2 *)
 405.             Ch := NextChar ;
 406.             if HexDigit ( Ch ) then
 407.             begin (* 3 *)
 408.               AddToSpelling ( '$' ) ;
 409.               GetNumber ( Ch ) ;
 410.               CharPosition := pred ( CharPosition ) ;
 411.               ReadSymbol := true ;
 412.             end (* 3 *)
 413.             else
 414.             begin (* 3 *)
 415.               CharPosition := pred ( CharPosition ) ;
 416.               ReadSymbol := false ;
 417.             end (* 3 *) ;
 418.           end (* 2 *) ;
 419.         '0' .. '9' :
 420.           begin (* 2 *)
 421.             GetNumber ( Ch ) ;
 422.             ReadSymbol := true ;
 423.           end (* 2 *) ;
 424.         'A' .. 'Z' , 'a' .. 'z' , '_' :
 425.           begin (* 2 *)
 426.             while AlfaChar ( Ch ) do
 427.             begin (* 3 *)
 428.               AddToSpelling ( Ch ) ;
 429.               Ch := NextChar ;
 430.             end (* 3 *) ;
 431.             CharPosition := CharPosition - 1 ;
 432.             ReadSymbol := true ;
 433.           end (* 2 *) ;
 434.         '/' :
 435.           begin (* 2 *)
 436.             Ch := NextChar ;
 437.             if Ch = '/' then
 438.               GetSourceLine ;
 439.             ReadSymbol := false ;
 440.           end (* 2 *) ;
 441.         '{' :
 442.           begin (* 2 *)
 443.             while Ch <> '}' do
 444.             begin (* 3 *)
 445.               Ch := NextChar ;
 446.               if Ch = chr ( 0 ) then
 447.                 GetSourceLine ;
 448.               if EndOfFile then
 449.                 Ch := '}' ;
 450.             end (* 3 *) ;
 451.             ReadSymbol := false ;
 452.           end (* 2 *) ;
 453.         '(' :
 454.           begin (* 2 *)
 455.             Ch := NextChar ;
 456.             if Ch = '*' then
 457.               SkipComment
 458.             else
 459.               CharPosition := CharPosition - 1 ;
 460.             ReadSymbol := false ;
 461.           end (* 2 *) ;
 462.         '''' :
 463.           begin (* 2 *)
 464.             AddToSpelling ( Ch ) ;
 465.             repeat
 466.               Ch := NextChar ;
 467.               AddToSpelling ( Ch ) ;
 468.             until ( Ch = '''' ) or ( CharPosition > ActualLineSize ) ;
 469.             ReadSymbol := true ;
 470.           end (* 2 *) ;
 471.         else
 472.           ReadSymbol := false ;
 473.       end (* case *) ;
 474.       end (* 1 *) ;
 475.   end (* ReadSymbol *) ;
 476.
 477. begin (* TCrossRefForm.RunProcess *)
 478.   TotalLines := InputFileMemo . Lines . Count ;
 479.   if TotalLines > 0 then
 480.   begin (* 1 *)
 481.     LineNumber := 0 ;
 482.     EndOfFile := false ;
 483.     repeat
 484.       GetSourceLine ;
 485.       repeat
 486.         if ReadSymbol then
 487.           AddKey ( Spelling , LineNumber , TopCrossTree , ChangedLength ) ;
 488.       until CharPosition > ActualLineSize ;
 489.     until ( LineNumber >= TotalLines ) or EndOfFile ;
 490.   end (* 1 *) ;
 491. end (* TCrossRefForm.RunProcess *) ;
 492.
 493.
 494. procedure TCrossRefForm.PrintCross ;
 495.
 496.   var
 497.     Str                 : string ;
 498.
 499.   procedure PrintContent ( NodeEntry : NodeRecordTypePtr ) ;
 500.
 501.     var
 502.       Counter           : integer ;
 503.       RefElem           : ReferencePointer ;
 504.
 505.   begin (* PrintContent *)
 506.     if NodeEntry <> nil then
 507.     begin (* 1 *)
 508.       PrintContent ( NodeEntry ^ . LeftLink ) ;
 509.       Str := NodeEntry ^ . Key + ' ' ;
 510.       Counter := 0 ;
 511.       RefElem := NodeEntry ^ . ReferenceEntry ;
 512.       repeat
 513.         Str := Str + LineNumberCnv ( RefElem ^ . LineNo ) + ' ' ;
 514.         RefElem := RefElem ^ . FwdLink ;
 515.         Counter := Counter + 1 ;
 516.         if Counter > 20 then
 517.         begin (* 2 *)
 518.           Memo . Lines . Add ( Str ) ;
 519.           Str := '' ;
 520.           for Counter := 0 to KeyLength do
 521.             Str := Str + ' ' ;
 522.           Counter := 0 ;
 523.         end (* 2 *) ;
 524.       until RefElem = nil ;
 525.       if Counter <> 0 then
 526.         Memo . Lines . Add ( Str ) ;
 527.       PrintContent ( NodeEntry ^ . RightLink ) ;
 528.     end (* 1 *) ;
 529.   end (* PrintContent *) ;
 530.
 531. begin (* TCrossRefForm.PrintCross *)
 532.   Str := '' ;
 533.   Memo . Lines . Add ( Str ) ;
 534.   Memo . Lines . Add ( Str ) ;
 535.   Memo . Lines . Add ( Str ) ;
 536.   Str := '**************************************************************' ;
 537.   Memo . Lines . Add ( Str ) ;
 538.   PrintContent ( TopCrossTree ) ;
 539. end (* TCrossRefForm.PrintCross *) ;
 540.
 541.
 542. procedure TCrossRefForm.FormCreate ( Sender : TObject ) ;
 543. begin (* TCrossRefForm.FormCreate *)
 544.   TopCrossTree := nil ;
 545. end (* TCrossRefForm.FormCreate *) ;
 546.
 547.
 548. procedure TCrossRefForm.OpenFileButtonClick ( Sender : TObject ) ;
 549. begin (* TCrossRefForm.OpenFileButtonClick *)
 550.   Memo . Lines . Clear ;
 551.   InputFileMemo . Lines . Clear ;
 552.   DisposeTree ( TopCrossTree ) ;
 553.   OpenFileDialog . FileName := String ( '*.*' ) ;
 554.   if OpenFileDialog . Execute ( ) then
 555.   begin (* 1 *)
 556.     FileFileName := OpenFileDialog . FileName ;
 557.     if FileExists ( FileFileName ) then
 558.     begin (* 2 *)
 559.       InputFileMemo . Lines . LoadFromFile ( FileFileName ) ;
 560.       RunProcess ;
 561.       ReverseLinks ( TopCrossTree ) ;
 562.       PrintCross ;
 563.     end (* 2 *) ;
 564.   end (* if *) ;
 565. end (* TCrossRefForm.OpenFileButtonClick *) ;
 566.
 567.
 568. procedure TCrossRefForm.SaveButtonClick ( Sender : TObject ) ;
 569. begin (* TCrossRefForm.SaveButtonClick *)
 570.   Memo . Lines . SaveToFile ( '!.txt' ) ;
 571. end (* TCrossRefForm.SaveButtonClick *) ;
 572.
 573. end.
 574.



**************************************************************
'   '             247
'  '              250
' '                12  253  318  319  509  513  521
'!.txt'           570
'$'               403  408
''                255  295  462  462  468  468  519  532
'('               453
')'               387
'*'               384  456
'***************  536
'*.*'             553
'. '              300
'/'               434  437
'0'               328  419
'9'               328  419
'A'               337  349  424
'F'               337
'Z'               349  424
'_'               349  424
'a'               424
'z'               424
'{'               441
'}'               443  449
0                  23  280  282  302  323  377  396  446  479  481  510  520  522  525
1                  23  280  289  299  314  431  459  515
10                246
100               249
1000              252
16                 13
20                516
ActualLineSize    266  301  315  400  468  488
Add               300  518  526  533  534  535  537
AddKey             92  118  163  487
AddToSpelling     285  364  408  428  464  467
AlfaChar          343  347  350  352  426
Balance            27  108  120  123  127  131  135  145  146  148  149  150  152  155  165  168  172  176  180  190  191
                  193  194  195  197  200
BalanceState       22   27
Ch                285  288  326  328  328  331  333  333  334  337  337  343  345  345  346  349  349  349  358  360  362
                  364  365  372  376  377  384  386  387  395  396  400  401  402  405  406  409  421  426  428  429  436
                  437  443  445  446  449  455  456  464  466  467  468
ChangedLength      95  106  118  119  124  156  163  164  169  201  211  272  487
CharPosition      267  302  314  314  315  317  400  410  410  415  415  431  431  459  459  468  488
Classes             9
Clear             550  551
ClearSpelling     274  394
CnvStr            243  247  250  253  255  256  256  257
Controls            9
Count             478
Counter           502  510  515  515  516  520  522  525
CrossRefForm       57
CrossRefUnit        2
CurrentLine       268  295  298  300  301  317
Dialogs             9
Digit             326  328  334  346  362
Dispose            75   86
DisposeReference   68   84
DisposeTree        66   83   85  552
EndOfFile         271  294  304  380  448  482  489
Execute           554
FileExists        557
FileFileName       49  556  557  559
FileName          553  556
FileUtil            9
FormCreate         43  542
Forms               9
FwdLink            19   74  113  209  232  233  514
GetNumber         360  409  421
GetSourceLine     292  379  438  447  484
Graphics            9
HexDigit          331  335  338  340  406
Ident              23   26   92  269
InputFileMemo      41  298  478  551  559
IntToStr          256
Key                26   92  107  107  116  116  118  161  161  163  509
KeyLength          13   23  280  287  520
LeftLink           29   83  109  118  130  133  141  142  143  178  179  185  186  188  189  225  508
Length            301
LineNo             18   93  112  112  118  163  208  208  513
LineNumber        264  298  299  299  300  303  481  487  489
LineNumberCnv     240  257  300  513
Lines             298  300  478  518  526  533  534  535  537  550  551  559  570
LoadFromFile      559
Loop              277  280  281
Memo               40  300  518  526  533  534  535  537  550  570
New               104  105  207
NextChar          308  320  323  365  376  386  395  401  405  429  436  445  455  466
NextEntry          70   74   76
Node1              97  130  131  133  134  136  140  141  142  150  152  175  176  178  179  181  185  186  187  195  197
Node2              98  140  141  142  143  144  145  149  153  185  186  187  188  189  190  194  198
NodeEntry          66   81   83   84   85   86   87   94  102  104  107  108  109  110  111  116  118  120  123  127  130
                  133  134  135  136  143  144  146  148  153  155  161  163  165  168  172  175  178  179  180  181  188
                  189  191  193  198  200  209  210  216  223  225  226  227  228  233  234  499  506  508  509  511  527
NodeRecordType     24   25
NodeRecordTypePt   24   29   30   58   66   94   97   98  216  499
Number            240  246  249  252  256
OpenFileButton     38
OpenFileButtonCl   44  548
OpenFileDialog     42  553  554  556
PrintContent      499  508  527  538
PrintCross         47  494  562
ReadSymbol        355  397  411  416  422  432  439  451  460  469  472  486
RefElem           503  511  513  514  514  524
RefElem1          219  227  229  231  232  232
RefElem2          220  231  233  234
RefEntry           68   72   74   75   76
ReferenceElement   99  105  111  112  113  207  208  209  210
ReferenceEntry     28   84  111  209  210  227  228  233  234  511
ReferencePointer   16   19   28   68   70   99  219  220  503
ReferenceRecord    16   17
ReverseLinks      216  225  226  561
RightLink          30   85  110  133  134  140  141  143  144  163  175  178  186  187  188  226  527
RunProcess         46  261  560
SaveButton         39
SaveButtonClick    45  568
SaveToFile        570
Sender             43   44   45  542  548  568
SkipComment       369  457
Space              12  281  400
Spelling          269  281  288  487
SpellingInx       270  282  287  288  289  289
State1             22  127  128  131  145  150  166  191  194
State2             22  108  123  126  135  148  152  155  168  171  180  193  197  200
State3             22  121  146  149  172  173  176  190  195
StdCtrls            9
Str               497  509  513  513  518  519  521  521  526  532  533  534  535  536  537
String            553
Strings           298
SysUtils            9
TButton            38   39
TCrossRefForm      37   57  261  494  542  548  568
TForm              37
TMemo              40   41
TObject            43   44   45  542  548  568
TOpenDialog        42
TopCrossTree       58  487  538  544  552  561
TotalLines        265  303  478  479  489
UpCase            333  345
Wch               311  317  318  319  320
and               328  337  349  400
array              23
begin              71   73   80   82  101  103  117  122  129  132  139  162  167  174  177  184  206  222  224  230  245
                  279  286  293  297  313  316  327  332  344  361  363  374  378  385  393  399  404  407  414  420  425
                  427  435  442  444  454  463  477  480  505  507  517  531  543  549  555  558  569
boolean            95  271  272  326  331  343  355
case              120  165  402
char               23  285  308  311  326  331  343  358  360  372
chr               323  377  396  446
class              37
const              11
do                 72  229  280  362  400  426  443  520
else              115  138  147  151  160  183  192  196  205  248  251  254  296  322  336  339  348  351  383  398  413
                  458  471
end                20   31   53   77   78   88   89  114  125  137  154  157  158  159  170  182  199  202  203  204  212
                  213  235  236  237  258  283  290  305  306  321  324  329  341  353  366  367  382  389  391  412  417
                  418  423  430  433  440  450  452  461  470  473  474  475  490  491  523  528  529  539  545  563  564
                  565  571  573
exit              381  388
false             124  156  169  201  211  340  352  390  397  416  439  451  460  472  482
for               280  520
function          240  308  326  331  343  355
if                 81  102  116  119  131  145  149  161  164  176  190  194  223  246  249  252  287  294  303  315  318
                  334  337  346  349  377  380  384  387  396  406  437  446  448  456  479  486  506  516  525  554  557
implementation     60
integer            18   93  240  264  265  266  267  270  277  502
interface           6
nil                72   81   87  102  109  110  113  223  228  229  506  524  544
of                 23  120  165  402
or                349  468  489
pred              410  415
private            48
procedure          43   44   45   46   47   66   68   92  216  261  274  285  292  360  369  494  499  542  548  568
public             51
record             17   25
repeat            375  465  483  485  512
string             49  240  243  268  497
then               81  102  116  119  131  145  149  161  164  176  190  194  223  246  249  252  287  294  303  315  318
                  334  337  346  349  377  380  384  387  396  406  437  446  448  456  479  486  506  516  525  554  557
to                280  520
true              106  304  335  338  347  350  411  422  432  469
type               15
unit                2
until             390  468  488  489  524
uses                8
var                56   66   69   94   95   96  218  242  263  276  310  357  371  496  501
while              72  229  362  400  426  443


Dla tropicieli:

crossref.7z

[gaweł]

Inne spojrzenie


Nutahttps://www.youtube.com/watch?v=8a-HfNE3EIo

Choć dotychczas prezentacje algorytmów drzewiastych opierały się o zmienne wskaźnikowe i alokację dynamiczną, nie znaczy to, że tak być musi zawsze. Algorytmy drzewiaste mogą mieć zastosowanie nawet w świecie mikrokontrolerów. Tam mogą występować problemy z dynamiczną alokacją pamięci, więc...
Może warto przestawić myślenie na inne tory. Wyobraźmy sobie, że mamy dużą tablicę elementów o strukturze podobnej do struktury węzła w znaczeniu dotychczasowym. Leksykalnie w zapisie, to nawet może brzmieć identycznie, jednak warto dostrzec, że wskaźnik zmienił reprezentację na liczbę całkowitą.

Kod: Zaznacz cały

const
  NilConst              = $FFFF ;

type
  BalanceState          = ( State1 , State2 , State3 ) ;
  NodeRecordTypePtr     = integer ;
  NodeRecordType        = record
                            Key               : integer ;
                            Balance           : BalanceState ;
                            LeftLink          : NodeRecordTypePtr ;
                            RightLink         : NodeRecordTypePtr ;
                          end (* record *) ;

const
  ArrayEnd              = 127 ;

var
  TopTree               : NodeRecordTypePtr ;
  FirstFree             : NodeRecordTypePtr ;
  TreeArray             : array [ 0 .. ArrayEnd ] of NodeRecordType ;

Pomijając (do celów rysunkowych) elementy mało istotne, można to sobie wyobrazić jako:

tree07-01.png

Zmieniam sens znaczenia wskaźników z reprezentacji wskaźnikowej (adres w pamięci) na liczbową (indeks do tablicy). Z tym wiąże się jeszcze jedna zmiana: pascalowa stała wskaźnikowa nil musi mieć swój odpowiednik w świecie integer. Wprowadzam stałą o nazwie NilConst o wartości 16-bitowych jedynek. Typowo nil ma wartość 0, jednak w tym zastosowaniu to najgorszy wariant. Skoro nasz wskaźnik jest liczbą (indeksem do tablicy), to wartość 0 nie jest dobrym wyborem. Realizacja algorytmów drzewiastych w świecie o ograniczonych zasobach może przedstawiać się następująco:

tree07-02.png

Dodanie elementu (3) do tak zmodyfikowanego drzewa może wyglądać następująco:

tree07-03.png

Kolejnych dwóch elementów (1), (5):

tree07-04.png

Problemy „tworzenia” elementów drzewa po przemyśleniach mogą okazać się pozornymi. Można zaproponować „własną” implementację tej operacji. Wyobraźmy sobie, że jest zmienna FirstFree, która wskazuje na pierwszy wolny element. Skoro cały czas tworzone są elementy struktury drzewa, a te mają identyczną wielkość, można stworzyć pulę „wolnych” elementów. Każda akcja typu New ( <element drzewa> ), będzie pobierać z tej puli element. Każda akcja typu Dispose ( <element drzewa> ), będzie dodawać element do puli. Może to być ta sama tablica. Początkowo wszystkie jej elementy będą należeć do puli wolnych elementów. By ta koncepcja zadziałała, wymagana jest wstępna inicjacja. Pierwszy wolny element jest wskazany przez zmienną globalną (FirstFree). Każdy element puli wskazuje na kolejny wolny. Tu zostało wykorzystane pole LeftLink. Ostatni element zamiast wskazania na kolejny wolny zawiera wartość NilConst. Jak się temu przyjrzeć, to to stanowi klasyczną listę liniową.

Kod: Zaznacz cały

  FirstFree := 0 ;
  for Loop := 0 to ArrayEnd do
    TreeArray [ Loop ] . LeftLink := Loop + 1 ;
  TreeArray [ ArrayEnd ] . LeftLink := NilConst ;

Odpowiada to rysunkowi:

tree07-05.png

Akcja pobrania elementu z puli wolnych, może wyglądać następująco. Pobierany jest pierwszy wolny element: w zmiennej roboczej zapisane jest wskazanie na pierwszy wolny (już ten element nie zginie). Natomiast wskazanie na pierwszy wolny element jest zmodyfikowane, teraz wskazuje na następnika dotychczasowego pierwszego wolnego elementu. Program w wersji rysunkowej:

tree07-06.png

tree07-07.png

tree07-08.png

Akcja typu Dispose, może mieć następującą implementację:

Kod: Zaznacz cały

procedure MyDispose ( NodeEntry : NodeRecordTypePtr ) ;
begin (* MyDispose *)
  TreeArray [ NodeEntry ] . LeftLink := FirstFree ;
  FirstFree := NodeEntry ;
end (* MyDispose *) ;

Sam program wymaga nieznacznej modyfikacji źródłowej. Oczywista, że można to zrobić na wiele sposobów. Jednym z możliwych jest zaproponowany poniżej:
NodeEntry ^ . Key := Key ; ….................................... → TreeArray [ NodeEntry ] . Key := Key ;
NodeEntry ^ . Balance := State2 ; …........................... → TreeArray [ NodeEntry ] . Balance := State2 ;
NodeEntry ^ . LeftLink := nil ; …............................... → TreeArray [ NodeEntry ] . LeftLink := NilConst ;
NodeEntry ^ . RightLink := nil ; …............................. → TreeArray [ NodeEntry ] . RightLink := NilConst ;
Postępując podobnie w całym programie otrzymujemy jego nową wersję, Algorytm dodania do drzewa wyważonego w wersji „tablicowej”:

Kod: Zaznacz cały

procedure AddKey (     Key           : integer ;
                   var NodeEntry     : NodeRecordTypePtr ;
                   var ChangedLength : boolean ) ;
  var
    Node1               : NodeRecordTypePtr ;
    Node2               : NodeRecordTypePtr ;

begin (* AddKey *)
  if NodeEntry = NilConst then
  begin (* 1 *)
    NodeEntry := MyNew ( ) ;
    ChangedLength := true ;
    TreeArray [ NodeEntry ] . Key := Key ;
    TreeArray [ NodeEntry ] . Balance := State2 ;
    TreeArray [ NodeEntry ] . LeftLink := NilConst ;
    TreeArray [ NodeEntry ] . RightLink := NilConst ;
  end (* 1 *)
  else
    if Key < TreeArray [ NodeEntry ] . Key then
    begin (* 1 *)
      AddKey ( Key , TreeArray [ NodeEntry ] . LeftLink , ChangedLength ) ;
      if ChangedLength then
        case TreeArray [ NodeEntry ] . Balance of
        State3 :
          begin (* 2 *)
            TreeArray [ NodeEntry ] . Balance := State2 ;
            ChangedLength := false ;
          end (* 2 *) ;
        State2 :
          TreeArray [ NodeEntry ] . Balance := State1 ;
        State1 :
          begin (* 2 *)
            Node1 := TreeArray [ NodeEntry ] . LeftLink ;
            if TreeArray [ Node1 ] . Balance = State1 then
            begin (* 3 *)
              TreeArray [ NodeEntry ] . LeftLink := TreeArray [ Node1 ] . RightLink ;
              TreeArray [ Node1 ] . RightLink := NodeEntry ;
              TreeArray [ NodeEntry ] . Balance := State2 ;
              NodeEntry := Node1 ;
            end (* 3 *)
            else
            begin (* 3 *)
              Node2 := TreeArray [ Node1 ] . RightLink ;
              TreeArray [ Node1 ] . RightLink := TreeArray [ Node2 ] . LeftLink ;
              TreeArray [ Node2 ] . LeftLink := Node1 ;
              TreeArray [ NodeEntry ] . LeftLink := TreeArray [ Node2 ] . RightLink ;
              TreeArray [ Node2 ] . RightLink := NodeEntry ;
              if TreeArray [ Node2 ] . Balance = State1 then
                TreeArray [ NodeEntry ] . Balance := State3
              else
                TreeArray [ NodeEntry ] . Balance := State2 ;
              if TreeArray [ Node2 ] . Balance = State3 then
                TreeArray [ Node1 ] . Balance := State1
              else
                TreeArray [ Node1 ] . Balance := State2 ;
              NodeEntry := Node2 ;
            end (* 3 *) ;
            TreeArray [ NodeEntry ] . Balance := State2 ;
            ChangedLength := false ;
          end (* 2 *) ;
        end (* case *) ;
    end (* 1 *)
    else
      if Key > TreeArray [ NodeEntry ] . Key then
      begin (* 1 *)
        AddKey ( Key , TreeArray [ NodeEntry ] . RightLink , ChangedLength ) ;
        if ChangedLength then
          case TreeArray [ NodeEntry ] . Balance of
          State1 :
            begin (* 2 *)
              TreeArray [ NodeEntry ] . Balance := State2 ;
              ChangedLength := false ;
            end (* 2 *) ;
          State2 :
            TreeArray [ NodeEntry ] . Balance := State3 ;
          State3 :
            begin (* 2 *)
              Node1 := TreeArray [ NodeEntry ] . RightLink ;
              if TreeArray [ Node1 ] . Balance = State3 then
              begin (* 3 *)
                TreeArray [ NodeEntry ] . RightLink := TreeArray [ Node1 ] . LeftLink ;
                TreeArray [ Node1 ] . LeftLink := NodeEntry ;
                TreeArray [ NodeEntry ] . Balance := State2 ;
                NodeEntry := Node1 ;
              end (* 3 *)
              else
              begin (* 3 *)
                Node2 := TreeArray [ Node1 ] . LeftLink ;
                TreeArray [ Node1 ] . LeftLink := TreeArray [ Node2 ] . RightLink ;
                TreeArray [ Node2 ] . RightLink := Node1 ;
                TreeArray [ NodeEntry ] . RightLink := TreeArray [ Node2 ] . LeftLink ;
                TreeArray [ Node2 ] . LeftLink := NodeEntry ;
                if TreeArray [ Node2 ] . Balance = State3 then
                  TreeArray [ NodeEntry ] . Balance := State1
                else
                  TreeArray [ NodeEntry ] . Balance := State2 ;
                if TreeArray [ Node2 ] . Balance = State1 then
                  TreeArray [ Node1 ] . Balance := State3
                else
                  TreeArray [ Node1 ] . Balance := State2 ;
                NodeEntry := Node2 ;
              end (* 3 *) ;
              TreeArray [ NodeEntry ] . Balance := State2 ;
              ChangedLength := false ;
            end (* 2 *) ;
          end (* case *) ;
      end (* 1 *)
      else
      begin (* 1 *)
        ChangedLength := false ;
      end (* 1 *) ;
end (* AddKey *) ;

Program (w którym nie ma ani grama zmienneych wskaźnikowych) ilustrujący rozważania utworzy drzewo, wydrukuje je, po czym w całości je usunie, wydrukuje „stos” wolnych elementów, by pokazać, że nic nie zginęło.

Kod: Zaznacz cały

procedure TArrayTreeForm.TestButtonClick ( Sender : TObject ) ;

  var
    Loop                : integer ;

  procedure AddOp ( Key : integer ) ;

    var
      Str               : String ;
      ChangedLength     : boolean ;

  begin (* AddOp *)
    Str := 'Dodanie elementu: ' + IntToStr ( Key ) ;
    Memo . Lines . Add ( Str ) ;
    ChangedLength := false ;
    AddKey ( Key , TopTree , ChangedLength ) ;
    PrintTreeOp ;
    SaveOp ;
  end  (* AddOp *) ;

  procedure PrintFreeElements ;

    var
      Node              : NodeRecordTypePtr ;
      Str               : string ;

  begin (* PrintFreeElements  *)
    Str := 'Obszar wolnych elementow' ;
    Memo . Lines . Add ( Str ) ;
    if FirstFree = NilConst then
    begin (* 1 *)
      Str := 'Brak wolnych elementow' ;
      Memo . Lines . Add ( Str ) ;
    end (* 1 *)
    else
    begin (* 1 *)
      Str := 'Pierwszy wolny: ' + IntToStr ( FirstFree ) ;
      Memo . Lines . Add ( Str ) ;
      Node := FirstFree ;
      repeat
        Str := IntToStr ( Node ) ;
        Str := '  Element ' + IntToStr ( Node ) ;
        Node := TreeArray [ Node ] . LeftLink ;
        if Node = NilConst then
          Str := Str + ' nie ma nastepnika'
        else
          Str := Str + ' ma nastepnika ' + IntToStr ( Node ) ;
        Memo . Lines . Add ( Str ) ;
      until Node = NilConst ;
    end (* 1 *) ;
  end (* PrintFreeElements *) ;

begin (* TArrayTreeForm.TestButtonClick *)
  DisposeTree ( TopTree ) ;
  for Loop := 1 to 31 do
  begin (* 1 *)
    AddOp ( Loop ) ;
  end (* 1 *) ;
  PrintTreeOp ;
  DisposeTree ( TopTree ) ;
  PrintTreeOp ;
  PrintFreeElements ;
  SaveOp ;
end (* TArrayTreeForm.TestButtonClick *) ;


Na jakimś tam etapie, drzewo wygląda jak na rysunku.

tree07-09.png

Ciekawie wygląda pula wolnych elementów po akcji: biorę → oddaję. Oddało się w innej kolejności, co raczej nie powinno być niespodzianką. W sumie nie ma to żadnego znaczenia, istotne jest to, że na sztuki wszystko się zgadza (nic nie zginęło → sprawdziłem osobiście).

Kod: Zaznacz cały

Obszar wolnych elementow
Pierwszy wolny: 15
  Element 15 ma nastepnika 23
  Element 23 ma nastepnika 27
  Element 27 ma nastepnika 29
  Element 29 ma nastepnika 30
  Element 30 ma nastepnika 28
  Element 28 ma nastepnika 25
  Element 25 ma nastepnika 26
  Element 26 ma nastepnika 24
  Element 24 ma nastepnika 19
  Element 19 ma nastepnika 21
  Element 21 ma nastepnika 22
  Element 22 ma nastepnika 20
  Element 20 ma nastepnika 17
  Element 17 ma nastepnika 18
  Element 18 ma nastepnika 16
  Element 16 ma nastepnika 7
  Element 7 ma nastepnika 11
  Element 11 ma nastepnika 13
  Element 13 ma nastepnika 14
  Element 14 ma nastepnika 12
  Element 12 ma nastepnika 9
  Element 9 ma nastepnika 10
  Element 10 ma nastepnika 8
  Element 8 ma nastepnika 3
  Element 3 ma nastepnika 5
  Element 5 ma nastepnika 6
  Element 6 ma nastepnika 4
  Element 4 ma nastepnika 1
  Element 1 ma nastepnika 2
  Element 2 ma nastepnika 0
  Element 0 ma nastepnika 31
  Element 31 ma nastepnika 32
  Element 32 ma nastepnika 33
 ( . . . )
  Element 125 ma nastepnika 126
  Element 126 ma nastepnika 127
  Element 127 nie ma nastepnika

„Tablicowe drzewo” niczym nie różni się od wskaźnikowego. To jest wyłącznie kwestia postrzegania i interpretacji. Jakkolwiek zrealizować poszczególne operacje atomowe, główna idea oraz istotne cechy nadał są te same. Pewnych własności nie da się wymazać.
Dla tropicieli:

ArrayTree.7z

[gaweł]

Jeszcze inne spojrzenie

Nuta na dziśhttps://www.youtube.com/watch?v=UdPOCQGYwrk

W strukturze elementu drzewa w pierwotnej wersji jako link w lewo oraz link w prawo występują typy wskaźnikowe (jako informacje o charakterze adresu w pamięci operacyjnej). Co stoi na przeszkodzie interpretować je jako informacje o charakterze adresowym w zewnętrznym pliku. Dane o charakterze adresowym w systemach 8-bitowych to zwyczajowo dane 16-bitowe. Z pewnością zakres przechowywanej informacji będzie mizerny, więc może by tak 32-bity. Zamiast przechowywać samo drzewo w pamięci operacyjnej może by tak ulokować je w innym miejscu: pamięci zewnętrznej. Z technicznego punktu widzenia nie jest to zbyt skomplikowane. Przykładowym rozwiązaniem może być układ AT45DB161 – jako zasobnik typu DataFlash o pojemności 16-megabitów, czyli 2 megabajty. Taki teren, to całkiem spora piaskownica do zagospodarowania. Można by tam urządzić jakąś małą bazkę danych. Obecnie każdy zagadnięty hasłem „baza danych” wręcz odruchowo odpowie SQL. A może jest inne rozwiązanie? Przestawny własne wyobrażenia na inne tory.
Baza danych to coś takiego, co jest przeznaczone do gromadzenia informacji i do szybkiego wyszukiwania określonych danych w wyniku zaistnienia określonych potrzeb. Jak zaprząc do tego algorytmy drzewiaste? Rozpatrzmy przykład.
Wyobraźmy sobie, że jakiś mikrokontroler (przykładowo ATMEGA2560, któremu zostało dołożone jako zewnętrzna pamięć RAM 32kb pamięci statycznej oraz na SPI „powieszony” wspomniany DataFlash). To środowisko stanowi minimum zasobów. Pomijam kwestie interfejsu komunikacyjnego, bo to leży poza sferą aktualnego zainteresowania.
Przykładowy rekord bazy danych może mieć następującą postać:

tree08-01.png

gdzie każde z tych pól ma przewidzianą określoną liczbę znaków. Z tego wynika dosyć istotna cecha: rekordy takiej bazy danych są rekordami o stałej długości (zajmują powtarzalną stałą wielkość w przestrzeni adresowej).
Patrząc na obszar DataFlash, jako zewnętrzna (dla mikrokontrolera) pamięć musi zawierać w sobie jakąś organizację. Nie będę tu namawiał do implementacji systemu FAT czy jakiegokolwiek innego, niemniej jakieś podstawowe minimum organizacyjne musi zostać zachowane. Patrząc na temat tak całkiem z boku przez pryzmat systemów operacyjnych, to nasza bazka danych w najprostszym przypadku składałaby się z dwóch plików: samej bazki → pliku zawierającego wyłącznie zgromadzone dane oraz z pliku indeksowego → pliku pozwalającego na szybkie wyszukiwanie wymaganych danych (coś jak katalog w bibliotece).
Ponieważ jest jedna przestrzeń na przechowywane dane, to „wszystkie pliki” trzeba połączyć do jednej kupy. Z tego względu wydzielam trzy różne struktury, które za każdym razem muszą był łatwo pozyskiwalne, czyli mieć stały adres w przestrzeni. Pod pojęciem adresu w tym miejscu uznaję ofset w pamięci: jak daleko w stosunku do początku pamięci DataFlash znajduje się te <coś>. W każdym przypadku taki odpowiedni rekord danych będzie zawierał istotne informację z punktu widzenia określonej potrzeby.
Przykładowo: baza danych. Specyfiką tego jest to, że generalnie dane przyrastają. Dodając nowe dane przesuwa się granica umownego końca przestrzeni danych. Jednak czasami zachodzi potrzeba usunięcia czegoś. W takim przypadku, powstaje „dziura” w wypełnieniu pamięci DataFlash. Ponieważ nic nie może się zmarnować, to utworzona jest lista liniowa rekordów z odzysku. Dodając nowy rekord, należy sprawdzić, czy czegoś nie da się odzyskać. Skoro jest lista odzyskowych elementów, to koniecznością staje się przechowywanie wskazania na pierwszy wolny rekord (Wolny rekord → jako 32-bitowy ofset w przestrzeni adresowej DataFlash). W nim (gdzieś już daleko w przestrzeni) zapisany jest jego następnik.

tree08-02a.png

Podobnie, część logicznie związana z indeksem (strukturą drzewa) wymaga swojej części „technicznej” umieszczonej w dobrze znanym miejscu.

tree08-02b.png

Jak w każdym drzewie, tu również jest niezbędne wskazanie na szczyt drzewa. Jest to informacja, która z czasem ulega modyfikacji, toteż niezbędne jest przechowywanie tych danych w „dobrze znanym miejscu” w pamięci DataFlash. Podobnie, może zaistnieć problem odzysku danych. Jeżeli zaistnieje zwolnienie pojedynczego elementu, to by nie generować dziur, konieczne jest notowanie wolnych elementów ze struktury drzewa. Coś takiego było wyżej przedstawione przy okazji tablicowej realizacji drzewa. Samo drzewo może również przechowywać informacje o duplikatach. Dokładnie tej klasy problem był opisany wyżej przy okazji Cross Reference. Zatem w strukturze możliwych danych występuje mały rekord zawierający powiązanie kolejnych rekordów bazy danych o identycznym kluczu oraz wskazanie na kolejny element takiej listy (listy identycznych kluczy). Te minimum informacji właśnie jest pokazane na powyższej ilustracji.
Nowe wymagania oznaczają potrzebę stworzenia nowej struktury elementu drzewa. Obok dotychczas znanych elementów występuje nowy: DataLink. Jest to, jak każda informacja o charakterze link informacją 32-bitową jako ofset w pamięci DataFlash. Ta istotna informacja pozwala powiązać indeks (kartkę w katalogu bibliotecznym z uwzględnieniem ewentualnych duplikatów jako listy liniowej) z danymi bazy danych (wskazaniem na „której półce stoi książka”). Jeżeli rekord danych będzie reprezentowany przez adres w przestrzeni DataFlash (czyli 32-bitowy ofset), to przechowując takie wskazanie w strukturze każdego elementu drzewa, uzyskuje się powiązanie jednych danych z drugimi.

tree08-02c.png

Do kompletu należy dodać jeszcze dane organizujące całość (jako plik).

tree08-02.png

Tu minimum, to przechowywanie położenia końca „pliku”, by w operacjach rozszerzenia takiego specyficznego pliku było wiadomo, gdzie się on kończy.
Operacja dodania nowej informacji do bazy danych oznacza w pierwszej kolejności dopisanie samego rekordu danych. To może skończyć się rozszerzeniem „pliku” lub odzyskaniem jakiejś „dziury” w wyniku wyjęcia jej z listy wolnych miejsc. Finalnie, gdziekolwiek dane zostaną zapisane, informacją zwrotną z tej operacji jest ofset położenia rekordu danych. Mając ten ofset i klucz, realizowane jest dodanie elementu drzewa. Tu również może zaistnieć rozbudowanie drzewa (w wyniku rozszerzenia wielkości „pliku” lub odzysku danych z listy wolnych elementów struktury drzewa). Finalnie może to wyglądać jak na ilustracji (NilConst będzie $FFFFFFFF - 32-bity):

tree08-03.png

Odszukanie informacji (np. do kogo należy numer tel 229555777) teraz sprowadza się do:

• wczytanie porcji organizacyjnej indeksu, która zapisana jest w dobrze znanym miejscu w DataFlash,
• z wczytanej porcji uzyskuje się wskazanie na szczyt drzewa,
• mając szczyt drzewa rekurencyjnie odszukać taki element drzewa, który jest zgodny z poszukiwanym kluczem (wymienionym wyżej numerem telefonu),
• mając element drzewa, pozyskać z niego wskazanie na położenie rekordu danych (DataLink).

W rezultacie całej zadymy posiadamy informację gdzie jest zapisany rekord w DataFlash zawierający to co jest poszukiwane.
Oczywiście ze względu na zewnętrzny charakter pamięci do przechowywania wszystkich informacji, należy pamiętać, że algorytm obsługi drzewa przetwarza dane z „obcej” pamięci.
Pewnemu rozszerzeniu ulega struktura elementu drzewa:

Kod: Zaznacz cały

  NodeRecordTypePtr     = cardinal ;
  BalanceState          = ( State1 , State2 , State3 ) ;
  NodeRecordType        = record
                            Key             : array [ 0 .. <ileś> ] od char ;
                            Balance         : BalanceState ;
                            DataLink        : cardinal ;
                            LeftLink        : NodeRecordTypePtr ;
                            RightLink       : NodeRecordTypePtr ;
                            DuplLink        : cardinal ;
                          end (* record *) ;

Dotychczasowa operacja poszukiwania danych w strukturze drzewa musi być zmodyfikowana przykładowo do postaci pokazanej poniżej. Pamiętając, że zmienna lokalna Node znajduje się w pamięci RAM a dane ją wypełniające znajdują się w innej przestrzeni (DataFlash), konieczne jest wczytanie obszaru DataFlash spod ofsetu NodeEntry (to jest inny „świat”):

Kod: Zaznacz cały

function SearchKey ( Key       : integer ;
                     NodeEntry : NodeRecordTypePtr ) : NodeRecordTypePtr ;

  var
    Node              :  NodeRecordType ;

begin (* SearchKey *)
  if NodeEntry = NilConst then
    SearchKey := NilConst
  else
  begin (* 1 *)
    Wczytaj_Z_DataFlash ( Node ,  NodeEntry ) ;
    if Node . Key = Key then
      SearchKey := NodeEntry
    else
      if Key < Node . Key then
        SearchKey := SearchKey ( Key , Node . LeftLink )
      else
        SearchKey := SearchKey ( Key , Node . RightLink )
  end (* 1 *) ;
end (* SearchKey *) ;

Również identycznym komplikacjom podlegają wszystkie inne operacje. W niektórych przypadkach jest to oczywiste, w niektórych można je przeoczyć na pierwszy rzut oka.

Kod: Zaznacz cały

procedure AddKey (     Key           : string ;
                       DataLink      : cardinal ;
                   var NodeEntry     : NodeRecordTypePtr ;
                   var ChangedLength : boolean ) ;
  var
    Node1               : NodeRecordTypePtr ;
    Node2               : NodeRecordTypePtr ;
    Node                : NodeRecordType ;

begin (* AddKey *)
  if NodeEntry = NilConst then
  begin (* 1 *)
    NodeEntry := UtworzNowyRekord ( ) ;
    ChangedLength := true ;
    Node . Key := Key ;
    Node . DataLink := DataLink ;
    Node . Balance := State2 ;
    Node . LeftLink := NilConst ;
    Node . RightLink := NilConst ;
    Node . DuplLink := NilConst ;
    Zapisz_Do_DataFlash ( Node ,  NodeEntry ) ;
  end (* 1 *)
( . . . )
end (* AddKey *) ;

W powyższym kawałku, naturalne jest, że DataFlash został wzbogacona o nowy rekord, więc konieczna jest aktualizacja zawartości DataFlash, tak by dane były konsystentne. Trudniej jest zauważyć, że parametr wywołania NodeEntry, również uległa zmianie. Ta nowa zawartości również musi mieć zwoje odbicie w DataFlash. Jednak ta informacja jest częścią składową elementu drzewa na poprzednim poziomie rekurencji, do którego w danej chwili nie ma dostępu.

Kod: Zaznacz cały

procedure AddKey (     Key           : string ;
                       DataLink      : cardinal ;
                   var NodeEntry     : NodeRecordTypePtr ;
                   var ChangedLength : boolean ) ;
  var
    Node1               : NodeRecordTypePtr ;
    Node2               : NodeRecordTypePtr ;
    Node                : NodeRecordType ;
    SaveLink            : cardinal ;

begin (* AddKey *)
  if NodeEntry = NilConst then
  begin (* 1 *)
    NodeEntry := UtworzNowyRekord ( ) ;
( . . . )
  end (* 1 *)
  else
  begin (* 1 *)
    Wczytaj_Z_DataFlash ( Node ,  NodeEntry ) ;
    if Key < Node . Key then
    begin (* 1 *)
      SaveLink :=  Node . LeftLink ;
      AddKey ( Key , DataLink , Node . LeftLink , ChangedLength ) ;
      if SaveLink <>  Node . LeftLink then
        Zapisz_Do_DataFlash ( Node ,  NodeEntry ) ;
( . . . )
end (* AddKey *) ;

Dostęp ten jest natomiast na innym poziomie rekurencji, jednak w tym kontekście trudno jest określić, czy zaistniała zmiana zawartości pola. Dobrym rozwiązaniem jest zapamiętanie linku przez rekurencyjnym wywołaniem i po wyjściu z rekurencji sprawdzić, czy zaistniała odpowiednia zmiana i dokonać aktualizacji zawartości DataFlash. Również każda modyfikacja współczynnika zrównoważenia drzewa wymaga „odciśnięcia swego piętna” w zawartości DataFlash.
Taki indeks pozwala szybko lokalizować dane mając znany numer telefonu. Naturalnym jest, że zachodziłaby potrzeba znalezienia danych mając jedynie imię i nazwisko. W ten sposób dochodzimy powoli do idei „lasu”. Jeżeli dodawany element drzewa posiada pole wskazujące na położenie danych w przestrzeni DataFlash, to zmieńmy znaczenie tej informacji: niech będzie to wskazaniem na szczyt drzewa. Reasumując, powstaje drzewo drzew. Kiedyś w ramach żartu nazwałem do „lasem” i tak już zostało.
Dodanie kolejnego indeksu wymagałoby również dodania porcji organizacyjnej w „dobrze znanym miejscu”. Drugie drzewo, to również drugi szczyt drzewa, lista rekordów z odzysku (inna długość klucza to inna wielkość struktury rekordu drzewa a to prowadzi do innej wielkości „dziur” po usuniętych elementach w przestrzeni DataFlash).
Obrazkowo może to wyglądać następująco:

tree08-04.png

Teraz wyszukanie wszystkich Kowalskich sprowadza się do „wydruku” całego drzewa (w sensie algorytmu jest to wydruk drzewa, w sensie organizacyjnym jest to wydruk drzewa imion „przypiętego” do drzewa nazwisk).
Te rozwiązania stosowałem w rzeczywistych rozwiązaniach pod koniec lat 80-tych tworząc różne bazy danych z rekordami o stałej długości sortując tysiące rekordów i jakoś to się nie gubiło. Co prawa, to realizacja opierała się o komputery PC a pliki (jako rozdzielone) były w przestrzeni dysków. Czasy się trochę zmieniły, ewolucji ulegają możliwości technologiczne, jednak algorytmy, jako przepis na osiągnięcie celu pozostają takie same.
Na tym zakończę już dywagacje na temat drzew i czas przejść na wyższy level: B-drzewa. To jest „odlotowy” wynalazek.

[piotrek]

Reasumując, powstaje drzewo drzew. Kiedyś w ramach żartu nazwałem do „lasem” i tak już zostało.

Używając "drewnianej" terminologii można element z dwoma nullami i rodzicem nazwać "liściem". I byłby to żart całkiem na miejscu

[gaweł]

Używając "drewnianej" terminologii można element z dwoma nullami i rodzicem nazwać "liściem". I byłby to żart całkiem na miejscu

Okazuje się, że przyroda jest niedościgła ze swoimi rozwiązaniami
Kontynuacja rozważań przyrodniczo-ekologicznych jest B-drzewa