Building and flattening a dependency graph

Question

The Problem

Given a list of dependencies ('a * 'a) list where the first item has a dependency on the second item, construct a dependency graph and then 'flatten' it into a single 'a list such that no item comes after one of its dependencies.

Constraints

I am trying to improve my functional programming/idiomatic F#, so I want to avoid mutability.

My Solution

let flip f x y = f y x

module Set =
    let addMany set xs = Seq.fold (flip Set.add) set xs

module DependencyGraph =
    let build xs =
        let add map (a,b) =
            let value = 
                match Map.tryFind a map with
                | Some list -> (b :: list)
                | None      -> [b]
            Map.add a value map
        Seq.fold add Map.empty xs

    let flatten root map =
        let rootAdded =
            map
            |> Map.toSeq
            |> Seq.map fst
            |> Seq.toList
            |> (fun xs -> Map.add root xs map)

        let rec flatten' visited resolved node =
            let visited' = Set.add node visited
            let resolved' = Set.add node resolved

            let visit dependencies =
                let folder seq d =
                    d
                    |> flatten' visited' (Set.addMany resolved' seq)
                    |> (flip Seq.append) seq
                    |> Seq.cache
                Seq.fold folder Seq.empty dependencies

            if Set.contains node visited then do
                failwith "Circular dependency detected"
            seq {
                if not <| (Set.contains node resolved || node = root) then
                    yield node

                match Map.tryFind node rootAdded with
                | None              -> ()
                | Some dependencies -> yield! visit dependencies
            }

        flatten' Set.empty Set.empty root

Usage

> [4,3; 1,2; 1,3; 3,2]
  |> DependencyGraph.build
  |> DependencyGraph.flatten 0
  |> Seq.toList;;
val it : int list = [4; 1; 3; 2]

Analysis

    let build xs =
        let add map (a,b) =
            let value = 
                match Map.tryFind a map with
                | Some list -> (b :: list)
                | None      -> [b]
            Map.add a value map
        Seq.fold add Map.empty xs

The graph is transformed by the build function from a ('a * 'a) list into a Map<'a, 'a list>. I am fairly happy with this function, it seems to be idiomatic F# to me.

---

    let flatten root map =
        let rootAdded =
            map
            |> Map.toSeq
            |> Seq.map fst
            |> Seq.toList
            |> (fun xs -> Map.add root xs map)

The flatten function takes a "root" node that I use to connect potentially disconnected subgraphs. I don't really like this, I feel like it shouldn't be necessary, but it seemed to fit the rest of the algorithm.

---

        let rec flatten' visited resolved node =
            let visited' = Set.add node visited
            let resolved' = Set.add node resolved

Once the root has been added to the graph, it is passed in to a recursive closure, flatten', with two accumulators. visited is for tracking circular references; resolved is for excluding repeated nodes. I don't know how necessary it is to have these two accumulators instead of just one but they do have separate responsibilities.

---

            let visit dependencies =
                let folder seq d =
                    d
                    |> flatten' visited' (Set.addMany resolved' seq)
                    |> (flip Seq.append) seq
                    |> Seq.cache
                Seq.fold folder Seq.empty dependencies

Something else I don't like is the implementation of the visit closure - specifically that it uses a fold with two state objects: a sequence and a set of resolved parameters. This was the only way I could think of to iterate through a list of dependencies while passing in an updated resolved set for each item and simultaneously preserving the order of the sequence returned.

I realised that I don't need to pass the resolved set through the fold - instead I can just insert the previous results into the set (possibly inefficient?)

---

            if Set.contains node visited then do
                failwith "Circular dependency detected"

I also wasn't sure how to represent a circular reference without using an exception - perhaps a discriminated union with a case for circular references could be incorporated?

---

        seq {
            if not <| (Set.contains node resolved || node = root) then
                yield node

            match Map.tryFind node rootAdded with
            | None              -> ()
            | Some dependencies -> yield! visit dependencies
        }

Finally, this match clause seems overly complicated. I feel like there's probably some method on Option that I could use here.

---

All feedback welcomed, please bear in mind that I'm going for a functional approach here as much as possible!

Answer 1

This is what I came up with.

let depend d =
  let map = 
    d
    |> Seq.groupBy fst 
    |> Seq.map (fun (key, values) -> (key, values |> Seq.map snd))
    |> Map.ofSeq

  let flattened = 
    seq {
      for i in d do yield fst i; yield snd i}
    |> Seq.distinct
    |> List.ofSeq

  let rec toList l n m =
    match l with
    |[] -> Some n
    |h::t -> match map |> Map.tryFind h with
             |Some v -> match Set.isSubset (Set.ofSeq v) (Set.ofList n) with
                        |true -> toList t (h::n) 0
                        |false -> match m > (Seq.length l) with
                                  |true -> None
                                  |false -> toList (t @ [h]) n (m+1)
             |None -> toList t (h::n) 0
  toList flattened [] 0

Signature is as follows:

val depend : d:seq<'a * 'a> -> 'a list option when 'a : comparison

I return a None when a circular dependency is detected. Its definitely better than throwing an exception as the return type makes the caller of the function aware that a failure is possible instead of "lying" about returning a list when in fact an exception may be thrown.

EDIT: Fixed incorrect circular dependency as mentioned in your comments.