Commit c94d9d86 by 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 = ... @@ -12,12 +12,18 @@ let argspec = Arg.parse argspec (fun x -> graphfile := Some(x)) "Usage";; Arg.parse argspec (fun x -> graphfile := Some(x)) "Usage";; (* Tree we're constructing *) (* 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 = let rec tree_depth (tree : tree_node) : int = match tree with match tree with NoNode -> 0 NoNode -> -1 | TreeNode(_,l,r) -> 1 + (max (tree_depth l) (tree_depth r)) | 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 = let debug (str : string) : unit = ... @@ -58,23 +64,30 @@ let do_nothing () : unit = ... @@ -58,23 +64,30 @@ let do_nothing () : unit = raise (Failure "do_nothing called") raise (Failure "do_nothing called") ;; ;; let (graph,_) = match !graphfile with let (graph,headers) = match !graphfile with Some(x) -> Graph.read_subgraph_file x Some(x) -> Graph.read_subgraph_file x | None -> Graph.read_subgraph_file "-" | 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 ("Graph size " ^ (string_of_int (List.length graph.Graph.nodes)));; debug ("Edges " ^ (string_of_int (List.length graph.Graph.edges)));; debug ("Edges " ^ (string_of_int (List.length graph.Graph.edges)));; *) let hops = Dijkstra.get_all_first_hops graph;; let hops = Dijkstra.get_all_first_hops graph;; let size = Array.length hops;; let size = Array.length hops;; let estimated_routes = ref (size * (size - 1));; 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 = let initial_node_set (i : int) (_ : 'b) : 'a node_sets_entry option = debug("Setting up node set " ^ (string_of_int i)); debug("Setting up node set " ^ (string_of_int i)); let node_set = Dre.ISet.singleton i in 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;; let node_sets = Array.mapi initial_node_set hops;; ... @@ -98,13 +111,18 @@ let consider_combining (node_sets : 'a node_sets) (matrix : matrix) ... @@ -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) 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 heap = Heap.make_heap (-1,-1) in let (matrix : matrix) = Array.make_matrix size size None in let (matrix : matrix) = Array.make_matrix size size None in debug "init_heap called"; for i = 0 to size - 1 do for i = 0 to size - 1 do for j = i + 1 to size - 1 do for j = i + 1 to size - 1 do consider_combining node_sets matrix hops heap i j 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; done; (heap, matrix) (heap, matrix) ;; ;; ... @@ -156,7 +174,8 @@ let combine_with_all (node_sets : 'a node_sets) (matrix : 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) 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)); debug ("Combining " ^ (string_of_int a) ^ " with " ^ (string_of_int b)); if b <= a then raise (Failure "b <= a"); if b <= a then raise (Failure "b <= a"); let old1 = match node_sets.(a) with let old1 = match node_sets.(a) with ... @@ -167,9 +186,12 @@ let combine (node_sets : 'a node_sets) (matrix : matrix) ... @@ -167,9 +186,12 @@ let combine (node_sets : 'a node_sets) (matrix : matrix) | Some(x) -> x in | Some(x) -> x in let (s1,blob1,tree1) = old1 in let (s1,blob1,tree1) = old1 in let (s2,blob2,tree2) = old2 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 s3 = Dre.ISet.union s1 s2 in let blob3 = combine_blob hops s1 s2 blob1 blob2 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; remove_from_matrix matrix a b; (* (* debug "Heap: "; debug "Heap: "; ... @@ -182,8 +204,10 @@ let combine (node_sets : 'a node_sets) (matrix : matrix) ... @@ -182,8 +204,10 @@ let combine (node_sets : 'a node_sets) (matrix : matrix) combine_with_all node_sets matrix hops heap a combine_with_all node_sets matrix hops heap a ;; ;; exception OutOfBits;; let rec greedy_combine (node_sets : 'a node_sets) (matrix : matrix) 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 if remaining <= 0 then begin let rec find_tree (i : int) : tree_node = let rec find_tree (i : int) : tree_node = match node_sets.(i) with match node_sets.(i) with ... @@ -194,18 +218,55 @@ let rec greedy_combine (node_sets : 'a node_sets) (matrix : matrix) ... @@ -194,18 +218,55 @@ let rec greedy_combine (node_sets : 'a node_sets) (matrix : matrix) let (score,(a,b)) = Heap.min heap in let (score,(a,b)) = Heap.min heap in let (x,y) = if a < b then (a,b) else (b,a) in let (x,y) = if a < b then (a,b) else (b,a) in estimated_routes := !estimated_routes + score; 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; 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 end ;; ;; let (heap,matrix) = initialize_heap node_sets hops in let (heap,matrix) = initialize_heap node_sets hops bins in debug "Heap initialized"; 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) = let rec print_tree (root : tree_node) = match root with match root with NoNode -> () NoNode -> () | TreeNode(id,left,right) -> begin | TreeNode(id,heigt,left,right) -> begin print_tree left; print_tree left; output_string stdout ((string_of_int id) ^ "\n"); output_string stdout ((string_of_int id) ^ "\n"); print_tree right print_tree right ... @@ -219,7 +280,7 @@ let tree_placement (howmany : int) (tree : tree_node) : (int * int32 array) = ... @@ -219,7 +280,7 @@ let tree_placement (howmany : int) (tree : tree_node) : (int * int32 array) = raise (Failure "Tree too deep"); *) raise (Failure "Tree too deep"); *) match tree with match tree with NoNode -> -1 NoNode -> -1 | TreeNode(id,left,right) -> | TreeNode(id,height,left,right) -> if left == NoNode && right == NoNode then begin if left == NoNode && right == NoNode then begin (* Leaf node *) (* Leaf node *) locations.(id) <- sofar; 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