3
\$\begingroup\$

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!

\$\endgroup\$
2
\$\begingroup\$

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.

\$\endgroup\$
  • \$\begingroup\$ It doesn't seem to work on the input sequence [1,2; 2,3; 3,4] \$\endgroup\$ – AlexFoxGill Aug 4 '15 at 8:42
  • \$\begingroup\$ My circular dependancy detection was broken. I just removed that for now. \$\endgroup\$ – Kevin Aug 4 '15 at 8:49
  • \$\begingroup\$ Added circular dependancy checking back in and return an Option type. \$\endgroup\$ – Kevin Aug 4 '15 at 12:29

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.