Last active
August 11, 2017 21:00
-
-
Save bcachet/8e1155f75ea36f1b417f84ea88dae312 to your computer and use it in GitHub Desktop.
Kahn sorting in F#
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
namespace Graph | |
// Implementation based on https://gist.github.com/alandipert/1263783 | |
module Map = | |
let keys map = | |
map |> Map.toSeq |> Seq.map fst |> Set.ofSeq | |
let values map = | |
map |> Map.toSeq |> Seq.map snd |> Set.ofSeq | |
let update key f map = | |
let value = map |> Map.find key | |
map | |
|> Map.remove key | |
|> Map.add key (f value) | |
module Set = | |
let take1 set = | |
let item = set |> Seq.head | |
(item, set |> Set.remove item) | |
type Graph<'node when 'node : comparison> = Map<'node, Set<'node>> | |
module Graph = | |
let private noIncoming g = | |
let nodes = g |> Map.keys | |
let withIncoming = g |> Map.values |> Set.unionMany | |
Set.difference nodes withIncoming | |
let private hasEdges g = | |
not (g |> Map.values |> Seq.forall Set.isEmpty) | |
let private normalize g = | |
let edges = g |> Map.values |> Set.fold Set.union Set.empty | |
Set.difference edges (g |> Map.keys) | |
|> Set.fold (fun map key -> map |> Map.add key Set.empty) g | |
let kahn graph = | |
let rec sort g l s = | |
if (Seq.isEmpty s) then | |
match hasEdges g with | |
| true -> None | |
| false -> Some(l) | |
else | |
let n, s' = Set.take1 s | |
let m = g |> Map.find n | |
let g' = Set.fold (fun map e -> Map.update n (fun s -> s |> Set.remove e) map) g m | |
sort g' (Seq.append l [n]) (Set.union s' (Set.intersect (noIncoming g') m)) | |
sort (normalize graph) [] (noIncoming graph) | |
let ofNodes (nodesWithEdges:('a * 'a list) list) = | |
nodesWithEdges | |
|> Seq.map(fun kv -> fst kv, snd kv |> Set.ofSeq) | |
|> Map.ofSeq | |
let addNode (n: 'n) (g: Graph<'n>) : Graph<'n> = | |
match Map.tryFind n g with | |
| None -> Map.add n Set.empty g | |
| Some _ -> g | |
let addEdge ((n1, n2): 'n * 'n) (g: Graph<'n>) : Graph<'n> = | |
let g' = | |
match Map.tryFind n2 g with | |
| None -> addNode n2 g | |
| Some _ -> g | |
match Map.tryFind n1 g with | |
| None -> Map.add n1 (Set.singleton n2) g' | |
| Some ns -> Map.add n1 (Set.add n2 ns) g' | |
let ofEdges(edges:('a * 'a) list) = | |
Seq.fold (fun g edge -> g |> addEdge edge) Map.empty edges |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#load "graph.fs" | |
open Graph | |
let acyclGraph = Graph.ofNodes [7, [11; 8]; | |
5, [11]; | |
3, [8; 10]; | |
11, [2; 9]; | |
8, [9]] | |
Graph.kahn acyclGraph | |
// Some( Seq [3; 5; 7; 8; 11; 2; 9; 10]) | |
let cyclGraph = Graph.ofEdges [ 7, 11; | |
7, 8; | |
5, 11; | |
3, 8; | |
3, 10; | |
11, 2; | |
11, 9; | |
8, 9; | |
2, 11] | |
Graph.kahn cyclGraph |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment