-
Notifications
You must be signed in to change notification settings - Fork 0
/
GraphColor.fs
91 lines (64 loc) · 2.87 KB
/
GraphColor.fs
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
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
namespace EdwinRotgans
open System
open System.Collections.Generic
/// Generic Node with color option
module ColoredGraph =
/// Generic Node with color option
type Node<'T,'C> when 'T : comparison and 'C :> IComparable = {
Label: 'T
Color: 'C option
Neighbours: Set<'T>
} with
static member Create label =
{Label=label; Color=None; Neighbours = set<'T>[] }
member node.UpdateColor color = {node with Color = Some color}
member node.LinkNode label =
{node with Neighbours = node.Neighbours.Add label}
/// Functions to assign colors to nodes of the type ColoredGraph
module ColorGraph =
open ColoredGraph
let private getIndexedNode nodes label =
nodes
|> Array.indexed
|> Array.find (fun (i,node) -> node.Label = label )
/// Function to generate a dictionary of linked nodes form a list of vertices
/// Any loops between a node and itself are ignored
let private nodesFromVertices vertices =
vertices
|> List.collect (fun (label1,label2) -> [label1;label2])
|> Set |> Seq.toArray
|> Array.map Node<'T,IComparable>.Create
/// Creates a list of nodes with neighbours as provided by the list of vertices
let connectNodes vertices =
let nodes = nodesFromVertices vertices
let findByLabel = getIndexedNode nodes
// Store all connections in g
for label1,label2 in vertices do
let idx1, node1 = findByLabel label1
let idx2, node2 = findByLabel label2
nodes.[idx1] <- node1.LinkNode label2
nodes.[idx2] <- node2.LinkNode label1
// return graphDict
nodes
/// Assigns a color to each of the nodes
let colorGraph paletSeq nodes =
let findByLabel = getIndexedNode nodes
// Colors
let maxNumberOfNeighbours = nodes |> Array.map (fun node -> node.Neighbours.Count) |> Array.max
let palet = paletSeq |> Seq.take (maxNumberOfNeighbours+1) |> Seq.toList
// Set Graph colors
for i,node in nodes |> Array.indexed do
// Filter colors
let forbiddenColors =
node.Neighbours
|> Set.map (findByLabel >> snd)
|> Set.filter (fun neighbour -> neighbour.Color.IsSome )
|> Set.map (fun neighbour -> neighbour.Color.Value)
// Pick color
let color = palet |> List.tryFind (forbiddenColors.Contains >> not)
// Assign color
match color with
| Some c -> nodes.[i] <- node.UpdateColor c
| None -> ()
// return list of colored nodes
nodes |> Array.toList