fonctions refaites+test
This commit is contained in:
父節點
ff3df1e80e
當前提交
e21163ae86
共有 4 個文件被更改,包括 68 次插入 和 25 次删除
|
@ -1,61 +1,94 @@
|
||||||
open Graph
|
open Graph
|
||||||
open Tool
|
open Tool
|
||||||
|
|
||||||
|
type path = id list
|
||||||
|
|
||||||
(* Create a list of pairs (origin,end) from a list of nodes *)
|
(* Create a list of pairs (origin,end) from a list of nodes *)
|
||||||
let rec createArcFromNodes = function
|
let rec create_arcs_from_nodes = function
|
||||||
| a -> []
|
| [] -> []
|
||||||
| a :: b :: rest -> (a,b) :: (createArcsFromNodes (b :: rest))
|
| a :: [] -> []
|
||||||
|
| a :: b :: rest -> (a,b) :: (create_arcs_from_nodes (b :: rest))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(* Return the minimum value of a path's arcs*)
|
(* Return the minimum value of a path's arcs*)
|
||||||
let getMinLabelFromPath (graph : int graph) (path : (id * id) list) =
|
let get_min_label_from_path (graph : int graph) (path : (id * id) list) =
|
||||||
let min = 999 in
|
let min = Some 999 in
|
||||||
List.foldleft
|
List.fold_left
|
||||||
(
|
(
|
||||||
fun acu (id1, id2) ->
|
fun acu (id1, id2) ->
|
||||||
let label = int_of_string (find_arc graph id1 id2) in
|
let label = find_arc graph id1 id2 in
|
||||||
if label < acu then acu = label
|
if label < acu then label else acu
|
||||||
)
|
)
|
||||||
min path
|
min path
|
||||||
|
|
||||||
|
|
||||||
(* Add a value to every arc of a path *)
|
(* Add a value to every arc of a path *)
|
||||||
let addValueToArcs (graph : int graph) (path : (id * id) list) (value : int) =
|
let add_value_to_arcs (graph : int graph) (path : (id * id) list) (value : int) =
|
||||||
List.foldleft
|
List.fold_left
|
||||||
(
|
(
|
||||||
fun acu (id1, id2) ->
|
fun acu (id1, id2) ->
|
||||||
let vArc = find_arc graph id1 id2 in
|
add_arc acu id1 id2 value
|
||||||
add_arc acu (vArc + value)
|
|
||||||
)
|
)
|
||||||
graph path
|
graph path
|
||||||
|
|
||||||
|
|
||||||
(* Reverse a path and its arc
|
(* Reverse a path and its arc
|
||||||
ex :[(a, b);(b, c)] -> [(b,a);(c, b)] *)
|
ex :[(a, b);(b, c)] -> [(b,a);(c, b)] *)
|
||||||
let revArcs (path : (id * id) list) =
|
let rev_arcs (path : (id * id) list) =
|
||||||
List.map (fun (id1, id2) -> (id2, id1)) path
|
List.map (fun (id1, id2) -> (id2, id1)) path
|
||||||
|
|
||||||
|
|
||||||
let fordFulkAlgorithm graph origin end =
|
(* Get the final graph after the FFalgorithm
|
||||||
|
The label of every arc becomes "x/max_capacity" where x
|
||||||
|
is the value of the opposite arc on the residual graph*)
|
||||||
|
let get_final_graph (initGraph : int graph) (residualGraph : int graph) =
|
||||||
|
|
||||||
|
(* First get the initial and residual graph as string graphs *)
|
||||||
|
let initGraphString = gmap initGraph string_of_int in
|
||||||
|
let residualGraphString = gmap residualGraph string_of_int in
|
||||||
|
let finalGraph = clone_nodes initGraph in
|
||||||
|
|
||||||
|
(* For every arc in the initial graph, we get its label (aka max_capacity)
|
||||||
|
then, we get the label of the opposite arc in the residual graph.
|
||||||
|
If it exists then the arc of the final graph gets the label "x/max_capacity",
|
||||||
|
"0/max_capacity" otherwise*)
|
||||||
|
e_fold initGraph
|
||||||
|
(
|
||||||
|
fun acu id1 id2 x ->
|
||||||
|
let label_arc = find_arc initGraphString id1 id2 in
|
||||||
|
let label_arc = (match label_arc with
|
||||||
|
|None -> "-1"
|
||||||
|
|Some x -> x) in
|
||||||
|
let label_rev_arc = find_arc residualGraphString id2 id1 in
|
||||||
|
match label_rev_arc with
|
||||||
|
|None -> new_arc acu id1 id2 ("0/"^label_arc)
|
||||||
|
|Some x -> new_arc acu id1 id2 (""^x^"/"^label_arc)
|
||||||
|
|
||||||
|
)
|
||||||
|
finalGraph
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
(*let fordFulkAlgorithm graph origin end = assert false *)
|
||||||
(*
|
(*
|
||||||
let flow = 0 in
|
let flow = 0 in
|
||||||
While there's a path
|
While there's a path
|
||||||
Find a path
|
Find a path
|
||||||
let path = findPath graph origin end [] in
|
let path = xxxxx graph origin end [] in
|
||||||
let arcs = createArcFromNodes path in
|
let arcs = create_arcs_from_nodes path in
|
||||||
|
|
||||||
Find the min value of the path
|
Find the min value of the path
|
||||||
let min = getMinLabelFromPath graph arcs in
|
let min = get_min_label_from_path graph arcs in
|
||||||
|
|
||||||
Substract the min to every arc of the path
|
Substract the min to every arc of the path
|
||||||
graph = addValueToArcs graph arcs (-min) in
|
graph = add_value_to_arcs graph arcs (-min) in
|
||||||
|
|
||||||
Get the reverse path
|
Get the reverse path
|
||||||
let reverse = revArcs arcs in
|
let reverse = rev_arcs arcs in
|
||||||
|
|
||||||
Add the min to every arc of the reverse path
|
Add the min to every arc of the reverse path
|
||||||
graph = addValueToArcs graph reverse min in
|
graph = add_value_to_arcs graph reverse min in
|
||||||
|
|
||||||
Add the min to the flow
|
Add the min to the flow
|
||||||
flow = flow + min
|
flow = flow + min
|
||||||
|
|
|
@ -2,3 +2,12 @@ open Graph
|
||||||
open Tool
|
open Tool
|
||||||
|
|
||||||
type path = id list
|
type path = id list
|
||||||
|
|
||||||
|
|
||||||
|
(* for testing purpose *)
|
||||||
|
|
||||||
|
(* val rev_arcs: (id * id) list -> (id * id) list
|
||||||
|
|
||||||
|
val add_value_to_arcs: int graph -> (id * id) list -> int -> int graph
|
||||||
|
|
||||||
|
val get_final_graph: int graph -> int graph -> string graph *)
|
|
@ -1,5 +1,6 @@
|
||||||
open Gfile
|
open Gfile
|
||||||
open Tool
|
open Tool
|
||||||
|
open FFAlgorithm
|
||||||
|
|
||||||
let () =
|
let () =
|
||||||
|
|
||||||
|
@ -25,7 +26,7 @@ let () =
|
||||||
let graph = from_file infile in
|
let graph = from_file infile in
|
||||||
|
|
||||||
(* Rewrite the graph that has been read. *)
|
(* Rewrite the graph that has been read. *)
|
||||||
let () = write_file outfile (gmap graph (fun lbl -> string_of_int (int_of_string lbl *2) ) ) in
|
let () = write_file outfile graph in
|
||||||
let () = export outfile graph in
|
let () = export outfile graph in
|
||||||
()
|
()
|
||||||
|
|
||||||
|
|
|
@ -13,7 +13,7 @@ let gmap gr f =
|
||||||
e_fold gr (fun acu id1 id2 x -> new_arc acu id1 id2 (f x)) new_graph
|
e_fold gr (fun acu id1 id2 x -> new_arc acu id1 id2 (f x)) new_graph
|
||||||
|
|
||||||
let add_arc g id1 id2 n =
|
let add_arc g id1 id2 n =
|
||||||
let f=find_arc id1 id2 g in
|
let f = find_arc g id1 id2 in
|
||||||
match f with
|
match f with
|
||||||
|None->new_arc g id1 id2 n
|
|None->new_arc g id1 id2 n
|
||||||
|Some x->new_arc g id1 id2 (n+x)
|
|Some x->new_arc g id1 id2 (n+x)
|
||||||
|
|
載入中…
Reference in a new issue