Commit c94d9d86 authored by Robert Ricci's avatar Robert Ricci

Use Mintree to track how many bits are required by the current naming.

Right now, exits if you use too many bits, instead of falling back to
a different naming algorithm.
parent 694b93a1
......@@ -12,12 +12,18 @@ let argspec =
Arg.parse argspec (fun x -> graphfile := Some(x)) "Usage";;
(* Tree we're constructing *)
type tree_node = NoNode | TreeNode of (int * tree_node * tree_node);;
type tree_node = NoNode | TreeNode of (int * int * tree_node * tree_node);;
let rec tree_depth (tree : tree_node) : int =
match tree with
NoNode -> 0
| TreeNode(_,l,r) -> 1 + (max (tree_depth l) (tree_depth r))
NoNode -> -1
| TreeNode(_,_,l,r) -> 1 + (max (tree_depth l) (tree_depth r))
;;
let rec tree_height (tree : tree_node) : int =
match tree with
NoNode -> -1
| TreeNode(_,h,_,_) -> h;
;;
let debug (str : string) : unit =
......@@ -58,23 +64,30 @@ let do_nothing () : unit =
raise (Failure "do_nothing called")
;;
let (graph,_) = match !graphfile with
let (graph,headers) = match !graphfile with
Some(x) -> Graph.read_subgraph_file x
| None -> Graph.read_subgraph_file "-"
(*
let total_bits =
match List.filter (fun e -> let (k,_) = e in k = "total-bits") headers with
e :: [] -> let (k,v) = e in v
| _ -> 32;;
debug ("Total Bits " ^ (string_of_int total_bits));;
debug ("Graph size " ^ (string_of_int (List.length graph.Graph.nodes)));;
debug ("Edges " ^ (string_of_int (List.length graph.Graph.edges)));;
*)
let hops = Dijkstra.get_all_first_hops graph;;
let size = Array.length hops;;
let estimated_routes = ref (size * (size - 1));;
(* Keep bins of *)
let bins = Mintree.make total_bits;;
let initial_node_set (i : int) (_ : 'b) : 'a node_sets_entry option =
debug("Setting up node set " ^ (string_of_int i));
let node_set = Dre.ISet.singleton i in
Some(node_set,blob_from_set hops node_set,TreeNode(i,NoNode,NoNode));;
Some(node_set,blob_from_set hops node_set,TreeNode(i,0,NoNode,NoNode));;
let node_sets = Array.mapi initial_node_set hops;;
......@@ -98,13 +111,18 @@ let consider_combining (node_sets : 'a node_sets) (matrix : matrix)
;;
let initialize_heap (node_sets : 'a node_sets) (hops : int array array)
: (nodepair Heap.heap * matrix) =
(bins : Mintree.bins_t) : (nodepair Heap.heap * matrix) =
let heap = Heap.make_heap (-1,-1) in
let (matrix : matrix) = Array.make_matrix size size None in
debug "init_heap called";
for i = 0 to size - 1 do
for j = i + 1 to size - 1 do
consider_combining node_sets matrix hops heap i j
done
done;
(* Also add to the bins which count how many trees of each
* depth we have *)
debug "Calling add_to_bin";
Mintree.add_to_bin bins 0
done;
(heap, matrix)
;;
......@@ -156,7 +174,8 @@ let combine_with_all (node_sets : 'a node_sets) (matrix : matrix)
;;
let combine (node_sets : 'a node_sets) (matrix : matrix)
(hops : int array array) (heap : nodepair Heap.heap) (a : int) (b: int) : unit =
(hops : int array array) (heap : nodepair Heap.heap) (a : int)
(b: int) : unit =
debug ("Combining " ^ (string_of_int a) ^ " with " ^ (string_of_int b));
if b <= a then raise (Failure "b <= a");
let old1 = match node_sets.(a) with
......@@ -167,9 +186,12 @@ let combine (node_sets : 'a node_sets) (matrix : matrix)
| Some(x) -> x in
let (s1,blob1,tree1) = old1 in
let (s2,blob2,tree2) = old2 in
let h1 = tree_height tree1 in
let h2 = tree_height tree2 in
let s3 = Dre.ISet.union s1 s2 in
let blob3 = combine_blob hops s1 s2 blob1 blob2 in
let tree3 = TreeNode(a, tree1, tree2) in
let d3 = (1 + max h1 h2) in
let tree3 = TreeNode(a, d3, tree1, tree2) in
remove_from_matrix matrix a b;
(*
debug "Heap: ";
......@@ -182,8 +204,10 @@ let combine (node_sets : 'a node_sets) (matrix : matrix)
combine_with_all node_sets matrix hops heap a
;;
exception OutOfBits;;
let rec greedy_combine (node_sets : 'a node_sets) (matrix : matrix)
(hops : int array array) (heap : nodepair Heap.heap) (remaining : int) : tree_node =
(hops : int array array) (heap : nodepair Heap.heap)
(remaining : int) (bins: Mintree.bins_t) : tree_node =
if remaining <= 0 then begin
let rec find_tree (i : int) : tree_node =
match node_sets.(i) with
......@@ -194,18 +218,55 @@ let rec greedy_combine (node_sets : 'a node_sets) (matrix : matrix)
let (score,(a,b)) = Heap.min heap in
let (x,y) = if a < b then (a,b) else (b,a) in
estimated_routes := !estimated_routes + score;
debug ("Combined " ^ (string_of_int x) ^ " and " ^ (string_of_int y));
(* Try to find the depths of the two subtrees. This is not pretty *)
match node_sets.(x) with
None -> debug("X had no node_sets entry")
| Some(_,_,tree) -> (
match tree with
TreeNode(_,h,_,_) -> (
debug("X had height " ^ (string_of_int h));
Mintree.remove_from_bin bins h
)
);
;
match node_sets.(y) with
None -> debug("Y had no node_sets entry")
| Some(_,_,tree) -> (
match tree with
TreeNode(_,h,_,_) -> (
debug("Y had height " ^ (string_of_int h));
Mintree.remove_from_bin bins h
)
);
;
combine node_sets matrix hops heap x y;
greedy_combine node_sets matrix hops heap (remaining - 1)
match node_sets.(x) with
None -> debug("X has no node_sets entry")
| Some(_,_,tree) -> (
match tree with
TreeNode(_,h,_,_) -> (
debug("New x has height " ^ (string_of_int h));
Mintree.add_to_bin bins h
)
);
;
let min_height = Mintree.height_of bins in
debug ("Currently uses " ^ (string_of_int min_height) ^
" bits (" ^ (string_of_int total_bits) ^ ") bits max");
if min_height > total_bits then
raise OutOfBits;
greedy_combine node_sets matrix hops heap (remaining - 1) bins
end
;;
let (heap,matrix) = initialize_heap node_sets hops in
let (heap,matrix) = initialize_heap node_sets hops bins in
debug "Heap initialized";
let root = greedy_combine node_sets matrix hops heap (size - 1) in
let root = greedy_combine node_sets matrix hops heap (size - 1) bins in
let rec print_tree (root : tree_node) =
match root with
NoNode -> ()
| TreeNode(id,left,right) -> begin
| TreeNode(id,heigt,left,right) -> begin
print_tree left;
output_string stdout ((string_of_int id) ^ "\n");
print_tree right
......@@ -219,7 +280,7 @@ let tree_placement (howmany : int) (tree : tree_node) : (int * int32 array) =
raise (Failure "Tree too deep"); *)
match tree with
NoNode -> -1
| TreeNode(id,left,right) ->
| TreeNode(id,height,left,right) ->
if left == NoNode && right == NoNode then begin
(* Leaf node *)
locations.(id) <- sofar;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment