Graph Colouring
/*
* Graph Colouring
* A graph is represented by a list, each item of which is of the form
* g(V,Ns), where V is a vertex, and Ns is a list of its neighbours.
* The graph colouring problem is to find a smallest set of colours such
* that when each vertex of a graph is assigned a colour from the set,
* no two neighboring vertices are assigned the same colour
*/
/* colour(Graph, NumberOfColours, VVs) is true if for the Vertex of each */
/* element g(Vertex,Neighbours) of the Graph the corresponding element */
/* of VVs is vv(Vertex,Colour) where Colour is an integer between 1 and */
/* NumberOfColours, such that no two adjacent vertices have the same */
/* Colour. On backtracking, all solutions will be found. */
/* e.g. colour([g(1,[2]),g(2,[1,3,4]),g(3,[2,4]),g(4,[2,3])], 3, */
/* [vv(2,1),vv(4,2),vv(3,3),vv(1,2)]). */
colour(Graph, NumberOfColours, VVs):-
quicksort(Graph, SortedGraph), % Sort by decreasing number of neighbours
% This is the "largest-degree heuristic"
integers(1, NumberOfColours, Colours),
initialize_domains(SortedGraph, Colours, VDs),
fc(VDs, VVs).
/* quicksort(Xs, Ys) is true if Ys is a sorted permutation of the list Xs. */
quicksort(Xs, Ys):-quicksort_1(Xs, Ys, []).
quicksort_1([], Ys, Ys).
quicksort_1([X|Xs], Ys, Zs):-
partition(Xs, X, Ms, Ns),
quicksort_1(Ns, Ws, Zs),
quicksort_1(Ms, Ys, [X|Ws]).
partition([], _, [], []).
partition([L|Ls], X, Ms, [L|Ns]):-
L=g(_,Vs),
X=g(_,Ws),
is_shorter(Vs, Ws), !, % Sort by decreasing number of neighbours
partition(Ls, X, Ms, Ns).
partition([L|Ls], X, [L|Ms], Ns):-
partition(Ls, X, Ms, Ns).
/* is_shorter(Xs, Ys) is true if the list Xs contains fewer elements than */
/* the list Ys. */
is_shorter([], [_|_]).
is_shorter([_|Xs], [_|Ys]):-is_shorter(Xs, Ys).
initialize_domains([], _, []).
initialize_domains([G|Graph], Colours, [vd(G,Colours)|Domains_]):-
initialize_domains(Graph, Colours, Domains_).
/* fc(VDs, VVs) is true if for each element vd(g(Vertex,Neighbours),Di) of */
/* VDs the corresponding element of VVs is vv(Vertex,Colour) where */
/* Colour is an element of Di, such that no two adjacent vertices have */
/* the same Colour. On backtracking, all solutions will be found. */
fc([], []).
fc([vd(g(Vertex,Neighbours),Domain)|VDs], [vv(Vertex,Colour)|VVs]):-
member(Colour, Domain),
update_domains(Neighbours, Colour, VDs, VDs1),
fc(VDs1, VVs).
/* update_domains(Neighbours, Colour, VDs0, VDs) is true if: each element */
/* vd(Xh,Dk) of VDs is the same as the corresponding element vd(Xh,Dh) */
/* of VDs0 except that Colour is removed from Dh if Xh is a member of */
/* Neighbours; and no domain Dk is empty. */
update_domains([], _, VDs, VDs).
update_domains([Neighbour|Neighbours], Colour, VDs0, VDs):-
update_domain(VDs0, Neighbour, Colour, VDs1),
update_domains(Neighbours, Colour, VDs1, VDs).
/* update_domain(VDs0, Vertex, Colour, VDs) is true if: each element */
/* vd(Xh,Dk) of VDs is the same as the corresponding element vd(Xh,Dh) */
/* of VDs0 except that Colour is removed from Dh if Xh equals Vertex; */
/* and no domain Dk is empty. */
update_domain([], _, _, []).
update_domain([VD0|VDs0], Vertex, Colour, [vd(V,Domain)|VDs0]):-
VD0=vd(V,Domain0),
V=g(Vertex,_),
!,
delete(Domain0, Colour, Domain),
Domain=[_|_].
update_domain([VD|VDs0], Vertex, Colour, [VD|VDs]):-
update_domain(VDs0, Vertex, Colour, VDs).
/* delete(Ys, X, Zs) is true if Zs is the result of removing the first */
/* occurrence of the element X from the list Ys. */
delete([], _, []).
delete([X|Ys], X, Ys):-!.
delete([Y|Ys], X, [Y|Zs]):-delete(Ys, X, Zs).
/* integers(M, N, Is) is true if Is is the list of integers from M to N */
/* inclusive. */
integers(N, N, [N]):-!.
integers(I, N, [I|Is]):-I < N, I1 is I + 1, integers(I1, N, Is).
/* member(X, Xs) is true if the element X is contained in the list Xs. */
%member(X, [X|_]).
%member(X, [_|Xs]):-member(X, Xs).
LPA Index
Home Page