Skip to content

Commit 78ebc99

Browse files
Matth-LMatth-L
committed
Implémentation dinic fonctionne
1 parent 3d3a514 commit 78ebc99

File tree

4 files changed

+184
-82
lines changed

4 files changed

+184
-82
lines changed

‎.gitignore‎

Lines changed: 1 addition & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -1,29 +1,7 @@
1-
*.annot
21
*.cmo
3-
*.cma
42
*.cmi
5-
*.a
63
*.o
7-
*.cmx
8-
*.cmxs
9-
*.cmxa
10-
11-
# ocamlbuild working directory
12-
_build/
134

145
# ocamlbuild targets
156
*.byte
16-
*.native
17-
18-
# oasis generated files
19-
setup.data
20-
setup.log
21-
22-
# Merlin configuring file for Vim and Emacs
23-
.merlin
24-
25-
# Dune generated files
26-
*.install
27-
28-
# Local OPAM switch
29-
_opam/
7+
*.native

‎Makefile‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
OCAMLFLAGS = ocamlc -g
22
OCAMLDEBUG = ocamlrun -b -t cprogs
3-
TARGET = test phase1
3+
TARGET = test phase1 phase2
44

55
.PHONY = all clean tests
66

@@ -26,4 +26,4 @@ testGraph.cmo : testGraph.ml
2626
$(OCAMLFLAGS) -c testGraph.ml
2727

2828
clean :
29-
rm -f *.cmo *.cmi $(TARGET)
29+
rm -vf *.cmo *.cmi $(TARGET)

‎graph.ml‎

Lines changed: 98 additions & 36 deletions
Original file line numberDiff line numberDiff line change
@@ -267,6 +267,23 @@ module Make (X : Map.OrderedType) = struct
267267
type node = NodeMap.key
268268
type graph = (int * int) NodeMap.t NodeMap.t
269269

270+
(*
271+
pour stocker les chemins, on va utiliser des ensembles,
272+
cela permet de ne pas se faire avoir par l'ordre et de fold
273+
sans prendre en compte du sens dans lequel on lit
274+
*)
275+
module SetOfPath = Set.Make (struct
276+
type t = (node * int * int) list
277+
278+
let compare = compare
279+
end)
280+
281+
module SetOfPhase2 = Set.Make (struct
282+
type t = int * (node * int * int) list
283+
284+
let compare = compare
285+
end)
286+
270287
let empty = NodeMap.empty
271288
let is_empty g = NodeMap.is_empty g
272289

@@ -326,6 +343,11 @@ module Make (X : Map.OrderedType) = struct
326343
else
327344
false
328345

346+
(* dans set_of_path les listes sont de la forme (n,min,max),
347+
il faut donc un moyen de savoir quand n est dedans*)
348+
let mem_set_of_path n1 l =
349+
List.fold_left (fun acc (n, min, max) -> acc || n = n1) false l
350+
329351
(********************** ADDING FUNCTION ***********************************)
330352

