(* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *) (* 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
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}