Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/branches/SMLNJ/src/MLRISC/graphs/ugraph.sml
ViewVC logotype

Annotation of /sml/branches/SMLNJ/src/MLRISC/graphs/ugraph.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 411 - (view) (download)

1 : monnier 245 (*
2 : monnier 411 * Undirected graph view. This makes a graph look undirected.
3 :     *
4 :     * -- Allen
5 : monnier 245 *)
6 :    
7 :     signature UNDIRECTED_GRAPH_VIEW =
8 :     sig
9 :    
10 :     val undirected_view : ('n,'e,'g) Graph.graph -> ('n,'e,'g) Graph.graph
11 :    
12 :     end
13 :    
14 :     structure UndirectedGraphView : UNDIRECTED_GRAPH_VIEW =
15 :     struct
16 :    
17 :     structure G = Graph
18 :     structure Sort = Sorting
19 :    
20 :     fun undirected_view (G.GRAPH G) =
21 :     let fun adjacent_edges i =
22 :     let val in_edges = map (fn (i,j,e) => (j,i,e)) (#in_edges G i)
23 :     val out_edges = #out_edges G i
24 :     in
25 :     Sort.sort_uniq (fn ((i,j,_),(i',j',_)) =>
26 :     i < i' orelse i = i' andalso j < j')
27 :     (fn ((i,j,_),(i',j',_)) => i = i' andalso j = j')
28 :     (in_edges @ out_edges)
29 :     end
30 :     fun adjacent_nodes i =
31 :     let val succ = #succ G i
32 :     val pred = #pred G i
33 :     in
34 :     Sort.sort_uniq op< op= (succ @ pred)
35 :     end
36 :    
37 :     fun has_edge (i,j) = #has_edge G (i,j) orelse #has_edge G (j,i)
38 :    
39 :     in
40 :     G.GRAPH
41 :     { name = #name G,
42 :     graph_info = #graph_info G,
43 :     new_id = #new_id G,
44 :     add_node = #add_node G,
45 :     add_edge = #add_edge G,
46 :     remove_node = #remove_node G,
47 :     set_in_edges = #set_in_edges G,
48 :     set_out_edges = #set_out_edges G,
49 :     set_entries = #set_exits G,
50 :     set_exits = #set_entries G,
51 :     garbage_collect = #garbage_collect G,
52 :     nodes = #nodes G,
53 :     edges = #edges G,
54 :     order = #order G,
55 :     size = #size G,
56 :     capacity = #capacity G,
57 :     out_edges = adjacent_edges,
58 :     in_edges = adjacent_edges,
59 :     succ = adjacent_nodes,
60 :     pred = adjacent_nodes,
61 :     has_edge = has_edge,
62 :     has_node = #has_node G,
63 :     node_info = #node_info G,
64 :     entries = #exits G,
65 :     exits = #entries G,
66 :     entry_edges = #entry_edges G,
67 :     exit_edges = #exit_edges G,
68 :     forall_nodes = #forall_nodes G,
69 :     forall_edges = #forall_edges G
70 :     }
71 :     end
72 :     end
73 :    

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0