Finding Paths in a (DAG) Directional Acyclic Graph

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 the tuple reports the second int .

I can easily display this with

 let orgMap = Map.ofArray reporting 

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

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

which returns

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

What I really would like to see, however, is the whole structure, from 2 to the end. For example, I would like to find a way that could give me a sample output

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

if i am looking for person 2 or

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

if I'm interested in face 3.

Can I do it? If so, how? Is there any other structure than map which would be the best way to do this?

Thanks in advance for your help.

Answer 1

Since OCaml is close to F # and trying to find topological sorting in F #, there was nothing useful, I was looking for OCaml code.

I found an Introduction to Objective Caml , in which there was a solution to the problem using the Depth First Search method and was used as the basis for this answer. Also, since you are new to F #, you can view the document and see how the code is output. Oddly enough, I looked at the rest of the document after posting this post, and it has a more advanced version of DFS in the document.

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

The answers are not in the order you were in, 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)] 

Answer 2

I assume that you want to get a list of int pairs with "numbers" that directly or indirectly report some "root". Here is a simple but ineffective solution:

 let reportStructure = [|(2, 1); (3, 2); (4, 2); (5, 3); (6, 4); (7, 3)|] let reportStructureSet = reportStructure |> Set.ofArray let reportingDirectlyTo root raportsToSet = raportsToSet |> Set.filter(fun (_, key) -> key = root) let addNextGeneration previousIteration raportsToSet = let numbersLowerInHierarchy = previousIteration |> Set.map fst raportsToSet |> Set.filter( // select only those elements from raportsToSet... fun (num, supervisor) -> // ...which either are already in previousIteration (Set.contains (num, supervisor) previousIteration) || // ...or are "below" someone from previousIteration (Set.contains supervisor numbersLowerInHierarchy)) let reportingDirectlyOrIndirectlyTo root raportsToSet = // applies addNextGeneration until is "stabilizes" on some value let rec fixPointHelper previousIteration = let nextIteration = addNextGeneration previousIteration raportsToSet if nextIteration = previousIteration then nextIteration else fixPointHelper nextIteration // set of numbers directly reporting to root let reportsDirectly = reportingDirectlyTo root raportsToSet // start "iteration" using numbers directly reporting to root fixPointHelper reportsDirectly let reportingDirectlyOrIndirectlyToList root raportsToSet = reportingDirectlyOrIndirectlyTo root raportsToSet |> Set.toList 

If you want to implement an effective solution, you should interpret reportStructureSet as a graph as follows:

• int - vertices
• pair int are directed edges

Then just check which edges are accessible from "root" using DFS .

Answer 3

I like f # puzzles, so I hit that one. I hope you will like it.

 let orgList = [(2, 1); (3, 2); (4, 2); (5, 3); (6, 4); (7, 3)] let orgMap = orgList |> List.fold (fun acc item -> let key = snd item match Map.tryFind key acc with | Some(value) -> let map' = Map.remove key acc Map.add(key) (item::value) map' | None -> Map.add(key) (item::[]) acc ) Map.empty<int, (int*int) list> let findReports supervisor = let rec findReports' acc collection = match collection with | head::tail -> (findReports' (head::acc) tail) @ match Map.tryFind (fst head) orgMap with | Some(value) -> (findReports' [] value) | None -> [] | [] -> acc findReports' [] (Map.find supervisor orgMap) findReports 2 |> List.map fst |> List.distinct 

returns

 val it : int list = [3; 4; 5; 7; 6] 

findReports 2 returns

 val it : (int * int) list = [(3, 2); (4, 2); (5, 3); (7, 3); (6, 4)] 

---

I will break it to clarify.

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

We take your list of tuples and create a functional boss map in the list ((report, boss)). This may be known as an adjacency list, which is used to move graphs.

 let orgMap = orgList |> List.fold (fun acc item -> let key = snd item match Map.tryFind key acc with 

If there is a list of reports under the boss, add to this list.

  | Some(reports) -> let map' = Map.remove key acc Map.add(key) (item::reports) map' 

Otherwise, add to the empty list and paste into the dictionary.

  | None -> Map.add(key) (item::[]) acc 

Start with a blank card as a battery.

  ) Map.empty<int, (int*int) list> 

Count items to find all reports.

 let findReports supervisor = let rec findReports' acc collection = match collection with 

If there is an item, add it to the battery. This is a BFS. If you switch the expression before and after the concatenation operator (@), it will become DFS.

  | head::tail -> (findReports' (head::acc) tail) 

Combine the current list with a recursive list of reports in reports.

  @ match Map.tryFind (fst head) orgMap with | Some(value) -> (findReports' [] value) | None -> [] 

If at the end of the list, return the list.

  | [] -> acc 

Run the recursive function.

  findReports' [] (Map.find supervisor orgMap) 

Run the function.

 findReports 7 

Return only reports

 |> List.map fst 

Do not report twice.

 |> List.distinct