Ninety-Nine F# Problems - Problems 80 - 89 - Graphs

 1: /// Ninety-Nine F# Problems - Problems 80 - 89
 2: ///
 3: /// These are F# solutions of Ninety-Nine Haskell Problems 
 4: /// (http://www.haskell.org/haskellwiki/H-99:_Ninety-Nine_Haskell_Problems), 
 5: /// which are themselves translations of Ninety-Nine Lisp Problems
 6: /// (http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
 7: /// and Ninety-Nine Prolog Problems
 8: /// (https://sites.google.com/site/prologsite/prolog-problems).
 9: ///
10: /// If you would like to contribute a solution or fix any bugs, send 
11: /// an email to paks at kitiara dot org with the subject "99 F# problems". 
12: /// I'll try to update the problem as soon as possible.
13: ///
14: /// The problems have different levels of difficulty. Those marked with a single asterisk (*) 
15: /// are easy. If you have successfully solved the preceeding problems you should be able to 
16: /// solve them within a few (say 15) minutes. Problems marked with two asterisks (**) are of 
17: /// intermediate difficulty. If you are a skilled F# programmer it shouldn't take you more than 
18: /// 30-90 minutes to solve them. Problems marked with three asterisks (***) are more difficult. 
19: /// You may need more time (i.e. a few hours or more) to find a good solution
20: ///
21: /// Though the problems number from 1 to 99, there are some gaps and some additions marked with 
22: /// letters. There are actually only 88 problems.
23: ///
24: 
25: // The solutions to the problems below use there definitions for Grahps
26: type 'a Edge = 'a * 'a
27: 
28: type 'a Graph = 'a list * 'a Edge list
29: 
30: let g = (['b';'c';'d';'f';'g';'h';'k'],[('b','c');('b','f');('c','f');('f','k');('g','h')])
31: 
32: type 'a Node = 'a * 'a list
33: 
34: type 'a AdjacencyGraph = 'a Node list
35: 
36: let ga = [('b',['c'; 'f']); ('c',['b'; 'f']); ('d',[]); ('f',['b'; 'c'; 'k']); 
37:                                                     ('g',['h']); ('h',['g']); ('k',['f'])]
38: 

(***) Problem 80 : Conversions

 1: /// Write predicates to convert between the different graph representations. With these 
 2: /// predicates, all representations are equivalent; i.e. for the following problems you 
 3: /// can always pick freely the most convenient form. The reason this problem is rated 
 4: /// (***) is not because it's particularly difficult, but because it's a lot of work to 
 5: /// deal with all the special cases. 
 6: /// 
 7: /// Example in F#:
 8: /// 
 9: /// > let g = (['b';'c';'d';'f';'g';'h';'k'],[('b','c');('b','f');
10: ///                                                 ('c','f');('f','k');('g','h')]);;
11: /// 
12: /// > graph2AdjacencyGraph g;;
13: /// val it : char AdjacencyGraph =
14: ///   [('b', ['f'; 'c']); ('c', ['f'; 'b']); ('d', []); ('f', ['k'; 'c'; 'b']);
15: ///    ('g', ['h']); ('h', ['g']); ('k', ['f'])]
16: ///
17: /// > let ga = [('b',['c'; 'f']); ('c',['b'; 'f']); ('d',[]); ('f',['b'; 'c'; 'k']); 
18: ///                                             ('g',['h']); ('h',['g']); ('k',['f'])];;
19: /// 
20: /// > adjacencyGraph2Graph ga;;
21: /// val it : char Graph =
22: ///   (['b'; 'c'; 'd'; 'f'; 'g'; 'h'; 'k'],
23: ///    [('b', 'c'); ('b', 'f'); ('c', 'f'); ('f', 'k'); ('g', 'h')])
24: 
25: (Solution)

(**) Problem 81: Path from one node to another one

 1: /// Write a function that, given two nodes a and b in a graph, returns all 
 2: /// the acyclic paths from a to b.
 3: /// 
 4: /// Example:
 5: /// 
 6: /// Example in F#:
 7: /// 
 8: /// > paths 1 4 [(1,[2;3]);(2,[3]);(3,[4]);(4,[2]);(5,[6]);(6,[5])];;
 9: /// val it : int list list = [[1; 2; 3; 4]; [1; 3; 4]]
10: ///
11: /// > paths 2 6 [(1,[2;3]);(2,[3]);(3,[4]);(4,[2]);(5,[6]);(6,[5])];;
12: /// val it : int list list = []
13: 
14: (Solution)

