commons/ograph_simple.ml

   1 open Common
   2
   3 open Ocollection
   4 open Oset
   5 open Oassoc
   6 (* open Ograph *)
   7
   8 open Oassocb
   9 open Osetb
  10
  11
  12 (* Difference with ograph_extended ? why not share code ? could, but
  13  * in ograph_extended we dont force the user to have a key and we
  14  * generate those keys as he add nodes. Here we assume the user already
  15  * have an idea of what kind of key he wants to use (a string, a
  16  * filename, a, int, whatever)
  17 *)
  18
  19 class ['key, 'a,'b] ograph_mutable =
  20   let build_assoc () = new oassocb [] in
  21   let build_set ()   = new osetb Setb.empty in
  22
  23 object(o)
  24
  25
  26   val mutable succ = build_assoc()
  27   val mutable pred = build_assoc()
  28   val mutable nods = (build_assoc() : ('key, 'a) Oassocb.oassocb)
  29
  30   method add_node i (e: 'a) =
  31     nods <- nods#add (i, e);
  32     pred <- pred#add (i, build_set() );
  33     succ <- succ#add (i, build_set() );
  34
  35   method del_node (i) =
  36     (* check: e is effectively the index associated with e,
  37        and check that already in *)
  38
  39     (* todo: assert that have no pred and succ, otherwise
  40      * will have some dangling pointers
  41      *)
  42     nods <- nods#delkey i;
  43     pred <- pred#delkey i;
  44     succ <- succ#delkey i;
  45
  46   method del_leaf_node_and_its_edges (i) =
  47     let succ = o#successors i in
  48     if not (succ#null)
  49     then failwith "del_leaf_node_and_its_edges: have some successors"
  50     else begin
  51       let pred = o#predecessors i in
  52       pred#tolist +> List.iter (fun (k, edge) ->
  53         o#del_arc (k,i) edge;
  54       );
  55       o#del_node i
  56     end
  57
  58   method leaf_nodes () =
  59     let (set : 'key Oset.oset)  = build_set () in
  60     o#nodes#tolist +> List.fold_left (fun acc (k,v) ->
  61       if (o#successors k)#null
  62       then acc#add k
  63       else acc
  64     ) set
  65
  66
  67   method replace_node i (e: 'a) =
  68     assert (nods#haskey i);
  69     nods <- nods#replkey (i, e);
  70
  71   method add_arc (a,b) (v: 'b) =
  72     succ <- succ#replkey (a, (succ#find a)#add (b, v));
  73     pred <- pred#replkey (b, (pred#find b)#add (a, v));
  74   method del_arc (a,b) v =
  75     succ <- succ#replkey (a, (succ#find a)#del (b,v));
  76     pred <- pred#replkey (b, (pred#find b)#del (a,v));
  77
  78   method successors   e = succ#find e
  79   method predecessors e = pred#find e
  80
  81   method nodes = nods
  82   method allsuccessors = succ
  83
  84   (* detect if no loop ? *)
  85   method ancestors k =
  86     let empty_set = build_set() in
  87
  88
  89     let rec aux acc x =
  90       if acc#mem x
  91       then
  92         (* bugfix: have_loop := true; ? not, not necessarally.
  93          * if you got a diamon, seeing a second time the same
  94          * x does not mean we are in a loop
  95          *)
  96         acc
  97       else
  98         let acc = acc#add x in
  99         let prefs = o#predecessors x in
 100         let prefs = prefs#tolist +> List.map fst in
 101         prefs +> List.fold_left (fun acc x -> aux acc x) acc
 102     in
 103     let set = aux empty_set k in
 104     let set = set#del k in
 105     set
 106
 107
 108
 109
 110 end
 111
 112
 113 let print_ograph_generic ~str_of_key ~str_of_node filename g =
 114   Common.with_open_outfile filename (fun (pr,_) ->
 115     pr "digraph misc {\n" ;
 116     pr "size = \"10,10\";\n" ;
 117
 118     let nodes = g#nodes in
 119     nodes#iter (fun (k,node) ->
 120       pr (spf "%s [label=\"%s\"];\n" (str_of_key k) (str_of_node k node))
 121     );
 122     nodes#iter (fun (k,node) ->
 123       let succ = g#successors k in
 124       succ#iter (fun (j,edge) ->
 125         pr (spf "%s -> %s;\n" (str_of_key k) (str_of_key j));
 126       );
 127     );
 128     pr "}\n" ;
 129     );
 130   ()