← Back to branch summary

~ubuntu-branches/ubuntu/breezy/ocamlgraph/breezy

« back to all changes in this revision

Viewing changes to flow.ml

  • Committer: Bazaar Package Importer
  • Author(s): Sylvain Le Gall
  • Date: 2005-03-23 23:17:46 UTC
  • mfrom: (2.1.1 hoary)
  • Revision ID: james.westby@ubuntu.com-20050323231746-8rmzgp3zyslg4me5
Tags: 0.90-2
http://bugs.debian.org/294806
http://bugs.debian.org/289138
* Transition to ocaml 3.08.3 : depends on ocaml-nox-3.08.3
* Patch 03_META use graph.cma and graph.cmxa ( Closes: #294806 )
* Correct the patch 01_makefile to install graph.a ( Closes: #289138 )

Show diffs side-by-side

added added

removed removed

Lines of Context:
flow.ml
27
27
  val compare : t -> t -> int
28
28
end
29
29
 
30
 
 
31
30
module type G_GOLDBERG = sig
32
31
  type t
33
32
  module V : Sig.COMPARABLE
34
 
  module E : sig 
35
 
    type t 
36
 
    type label 
37
 
    val compare : t -> t -> int
38
 
    val create : V.t -> label -> V.t -> t
39
 
    val label : t -> label 
40
 
    val dst : t -> V.t 
41
 
    val src : t -> V.t
42
 
  end 
 
33
  module E : Sig.EDGE with type vertex = V.t
43
34
  val nb_vertex : t -> int
44
35
  val iter_vertex : (V.t -> unit) -> t -> unit
45
36
  val iter_edges_e : (E.t -> unit) -> t -> unit
61
52
 
62
53
  let fold_booleen f = List.fold_left (fun r x->(f x) or r) false
63
54
 
64
 
  let capacite_restante g e = F.sub (F.max_capacity (G.E.label e)) (E.find flot (G.E.src e, G.E.dst e))
 
55
  let capacite_restante g e = 
 
56
    F.sub (F.max_capacity (G.E.label e)) (E.find flot (G.E.src e, G.E.dst e))
65
57
 
66
58
  let reste_excedent x = F.compare (V.find excedents x) F.zero > 0 
67
59
      
68
60
  let flux_et_reflux g x = 
69
 
    let s =  G.fold_succ_e 
70
 
               (fun e s->if F.compare (capacite_restante g e) (F.min_capacity (G.E.label e)) > 0 then e::s else s) 
71
 
               g x [] 
 
61
    let s = 
 
62
      G.fold_succ_e 
 
63
        (fun e s->
 
64
           if F.compare 
 
65
             (capacite_restante g e) (F.min_capacity (G.E.label e))
 
66
             > 0 
 
67
           then e::s else s) 
 
68
        g x [] 
72
69
    in 
73
 
      G.fold_pred_e 
74
 
        (fun e s -> 
75
 
           if F.compare (E.find flot (G.E.src e, G.E.dst e)) (F.min_capacity (G.E.label e)) > 0 
76
 
           then (G.E.create (G.E.dst e) (G.E.label e) (G.E.src e))::s else s)
77
 
        g x s
 
70
    G.fold_pred_e 
 
71
      (fun e s -> 
 
72
         if F.compare 
 
73
           (E.find flot (G.E.src e, G.E.dst e)) (F.min_capacity (G.E.label e))
 
74
           > 0 
 
75
         then (G.E.create (G.E.dst e) (G.E.label e) (G.E.src e))::s else s)
 
76
      g x s
78
77
 
79
78
  let pousser g e l =
80
 
    let x,y = G.E.src e , G.E.dst e in
 
79
    let x, y = G.E.src e, G.E.dst e in
81
80
    let ex = V.find excedents x in
82
81
    let cxy = capacite_restante g e in
83
 
      if F.compare ex F.zero > 0 &&
84
 
        F.compare cxy (F.min_capacity (G.E.label e)) >0 &&
85
 
        V.find hauteur x = (V.find hauteur y + 1)
86
 
      then
87
 
        let d = if F.compare ex cxy <0 then ex else cxy in
88
 
        let fxy = E.find flot (x,y) in
89
 
        let ex = V.find excedents x in
90
 
        let ey = V.find excedents y in
91
 
          E.replace flot (x,y) (F.add fxy d);
92
 
          E.replace flot (y,x) (F.sub F.zero (F.add fxy d));
93
 
          V.replace excedents x (F.sub ex d);
94
 
          V.replace excedents y (F.add ey d);
95
 
          if reste_excedent x then l:=Sv.add x !l;
96
 
          if reste_excedent y then l:=Sv.add y !l;
97
 
          true
98
 
      else 
99
 
        (if F.compare ex F.zero > 0 then l:=Sv.add x !l; false)
 
82
    if F.compare ex F.zero > 0 &&
 
83
      F.compare cxy (F.min_capacity (G.E.label e)) > 0 &&
 
84
      V.find hauteur x = (V.find hauteur y + 1)
 
85
    then
 
86
      let d = if F.compare ex cxy < 0 then ex else cxy in
 
87
      let fxy = E.find flot (x,y) in
 
88
      let ex = V.find excedents x in
 
89
      let ey = V.find excedents y in
 
90
      E.replace flot (x,y) (F.add fxy d);
 
91
      E.replace flot (y,x) (F.sub F.zero (F.add fxy d));
 
92
      V.replace excedents x (F.sub ex d);
 
93
      V.replace excedents y (F.add ey d);
 
94
      if reste_excedent x then l:=Sv.add x !l;
 
95
      if reste_excedent y then l:=Sv.add y !l;
 
96
      true
 
97
    else 
 
98
      (if F.compare ex F.zero > 0 then l:=Sv.add x !l; 
 
99
       false)
100
100
 
101
101
  let elever g p x = 
102
102
    let u = flux_et_reflux g x in
103
 
      reste_excedent x
104
 
      && not (G.V.equal x p) 
105
 
      && List.for_all (fun e -> (V.find hauteur (G.E.src e)) <= (V.find hauteur (G.E.dst e))) u 
106
 
      && (let min = List.fold_left (fun m e-> min (V.find hauteur (G.E.dst e)) m) max_int u in
107
 
            V.replace hauteur x (1+min); true)
 
103
    reste_excedent x
 
104
    && not (G.V.equal x p) 
 
105
    && 
 
106
    List.for_all 
 
107
      (fun e -> (V.find hauteur (G.E.src e)) <= (V.find hauteur (G.E.dst e))) u
 
108
    && 
 
109
    (let min = 
 
110
       List.fold_left (fun m e -> min (V.find hauteur (G.E.dst e)) m) max_int u
 
111
     in
 
112
     V.replace hauteur x (1+min); 
 
113
     true)
108
114
 
109
115
  let init_preflot g s p = 
110
116
    G.iter_vertex (fun x -> V.add excedents x F.zero; V.add hauteur x 0) g;
111
117
    G.iter_edges_e 
112
118
      (fun e -> 
113
119
         let x,y = G.E.src e, G.E.dst e in 
114
 
           E.add flot (x,y) (F.flow (G.E.label e)); 
115
 
           E.add flot (y,x) (F.sub F.zero (F.flow (G.E.label e))))
 
120
         E.add flot (x,y) (F.flow (G.E.label e)); 
 
121
         E.add flot (y,x) (F.sub F.zero (F.flow (G.E.label e))))
116
122
      g;
117
123
    V.add hauteur s (G.nb_vertex g);
118
124
    G.fold_succ_e 
119
125
      (fun e l -> 
120
126
         let y = G.E.dst e in
121
 
           let c = F.max_capacity (G.E.label e) in 
122
 
             E.add flot (s,y) c;
123
 
             E.add flot (y,s) (F.sub F.zero c);
124
 
             V.add excedents y c;
125
 
             y::l)
 
127
         let c = F.max_capacity (G.E.label e) in 
 
128
         E.add flot (s,y) c;
 
129
         E.add flot (y,s) (F.sub F.zero c);
 
130
         V.add excedents y c;
 
131
         y::l)