(*) Problem 82: Cycle from a given node

 1: /// Write a predicate cycle(G,A,P) to find a closed path (cycle) P starting at a given node
 2: ///  A in the graph G. The predicate should return all cycles via backtracking.
 3: /// 
 4: /// Example:
 5: /// 
 6: /// <example in lisp>
 7: /// Example in F#:
 8: /// 
 9: /// > cycle 2 [(1,[2;3]);(2,[3]);(3,[4]);(4,[2]);(5,[6]);(6,[5])];;
10: /// val it : int list list = [[2; 3; 4; 2]]
11: ///
12: /// > cycle 1 [(1,[2;3]);(2,[3]);(3,[4]);(4,[2]);(5,[6]);(6,[5])];;
13: /// val it : int list list = []
14: 
15: (Solution)

(**) Problem 83: Construct all spanning trees

 1: /// Write a predicate s_tree(Graph,Tree) to construct (by backtracking) all spanning trees 
 2: /// of a given graph. With this predicate, find out how many spanning trees there are for 
 3: /// the graph depicted to the left. The data of this example graph can be found in the file
 4: /// p83.dat. When you have a correct solution for the s_tree/2 predicate, use it to define 
 5: /// two other useful predicates: is_tree(Graph) and is_connected(Graph). Both are 
 6: /// five-minutes tasks!
 7: /// 
 8: /// Example:
 9: /// 
10: /// <example in lisp>
11: /// Example in F#:
12: 
13: (Solution needed)

(**) Problem 84: Construct the minimal spanning tree

 1: /// Write a predicate ms_tree(Graph,Tree,Sum) to construct the minimal spanning tree of a given
 2: /// labelled graph. Hint: Use the algorithm of Prim. A small modification of the solution of 
 3: /// P83 does the trick. The data of the example graph to the right can be found in the file p84.dat.
 4: /// 
 5: /// Example:
 6: /// 
 7: /// <example in lisp>
 8: /// 
 9: /// Example in F#: 
10: /// > let graphW = [('a',['b'; 'd';]); ('b',['a';'c';'d';'e';]); ('c',['b';'e';]); 
11: ///                 ('d',['a';'b';'e';'f';]); ('e',['b';'c';'d';'f';'g';]); ('f',['d';'e';'g';]); 
12: ///                 ('g',['e';'f';]); ];;
13: /// > let gwF = 
14: ///     let weigthMap = 
15: ///         Map [(('a','b'), 7);(('a','d'), 5);(('b','a'), 7);(('b','c'), 8);(('b','d'), 9);
16: ///              (('b','e'), 7);(('c','b'), 8);(('c','e'), 5);(('d','a'), 5);(('d','b'), 9);
17: ///              (('d','e'), 15);(('d','f'), 6);(('e','b'), 7);(('e','c'), 5);(('e','d'), 15);
18: ///              (('e','f'), 8);(('e','g'), 9);(('f','d'), 6);(('f','e'), 8);(('f','g'), 11);
19: ///              (('g','e'), 9);(('g','f'), 11);]
20: ///     fun (a,b) -> weigthMap.[(a,b)];;
21: /// 
22: /// val graphW : (char * char list) list =
23: ///   [('a', ['b'; 'd']); ('b', ['a'; 'c'; 'd'; 'e']); ('c', ['b'; 'e']);
24: ///    ('d', ['a'; 'b'; 'e'; 'f']); ('e', ['b'; 'c'; 'd'; 'f'; 'g']);
25: ///    ('f', ['d'; 'e'; 'g']); ('g', ['e'; 'f'])]
26: /// val gwF : (char * char -> int)
27: /// 
28: /// > prim gw gwF;;
29: /// val it : char Graph =
30: ///   (['a'; 'd'; 'f'; 'b'; 'e'; 'c'; 'g'],
31: ///    [('a', 'd'); ('d', 'f'); ('a', 'b'); ('b', 'e'); ('e', 'c'); ('e', 'g')])
32: /// 
33: 
34: (Solution)

(**) Problem 85: Graph isomorphism

 1: /// Two graphs G1(N1,E1) and G2(N2,E2) are isomorphic if there is a bijection f: N1 -> N2 such
 2: /// that for any nodes X,Y of N1, X and Y are adjacent if and only if f(X) and f(Y) are adjacent.
 3: /// 
 4: /// Write a predicate that determines whether two graphs are isomorphic. Hint: Use an open-ended
 5: /// list to represent the function f.
 6: /// 
 7: /// Example:
 8: /// 
 9: /// <example in lisp>
10: /// 
11: /// Example in F#: 
12: 
13: (Solution needed)

