(*graph-search*) datatype 'a gnode = gempty|Gnode of ('a*'a gnode); (* A gnode has a name and a gnode as an ancestor. The ancestor is created during the process of searching the graph on nodes. Initially a gnode's ancestor is gempty (unknown) *) fun make_node name = Gnode(name,gempty); fun show_gnode (Gnode(n,_)) = n; fun equal_gnodes gempty n2 = false |equal_gnodes n1 gempty = false |equal_gnodes (Gnode(n1,_)) (Gnode(n2,_)) = n1=n2; (* Two gnodes are considered to be equal if they have the same name. *) (***********************************************************************) datatype 'a adjacent = Adjacent of (('a gnode)*('a gnode)list); (* adjacent defines the gnodes that are adjacent to a gnode. It is in the form of an association, that (n,s) where n is a gnode and s is a list of gnode's that are adjacent to n *) fun make_adjacent (n,s) = Adjacent(n,s); (* where n is adjacent to nodes s in G *) fun show_adjacent (Adjacent(n,s)) = ((show_gnode n), "adjacent to", (map show_gnode s)); (******************* THE GRAPH **********************************) val a = make_node "a" and b = make_node "b" and c = make_node "c" and d = make_node "d" and e = make_node "e" and f = make_node "f" and g = make_node "g"; val adj_list = map make_adjacent [(a,[b,d]), (b,[c]), (c,[b]), (d,[e]), (e,[c,f,g])]; (******************************************************************) fun succ [] node = [] |succ ((Adjacent(n,s))::x) node = if equal_gnodes n node then s else succ x node; val gsucc = succ adj_list; (* Partially applied function "succ adj_list n". Can now make the following calls: *) gsucc a; gsucc e; gsucc d; (********************************************************************) fun gmember n1 (n2::nodes) = equal_gnodes n1 n2 orelse gmember n1 nodes |gmember n1 [] = false; fun make_ancestor a gempty = gempty |make_ancestor a (Gnode(n,_)) = Gnode(n,a); fun dfs s g visited unvisited = if equal_gnodes s g (*1*) then s (*2*) else if unvisited=[] (*3*) then gempty (*4*) else if gmember s visited (*5*) then dfs (hd unvisited) g visited (tl unvisited) (*6*) else let val uv = (map (make_ancestor s) (gsucc s)) (*7*) @unvisited (*8*) in dfs (hd uv) g (s::visited) (tl uv) end; (*9*) (* Depth First Search from start node s to goal node g. (1) If the start and the goal node are the same then deliver s (not g) as s is the head of the route back to g via the ancestor links. (3) not(equal_gnodes s g) and unvisited = [] All possible paths have been traversed without reaching g therefore deliver gempty (5) s is a member of visited. We have been here already. Search from the next unvisited node. We do NOT add to the set of visited nodes. We remove a new s from unvisited. (7) s is not a member of visited. Get all nodes that are adjacent to s. Make s their ancestor. APPEND the current set of unvisited nodes to the set of successors of s. (9) Search from a successor of s, adding s to the set of visited nodes, and adding the remaining successors of s onto unvisited. *) fun route gempty = [] |route (Gnode(n,a)) = n::route a; (* Given a node, trace back through its ancestor reference *) fun depth_first s g = rev(route (dfs s g [] (gsucc s))); (* Sanitised depth first search. *) depth_first a g; (* Exercises: (1) Modify dfs to become bfs (breadth first search) (2) Modify dfs to also deliver the number of nodes visited (3) Modify the data structures such that if Ni is adjacent to Nj there is an associated cost for this traversal. Then create a function best_first search that finds the minimum cost path from s to g. *)