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
 [smlnj] / MLRISC / trunk / graphs / ugraph.sml

# Annotation of /MLRISC/trunk/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 :