Finding paths in (DAG) directed acyclic graph given destination

Question

Let's say I have this array:

let reportStructure = [|(2, 1); (3, 2); (4, 2); (5, 3); (6, 4); (7, 3)|]

where the first int in a tuple reports to the second int.

I can map that really easily with

let orgMap = Map.ofArray reporting

From there, I could easily get a list of all the ints that report to 2 with

orgMap 
|> Map.filter (fun _ key -> key = 2)

which returns

map [(3, 2); (4, 2)]

What I'd really like to see, however, is the entire structure, from 2 all the way down. For example, I'd like to find a way that could give me the sample output

map [(3, 2); (4, 2); (5, 3); (6, 4); (7, 3)]

if I'm looking for person 2 or

map [(5, 3); (7, 3)]

if I'm interested in person 3.

Can I do this? If so, how? Is there another structure other than a map that would be a better way to make this happen?

Thanks in advance for your help.

Answer 1

Since OCaml is close to F# and trying to find Topological sort in F# was not turning up anything useful I looked for OCaml code.

I found An Introduction to Objective Caml which had a solution to your problem using Depth First Search and used it as the basis for this answer. Also because you are new to F# you can review the document and see how the code is derived. Oddly I took a look at the remainder of the document after posting this and he has a more advanced version of DFS latter in the document.

Your input is an array [| |] but your answer is a list [] so I did most of the work as list.

The answers are not in the same order as you had, but they are in the same format.

    let reportStructure = [|(2, 1); (3, 2); (4, 2); (5, 3); (6, 4); (7, 3)|]

    //
    //  6 -> 4 -> 2
    //  5 -> 3 -> 2 -> 1 
    //  7 -> 3

    // val revStructure : tl:('a * 'b) list -> ('b * 'a) list
    let revStructure tl = List.map (fun (a,b) -> (b,a)) tl

    // val mem : item:'a -> list:'a list -> bool when 'a : equality
    let mem item list = List.exists (fun x -> x = item) list 

    // val successors : n:'a -> edges:('a * 'b) list -> 'b list when 'a : equality
    let successors n edges = 
        let matching (s,_) = s = n
        List.map snd (List.filter matching edges)

    // val dist : pred:'a -> succs:'b list -> ('a * 'b) list
    let dist pred succs = List.map (fun y -> (pred,y)) succs

    // val dfsPairs : edges:('a * 'a) list -> start:'a -> ('a * 'a) list when 'a : equality
    let dfsPairs edges start =
        let rec dfsPairsInner edges visited start result = 
            match start with 
            | [] -> List.rev (revStructure result) 
            | n::nodes -> 
                if mem n visited then 
                    dfsPairsInner edges visited nodes result
                else 
                    let predecessors = dist n (successors n edges)
                    let result =
                        match predecessors with
                        | [] -> result
                        | _ -> predecessors @ result
                    dfsPairsInner edges (n::visited) ((successors n edges) @ nodes) result
        dfsPairsInner edges [] [start] []

    let revEdges = revStructure (List.ofArray reportStructure)

    let result = dfsPairs revEdges 2
    // val result : (int * int) list = [(4, 2); (3, 2); (7, 3); (5, 3); (6, 4)]

    let result = dfsPairs revEdges 3
    // val result : (int * int) list = [(7, 3); (5, 3)]