kamlostuff / topological.ml

 ``` 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54``` ```type 'a graph = 'a list * (('a * 'a) list) let vertexes:('a graph -> 'a list) = fst let edges:('a graph -> ('a * 'a) list) = snd let make_graph:('a list -> ('a * 'a) list -> 'a graph) = fun vertexes edges -> (vertexes, edges) let graph:(int graph) = let node2 = 2 and node3 = 3 and node5 = 5 and node7 = 7 and node8 = 8 and node9 = 9 and node10 = 10 and node11 = 11 in ([node2; node3; node5; node7; node8; node9; node10; node11], [(node3, node8); (node3, node10); (node5, node11); (node7, node11); (node7, node8); (node8, node9); (node11, node2); (node11, node9); (node11, node10) ]) let incoming from_graph for_node = let work acc (from, to_) = if to_ == for_node then (from::acc) else acc in (for_node, List.fold_left work [] (edges from_graph)) let all_incoming graph = let incoming' = incoming graph in List.map incoming' (vertexes graph) let topological_sort graph = let graph_size = List.length (vertexes graph) in let rec choose sorted all_incom vert = match vert with | [] -> failwith "Graph contains circuits!" | (head::tail) -> let in_sorted = List.mem head sorted in let is_begining = List.length (List.assoc head all_incom) = 0 in if not in_sorted && is_begining then head else choose sorted all_incom tail in let rec sort sorted all_incom vertexes' = if List.length sorted < graph_size then let vert = choose sorted all_incom vertexes' in let vertexes'' = List.filter ((!=) vert) vertexes' in let sorted' = (vert::sorted) in let work (to_, from) = (to_, List.filter ((!=) vert) from) in let all_incom' = List.map work all_incom in sort sorted' all_incom' vertexes'' else List.rev sorted in let sorted_vertexes = sort [] (all_incoming graph) (vertexes graph) in make_graph sorted_vertexes (edges graph) ```