15.4.791  src/lib/graph/subgraph-p.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_P_View {
        #
        #  Node and edge induced subgraph; readonly 
        subgraph_p_view 
                      : List( odg::Node_Id )
                      ->
                      (odg::Node_Id -> Bool)
                      ->
                      ((odg::Node_Id, odg::Node_Id) -> 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 odg =  oop_digraph;                                         # oop_digraph   is from   src/lib/graph/oop-digraph.pkg
herein

    package   subgraph_p_view
    : (weak)  Subgraph_P_View                                           # Subgraph_P_View       is from   src/lib/graph/subgraph-p.pkg
    {
        fun subgraph_p_view nodes node_p edge_p (odg::DIGRAPH graph)
            =
            {   fun readonly _
                    =
                    raise exception odg::READ_ONLY;

                fun filter_nodes ns =  list::filter   (\\ (i, _)    =  node_p  i    )   ns;
                fun filter_edges es =  list::filter   (\\ (i, j, _) =  edge_p (i, j))   es;

                fun get_nodes ()
                    =
                    map'  nodes  (\\ i =  (i, graph.node_info i));

                fun get_edges ()
                    =
                    list::fold_backward
                        (\\ (n, l)
                            = 
                            list::fold_backward
                                (\\ (e as (i, j, _), l)
                                    =
                                    if (edge_p (i, j))   e ! l;
                                    else                     l;
                                    fi
                                )
                                l 
                                (graph.out_edges n)
                        )
                        []
                        nodes;

                fun order () =  length nodes;
                fun size ()  =  length (get_edges());

                fun out_edges i =  filter_edges (graph.out_edges i);
                fun in_edges  i =  filter_edges (graph.in_edges i);

                fun get_succ i
                    =
                    list::fold_backward
                        (\\ ((i, j, _), ns)
                            =
                            if (edge_p (i, j))   j ! ns;
                            else                     ns;
                            fi
                        )
                        []
                        (graph.out_edges i);

                fun get_pred i
                    =
                    list::fold_backward
                        (\\ ((i, j, _), ns)
                            =
                            if (edge_p (i, j))   i ! ns;
                            else                     ns;
                            fi
                        )
                        []
                        (graph.in_edges i);

                fun has_edge (i, j) =  edge_p (i, j);
                fun has_node i      =  node_p i; 

                fun node_info i
                    =
                    graph.node_info i;

                fun entry_edges i
                    =
                    if   (node_p  i)

                         list::filter
                            (\\ (i, j, _) =  not (edge_p (i, j))) 
                            (graph.in_edges i);
                    else
                         [];
                    fi;

                fun exit_edges i
                    =
                    if   (node_p  i)

                         list::filter
                             (\\ (i, j, _) =  not (edge_p (i, j)))
                             (graph.out_edges i);
                    else
                         [];
                    fi;

                fun entries ()
                    =
                    list::fold_backward

                        (\\ (i, ns)
                            =
                            if  (list::exists
                                   (\\ (i, j, _) =  not (edge_p (i, j)))
                                   (graph.in_edges i))

                                 i ! ns;
                            else
                                 ns;
                            fi
                        )
                        [] 
                        nodes;

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

                                 i ! ns;
                            else     ns;
                            fi
                        )
                        [] 
                        nodes;

                fun forall_nodes f
                    =
                    apply
                        (\\ i =  f (i, graph.node_info i))
                        nodes;

                fun forall_edges f
                    =
                    apply
                        f
                        (get_edges ());

                odg::DIGRAPH
                  {
                    name            => graph.name,
                    graph_info      => graph.graph_info,
                    allot_node_id   => graph.allot_node_id,
                    add_node        => readonly,
                    add_edge        => readonly,
                    remove_node     => readonly,
                    set_in_edges    => readonly,
                    set_out_edges   => readonly,
                    set_entries     => readonly,
                    set_exits       => readonly,
                    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
                  };
            };          # fun subgraph_p_view
    };
end;