Previous Up Next

Module Graph

module type GRAPH =
   sig
     type graph
     type node
     type edge = node × node

     val nodesgraph → node list
     val edgesgraph → edge list

     val succnode → node list
     val prednode → node list
     val adjnode → node list
     val eqnode × node → bool

     val new_graphunit → graph
     val new_nodegraph → node
     exception Graph_edge
     val mk_edgenode × node → unit
     val rm_edgenode × node → unit

     module TableTable.ITABLE with type key = node

     val nodenamenode → string
end

module Graph : GRAPH =
   struct

     type node = int (∗ nodes are numbered ∗)
     type noderep = Node of (node list × node list) (∗ succ, pred ∗)

     let bogus_node = Node([−1],[ ])
     let empty_node = Node([ ],[ ])

     let is_bogus n = match n with
       Node (−1::_,_) → true
     ∣ _ → false

     let nodename(g,i) = "n" ^ string_of_int(i)

     class cgraph = (∗ class for graphs ∗)
       object 
         val mutable nodecounter : node= 0 (∗ number of used nodes = next free node ∗)
                                             (∗ all nodes from 0 to nodecounter -1 ∗)
                                             (∗ are used, none is ever recycled, i.e., never ∗)
                                             (∗ a node is removed from the graph. ∗)
         val mutable bound = 5
         val mutable ga : noderep array = Array.make 5 bogus_node (∗ we cannot use bound here! ∗)

         method get_ga() = ga
         method inc() = nodecounter ← nodecounter +1;
                   if (nodecounter = bound)
           then
             ( ga ← Array.append ga (Array.make bound bogus_node);
               bound ← bound × 2;
                     )
           else
             ()
         method get_nodecounter() = nodecounter
       end

     type graph = cgraph
     type node = graph × node
     type edge = node × node

     The function new_node cannot be a method of cgraph, since the return type node is not yet defined.
     let new_node(g:graph) : node = 
       let rec look (lo,hi) =
                 (if (lo = hi)
         then (Array.set (g#get_ga()) lo empty_node;
               g#inc(); 
                       (g,lo))
         else 
           (let m = (lo + hi) / 2
           in if is_bogus(Array.get (g#get_ga()) m)
           then look (lo,m)
           else look (m+1,hi)))
       in look(0, 0 + g#get_nodecounter()) (∗ or 1 + nodecounter? ∗)

     let aget (ggraph) (inode) : noderep = Array.get (g#get_ga()) i
     let eq (((_,a),(_,b)) : node × node) = (a=b) (∗ comparison of indices ∗)
     let augment (ggraph) (nnode) : node = (g,n) (∗ pick out the node ∗)

     let nodes (ggraph) = 
       let rec f (iint) =
                 if is_bogus (aget g i)
         then [ ]
         else (g,i) :: f(i+1)
       in f 0

     let succ ((g,i): node) : node list = 
       let Node(s,_) = aget g i (∗ extract the list of successors ∗)
       in List.map (augment gs (∗ and bundle each with g ∗)

     let pred ((g,i): node) : node list = (∗ analogous to succ ∗)
       let Node(_,p) =aget g i
       in List.map (augment gp

     let edges (ggraph) = 
       let ns = nodes g (∗ get all nodes first ∗)
       in 
       List.fold_left 
         (fun (el_accumedge list) → fun (n : node) →
           let (nsuccnode list) = succ n (∗ edges are only implicit ∗)
           in let (el : edge list) = List.map (fun (m:node) → ((n,m): edge)) nsucc
           in (∗ el are the outgoing edges from the current node. ∗)
           ((el @ el_accum): edge list) (∗ results in duplicates ∗)
         )
         [ ]
         ns (∗ all nodes to iterate through ∗)
(∗ a = list. b = node ∗)
(∗ val fold_left : (-a -> -b -> -a) -> -a -> -b list -> -a List.fold_left f a b1; ...; bn is f (... (f (f a b1) b2) ...) bn. ∗)

     let adj gi = (pred gi) @ (succ gi)

     let new_graph () : graph = new cgraph

     exception Graph_edge

     let rec delete (inl) = match (i,nlwith
       (i,j::rest) → (if i=j then rest else j::delete(i,rest))
     ∣ (_,[ ]) → raise Graph_edge

     let diddle_edge (changenode × (node list) → node list
       (((g,i), (g,j)) : node × node ) : unit =
       (∗ check (g,g’); ∗)
       (let Node(sipi) = Array.get (g#get_ga()) i
       in Array.set (g#get_ga()) i (Node(change (jsi), pi))); (∗ successors adapted ∗)
       let Node(sjpj) = Array.get (g#get_ga()) j
       in Array.set (g#get_ga()) j (Node(sjchange(ipj))) (∗ predecessors adapted ∗)

     let mk_edge = diddle_edge (function (e,l) → e::l)
     let rm_edge = diddle_edge delete

     module Intkey : Table.INTKEY with type key = node =
       struct
         type key = node
         let get_int ((g,x): node) = (x :int)
       end

module Table : Table.ITABLE with type key = node = Table.IntmaptableFun(Intkey)
     module Table : Table.ITABLE with type key = node = Table.ITableFun(Intkey)

end

 ,
Previous Up Next