126
132
      g s []
127
133
      
128
134
  let maxflow g s p = 
131
137
      or G.fold_pred_e (fun e r->pousser g e l or r) g x false
132
138
    in
133
139
    let todo = ref (init_preflot g s p) in
134
 
      while 
135
 
        (fold_booleen (elever g p) !todo) or 
136
 
        (let l = ref Sv.empty in 
137
 
         let r = fold_booleen (push_and_pull l) !todo in
138
 
           todo:=Sv.elements !l; r)
139
 
      do () done;
140
 
      let flot_max = 
141
 
        G.fold_pred_e (fun e f -> F.add (E.find flot (G.E.src e,p)) f) g p F.zero
142
 
      in
143
 
      let flot_init = 
144
 
        G.fold_pred_e (fun e f -> F.add (F.flow (G.E.label e)) f) g p F.zero
145
 
      in
146
 
      let f e = 
147
 
        let x,y = G.E.src e, G.E.dst e in 
148
 
          try E.find flot (x,y) 
149
 
          with Not_found -> F.flow (G.E.label e)
150
 
      in
151
 
        f, F.sub flot_max flot_init
 
140
    while 
 
141
      (fold_booleen (elever g p) !todo) or 
 
142
      (let l = ref Sv.empty in 
 
143
       let r = fold_booleen (push_and_pull l) !todo in
 
144
       todo:=Sv.elements !l; r)
 
145
    do () done;
 
146
    let flot_max = 
 
147
      G.fold_pred_e (fun e f -> F.add (E.find flot (G.E.src e,p)) f) g p F.zero
 
148
    in
 
149
    let flot_init = 
 
150
      G.fold_pred_e (fun e f -> F.add (F.flow (G.E.label e)) f) g p F.zero
 
151
    in
 
152
    let f e = 
 
153
      let x,y = G.E.src e, G.E.dst e in 
 
154
      try E.find flot (x,y) 
 
155
      with Not_found -> F.flow (G.E.label e)
 
156
    in
 
157
    f, F.sub flot_max flot_init
152
158
end
153
159
 
154
160
 
285
291
    let succ s = 
286
292
      G.iter_succ_e
287
293
        (fun e ->
288
 
           assert (s = G.E.src e);
 
294
           assert (G.V.equal s (G.E.src e));
289
295
           let t = G.E.dst e in
290
296
           if not (Mark.mem t || is_full r e) then 
291
297
             Mark.set t (Some e) Mark.Plus)
294
300
    let pred s = 
295
301
      G.iter_pred_e
296
302
        (fun e ->
297
 
           assert (s = G.E.dst e);
 
303
           assert (G.V.equal s (G.E.dst e));
298
304
           let t = G.E.src e in
299
305
           if not (Mark.mem t || is_empty r e) then
300
306
             Mark.set t (Some e) Mark.Minus)