Coloring of a non-oriented planar graph in Prolog

Question

I have a program for coloring graphs with 3 colors, neighbouring nodes need to have different colors.

My problem is, it is working only for directed graph, when I use non-directed graph it fails on stack overflow. I know there are some mistakes, could you help me to make it work for non-directed graph?

There is also problem with that findall/3 at the end. I need to change it to finding all nodes, not only nodes with edge(V,_) but I don't know exactly how to do that. I'm beginner and I need the solution to be simple. Thanks.

edge(1,2).
edge(2,3).
edge(2,4).
edge(3,4).

%for making the non-oriented graph I tried to use nonedge(X, Y) :- edge(X, Y).
%                                                 nonedge(X, Y) :- edge(Y, X).

color(blue).                                
color(red).
color(green).

coloring([V-C]) :-
   color(C),
   \+ edge(V,_).
coloring([V-C,V1-C1|Coloring]) :-
   color(C),
   edge(V, V1),
   V \== V1,
   coloring([V1-C1|Coloring]),
   C1 \== C.

colors(X) :-                      
   coloring(X),
   findall(V, edge(V,_), List),
   length(List, Len),
   length(X, Len).

I'm suspecting this is not the working version for the directed graph? Can you add an example of expected input-output as well? — Sam Segers, Jan 10 '16 at 19:38
It is working,but not 100% right.. Without that `oh(X, Y) :- h(X, Y). oh(X, Y) :- h(Y, X).` I've got directed graph and when I hit ` ?- colors(X).` I get `X = [1-blue, 2-red, 3-blue, 4-red] ` which is good. I want to make it work also with that bothsided edges and I need to correct that `findall ` to display all nodes, not only ones with edge(V,_) — Tereza, Jan 10 '16 at 19:50
where is your `edge` predicate then? It should be changed to `oh` or there is more missing? — Sam Segers, Jan 10 '16 at 19:53
sorry there was a mistake. its corrected now.thats a working version. — Tereza, Jan 10 '16 at 20:03
Oh it's a copy paste from http://stackoverflow.com/questions/10713690/how-to-graph-coloring-in-prolog — Sam Segers, Jan 10 '16 at 20:28
yea but when I tried to make it nonoriented I got stackoverflow and that findall is not working correctly either. — Tereza, Jan 10 '16 at 20:33

repeat · Answer 1 · 2019-02-01T18:13:30.150

In this answer we represent graph data not in the same way that the OP described.

Instead, a graph is list of pairs Id-Neibs with Neibs being a list of neighboring node Id's, as defined by the type-check predicate is_graph/1 (shown at the end of the answer).

To color the graph, we use clpfd:

:- use_module(library(clpfd)).

graph_coloring(G0, Zs) :-
   (  is_graph(G0)
   -> maplist(node_augmented_color, G0, G, Zs),
      maplist(agraph_coloring_outer(G), G)
   ;  throw(error(domain_error(graph,G0),_))
   ).

node_augmented_color(ID-Neibs, t(ID,Color,Neibs), Color).

agraph_coloring_outer(G, t(_,Color_v,Neibs_v)) :-
   maplist(agraph_coloring_inner(G,Color_v), Neibs_v).

agraph_coloring_inner(G, Color_x, Id_y) :-
   member(t(Id_y,Color_y,_), G),
   Color_x #\= Color_y.

Sample query using SWI-Prolog 8.0.0:

?- graph_coloring([1-[2],2-[1,3,4],3-[2,4],4-[2,3]], Zs),
   Zs ins 1..3,
   labeling([], Zs).
Zs = [1,2,1,3] ;
Zs = [1,2,3,1] ;
Zs = [1,3,1,2] ;
Zs = [1,3,2,1] ;
Zs = [2,1,2,3] ;
Zs = [2,1,3,2] ;
Zs = [2,3,1,2] ;
Zs = [2,3,2,1] ;
Zs = [3,1,2,3] ;
Zs = [3,1,3,2] ;
Zs = [3,2,1,3] ;
Zs = [3,2,3,1] ;
false.

To define the type-check is_graph/1 (based on iwhen/2 and distinct/1) write:

is_graph(G) :-
   iwhen(ground(G), is_graph_aux(G)).

is_graph_aux(G) :-
   maplist(pair_key, G, Nodes),
   distinct(Nodes),
   maplist(is_graph_aux_outer(G), G).

pair_key(K-_, K).

is_graph_aux_outer(G, E-Xs) :-
   distinct(Xs),
   maplist(is_graph_aux_inner(G,E), Xs).

is_graph_aux_inner(G, E, X) :-
   member(X-Ys, G),
   member(E, Ys).

score 0 · Accepted Answer · edited May 23 '17 at 11:44

The code does not work with loops as well. It only checks if the previous is not the same. But in your example 2 -> 3 -> 4 -> 2 -> .. will never end.

Also if your graph is disconnected it will never return the entire graph.

For both reasons I would suggest a totally different approach, first find all unique vertices. Then assign them a color and check if no previously set colors conflict with the set colors.

colors(Colored) :-
        findall(U,edge(U,_),Vertices), 
        list_to_set(Vertices, UniqueVertices), %% find all unique vertices
        coloring(UniqueVertices,[], Colored). %% color them

The coloring predicate will look like:

coloring([],Acc,Acc). %% base case for empty list
coloring([H|T],Acc,AccRes) :-
    color(C), %% pick a valid color
    not((edge(H, V), member(V-C,Acc))), %% No linked vertex should have the same color
    coloring(T,[H-C|Acc],AccRes). %% Color the rest of the vertices

This code uses an accumulator which hold the previously set vertex-color combinations.

Coloring of a non-oriented planar graph in Prolog

2 Answers2