commons/ocollection/ograph2way.ml

   1 open Common
   2
   3 open Ocollection
   4 open Oset
   5 open Ograph
   6
   7 open Osetb
   8
   9 (* graph2way  prend en parametre le type de finitemap et set a prendre
  10  * todo? add_arc doit ramer, car del la key, puis add =>
  11  * better to have a ref to a set
  12  * todo: efficient graph: with pointers and a tag: visited
  13  * => need keep global value visited_counter
  14  * check(that node is in, ...), display
  15  *
  16  * pourrait remettre val nods, a la place de les calculer. mais bon
  17  * s'en sert pas vraiment car y'a pas de notion d'identifiant de noeud
  18  * et de label.
  19  *
  20  * invariant: key in pred is also in succ (completness) and value in
  21  * either table is a key also
  22  *)
  23 class ['a] ograph2way   asucc apred (*f1*) f2 =
  24 object(o)
  25   inherit ['a] ograph
  26
  27   val succ = asucc  (* f1() ## new oassocb [] *)
  28   val pred = apred  (* f1() ## new oassocb [] *)
  29     (* val nods = anodes ##f2() ## new osetb [] *)
  30
  31   method empty = raise Todo (*{< succ = f1() ;(* new oassocb []; *)
  32                                    pred = f1(); (* new oassocb []; *)
  33                                    (* nods = f2(); ##new osetb []; *)
  34                                 >}*)
  35
  36   method add_node e = {< (* nods = nods#add e; *)
  37     pred = pred#add (e, f2() );(* new osetb []); *)
  38     succ = succ#add (e, f2() );(* new osetb []); *)
  39   >}
  40   method del_node e = {< (* nods = nods#del e; *)
  41     pred = pred#delkey e;
  42     succ = succ#delkey e;
  43   >}
  44   method add_arc (a,b) = {<
  45     succ = succ#replkey (a, (succ#find a)#add b);
  46     pred = pred#replkey (b, (pred#find b)#add a);
  47   >}
  48   method del_arc (a,b) = {<
  49     succ = succ#replkey (a, (succ#find a)#del b);
  50     pred = pred#replkey (b, (pred#find b)#del a);
  51   >}
  52   method successors   e = succ#find e
  53   method predecessors e = pred#find e
  54   method nodes = (* nods *)
  55     (*  could take pred,  same *)
  56     (* caml typing sux, arrive pas a faire:  pred#fold (fun a (k,v) -> a#add k) (new osetb Setb.empty)  *)
  57     let a = ref (new osetb Setb.empty) in
  58     succ#iter (fun (k,v) -> a := !a#add k);
  59     !a
  60
  61
  62
  63   method ancestors xs =
  64     let rec aux xs acc =
  65       match xs#view with (* could be done with an iter *)
  66       | Empty -> acc
  67       | Cons(x, xs) -> (acc#add x)
  68           +> (fun newacc -> aux (o#predecessors x) newacc)
  69           +> (fun newacc -> aux xs newacc)
  70     in aux xs (f2()) (* (new osetb []) *)
  71
  72   method children  xs =
  73     let rec aux xs acc =
  74       match xs#view with (* could be done with an iter *)
  75       | Empty -> acc
  76       | Cons(x, xs) -> (acc#add x)
  77           +> (fun newacc -> aux (o#successors x) newacc)
  78           +> (fun newacc -> aux xs newacc)
  79     in aux xs (f2()) (* (new osetb []) *)
  80
  81
  82   method brothers  x =
  83     let parents = o#predecessors x in
  84     (parents#fold (fun acc e -> acc $++$ o#successors e) (f2()))#del x
  85
  86 end