331353
(* ajoute un noeud au graphe, qui n'est relié à rien *)
@@ -494,17 +516,6 @@ module Make (X : Map.OrderedType) = struct
494516

495517
(******************** Ensemble chemin *********************************)
496518

497-
(*
498-
pour stocker les chemins, on va utiliser des ensembles,
499-
cela permet de ne pas se faire avoir par l'ordre et de fold
500-
sans prendre en compte du sens dans lequel on lit
501-
*)
502-
module SetOfPath = Set.Make (struct
503-
type t = (node * int * int) list
504-
505-
let compare = compare
506-
end)
507-
508519
(*
509520
ex ensemble :
510521
{
@@ -515,6 +526,7 @@ module Make (X : Map.OrderedType) = struct
515526
*)
516527

517528
(* fonction qui ajoute tous les chemins dans un ensemble de chemin *)
529+
(* uniquement si l'arête n'est pas pleine *)
518530
let add_paths_to_set ensInit g =
519531
(* on fold dans l'ensemble des chemins*)
520532
SetOfPath.fold
@@ -529,13 +541,16 @@ module Make (X : Map.OrderedType) = struct
529541
(* on ajoute le nouveau chemin à l'ensemble des chemin*)
530542
(fun nodeSuccessor (min, max) acc2 ->
531543
(* on vérifie si le noeud est déja la , pour ça il suffit de regarde si la tête c'est le même ça prend moins de temps qu'un mem *)
532-
let newPath =
533-
if List.hd listOfPath = (nodeSuccessor, min, max) then
534-
listOfPath
535-
else
536-
(nodeSuccessor, min, max) :: listOfPath
537-
in
538-
SetOfPath.add newPath acc2)
544+
if min <> max then
545+
let newPath =
546+
if List.hd listOfPath = (nodeSuccessor, min, max) then
547+
listOfPath
548+
else
549+
(nodeSuccessor, min, max) :: listOfPath
550+
in
551+
SetOfPath.add newPath acc2
552+
else
553+
acc2)
539554
succs_of_n acc1)
540555
ensInit ensInit
541556

@@ -583,11 +598,15 @@ module Make (X : Map.OrderedType) = struct
583598

584599
(* fonction qui prend tous les chemins dans un ensemble, trouve le plus cours, et filtre afin de garder tout ceux égal au plus court*)
585600
let allShortestPaths start goal g =
586-
let allPath = all_path start goal g in
587-
let shortest = shortestOfSet allPath in
588-
SetOfPath.filter
589-
(fun listOfPath -> List.length listOfPath = shortest)
590-
allPath
601+
try
602+
let allPath = all_path start goal g in
603+
let shortest = shortestOfSet allPath in
604+
SetOfPath.filter
605+
(fun listOfPath -> List.length listOfPath = shortest)
606+
allPath
607+
with Not_found ->
608+
Printf.printf "plus de chemin entre start et goal\n";
609+
SetOfPath.empty
591610

592611
(***********************************************************)
593612
(***********************************************************)
@@ -617,11 +636,6 @@ module Make (X : Map.OrderedType) = struct
617636
(sum_ponderation_D , [chemin D])
618637
}
619638
*)
620-
module SetOfPhase2 = Set.Make (struct
621-
type t = int * (node * int * int) list
622-
623-
let compare = compare
624-
end)
625639

