(* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *)
(*  Soubor: STROM.PAS                                                      *)
(*  Obsah: procedury pro praci s binarnim stromem                          *)
(*  Posledni uprava: 12.7.2007                                             *)
(*  Autor: Mircosoft                                                       *)
(*  Pro kompilaci: toto neni kompletni program                             *)
(*  Pro spusteni:    -''-                                                  *)
(*  Upozorneni: tyto zdrojove kody pouzivate na vlastni nebezpeci          *)
(*                       !!!! nevyzkouseno !!!!                            *)
(* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *)

{Binarni strom se vyznacuje tim, ze:
 a) Z kazdeho uzlu vychazeji maximalne dve vetve.
 b) Hodnota klice v uzlech v leve vetvi je vzdy mensi nez hodnota klice
    v uzlu, ze ktereho tato vetev vychazi.
 c) Hodnota klice v prave vetvi je naopak vzdy vetsi.
To velmi usnadnuje a zrychluje vyhledavani dat ve stromu.}

type
tklic = integer;{datovy typ klice v uzlech stromu - upravte si dle potreby}

UkNaUzel = ^uzel;

uzel = record
       klic:tklic;
       levy,pravy:uknauzel;
       {...pak by tu asi byla jeste nejaka smysluplna data,
        kvuli kterym by stalo za to strom tvorit...}
       end;


procedure VytvorUzel(var p:uknauzel; d:tklic);
Begin
new(p);{vytvori uzel v pameti}
with p^ do begin{nacpe do nej hodnoty}
           levy:=nil; pravy:=nil;
           klic:=d;
           end;
End;{vytvoruzel}

procedure insert(var strom:uknauzel; d:tklic);
{najde misto, kde do stromu bude pasovat novy klic, a tam vytvori novy uzel s timto klicem}
var p:uknauzel;
    hotovo:boolean;
Begin
if strom=nil then vytvoruzel(strom,d){kdyz je strom prazdny, neni co resit}
             else begin
                  p:=strom;{nastavim se na koren stromu}
                  hotovo:=false;
                   repeat{a jedu:}
                   if d<p^.klic then if p^.levy=nil then begin
                     {kdyz je mensi} {a vlevo je volno}  vytvoruzel(p^.levy,d);{tak vytvorim novy uzel}
                                                         hotovo:=true;
                                                         end
                                                    else p:=p^.levy{jinak jdu dal}
                                else if p^.pravy=nil then begin {tak postup zopakuju s malou obmenou}
                               {a kdyz je vetsi}          vytvoruzel(p^.pravy,d);
                                                          hotovo:=true;
                                                          end
                                                     else p:=p^.pravy;
                   until hotovo;
                  end;
End;{insert}

function search(koren:uknauzel; d:tklic):uknauzel;{najde uzel podle hodnoty klice a vrati ukazatel na nej}
Begin
if koren=nil then search:=nil{kdyz uzel Koren neexistuje, tak vracime nil a koncime}
 else if koren^.klic=d then search:=koren{kdyz existuje a ma pozadovany klic, tak vratime ukazatel na nej}
  else if d<koren^.klic then search:=search(koren^.levy,d){kdyz je D mensi nez klic korenu, bude urcite nekde v leve vetvi}
   else search:=search(koren^.pravy,d);{a kdyz je vetsi, bude nekde vpravo}
End;{search}

procedure SmazUzel(var ktery:uknauzel);{smaze uzel i s vetvemi, ktere z nej vedou}
Begin
if ktery^.levy<>nil then smazuzel(ktery^.levy);{kdyz leva vetev neni prazdna, smazeme ji}
if ktery^.pravy<>nil then smazuzel(ktery^.pravy);{to same s pravou}
dispose(ktery);{a konecne smazeme pozadovany uzel}
ktery:=nil;{to abychom pak vedeli, ze ten uzel neexistuje - dulezite!}
End;{smazuzel}

procedure delete(var strom:uknauzel; d:tklic);{smaze uzel zadany hodnotou klice}
var p:uknauzel;
Begin
p:=search(strom,d);{existuje?}
if p<>nil then smazuzel(p);{jo - smazeme ho}
End;{delete}

procedure preorder(odkud:uknauzel);
{vypise nejdriv klic uzlu Odkud, pak obsah leve vetve a pak prave - nevim, jestli to tak je dobre}
Begin
write(odkud^.klic,',');{vypis vlastniho obsahu}
if odkud^.levy<>nil then preorder(odkud^.levy);{vypis leve vetve}
if odkud^.pravy<>nil then preorder(odkud^.pravy);{vypis prave vetve}
End;{preorder}

procedure inorder(odkud:uknauzel);
{vypise nejdriv obsah leve vetve, pak svuj a pak pravou vetev - snad je to dobre}
Begin
if odkud^.levy<>nil then inorder(odkud^.levy);
write(odkud^.klic,',');
if odkud^.pravy<>nil then inorder(odkud^.pravy);
End;{inorder}

procedure postorder(odkud:uknauzel);
{leva, prava, pak vlastni}
Begin
if odkud^.levy<>nil then postorder(odkud^.levy);
if odkud^.pravy<>nil then postorder(odkud^.pravy);
write(odkud^.klic,',');
End;{postorder}


{EOF}