namespace Graph.TransitiveReduction

open System
open System.Collections
open System.Collections.Generic

/// Adjacency list representation of a graph, mapping each vertex to its successors
type Graph<'a when 'a : comparison> = Map<'a, 'a Set>

#nowarn "40"

module Graph = 
    /// Reachable nodes from the given root
    let reachableF (g: Graph<'a>) k (root:'a) = 
        match g.TryFind root with
        | None    -> Set.empty
        | Some nn -> Seq.map k nn |> Set.unionMany

    let rec fix f x = f (fix f) x

    let reachable g root = fix (reachableF g) root

    /// Builds a table of the reachable nodes from every node in the graph
    let reachableAll g : Map<'a,Set<'a>> =
        let rec m = g |> Map.map (fun n _ -> lazy(Set.add n (reachableF g k n)))
        and k   n  = m.[n].Value
        m |> Map.map(fun _ e -> e.Value)
                 
    /// The transitive reduction of a graph is the minimal set of edges with the same transitive closure
    let transitiveReductionHelper (dfss : Map<_,_>) (g:Graph<'a>) : Graph<'a> =

        let reachable n = Set.add n (dfss.[n])

        g |> Map.map(fun n ss -> 
                ss
                |> Set.filter(fun s -> not <| Seq.exists (fun s' -> s' <> s && reachable(s').Contains s) ss)
                |> Set.ofSeq)

    let transitiveReduction g = transitiveReductionHelper (reachableAll g) g

module Example =
    let g1 : Graph<int> 
             = Map.ofSeq <|
                [ 0, Set.ofSeq [|1;2;3|]
                  1, Set.ofSeq [|2|]
                  2, Set.ofSeq [|3|]
                  3, Set.ofSeq [| |]
                ]        

    let g1' = Graph.transitiveReduction g1