626640
(**
627641
@requires une liste de chemin sous la forme [(a,1) ; (b,2)] ...
@@ -720,8 +734,10 @@ module Make (X : Map.OrderedType) = struct
720734
let get_bottleneck l =
721735
List.fold_left
722736
(fun acc (n1, min, max) ->
723-
if max < acc || max != 0 then
724-
max
737+
if acc = 0 then
738+
max - min
739+
else if max - min < acc then
740+
max - min
725741
else
726742
acc)
727743
(get3rd (List.hd l))
@@ -746,13 +762,23 @@ module Make (X : Map.OrderedType) = struct
746762
in
747763
aux list_of_path
748764

749-
let change_flow n1 n2 min max g =
765+
let change_flow n1 n2 (min, max) g =
750766
let succs_of_n1 = succs n1 g in
751767
let new_succs_n1 = NodeMap.add n2 (min, max) succs_of_n1 in
752768
NodeMap.add n1 new_succs_n1 g
753769

754770
(* en appliquant le bottleneck à la liste à l'envers, donc de start à goal, on le parcourt également, si on sature une arête on la supprime du graphe , on refait l'ensemble à partir de ça et on recommence ? *)
755771

772+
let add_until_saturated bneck borneMin borneMax =
773+
let remain = borneMax - borneMin in
774+
if remain > 0 then
775+
if bneck >= remain then
776+
(borneMax, borneMax)
777+
else
778+
(borneMin + bneck, borneMax)
779+
else
780+
(borneMin, borneMax)
781+
756782
(**
757783
@warning list_of_path est dans le bon sens
758784
*)
@@ -767,8 +793,9 @@ module Make (X : Map.OrderedType) = struct
767793
let rec aux l graphAux =
768794
match l with
769795
| (n1, min1, max1) :: (n2, min2, max2) :: t ->
770-
(* on change la valeur du flow *)
771-
let newG = change_flow n1 n2 bneck max2 graphAux in
796+
let newMinMax = add_until_saturated bneck min2 max2 in
797+
(* on change la valeur du flow si l'arête n'est pas saturé*)
798+
let newG = change_flow n1 n2 newMinMax graphAux in
772799
(* on applique aux élements d'après *)
773800
aux ((n2, min2, max2) :: t) newG
774801
| [] | [ _ ] -> graphAux
@@ -777,15 +804,50 @@ module Make (X : Map.OrderedType) = struct
777804

778805
(* une itération est faite, il faut maintenant supprimer les arêtes *)
779806

780-
let clean_graph_of_saturated_edge g =
807+
(* on crée une liste ou n1 ---> x est saturé, on stock n1 , dès qu'il apparait dans un chemin on dégage le chemin*)
808+
let list_of_blacklisted_node g =
781809
NodeMap.fold
782810
(fun noeudStart succs acc ->
783811
NodeMap.fold
784812
(fun noeudEnd (min, max) acc1 ->
785813
if min = max then
786-
remove_edge noeudStart noeudEnd acc1
814+
noeudStart :: acc1
815+
else
816+
acc1)
817+
succs acc)
818+
g []
819+
820+
let get_max_flow goal g =
821+
NodeMap.fold
822+
(fun noeudStart succs acc ->
823+
NodeMap.fold
824+
(fun noeudEnd (min, max) acc1 ->
825+
if noeudEnd = goal then
826+
acc1 + min
787827
else
788828
acc1)
789829
succs acc)
790-
g g
830+
g 0
831+
832+
(* le problème est que l'on fold et donc on rappel dinic avant même qu'il finisse de lire la première liste des ensembles*)
833+
834+
let clean_set_from_node n ens =
835+
SetOfPath.filter (fun listOfPath -> not (mem_set_of_path n listOfPath)) ens
836+
837+
(* fonction qui prend un ensemble de chemin, une liste de noeud
838+
et supprime tous les chemins dont le noeud appartient*)
839+
let clean_set s l =
840+
List.fold_left (fun acc noeud -> clean_set_from_node noeud acc) s l
841+
842+
let rec dinic start goal g =
843+
let shortest_path = allShortestPaths start goal g in
844+
if shortest_path = SetOfPath.empty then
845+
g
846+
else
847+
let g =
848+
SetOfPath.fold
849+
(fun path acc -> apply_bottleneck (List.rev path) acc)
850+
shortest_path g
851+
in
852+
dinic start goal g
791853
end

‎testGraph.ml‎

Lines changed: 83 additions & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -67,6 +67,20 @@ let goal_graph =
6767
('i', 0, 10, 't');
6868
]
6969

70+
let graph_file =
71+
PGraph.list_to_graph
72+
[
73+
('s', 0, 10, 's');
74+
('s', 0, 10, 'a');
75+
('s', 0, 5, 'b');
76+
('b', 0, 7, 'e');
77+
('a', 0, 4, 'b');
78+
('a', 0, 3, 'c');
79+
('c', 0, 7, 't');
80+
('d', 0, 12, 't');
81+
('e', 0, 28, 't');
82+
]
83+
7084
let graph_a_b = PGraph.list_to_graph_no_pond [ ('a', 'b') ]
7185

7286
let prettyPrint test nameOfTest commentaire =
@@ -474,34 +488,82 @@ let _ =
474488

475489
(*test nom des arêtes enlevé *)
476490
let _ =
477-
let graph =
478-
PGraph.list_to_graph_no_pond
479-
[
480-
('a', 'b');
481-
('a', 'd');
482-
('a', 'e');
483-
('b', 'c');
484-
('e', 'g');
485-
('b', 'f');
486-
('g', 'c');
487-
('f', 'c');
488-
('e', 'c');
489-
]
490-
in
491-
let set_blacklist = PGraph.blacklisted_node 'a' 'c' graph in
491+
let set_blacklist = PGraph.blacklisted_node 's' 't' graph_file in
492492
PGraph.NodeSet.iter (fun node -> Printf.printf "\n%c" node) set_blacklist
493493

494494
(*test get_bottleneck *)
495-
(* la 1e etape fonctionne *)
495+
496+
(* graph vidéo *)
497+
(* la 1e etape fonctionne
498+
let _ =
499+
Printf.printf "\n\ntest graph goal_graph \n";
500+
let shortest = PGraph.allShortestPaths 's' 't' goal_graph in
501+
Printf.printf "\nBefore applying bottleneck\n";
502+
pretty_print_all_shortest_paths shortest;
503+
let g =
504+
PGraph.SetOfPath.fold
505+
(fun path acc -> PGraph.apply_bottleneck (List.rev path) acc)
506+
shortest goal_graph
507+
in
508+
Printf.printf "\nAfter applying bottleneck\n";
509+
let newShortest = PGraph.allShortestPaths 's' 't' g in
510+
pretty_print_all_shortest_paths newShortest;
511+
Printf.printf "\n";
512+
Printf.printf "flow_maximal : %i\n" (PGraph.get_max_flow 't' g)
513+
*)
514+
515+
(* graph exo *)
516+
517+
(* test 1 itération*)
496518
let _ =
497-
let shortest = PGraph.allShortestPaths 's' 't' goal_graph in
519+
Printf.printf "\n\ntest graph graph_file \n";
520+
let shortest = PGraph.allShortestPaths 's' 't' graph_file in
498521
Printf.printf "\nBefore applying bottleneck\n";
499522
pretty_print_all_shortest_paths shortest;
523+
Printf.printf "\n";
500524
let g =
501525
PGraph.SetOfPath.fold
502-
(fun path acc -> PGraph.apply_bottleneck (List.rev path) acc)
503-
shortest goal_graph
526+
(fun path acc ->
527+
(* printing list*)
528+
PGraph.apply_bottleneck (List.rev path) acc)
529+
shortest graph_file
504530
in
505-
Printf.printf "\nAfter applying bottleneck\n";
531+
Printf.printf "\n 1 iteration \n";
506532
let newShortest = PGraph.allShortestPaths 's' 't' g in
507-
pretty_print_all_shortest_paths newShortest
533+
pretty_print_all_shortest_paths newShortest;
534+
Printf.printf "\n";
535+
Printf.printf "flow_maximal : %i" (PGraph.get_max_flow 't' g)
536+
537+
(*test dinic *)
538+
let _ =
539+
Printf.printf "\n\ntest dinic graph_file \n";
540+
let g = PGraph.dinic 's' 't' (PGraph.clean_graph 's' 't' graph_file) in
541+
Printf.printf "\n";
542+
PGraph.NodeMap.iter
543+
(fun node succs ->
544+
PGraph.NodeMap.iter
545+
(fun node2 (min, max) ->
546+
Printf.printf "%c -> %c : (%i,%i)\n" node node2 min max)
547+
succs)
548+
g;
549+
Printf.printf "\n";
550+
Printf.printf "flow_maximal : %i" (PGraph.get_max_flow 't' g)
551+
552+
(*
553+
(* test clean_set
554+
semble fonctionner *)
555+
let _ =
556+
Printf.printf "\n\ntest clean_set \n";
557+
let shortest = PGraph.allShortestPaths 's' 't' goal_graph in
558+
Printf.printf "\nBefore \n";
559+
pretty_print_all_shortest_paths shortest;
560+
let newSet = PGraph.clean_set shortest [ 'h'; 'a' ] in
561+
Printf.printf "\nAfter \n";
562+
pretty_print_all_shortest_paths newSet
563+
564+
(*test chemin qui n'existe pas *)
565+
let _ =
566+
Printf.printf "\n\ntest chemin qui n'existe pas \n";
567+
let shortest = PGraph.allShortestPaths 't' 's' goal_graph in
568+
Printf.printf "\n\n";
569+
pretty_print_all_shortest_paths shortest *)

0 commit comments

Comments
 (0)