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.

Copy Source
Copy Link
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 
 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)
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
 (http://www.haskell.org/haskellwiki/H-99:_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
 (https://sites.google.com/site/prologsite/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

Full name: Snippet.AdjacencyGraph<_>

  type: 'a AdjacencyGraph
  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 graph2AdjacencyGraph ((ns, es) : 'a Graph) : 'a AdjacencyGraph =
    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 adjacencyGraph2Graph (ns : 'a AdjacencyGraph) : 'a Graph=
    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 = [
        let current = List.head route
        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 = [
        let current = List.head route
        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()
            for v in adj.[u] do
                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'

More information

Link: http://fssnip.net/av
Posted: 2 years ago
Author: Cesar Mendoza (website)
Tags: Ninety-Nine F# Problems, tutorial, F#, graphs