(**) Problem 86: Node degree and graph coloration

 1: /// a) Write a predicate degree(Graph,Node,Deg) that determines the degree of a given node.
 2: /// 
 3: /// b) Write a predicate that generates a list of all nodes of a graph sorted according to 
 4: ///    decreasing degree.
 5: /// 
 6: /// c) Use Welch-Powell's algorithm to paint the nodes of a graph in such a way that adjacent 
 7: ///    nodes have different colors.
 8: /// 
 9: /// 
10: /// Example:
11: /// 
12: /// <example in lisp>
13: ///
14: /// Example in F#: 
15: /// > let graph = [('a',[]);('b',['c']);('c',['b';'d';'g']);('d',['c';'e']);('e',['d';'e';'f';'g']);('f',['e';'g']);('g',['c';'e';'f'])];;
16: /// > degree graph 'e';;
17: /// val it : int = 5
18: /// > sortByDegree graph;;
19: /// val it : char Node list =
20: ///   [ ('e',['d'; 'e'; 'f'; 'g']);  ('g',['c'; 'e'; 'f']);
21: ///     ('c',['b'; 'd'; 'g']);  ('f',['e'; 'g']);  ('d',['c'; 'e']);
22: ///     ('b',['c']);  ('a',[])]
23: /// val it : int = 5
24: /// > colorGraph graph;;
25: /// val it : (char * int) list =
26: ///   [('a', 0); ('b', 1); ('c', 0); ('d', 1); ('e', 0); ('f', 2); ('g', 1)]
27: 
28: (Solution)

(**) Problem 87: Depth-first order graph traversal (alternative solution)

 1: /// Write a predicate that generates a depth-first order graph traversal sequence. The starting 
 2: /// point should be specified, and the output should be a list of nodes that are reachable from 
 3: /// this starting point (in depth-first order).
 4: /// 
 5: /// Example:
 6: /// 
 7: /// <example in lisp>
 8: /// 
 9: /// Example in F#: 
10: ///
11: /// > let gdfo = (['a';'b';'c';'d';'e';'f';'g';], 
12: ///               [('a','b');('a','c');('a','e');('b','d');('b','f');('c','g');('e','f');]) 
13: ///               |> Graph2AdjacencyGraph;;
14: /// 
15: /// val gdfo : char AdjacencyGraph =
16: ///   [('a', ['e'; 'c'; 'b']); ('b', ['f'; 'd'; 'a']); ('c', ['g'; 'a']);
17: ///    ('d', ['b']); ('e', ['f'; 'a']); ('f', ['e'; 'b']); ('g', ['c'])]
18: /// 
19: /// > depthFirstOrder gdfo 'a';;
20: /// val it : char list = ['a'; 'e'; 'f'; 'b'; 'd'; 'c'; 'g']
21: 
22: (Solution)

(**) Problem 88: Connected components (alternative solution)

 1: /// Write a predicate that splits a graph into its connected components.
 2: /// 
 3: /// Example:
 4: /// 
 5: /// <example in lisp>
 6: /// 
 7: /// Example in F#: 
 8: /// > let graph = [(1,[2;3]);(2,[1;3]);(3,[1;2]);(4,[5;6]);(5,[4]);(6,[4])];;
 9: /// > connectedComponents graph;;
10: /// val it : int AdjacencyGraph list =
11: ///   [[(6, [4]); (5, [4]); (4, [5; 6])];
12: ///    [(3, [1; 2]); (2, [1; 3]); (1, [2; 3])]]
13: /// > 
14: 
15: (Solution)

(**) Problem 89: Bipartite graphs

 1: /// Write a predicate that finds out whether a given graph is bipartite.
 2: /// 
 3: /// Example:
 4: /// 
 5: /// <example in lisp>
 6: /// 
 7: /// Example in F#: 
 8: ///
 9: /// > let gdfo = [('a', ['b'; 'c'; 'e']); ('b', ['a'; 'd'; 'f']); ('c', ['a'; 'g']);('d', ['b']); 
10: ///               ('e', ['a'; 'f']); ('f', ['b'; 'e']); ('g', ['c'])];;
11: /// 
12: /// val gdfo : (char * char list) list =
13: ///   [('a', ['b'; 'c'; 'e']); ('b', ['a'; 'd'; 'f']); ('c', ['a'; 'g']);
14: ///    ('d', ['b']); ('e', ['a'; 'f']); ('f', ['b'; 'e']); ('g', ['c'])]
15: /// 
16: /// > isBipartite gdfo;;
17: /// val it : bool = true
18: 
19: (Solution)