PreviousUpNext

15.4.792  src/lib/graph/subgraph.pkg

#
# Subgraph adaptor.  This restricts the view of a graph.
#
# -- Allen Leung

# Compiled by:
#     src/lib/graph/graphs.lib

stipulate
    package odg =  oop_digraph;                                         # oop_digraph   is from   src/lib/graph/oop-digraph.pkg
herein

    api Subgraph_View {
        #       
        # Node induced subgraph:

        subgraph_view:  List( odg::Node_Id )
                          ->
                          (odg::Edge(E) -> Bool)
                          ->
                          odg::Digraph(N,E,G)                           # Here N,E,G stand stead for the types of client-package-supplied records associated with (respectively) nodes, edges and graphs.
                          -> 
                          odg::Digraph(N,E,G);
    };
end;

stipulate
    package iht =  int_hashtable;                                       # int_hashtable         is from   src/lib/src/int-hashtable.pkg
    package odg =  oop_digraph;                                         # oop_digraph           is from   src/lib/graph/oop-digraph.pkg
herein

    package   subgraph_view
    : (weak)  Subgraph_View                                             # Subgraph_View         is from   src/lib/graph/subgraph.pkg
    {
        fun subgraph_view nodes edge_pred (odg::DIGRAPH graph)
            =
            {   set =  iht::make_hashtable  { size_hint => 32,  not_found_exception => odg::NOT_FOUND  };
                ins =  iht::set set;

                ins =  \\ i =  ins (i, TRUE);

                fun rmv r
                    =
                    iht::drop  set  r;

                fun find r
                    =
                    the_else (iht::find set r, FALSE);


                apply ins nodes;


                fun edge_p (e as (i, j, _))
                    =
                    find i    and
                    find j    and
                    edge_pred e;


                fun check i
                    =
                    if (find i)
                        #
                        raise exception  odg::SUBGRAPH;
                    fi;

                fun check_edge e
                    =
                    if (edge_p  e)
                        #
                        raise exception  odg::SUBGRAPH;
                    fi;

                fun add_node (n as (i, _))
                    =
                    {   ins i;
                        #
                        graph.add_node n;
                    };

                fun add_edge (e as (i, j, _))
                    =
                    {   check i;
                        check j;
                        graph.add_edge e;
                    };

                fun remove_node i
                    =
                    {   check i;
                        rmv i;
                        graph.remove_node i;
                    };

                fun set_out_edges (i, es)
                    = 
                    {   check i;
                        apply check_edge es;
                        graph.set_out_edges (i, es);
                    };

                fun set_in_edges (j, es)
                    =
                    {   check j;
                        apply check_edge es;
                        graph.set_in_edges (j, es);
                    };

                fun get_nodes ()
                    =
                    map
                        (\\ (i, _)
                            =
                            (i, graph.node_info i)
                        ) 
                        (iht::keyvals_list set);

                fun get_edges ()
                    = 
                    {   fun find_edges ([], l)
                                =>
                                l;

                            find_edges (e ! es, l)
                                =>
                                if  (edge_p  e)   find_edges (es, e ! l);
                                else              find_edges (es,     l);   fi;
                      end;

                      fold_backward
                          (\\ ((i, _), l)
                              =
                              find_edges (graph.out_edges i, l))
                          [] 
                          (iht::keyvals_list set);
                    };

                fun order ()
                    =
                    iht::vals_count set;

                fun size  ()
                    =
                    {   fun find_edges ([], n)
                                =>
                                n;

                            find_edges (e ! es, n)
                                =>
                                if   (edge_p e)   find_edges (es, n+1);
                                else              find_edges (es, n);   fi;
                        end;

                        fold_backward
                            (\\ ((i, _), n) =  find_edges (graph.out_edges i, n))
                            0 
                            (iht::keyvals_list set);
                    };

                fun out_edges i =  (list::filter edge_p (graph.out_edges i));
                fun in_edges  i =  (list::filter edge_p (graph.in_edges  i));

                fun get_succ i =  map #2 (out_edges i);
                fun get_pred i =  map #1 (in_edges  i);

                fun has_edge (i, j) =  find i and find j;
                fun has_node  i     =  find i; 

                fun node_info i
                    =
                    {   check i;
                        graph.node_info i;
                    };

                fun entry_edges i
                    =
                    list::filter
                        (\\ (j, _, _) =  not (find j))
                        (graph.in_edges i);

                fun exit_edges i
                    =
                    list::filter
                        (\\ (_, j, _) =  not (find j))
                        (graph.out_edges i);

                fun entries ()
                    =
                    fold_backward
                        (\\ ((i, _), l)
                            =
                            if  (list::exists
                                     (\\ (j, _, _) =  not (find j)) 
                                     (graph.in_edges i))

                                 i ! l;
                            else     l;   fi)
                        [] 
                        (iht::keyvals_list set);

                fun exits ()
                    =
                    fold_backward
                        (\\ ((i, _), l)
                            =
                            if   (list::exists
                                     (\\ (_, j, _) =  not (find j)) 
                                     (graph.out_edges i))

                                 i ! l;
                            else     l;   fi)
                    [] 
                    (iht::keyvals_list set);

                fun forall_nodes f
                    =
                    iht::keyed_apply
                        (\\ (i, _) =  f (i, graph.node_info i))
                        set;

                fun forall_edges f
                    =
                    iht::keyed_apply
                        (\\ (i, _)
                            =
                            apply
                                (\\ e
                                    =
                                    if   (edge_p e   )   f e;   fi)
                                (graph.out_edges i))
                        set;

                odg::DIGRAPH
                  {
                    name            =>  graph.name,
                    graph_info      =>  graph.graph_info,
                    allot_node_id   =>  graph.allot_node_id,
                    add_node,
                    add_edge,
                    remove_node,
                    set_in_edges,
                    set_out_edges,
                    set_entries     =>  \\ _ =  raise exception odg::READ_ONLY,
                    set_exits       =>  \\ _ =  raise exception odg::READ_ONLY,
                    garbage_collect =>  graph.garbage_collect,
                    nodes           =>  get_nodes,
                    edges           =>  get_edges,
                    order,
                    size,
                    capacity        =>  graph.capacity,
                    out_edges,
                    in_edges,
                    next            =>  get_succ,
                    prior            =>  get_pred,
                    has_edge,
                    has_node,
                    node_info,
                    entries,
                    exits,
                    entry_edges,
                    exit_edges,
                    forall_nodes,
                    forall_edges

              #     fold_nodes,
              #     fold_edges
                  };
            };
    };
end;


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext