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

These are F# solutions of Ninety-Nine Haskell Problems which are themselves translations of Ninety-Nine Lisp Problems and Ninety-Nine Prolog Problems. The solutions are hidden so you can try to solve them yourself.

Tools:

### 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
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
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: ///
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: ///
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
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');])
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)```
type 'a Graph = 'a list * 'a Edge list

Full name: Snippet.Graph<_>
type 'T list = List<'T>

Full name: Microsoft.FSharp.Collections.list<_>

type: 'T list
implements: System.Collections.IStructuralEquatable
implements: System.IComparable<List<'T>>
implements: System.IComparable
implements: System.Collections.IStructuralComparable
implements: System.Collections.Generic.IEnumerable<'T>
implements: System.Collections.IEnumerable
type 'a Edge = 'a * 'a

Full name: Snippet.Edge<_>

Ninety-Nine F# Problems - Problems 80 - 89

These are F# solutions of Ninety-Nine Haskell Problems
which are themselves translations of Ninety-Nine Lisp Problems
(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
and Ninety-Nine Prolog Problems

If you would like to contribute a solution or fix any bugs, send
an email to paks at kitiara dot org with the subject "99 F# problems".
I'll try to update the problem as soon as possible.

The problems have different levels of difficulty. Those marked with a single asterisk (*)
are easy. If you have successfully solved the preceeding problems you should be able to
solve them within a few (say 15) minutes. Problems marked with two asterisks (**) are of
intermediate difficulty. If you are a skilled F# programmer it shouldn't take you more than
30-90 minutes to solve them. Problems marked with three asterisks (***) are more difficult.
You may need more time (i.e. a few hours or more) to find a good solution

Though the problems number from 1 to 99, there are some gaps and some additions marked with
letters. There are actually only 88 problems.

val g : char list * (char * char) list

Full name: Snippet.g
type 'a Node = 'a * 'a list

Full name: Snippet.Node<_>
type 'a AdjacencyGraph = 'a Node list

implements: System.Collections.IStructuralEquatable
implements: System.IComparable<List<'a Node>>
implements: System.IComparable
implements: System.Collections.IStructuralComparable
implements: System.Collections.Generic.IEnumerable<'a Node>
implements: System.Collections.IEnumerable
val ga : (char * char list) list

Full name: Snippet.ga

type: (char * char list) list
implements: System.Collections.IStructuralEquatable
implements: System.IComparable<List<char * char list>>
implements: System.IComparable
implements: System.Collections.IStructuralComparable
implements: System.Collections.Generic.IEnumerable<char * char list>
implements: System.Collections.IEnumerable
let nodeMap = ns |> List.map(fun n -> n, []) |> Map.ofList
(nodeMap,es)
||> List.fold(fun map (a,b) -> map |> Map.add a (b::map.[a]) |> Map.add b (a::map.[b]))
|> Map.toList

let sort ((a,b) as e) = if a > b then (b, a) else e
let nodes = ns |> List.map fst
let edges = (Set.empty, ns)
||> List.fold(fun set (a,ns) -> (set, ns) ||> List.fold(fun s b -> s |> Set.add (sort (a,b))) )
|> Set.toSeq
|> Seq.sort
|> Seq.toList
(nodes, edges)
let paths start finish (g : 'a AdjacencyGraph) =
let map = g |> Map.ofList
let rec loop route visited = [
if current = finish then
yield List.rev route
else
for next in map.[current] do
if visited |> Set.contains next |> not then
yield! loop (next::route) (Set.add next visited)
]
loop [start] <| Set.singleton start
let cycle start (g: 'a AdjacencyGraph) =
let map = g |> Map.ofList
let rec loop route visited = [
for next in map.[current] do
if next = start then
yield List.rev <| next::route
if visited |> Set.contains next |> not then
yield! loop (next::route) (Set.add next visited)
]
loop [start] <| Set.singleton start
let solution83 = "your solution here!!"
let prim (s : 'a AdjacencyGraph) (weightFunction: ('a Edge -> int)) : 'a Graph =
let map = s |> List.map (fun (n,ln) -> n, ln |> List.map(fun m -> ((n,m),weightFunction (n,m)))) |> Map.ofList
let nodes = s |> List.map fst
let emptyGraph = ([],[])

let rec dfs nodes (ns,es) current visited =
if nodes |> Set.isEmpty then
(List.rev ns, List.rev es)
else
let (a,b) as edge = ns
|> List.collect(fun n -> map.[n]
|> List.filter(fun ((n,m),w) -> Set.contains m visited |> not) )
|> List.minBy snd |> fst
let nodes' = nodes |> Set.remove b
dfs nodes' (b::ns,edge::es) b (Set.add b visited)
match nodes with
| [] -> emptyGraph
| n::ns -> dfs (Set ns) ([n],[]) n (Set.singleton n)

let solution85 = "your solution here!!"
let degree (g: 'a AdjacencyGraph) node =
let es = g |> List.find(fst >> (=) node) |> snd
// The degree of a node is the number of edges that go to the node.
// Loops get counted twice.
es |> List.sumBy(fun n -> if n = node then 2 else 1)

let sortByDegreeDesc (g : 'a AdjacencyGraph) =
// let use this degree function instead of the one above
// since we alredy have all the info we need right here.
let degree (u,adj) = adj |> List.sumBy(fun v -> if v = u then 2 else 1)
g |> List.sortBy(degree) |> List.rev

let colorGraph g =
let nodes = sortByDegreeDesc g
let findColor usedColors =
let colors = Seq.initInfinite id
colors |> Seq.find(fun c -> Set.contains c usedColors |> not)
let rec greedy colorMap nodes =
match nodes with
| [] -> colorMap |> Map.toList
| (n,ns)::nodes ->
let usedColors = ns |> List.filter(fun n -> Map.containsKey n colorMap) |> List.map(fun n -> Map.find n colorMap ) |> Set.ofList
let color = findColor usedColors
greedy (Map.add n color colorMap) nodes

greedy Map.empty nodes
type Color = White = 0 | Gray = 1 | Black = 2

// The algorithm comes from the book Introduction to Algorithms by Cormen, Leiserson, Rivest and Stein.
let depthFirstOrder (g : 'a AdjacencyGraph) start =
let nodes = g |> Map.ofList
let color = g |> List.map(fun (v,_) -> v, Color.White) |> Map.ofList |> ref
let pi = ref [start]

let rec dfs u =
color := Map.add u Color.Gray !color
for v in nodes.[u] do
if (!color).[v] = Color.White then
pi := (v::!pi)
dfs v
color := Map.add u Color.Black !color

dfs start
!pi |> List.rev
// using problem 87 depthFirstOrder function
let connectedComponents (g : 'a AdjacencyGraph) =
let nodes = g |> List.map fst |> Set.ofList
let start = g |> List.head |> fst
let rec loop acc g start nodes =
let dfst = depthFirstOrder g start |> Set.ofList
let nodes' = Set.difference nodes dfst
if Set.isEmpty nodes' then
g::acc
else
// once we have the dfst set we can remove those nodes from the graph and
// add them to the solution and continue with the remaining nodes
let (cg,g') = g |> List.fold(fun (xs,ys) v -> if Set.contains (fst v) dfst then (v::xs,ys) else (xs,v::ys)) ([],[])
let start' = List.head g' |> fst
loop (cg::acc) g' start' nodes'
loop [] g start nodes
open System.Collections.Generic; // this is where Queue<'T> is defined

let isBipartite (g : 'a AdjacencyGraph) =
// using the breath-first search algorithm, we can compute the distances
// from the first node to the other the nodes. If all the even distance nodes
// point to odd nodes and viceversa, then the graph is bipartite. This works
// for connected graphs.
// The algorithm comes from the book Introduction to Algorithms by Cormen, Leiserson, Rivest and Stein.
let isBipartite' (g : 'a AdjacencyGraph) =
let adj = g |> Map.ofList
// The Color enum is defined on problem 87
let mutable color = g |> List.map(fun (v,_) -> v, Color.White) |> Map.ofList
let mutable distances = g |> List.map(fun (v,_) -> v,-1) |> Map.ofList
let queue = new Queue<_>()
let start = List.head g |> fst
color <- Map.add start Color.Gray color
distances <- Map.add start 0 distances
queue.Enqueue(start)
while queue.Count <> 0 do
let u = queue.Peek()
if color.[v] = Color.White then
color <- Map.add v Color.Gray color
distances <- Map.add v (distances.[u] + 1) distances
queue.Enqueue(v)
queue.Dequeue() |> ignore
color <- Map.add u Color.Black color
let isEven n = n % 2 = 0
let isOdd = isEven >> not
let d = distances // this is just so distances can be captured in the closure below.
g |> List.forall(fun (v,edges) ->
let isOpposite = if d.[v] |> isEven then isOdd else isEven
edges |> List.forall(fun e -> d.[e] |> isOpposite))

// split the graph in it's connected components (problem 88) and test each piece for bipartiteness.
// if all the pieces are bipartite, the graph is bipartite.
g |> connectedComponents |> List.forall isBipartite'