Commit d3f5358c authored by Robert Ricci's avatar Robert Ricci

Snapshot: First (apparently) working version of the DRE algorithm.

I still have some optimizations to perform.
parent 162036f5
all: test-heap graph2dot test-dijk test-dijk.opt
all: test-heap graph2dot test-dijk test-dijk.opt test-dre test-dre.opt
%.cmx: %.ml
ocamlopt -c $<
......@@ -24,8 +24,11 @@ test-dijk: test-dijk.ml heap.cmo heap.cmi graph.cmo dijkstra.cmo
test-dijk.opt: heap.cmx graph.cmx dijkstra.cmx test-dijk.ml
ocamlopt -o $@ /usr/local/lib/ocaml/str.cmxa $^
test-dre: test-dre.ml heap.cmo graph.cmo dijkstra.cmo dre.cmo
ocamlc -g -o $0 $^ /usr/local/lib/ocaml/str.cma
test-dre: heap.cmo graph.cmo dijkstra.cmo dre.cmo test-dre.ml
ocamlc -g -o $@ /usr/local/lib/ocaml/str.cma $^
test-dre.opt: heap.cmx graph.cmx dijkstra.cmx dre.cmx test-dre.ml
ocamlopt -o $@ /usr/local/lib/ocaml/str.cmxa $^
clean:
-rm *.cmo *.cmx *.cmi graph2dot test-heap test-dijk test-dijk.opt
......@@ -81,6 +81,22 @@ let run_dijkstra (graph : ('a, 'b) Graph.t) (node : ('a, 'b) Graph.node)
type ('a,'b) internal_first_hop = INoHop | INoHopYet | INodeHop of ('a,'b) Graph.node;;
type ('a,'b) first_hop = NoHop | NodeHop of ('a,'b) Graph.node;;
let string_of_fh (fh : (int, 'b) first_hop) : string =
match fh with
NoHop -> "NoHop"
| NodeHop(n) -> string_of_int n.Graph.node_contents
;;
(* XXX - there has got to be a better way to do this, I'm sure *)
let fh_equal (a : ('a, 'b) first_hop) (b : ('a, 'b) first_hop) : bool =
match a with
NoHop ->
(match b with NoHop -> true | _ -> false)
| NodeHop(x) ->
(match b with
NoHop -> false
| NodeHop(y) -> x.Graph.node_contents == y.Graph.node_contents)
;;
exception HopInternalError;;
let get_first_hops (graph : ('a, 'b) Graph.t)
(pred : ('a, 'b) Graph.node array)
......@@ -94,7 +110,7 @@ let get_first_hops (graph : ('a, 'b) Graph.t)
| INodeHop(hop) -> INodeHop(hop) (* We've already found the first hop *)
| INoHopYet ->
(let parent = pred.(node.Graph.node_contents) in
let hop = if parent.Graph.node_contents = root.Graph.node_contents
let hop = if parent.Graph.node_contents == root.Graph.node_contents
then INodeHop(node) else hop_helper parent in
hops.(node.Graph.node_contents) <- hop;
hop)
......@@ -106,13 +122,31 @@ let get_first_hops (graph : ('a, 'b) Graph.t)
in
let rec copy_hops (i : int) : unit =
if i >= Array.length hops then () else
match hops.(i) with
INoHop -> out_hops.(i) <- NoHop
| INodeHop(h) -> out_hops.(i) <- NodeHop(h)
| INoHopYet -> raise HopInternalError
begin
(match hops.(i) with
INoHop -> out_hops.(i) <- NoHop
| INodeHop(h) -> out_hops.(i) <- NodeHop(h)
| INoHopYet -> raise HopInternalError);
copy_hops (i+1)
end
in
all_hops graph.Graph.nodes;
copy_hops 0;
out_hops
;;
(*
let get_all_first_hops (graph : ('a, 'b) Graph.t)
(pred : ('a, 'b) Graph.node array)
: ('a, 'b) first_hop array array =
let all_hops = Array.make_matrix (Graph.count_nodes graph) 0 NoHop in
let fill_array (base : unit) (node : (int, 'a) Graph.node) : unit =
let node_id = node.Graph.node_contents in
all_hops.(node_id) <- get_first_hops graph pred node;
base
in
Graph.fold_nodes graph fill_array ();
all_hops
;;
*)
......@@ -2,6 +2,26 @@
* Functions for computing DRE
*)
let compute_dre (graph : ('a, 'b) Graph.t) : unit =
()
(* let compute_dre (graph : ('a, 'b) Graph.t) : float array array = *)
let compute_dre (hops : ('a, 'b) Dijkstra.first_hop array array) : float array array =
(* Initialize the array of results *)
let n = Array.length hops in
let dre_matrix = Array.make_matrix n n 42.0 in
(* Helper function to decide if two nodes are equivalent from the
* perspective of another *)
let are_equivalent (u : int) (v : int) (w : int) : bool =
Dijkstra.fh_equal hops.(w).(u) hops.(w).(v) in
(* For now, try the simple, naive, way *)
for i = 0 to (n - 1) do
for j = 0 to (n - 1) do
if i != j then
let num_equiv = ref 0 in
for k = 0 to (n - 1) do
if (k != i && k != j) then
if are_equivalent i j k then num_equiv := (!num_equiv + 1)
done;
dre_matrix.(i).(j) <- ((float_of_int !num_equiv) /. (float_of_int (n - 2)))
done
done;
dre_matrix
;;
......@@ -99,6 +99,11 @@ let map_nodes graph visitor =
List.map visitor graph.nodes
;;
(* fold_nodes: ('a, 'b) t -> ('c -> ('a, 'b) node -> 'c) -> 'c list *)
let fold_nodes graph visitor base =
List.fold_left visitor base graph.nodes
;;
(* iterate_edges: ('a, 'b) t -> (('a, 'b) edge -> unit) -> unit *)
let iterate_edges graph visitor =
List.iter visitor graph.edges
......@@ -109,4 +114,10 @@ let map_edges graph visitor =
List.map visitor graph.edges
;;
(* count_nodes: ('a, 'b) t -> int *)
let count_nodes graph =
(* We should probably make this faster by storing the size in the graph *)
List.length graph.nodes
;;
(* More operations will be added later, of course... *)
......@@ -62,6 +62,15 @@ let rec print_pred (channel : out_channel) (preds : (int, 'b) Graph.node array)
print_pred channel preds (index + 1))
;;
let rec print_fhop (channel : out_channel) (fhops : (int, 'a) Dijkstra.first_hop array)
(index : int) : unit =
if index >= Array.length fhops then ()
else (output_string channel (string_of_int index ^ ": " ^ (match fhops.(index) with
Dijkstra.NoHop -> "X"
| Dijkstra.NodeHop(x) -> (string_of_int x.Graph.node_contents)) ^ "\n");
print_fhop channel fhops (index + 1))
;;
let rec dijk_all_nodes (g : ('a, 'b) Graph.t) (nodes : ('a, 'b) Graph.node list)
: unit =
match nodes with
......@@ -70,7 +79,9 @@ let rec dijk_all_nodes (g : ('a, 'b) Graph.t) (nodes : ('a, 'b) Graph.node list)
(* print_endline ("On " ^ string_of_int x.Graph.node_contents); *)
match Dijkstra.run_dijkstra g x with (_,pred) ->
(* XXX - return this somehow *)
let _ = Dijkstra.get_first_hops g pred x in
let fhops = Dijkstra.get_first_hops g pred x in
print_endline ("FHops for " ^ (string_of_int x.Graph.node_contents));
print_fhop stdout fhops 0;
(*
let res = Dijkstra.run_dijkstra g x in
match res with (weights,_) -> print_weights stdout weights 0; *)
......@@ -87,10 +98,12 @@ let g = make_graph_from_edges edges in
(* print_endline "Here 3"; *)
let node = Graph.find_node g 0 in
(* print_endline "Here 4"; *)
(* let res = Dijkstra.run_dijkstra g node in (); *)
let _ = dijk_all_nodes g g.Graph.nodes in
();
(* print_endline "Here 5"; *)
(* match res with (weights,preds) ->
print_weights stdout weights 0;
print_pred stdout preds 0;; *)
(*
let res = Dijkstra.run_dijkstra g node in
match res with (weights,preds) ->
(* print_weights stdout weights 0; *)
print_pred stdout preds 0;;
*)
......@@ -62,19 +62,16 @@ let rec print_pred (channel : out_channel) (preds : (int, 'b) Graph.node array)
print_pred channel preds (index + 1))
;;
let rec dijk_all_nodes (g : ('a, 'b) Graph.t) (nodes : ('a, 'b) Graph.node list)
: unit =
match nodes with
[] -> ()
| (x :: xs) ->
(* print_endline ("On " ^ string_of_int x.Graph.node_contents); *)
match Dijkstra.run_dijkstra g x with (_,pred) ->
(* XXX - return this somehow *)
let _ = Dijkstra.get_first_hops g pred x in
(*
let res = Dijkstra.run_dijkstra g x in
match res with (weights,_) -> print_weights stdout weights 0; *)
dijk_all_nodes g xs
let rec compute_all_dre (g : ('a, 'b) Graph.t) : float array array =
let hops = Array.make_matrix (Graph.count_nodes g) (Graph.count_nodes g) Dijkstra.NoHop in
let fill_array (base : unit) (node : (int, 'a) Graph.node) : unit =
let node_id = node.Graph.node_contents in
match (Dijkstra.run_dijkstra g node) with (_,pred) ->
hops.(node_id) <- Dijkstra.get_first_hops g pred node;
base
in
Graph.fold_nodes g fill_array ();
Dre.compute_dre hops
;;
exception NeedArg;;
......@@ -88,8 +85,14 @@ let g = make_graph_from_edges edges in
let node = Graph.find_node g 0 in
(* print_endline "Here 4"; *)
(* let res = Dijkstra.run_dijkstra g node in (); *)
let _ = dijk_all_nodes g g.Graph.nodes in
();
let dre_table = compute_all_dre g in
let print_cell (cell : float) : unit =
print_float cell; print_string "\t" in
let print_row (row : float array) : unit =
Array.iter print_cell row; print_newline() in
let print_dre_table (table : float array array) : unit =
Array.iter print_row table in
print_dre_table dre_table
(* print_endline "Here 5"; *)
(* match res with (weights,preds) ->
print_weights stdout weights 0;
......
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