add comments
This commit is contained in:
parent
d0f94713e4
commit
53246b1598
2 changed files with 25 additions and 15 deletions
|
@ -7,34 +7,41 @@ type path = string
|
||||||
(* Format of text files:
|
(* Format of text files:
|
||||||
% This is a comment
|
% This is a comment
|
||||||
|
|
||||||
% A node with its coordinates (which are not used).
|
% define a factory with its id and production rate
|
||||||
n 88.8 209.7
|
factory 0 6
|
||||||
n 408.9 183.0
|
|
||||||
|
|
||||||
% The first node has id 0, the next is 1, and so on.
|
% define a village with its id and demand
|
||||||
|
village 1 10
|
||||||
|
|
||||||
% Edges: e source dest label
|
% define a neutral node with its id
|
||||||
e 3 1 11
|
node 2
|
||||||
e 0 2 8
|
|
||||||
|
% define a road between 2 nodes using their ids and specifying the max capacity
|
||||||
|
road 0 1 2
|
||||||
|
|
||||||
*)
|
*)
|
||||||
|
|
||||||
|
(* Source and destination node
|
||||||
|
We use negative ids to prevent conflicts
|
||||||
|
*)
|
||||||
let source = (-1)
|
let source = (-1)
|
||||||
let destination = (-2)
|
let destination = (-2)
|
||||||
|
|
||||||
|
(* Reads a factory node, adds it to the graph and creates an arc from the source *)
|
||||||
let read_factory graph line =
|
let read_factory graph line =
|
||||||
try Scanf.sscanf line "factory %d %d" (fun id capacity -> new_arc (new_node graph id) source id capacity)
|
try Scanf.sscanf line "factory %d %d" (fun id capacity -> new_arc (new_node graph id) source id capacity)
|
||||||
with e ->
|
with e ->
|
||||||
Printf.printf "Cannot read factory in line - %s:\n%s\n%!" (Printexc.to_string e) line ;
|
Printf.printf "Cannot read factory in line - %s:\n%s\n%!" (Printexc.to_string e) line ;
|
||||||
failwith "from_file"
|
failwith "from_file"
|
||||||
|
|
||||||
|
(* Reads a village node, adds it to the graph and creates an arc to the destination *)
|
||||||
let read_village graph line =
|
let read_village graph line =
|
||||||
try Scanf.sscanf line "village %d %d" (fun id capacity -> new_arc (new_node graph id) id destination capacity)
|
try Scanf.sscanf line "village %d %d" (fun id capacity -> new_arc (new_node graph id) id destination capacity)
|
||||||
with e ->
|
with e ->
|
||||||
Printf.printf "Cannot read village in line - %s:\n%s\n%!" (Printexc.to_string e) line ;
|
Printf.printf "Cannot read village in line - %s:\n%s\n%!" (Printexc.to_string e) line ;
|
||||||
failwith "from_file"
|
failwith "from_file"
|
||||||
|
|
||||||
(* Reads a line with a node. *)
|
(* Reads a line with a neutral node and adds it to the graph *)
|
||||||
let read_node graph line =
|
let read_node graph line =
|
||||||
try Scanf.sscanf line "node %d" (fun id -> new_node graph id)
|
try Scanf.sscanf line "node %d" (fun id -> new_node graph id)
|
||||||
with e ->
|
with e ->
|
||||||
|
@ -45,7 +52,7 @@ let read_node graph line =
|
||||||
* (Necessary because the website we use to create online graphs does not generate correct files when some nodes have been deleted.) *)
|
* (Necessary because the website we use to create online graphs does not generate correct files when some nodes have been deleted.) *)
|
||||||
let ensure graph id = if node_exists graph id then graph else new_node graph id
|
let ensure graph id = if node_exists graph id then graph else new_node graph id
|
||||||
|
|
||||||
(* Reads a line with an arc. *)
|
(* Reads a line with an road and creates and arc between the nodes of the given id and capacity *)
|
||||||
let read_road graph line =
|
let read_road graph line =
|
||||||
try Scanf.sscanf line "road %d %d %d"
|
try Scanf.sscanf line "road %d %d %d"
|
||||||
(fun id1 id2 capacity -> new_arc (ensure (ensure graph id1) id2) id1 id2 capacity)
|
(fun id1 id2 capacity -> new_arc (ensure (ensure graph id1) id2) id1 id2 capacity)
|
||||||
|
@ -61,7 +68,6 @@ let read_comment graph line =
|
||||||
failwith "from_file"
|
failwith "from_file"
|
||||||
|
|
||||||
let circulation_from_file path =
|
let circulation_from_file path =
|
||||||
|
|
||||||
let infile = open_in path in
|
let infile = open_in path in
|
||||||
(* create source and destination *)
|
(* create source and destination *)
|
||||||
let initial_graph = new_node (new_node empty_graph source) destination in
|
let initial_graph = new_node (new_node empty_graph source) destination in
|
||||||
|
@ -89,10 +95,8 @@ let circulation_from_file path =
|
||||||
| _ -> read_comment graph line
|
| _ -> read_comment graph line
|
||||||
in
|
in
|
||||||
loop graph2
|
loop graph2
|
||||||
|
|
||||||
with End_of_file -> graph (* Done *)
|
with End_of_file -> graph (* Done *)
|
||||||
in
|
in
|
||||||
|
|
||||||
let final_graph = loop initial_graph in
|
let final_graph = loop initial_graph in
|
||||||
|
|
||||||
close_in infile ;
|
close_in infile ;
|
||||||
|
|
|
@ -25,16 +25,17 @@ type flow = {
|
||||||
|
|
||||||
type path = (id * id) list
|
type path = (id * id) list
|
||||||
|
|
||||||
|
(* Converts an int graph to a flow graph with the current capacity at 0 for each arc *)
|
||||||
(* int graph -> flow graph *)
|
(* int graph -> flow graph *)
|
||||||
let initialize_graph gr = gmap gr (fun c -> { current = 0; capacity = c })
|
let initialize_graph gr = gmap gr (fun c -> { current = 0; capacity = c })
|
||||||
|
|
||||||
|
(* adds an arc to the graph only if the value is different from 0 *)
|
||||||
(* int graph -> int -> int -> int -> int graph *)
|
(* int graph -> int -> int -> int -> int graph *)
|
||||||
let add_res_arc gr origin destination value = match value with
|
let add_res_arc gr origin destination value = match value with
|
||||||
| 0 -> gr
|
| 0 -> gr
|
||||||
| _ -> add_arc gr origin destination value
|
| _ -> add_arc gr origin destination value
|
||||||
|
|
||||||
|
(* Builds a residual graph from a flow graph *)
|
||||||
(* flow graph -> int graph *)
|
(* flow graph -> int graph *)
|
||||||
let build_res_graph gr = let gr_res = clone_nodes gr in
|
let build_res_graph gr = let gr_res = clone_nodes gr in
|
||||||
e_fold gr (fun g origin destination fl ->
|
e_fold gr (fun g origin destination fl ->
|
||||||
|
@ -44,6 +45,7 @@ let build_res_graph gr = let gr_res = clone_nodes gr in
|
||||||
add_res_arc new_g destination origin backward )
|
add_res_arc new_g destination origin backward )
|
||||||
gr_res
|
gr_res
|
||||||
|
|
||||||
|
(* Converts the predecessors Map to a path from origin to destination. An empty list is returned when no path is found *)
|
||||||
(* Int_map -> id -> id -> path *)
|
(* Int_map -> id -> id -> path *)
|
||||||
let predecessors_to_path predecessors origin destination =
|
let predecessors_to_path predecessors origin destination =
|
||||||
let rec loop o d acu = if o = d then
|
let rec loop o d acu = if o = d then
|
||||||
|
@ -57,6 +59,7 @@ let predecessors_to_path predecessors origin destination =
|
||||||
in
|
in
|
||||||
loop origin destination []
|
loop origin destination []
|
||||||
|
|
||||||
|
(* finds a path from the origin to the destination in the network graph *)
|
||||||
(* int network -> path *)
|
(* int network -> path *)
|
||||||
let find_path res_network = let queue = Queue.create () in
|
let find_path res_network = let queue = Queue.create () in
|
||||||
let () = Queue.add res_network.origin queue in
|
let () = Queue.add res_network.origin queue in
|
||||||
|
@ -81,7 +84,7 @@ let find_path res_network = let queue = Queue.create () in
|
||||||
in
|
in
|
||||||
find_path_rec queue visited Int_map.empty
|
find_path_rec queue visited Int_map.empty
|
||||||
|
|
||||||
|
(* Finds the minimum capacity on the path in the given graph *)
|
||||||
(* int graph -> path -> int *)
|
(* int graph -> path -> int *)
|
||||||
let find_min gr path = List.fold_left (fun current_min (s, d) ->
|
let find_min gr path = List.fold_left (fun current_min (s, d) ->
|
||||||
let current = find_arc gr s d in
|
let current = find_arc gr s d in
|
||||||
|
@ -90,6 +93,7 @@ let find_min gr path = List.fold_left (fun current_min (s, d) ->
|
||||||
| Some x -> min x current_min)
|
| Some x -> min x current_min)
|
||||||
max_int path
|
max_int path
|
||||||
|
|
||||||
|
(* Apply the given augmentation or reduction along the path on the flow graph *)
|
||||||
(* flow graph -> path -> int -> flow graph *)
|
(* flow graph -> path -> int -> flow graph *)
|
||||||
let apply_path gr path aug = List.fold_left (fun new_gr (s, d) ->
|
let apply_path gr path aug = List.fold_left (fun new_gr (s, d) ->
|
||||||
match find_arc new_gr s d with
|
match find_arc new_gr s d with
|
||||||
|
@ -99,10 +103,12 @@ let apply_path gr path aug = List.fold_left (fun new_gr (s, d) ->
|
||||||
| Some x -> new_arc new_gr s d {current = x.current + aug; capacity = x.capacity})
|
| Some x -> new_arc new_gr s d {current = x.current + aug; capacity = x.capacity})
|
||||||
gr path
|
gr path
|
||||||
|
|
||||||
|
(* Gets the max flow from the graph *)
|
||||||
(* flow network -> int *)
|
(* flow network -> int *)
|
||||||
let get_max_flow flow_network = let arcs = out_arcs flow_network.graph flow_network.origin in
|
let get_max_flow flow_network = let arcs = out_arcs flow_network.graph flow_network.origin in
|
||||||
List.fold_left (fun current (dest, flow) -> current + flow.current ) 0 arcs
|
List.fold_left (fun current (dest, flow) -> current + flow.current ) 0 arcs
|
||||||
|
|
||||||
|
(* Runs the ff algorithm on the given network *)
|
||||||
(* int network -> flow network *)
|
(* int network -> flow network *)
|
||||||
let run_ff network = let flow_graph = initialize_graph network.graph in
|
let run_ff network = let flow_graph = initialize_graph network.graph in
|
||||||
let rec loop fl =
|
let rec loop fl =
|
||||||
|
|
Loading…
Reference in a new issue