with Ada.Text_IO; use Ada.Text_IO; with Ada.Float_Text_IO; use Ada.Float_Text_IO; with Ada.Integer_Text_IO; use Ada.Integer_Text_IO; with Ada.Numerics.Elementary_Functions; use Ada.Numerics.Elementary_Functions; with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; with Ada.Text_IO, Ada.Numerics.Float_Random; use Ada.Text_IO, Ada.Numerics.Float_Random; with Ada.Command_Line; use Ada.Command_Line; procedure binTreeDL2TikZ is type BB; type rBB is access BB; type BB is record v : integer; ---value of node l,r : rBB; ---pointer to childs highl : natural:=0; ---highlight flag (1(red),2(green) or 3(blue)) end record; type node_span is record l,r : integer:=0; end record; level_distance : natural:= 8; sibling_distance : natural:= 10; addend_step : natural:= 1; Box_Size : Natural:= 4; -- in mm! Beamer_Flag : Boolean:=False; --------------------------------- function Empty return rBB is begin return null; end Empty; --------------------------------- function Isempty(a : rBB) return boolean is begin return (a=null); end Isempty; --------------------------------- function Add_key(a : integer; b : rBB) return rBB is n,m : rBB; begin if Isempty(b) then n := new BB'(a, Null, Null,0); return n; else n:= b; while n/=Null loop m:=n; if n.v > a then n:=n.l; else n:=n.r; end if; end loop; n:= new BB'(a, Null, Null,0); if m.v > a then m.l:=n; else m.r:=n; end if; return b; end if; end Add_key; --------------------------------- function Find_key(a : integer; b : rBB) return rBB is n : rBB:=b; begin if Isempty(b) then return Null; else while n/=Null loop if n.v=a then return n; elsif n.v > a then n:=n.l; else n:=n.r; end if; end loop; return n; end if; end Find_key; --------------------------------- function Find_father_of_key(a : integer; b : rBB) return rBB is n,p : rBB; begin if Isempty(b) then return Null; else n:= b; p:= Null; while n/=Null loop if n.v=a then return p; elsif n.v > a then p:=n; n:=n.l; else p:=n; n:=n.r; end if; end loop; return Null; end if; end Find_father_of_key; --------------------------------- -- find the inorder successor in subtree 'b', returns a -- pointer to successor and cut it out (correctly) from subtree --------------------------------- function Find_and_cut_key_successor(b : rBB) return rBB is n,m : rBB:=b; begin if Isempty(b) then return Null; else while true loop if n.l/=Null then m:=n; n:=n.l; else if m.l=n then m.l:= n.r; end if; return n; end if; end loop; end if; return n; --not necessary, only for the compiler ;-) end Find_and_cut_key_successor; --------------------------------- function Remove_key(a : integer; b : rBB) return rBB is s,r,f : rBB; begin if Isempty(b) then return Null; else r:= Find_key(a,b); if r=Null then return b; end if; --'a' was not in tree 'b' s:= Find_and_cut_key_successor(r.r); f:= Find_father_of_key(r.v, b); if s=Null and f/=Null then --(1) if f.l=r then f.l:= r.l; else f.r:= r.l; end if; return b; elsif s=Null and f=Null then --(3) return r.l; else --(2 & 4) r.v:= s.v; return b; end if; end if; end Remove_key; --------------------------------- procedure Put_inorder( b : rBB) is begin if b/=Null then Put_inorder(b.l); Put(b.v); Put_inorder(b.r); end if; end Put_inorder; --------------------------------- procedure Put_postorder( b : rBB) is begin if b/=Null then Put_postorder(b.l); Put_postorder(b.r); Put(b.v); end if; end Put_postorder; --------------------------------- procedure Put_preorder( b : rBB) is begin if b/=Null then Put(b.v); Put_preorder(b.l); Put_preorder(b.r); end if; end Put_preorder; --------------------------------- function Get_tree_depth(binb : rBB) return natural is function Rek(b : rBB) return natural is t1, t2 : natural; begin if Isempty(b) then return 0; else t1:= 1 + Rek(b.l); t2:= 1 + Rek(b.r); if t1 > t2 then return t1; else return t2; end if; end if; end Rek; begin return Rek(binb); end Get_tree_depth; --------------------------------- function Get_number_of_elements (binb : rBB) return natural is function Rek(b : rBB) return natural is begin if Isempty(b) then return 0; else return 1 + Rek(b.l) + Rek(b.r); end if; end Rek; begin return Rek(binb); end Get_number_of_elements; --------------------------------- procedure Splay_find (a : integer; binb : rBB; n,f,gf,ggf : out rBB; left_f, left_gf, left_ggf : out boolean) is working : boolean; begin if binb=Null then n:= Null; f:= Null; gf:= Null; ggf:= Null; left_f:=true; left_gf:=true; left_ggf:=true; else n:= binb; f:= Null; gf:= Null; ggf:= Null; working:= true; while working loop if n.v=a then working:= false; elsif n.v > a then if n.l=Null then working:= false; else ggf:= gf; gf:= f; f:=n; n:=n.l; left_ggf:= left_gf; left_gf:= left_f; left_f:=true; end if; else if n.r=Null then working:= false; else ggf:= gf; gf:= f; f:=n; n:=n.r; left_ggf:= left_gf; left_gf:= left_f; left_f:=false; end if; end if; end loop; end if; end Splay_find; --------------------------------- procedure Rotate_node (n,f,gf : rBB; left_f, left_gf : boolean) is begin if left_gf then if gf/=Null then gf.l:= n; end if; --'f' is root if left_f then f.l:= n.r; n.r:= f; else f.r:= n.l; n.l:= f; end if; else if gf/=Null then gf.r:= n; end if; --'f' is root if left_f then f.l:= n.r; n.r:= f; else f.r:= n.l; n.l:= f; end if; end if; end Rotate_node; --------------------------------- --------------------------------- function ST_splay_step (a : integer; binb : rBB) return rBB is n,f,gf, ggf : rBB; left_f, left_gf, left_ggf : boolean; begin Splay_find(a, binb, n, f, gf, ggf, left_f, left_gf, left_ggf); if n=Null then return binb; else if f=Null and gf=Null then return binb; -- n is root, no rotation required elsif f/=Null and gf=Null then -- 1 Rotation if left_f then f.l:= n.r; n.r:= f; return n; else f.r:= n.l; n.l:= f;new_line; return n; end if; else -- 2 rotations if (left_f and left_gf) or (Not(left_f) and Not(left_gf)) then Rotate_node(f, gf, ggf, left_gf, left_ggf); Rotate_node(n, f, ggf, left_f, left_ggf); else Rotate_node(n, f, gf, left_f, left_gf); Rotate_node(n, gf, ggf, left_gf, left_ggf); end if; if ggf=Null then return n; end if; end if; return binb; end if; end ST_splay_step; --------------------------------- function ST_splay(a : integer; binb : rBB) return rBB is b : rBB:= binb; begin for i in 1..Get_tree_depth(b) loop b:= ST_splay_step(a, b); end loop; return b; end ST_splay; --------------------------------- function ST_insert(a : integer; binb : rBB) return rBB is b : rBB:= binb; begin b:= ST_splay(a, binb); if a < b.v then b.l := new BB'(a, Null, Null,0); elsif a > b.v then b.r := new BB'(a, Null, Null,0); end if; return b; end ST_insert; --------------------------------- function ST_delete(a : integer; binb : rBB) return rBB is b, subl : rBB:= binb; begin b:= ST_splay(a, binb); if b.v=a then subl:= ST_splay(Integer'Last, b.l); if subl/=Null then subl.r:= b.r; return subl; else return b.r; end if; else return b; end if; end ST_delete; --------------------------------- procedure Highlight_node(a : integer; binb : rBB; color: natural) is n : rBB; begin n:= Find_key(a, binb); if n/=Null then n.highl:= color; end if; end Highlight_node; --------------------------------- procedure Dont_highlight_node(a : integer; binb : rBB) is n : rBB; begin n:= Find_key(a, binb); if n/=Null then n.highl:= 0; end if; end Dont_highlight_node; --------------------------------- procedure Dont_highlight_all(b : rBB) is begin if b/=Null then Dont_highlight_all(b.l); Dont_highlight_all(b.r); b.highl:=0; end if; end Dont_highlight_all; --------------------------------- procedure Output_Tree(r : rBB) is procedure Rek(b : rBB) is begin if b/=Null then if b.highl=1 then Put("child{node[fill=red!25] {\makebox[");Put(Box_Size, Width => 1);Put("mm]{"); Put(b.v, Width => 1); Put("}}"); new_line; elsif b.highl=2 then Put("child{node[fill=green!25] {\makebox[");Put(Box_Size, Width => 1);Put("mm]{"); Put(b.v, Width => 1); Put("}}"); new_line; elsif b.highl=3 then Put("child{node[fill=blue!25] {\makebox[");Put(Box_Size, Width => 1);Put("mm]{"); Put(b.v, Width => 1); Put("}}"); new_line; else Put("child{node {\makebox[");Put(Box_Size, Width => 1);Put("mm]{"); Put(b.v, Width => 1); Put("}}"); new_line; end if; if b.l/=Null then Rek(b.l); else Put("child[fill=none] {edge from parent[draw=none]}"); end if; if b.r/=Null then Rek(b.r); else Put("child[fill=none] {edge from parent[draw=none]}"); end if; Put("}"); end if; end Rek; begin if r/=Null then if r.highl=1 then Put("\node[fill=red!25] {\makebox[");Put(Box_Size, Width => 1);Put("mm]{"); Put(r.v, Width => 1); Put("}}"); new_line; elsif r.highl=2 then Put("\node[fill=green!25] {\makebox[");Put(Box_Size, Width => 1);Put("mm]{"); Put(r.v, Width => 1); Put("}}"); new_line; elsif r.highl=3 then Put("\node[fill=blue!25] {\makebox[");Put(Box_Size, Width => 1);Put("mm]{"); Put(r.v, Width => 1); Put("}}"); new_line; else Put("\node {\makebox[");Put(Box_Size, Width => 1);Put("mm]{"); Put(r.v, Width => 1); Put("}}"); new_line; end if; if r.l/=Null then Rek(r.l); else Put("child[fill=none] {edge from parent[draw=none]}"); end if; if r.r/=Null then Rek(r.r); else Put("child[fill=none] {edge from parent[draw=none]}"); end if; Put_line(";"); Put_line("\end{tikzpicture}"); end if; if Beamer_Flag then Put_line("\end{center}"); Put_line("\end{frame}"); end if; New_Line; end Output_Tree; --------------------------------- procedure Output_tikzstyle(r : rBB) is max_depth : natural:= Get_tree_depth(r); level_addend : array(1..max_depth) of natural; type nsa is array(1..max_depth) of node_span; span_dummy : nsa; ------------------- function Rek(b : rBB; level : natural) return nsa is span, left, right : nsa; left_based_depth : natural; right_based_depth: natural; left_is_deeper : boolean; still_overlaps : boolean:= false; min_depth : natural; begin for i in 1..max_depth loop span(i).r:= 0; span(i).l:= 0; --initialising span array end loop; if b/=Null then left_based_depth := Get_tree_depth(b.l)+level; right_based_depth:= Get_tree_depth(b.r)+level; left:= Rek(b.l, level +1); --recursive call for childs of node b right:= Rek(b.r, level +1); if b.r=Null and b.l=Null then return span; elsif b.r=Null then for i in (level+1)..left_based_depth loop span(i).l:= left(i).l - level_addend(level); span(i).r:= left(i).r - level_addend(level); end loop; return span; elsif b.l=Null then for i in (level+1)..right_based_depth loop span(i).l:= right(i).l + level_addend(level); span(i).r:= right(i).r + level_addend(level); end loop; return span; else if left_based_depth > right_based_depth then --which subtree is deeper? left_is_deeper:= true; min_depth:= right_based_depth; else left_is_deeper:= false; min_depth:= left_based_depth; end if; for i in level+1..min_depth loop if (left(i).r - level_addend(level) +8) >= (right(i).l + level_addend(level) -8) then still_overlaps:= true; end if; end loop; while still_overlaps loop level_addend(level):= level_addend(level) + addend_step; still_overlaps:= false; for i in level+1..min_depth loop if (left(i).r - level_addend(level) +8) >= (right(i).l + level_addend(level) -8) then still_overlaps:= true; end if; end loop; end loop; -- enough level_addend generated (sibling distance is now big enough) for i in level+1..min_depth loop span(i).l:= left(i).l - level_addend(level); span(i).r:= right(i).r + level_addend(level); end loop; if left_is_deeper then for i in min_depth+1..left_based_depth loop span(i).l:= left(i).l - level_addend(level); span(i).r:= left(i).r - level_addend(level); end loop; else for i in min_depth+1..right_based_depth loop span(i).l:= right(i).l + level_addend(level); span(i).r:= right(i).r + level_addend(level); end loop; end if; end if; end if; return span; end Rek; ------------------- begin for i in 1..level_addend'last loop level_addend(i):=sibling_distance; --initializing array end loop; for i in 1..Get_number_of_elements(r) loop --for secure, do this n-times span_dummy:= Rek(r,1); end loop; new_line; -- Output if Beamer_Flag then Put_line("\begin{frame} %---------------> new frame with one tikzpicture"); Put_line("\begin{center}"); else Put_line("% >>>> paste the following lines in your LaTeX document and \usepackage{tikz}"); Put_line("%----------------------------------------------------------------------------"); end if; Put("\begin{tikzpicture}[level distance="); Put(level_distance, Width=>1); Put_line("mm]"); Put_line("\tikzstyle{every node}=[draw,circle,black,text=black,inner sep=1pt]"); Put_line("\tikzstyle{edge from parent}=[draw,thick,black]"); for i in 1..level_addend'last loop Put("\tikzstyle{level "); Put(i, Width=>1); Put("}=[sibling distance="); Put(level_addend(i), Width=>1); Put_line("mm]"); end loop; new_line; end Output_tikzstyle; --------------------------------- function Parse_key(snum : string) return integer is sum : integer:=0; negative : boolean:= false; i : natural:= 1; begin while i<=3 and i<=snum'Length loop if Element(to_unbounded_string(snum), i) in '0'..'9' then sum:= 10 * sum + (Character'Pos(Element(to_unbounded_string(snum), i)) - Character'Pos('0')); elsif Element(to_unbounded_string(snum), i)='-' then negative:= true; end if; i:= i+1; end loop; if negative then sum:= sum*(-1); end if; return sum; end Parse_key; --------------------------------- procedure Read_input_file(name : string) is tree : rBB; zeile : String(1..50); lll : natural; File : file_type; procedure Parse_line(line : string) is begin if "add_node("=line(1..9) then tree:= Add_key(Parse_key(Slice(to_unbounded_string(line), 10, 12)), tree); elsif "draw_tree"=line(1..9) then Output_tikzstyle(tree); Output_Tree(tree); elsif "remove_node("=line(1..12) then tree:= Remove_key(Parse_key(Slice(to_unbounded_string(line), 13, 15)), tree); elsif "new_tree"=line(1..8) then tree:= Null; elsif "ST_splay_step("=line(1..14) then tree:= ST_splay_step(Parse_key(Slice(to_unbounded_string(line), 15, 17)), tree); elsif "ST_splay("=line(1..9) then tree:= ST_splay(Parse_key(Slice(to_unbounded_string(line), 10, 12)), tree); elsif "ST_member("=line(1..10) then tree:= ST_splay(Parse_key(Slice(to_unbounded_string(line), 11, 13)), tree); elsif "ST_insert("=line(1..10) then tree:= ST_insert(Parse_key(Slice(to_unbounded_string(line), 11, 13)), tree); elsif "ST_delete("=line(1..10) then tree:= ST_delete(Parse_key(Slice(to_unbounded_string(line), 11, 13)), tree); elsif "highlight_red_node("=line(1..19) then Highlight_node(Parse_key(Slice(to_unbounded_string(line), 20, 22)), tree, 1); elsif "highlight_green_node("=line(1..21) then Highlight_node(Parse_key(Slice(to_unbounded_string(line), 22, 24)), tree, 2); elsif "highlight_blue_node("=line(1..20) then Highlight_node(Parse_key(Slice(to_unbounded_string(line), 21, 23)), tree, 3); elsif "dont_highlight_node("=line(1..20) then Dont_highlight_node(Parse_key(Slice(to_unbounded_string(line), 21, 23)), tree); elsif "dont_highlight_all"=line(1..18) then Dont_highlight_all(tree); end if; end Parse_line; begin Open(File, In_File, name); while (not End_Of_File(File)) loop zeile:=" "; Get_Line(File, zeile, lll); Parse_line(zeile); end loop; Close(File); end Read_input_file; ----------------------------------------------------------------------------------- begin if Argument(2)="beamer" then Beamer_Flag:=True; end if; Read_input_file(Argument(1)); new_line; end binTreeDL2TikZ;