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 /MLRISC/trunk/graphs/ugraph.sml
ViewVC logotype

Annotation of /MLRISC/trunk/graphs/ugraph.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 429 - (view) (download)
Original Path: sml/branches/SMLNJ/src/MLRISC/graphs/ugraph.sml

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 : monnier 429 structure Sort = ListMergeSort
19 : monnier 245
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 : monnier 429 Sort.uniqueSort (fn ((i,j,_),(i',j',_)) =>
26 :     if i < i' then LESS
27 :     else if i = i' then
28 :     if j < j' then LESS
29 :     else if j = j' then EQUAL
30 :     else GREATER
31 :     else GREATER)
32 : monnier 245 (in_edges @ out_edges)
33 :     end
34 :     fun adjacent_nodes i =
35 :     let val succ = #succ G i
36 :     val pred = #pred G i
37 :     in
38 : monnier 429 Sort.uniqueSort Int.compare (succ @ pred)
39 : monnier 245 end
40 :    
41 :     fun has_edge (i,j) = #has_edge G (i,j) orelse #has_edge G (j,i)
42 :    
43 :     in
44 :     G.GRAPH
45 :     { name = #name G,
46 :     graph_info = #graph_info G,
47 :     new_id = #new_id G,
48 :     add_node = #add_node G,
49 :     add_edge = #add_edge G,
50 :     remove_node = #remove_node G,
51 :     set_in_edges = #set_in_edges G,
52 :     set_out_edges = #set_out_edges G,
53 :     set_entries = #set_exits G,
54 :     set_exits = #set_entries G,
55 :     garbage_collect = #garbage_collect G,
56 :     nodes = #nodes G,
57 :     edges = #edges G,
58 :     order = #order G,
59 :     size = #size G,
60 :     capacity = #capacity G,
61 :     out_edges = adjacent_edges,
62 :     in_edges = adjacent_edges,
63 :     succ = adjacent_nodes,
64 :     pred = adjacent_nodes,
65 :     has_edge = has_edge,
66 :     has_node = #has_node G,
67 :     node_info = #node_info G,
68 :     entries = #exits G,
69 :     exits = #entries G,
70 :     entry_edges = #entry_edges G,
71 :     exit_edges = #exit_edges G,
72 :     forall_nodes = #forall_nodes G,
73 :     forall_edges = #forall_edges G
74 :     }
75 :     end
76 :     end
77 :    

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