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:
|
||||
% This is a comment
|
||||
|
||||
% A node with its coordinates (which are not used).
|
||||
n 88.8 209.7
|
||||
n 408.9 183.0
|
||||
% define a factory with its id and production rate
|
||||
factory 0 6
|
||||
|
||||
% 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
|
||||
e 3 1 11
|
||||
e 0 2 8
|
||||
% define a neutral node with its id
|
||||
node 2
|
||||
|
||||
% 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 destination = (-2)
|
||||
|
||||
(* Reads a factory node, adds it to the graph and creates an arc from the source *)
|
||||
let read_factory graph line =
|
||||
try Scanf.sscanf line "factory %d %d" (fun id capacity -> new_arc (new_node graph id) source id capacity)
|
||||
with e ->
|
||||
Printf.printf "Cannot read factory in line - %s:\n%s\n%!" (Printexc.to_string e) line ;
|
||||
failwith "from_file"
|
||||
|
||||
(* Reads a village node, adds it to the graph and creates an arc to the destination *)
|
||||
let read_village graph line =
|
||||
try Scanf.sscanf line "village %d %d" (fun id capacity -> new_arc (new_node graph id) id destination capacity)
|
||||
with e ->
|
||||
Printf.printf "Cannot read village in line - %s:\n%s\n%!" (Printexc.to_string e) line ;
|
||||
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 =
|
||||
try Scanf.sscanf line "node %d" (fun id -> new_node graph id)
|
||||
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.) *)
|
||||
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 =
|
||||
try Scanf.sscanf line "road %d %d %d"
|
||||
(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"
|
||||
|
||||
let circulation_from_file path =
|
||||
|
||||
let infile = open_in path in
|
||||
(* create source and destination *)
|
||||
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
|
||||
in
|
||||
loop graph2
|
||||
|
||||
with End_of_file -> graph (* Done *)
|
||||
in
|
||||
|
||||
let final_graph = loop initial_graph in
|
||||
|
||||
close_in infile ;
|
||||
|
|
|
@ -25,16 +25,17 @@ type flow = {
|
|||
|
||||
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 *)
|
||||
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 *)
|
||||
let add_res_arc gr origin destination value = match value with
|
||||
| 0 -> gr
|
||||
| _ -> add_arc gr origin destination value
|
||||
|
||||
|
||||
(* Builds a residual graph from a flow graph *)
|
||||
(* flow graph -> int graph *)
|
||||
let build_res_graph gr = let gr_res = clone_nodes gr in
|
||||
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 )
|
||||
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 *)
|
||||
let predecessors_to_path predecessors origin destination =
|
||||
let rec loop o d acu = if o = d then
|
||||
|
@ -57,6 +59,7 @@ let predecessors_to_path predecessors origin destination =
|
|||
in
|
||||
loop origin destination []
|
||||
|
||||
(* finds a path from the origin to the destination in the network graph *)
|
||||
(* int network -> path *)
|
||||
let find_path res_network = let queue = Queue.create () in
|
||||
let () = Queue.add res_network.origin queue in
|
||||
|
@ -81,7 +84,7 @@ let find_path res_network = let queue = Queue.create () in
|
|||
in
|
||||
find_path_rec queue visited Int_map.empty
|
||||
|
||||
|
||||
(* Finds the minimum capacity on the path in the given graph *)
|
||||
(* int graph -> path -> int *)
|
||||
let find_min gr path = List.fold_left (fun current_min (s, d) ->
|
||||
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)
|
||||
max_int path
|
||||
|
||||
(* Apply the given augmentation or reduction along the path on the flow graph *)
|
||||
(* flow graph -> path -> int -> flow graph *)
|
||||
let apply_path gr path aug = List.fold_left (fun new_gr (s, d) ->
|
||||
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})
|
||||
gr path
|
||||
|
||||
(* Gets the max flow from the graph *)
|
||||
(* flow network -> int *)
|
||||
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
|
||||
|
||||
(* Runs the ff algorithm on the given network *)
|
||||
(* int network -> flow network *)
|
||||
let run_ff network = let flow_graph = initialize_graph network.graph in
|
||||
let rec loop fl =
|
||||
|
|
Loading…
Reference in a new issue