open Mlpost
open Box
open Tree
let sprintf = Format.sprintf

hide mpost
show cairo png
show cairo ps
show cairo pdf
show cairo svg

let tree1 =
let node s = node (tex s) in
let leaf s = leaf (tex s) in
draw (node "1" [node "2" [leaf "4"; leaf "5"];
node "3" [leaf "6"; leaf "7"]])

let tree2 =
let leaf s = leaf (tex ~style:Rect s) in
let node s = node ~arrow_style:Undirected (tex ~style:Rect s) in
draw
(node "1" [node "2" [leaf "4"; leaf "5"];
node "3" [leaf "6"; leaf "7"]])

let tree3 =
let node s = node ~arrow_style:Undirected ~edge_style:Curve (tex s) in
let leaf s = leaf (tex s) in
draw (node "1" [node "2" [leaf "4"; leaf "5"];
node "3" [leaf "6"; leaf "7"]])

let tree4 =
let node s = node ~arrow_style:Undirected ~edge_style:Square (tex s) in
let leaf s = leaf (tex s) in
draw
(node "1" [node "2" [leaf "4"; leaf "5"];
node "3" [leaf "6"; leaf "7"]])

let tree5 =
let node s = node ~arrow_style:Undirected ~edge_style:HalfSquare (tex s) in
let leaf s = leaf (tex s) in
draw
(node "1" [node "2" [leaf "4"; leaf "5"];
node "3" [leaf "6"; leaf "7"]])

let tree6 =
let node s = node ~edge_style:HalfSquare (tex s) in
let leaf s = leaf (tex s) in
draw
(node "1" [node "2" [leaf "4"; leaf "5"];
node "3" [leaf "6"; leaf "7"]])

let tree7 =
let node s =
node ~arrow_style:Undirected ~edge_style:HalfSquare (Box.tex s) in
let leaf s = leaf (Box.tex s) in
draw
(node "1" [node "2" [node "3" [leaf "4"]; leaf "5"];
node "3" [node "6" [leaf "8"; node "6" [leaf "8"; leaf "9"]];
node "7" [leaf "10"]]])

let stern_brocot h =
let frac (a,b) = tex (sprintf "$\\frac{%d}{%d}$" a b) in
let rec make ((a,b) as lo) ((c,d) as hi) h =
let r = a+c, b+d in
if h = 1 then
leaf (frac r)
else
node ~arrow_style:Undirected (frac r) [make lo r (h-1); make r hi (h-1)]
in
make (0,1) (1,0) h
let tree8 = draw (stern_brocot 5)

let texint n = tex (sprintf "$F_{%d}$" n)
let rec fib = function
| 0 | 1 as n -> leaf (texint n)
| n -> node ~arrow_style:Undirected (texint n) [fib (n-1); fib (n-2)]
let tree9 = draw (fib 5)

type 'a t = | Node of 'a * 'a t list
let rec bin = function
| 0 -> Node (0, [])
| n ->
let (Node (_,l) as t) = bin (n-1) in
Node (n, t :: l)
let rec trans (Node (n,l)) =
node ~arrow_style:Undirected (tex (sprintf "${2^{%d}}$" n))
(List.map trans l)
let tree10 = draw (trans (bin 4))

open Tree.Simple
open Num
let point =
let pen = Pen.scale (bp 2.) (Pen.circle) in
Box.pic ~dx:zero ~dy:zero (Path.draw ~pen (Path.pathp [Point.origin]))
let rec bin = function
| 0 -> Node (point, [])
| n ->
let (Node (p,l) as t) = bin (n-1) in
Node (p, t :: l)
let rec to_tree (Node (b,l)) =
node ~arrow_style:Undirected ~valign:`Right b (List.map to_tree l)
let tree11 = draw (to_tree (bin 5))

open Tree_adv
open Tree_adv.Overlays
let (++) = Command.(++)
let rec to_tree = function
| Node (e,l) -> Tree.node e (List.map to_tree l)
let node i e l = Node ([Aft i,tex e],l)
let place_not_simple t =
let module P = Place(Overlays_Boxlike(Box)) in
let bplace t = Tree.to_box (to_tree t) in
P.gen_place ~place:bplace t
let tree_adv_draw t i =
let keep e = try Some (assoq i e)
with Not_found -> None in
let t = filter_option keep t in
let t_arrow = gen_draw_arrows Command.nop
~style:Helpers.draw_simple_arrow
~corner:Box.corner t in
(Tree_adv.draw (fun x -> x) t) ++
(fold (++) Command.nop t_arrow)
let mytree_placed =
let t = node 0 "A"
[ node 0 "B" [node 0 "D" [];node 0 "E" []];
node 0 "C" [node 1 "F" [];node 2 "G" []]] in
place_not_simple t
let tree12 = tree_adv_draw mytree_placed 0

let tree13 = tree_adv_draw mytree_placed 1

let tree14 = tree_adv_draw mytree_placed 2

let _ =
List.iter (fun (name,fig) -> Metapost.emit name
(Picture.scale (Num.bp 3.) fig))
[ "tree1", tree1;
"tree2", tree2;
"tree3", tree3;
"tree4", tree4;
"tree5", tree5;
"tree6", tree6;
"tree7", tree7;
"tree8", tree8;
"tree9", tree9;
"tree10", tree10;
"tree11", tree11;
"tree12", tree12;
"tree13", tree13;
"tree14", tree14;
]

*This document was generated using
caml2html*