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.

• Alex: It doesn't seem to work on the input sequence [1,2; 2,3; 3,4]
• Kevin: My circular dependancy detection was broken. I just removed that for now.
• Kevin: Added circular dependancy checking back in and return an Option type.