I'm trying to make the simple graph coloring algorithm in Prolog, but I'm having a bit of a hard time understanding the language. I know what I want to do - I want to go to a vertex, find all the other vertices connected to it, check my vertex's color, and depending on that, color the other vertices with different colors. I'm just having a hard time translating this to Prolog. If it was a C dialect or Java, it would be a piece of cake for me, but this is giving me fits.
This is what I have so far:
main:- graph_coloring.
%color_list([blue, red, green, yellow, white], colors).
%vertex_list([a, b, c, d], vertices).
%edge_list([(a,b),(b,c),(c,d)], edges).
%Our graph
color(blue).
color(red).
color(green).
color(black).
color(white).
%graph([a-b, b-c, b-d, c-d]).
vertex(a).
vertex(b).
vertex(c).
vertex(d).
%Subject to changing, so are asserted into listener at runtime.
init_dynamic_facts:-
assertz(vertex_color(a, none)),
assertz(vertex_color(b, none)),
assertz(vertex_color(c, none)),
assertz(vertex_color(d, none)),
assertz(location(a)).
edge(a,b).
edge(b,c).
edge(b,d).
edge(c,d).
is_connect(A,B):-
edge(A,B).
is_connect(A,B):-
edge(B,A).
connections(Vertex):-
edge(Vertex,X).
connections(Vertex):-
edge(X,Vertex).
move(Vertex):-
retract(location(_)),
asserta(location(Vertex)).
paint_vertex(Vertex, Color):-
retract(vertex_color(Vertex,_)),
asserta(vertex_color(Vertex, Color)).
find_vertex_color(Vertex):-
vertex_color(Vertex, X).
graph_coloring:-
location(Current_vertex),
vertex_color(Current_vertex, Curr_color),
( Curr_color =:= none ->
connections(Current_vertex, Others),
vertex_color(Others, Other_colors),
paint_vertex(Current_vertex,
How can I complete this algorithm?
(edited: more code under graph_coloring)
I would like to mention this problem is a typical constraint satisfaction problem and can be efficiency solved using the CSP module of SWI-Prolog. Here is the full algorithm:
:- use_module(library(clpfd)).
color(red).
color(blue).
color(green).
vertex(a).
vertex(b).
vertex(c).
vertex(d).
vertex(e).
edge(a,b).
edge(a,c).
edge(b,c).
edge(b,d).
edge(c,d).
colorGraph(ColorList) :-
findall((X, Y), edge(X, Y), Edges),
findall(X, vertex(X), Vertexes),
findall(hasColor(X, _), member(X, Vertexes), ColorList),
createConstraint(Edges,ColorList),
colorNodes(ColorList).
createConstraint([],_).
createConstraint([(V1,V2)|RL],ColorList):-
member(hasColor(V1,C1),ColorList),
member(hasColor(V2,C2),ColorList),
dif(C1,C2),
createConstraint(RL,ColorList).
colorNodes([]).
colorNodes([hasColor(_,C)|Nodes]) :-
color(C),
colorNodes(Nodes).
color/1 indicates the colors available, vertex/1 indicates the vertexes in the graph and edge/2 defines the couples between the vertexes. Moreover, colorGraph(?List) determines the color of the vertexes, where List is a list of hasColor(Vertex, Color) clauses, Vertex being the colored vertex using Color.
Let's details each part of the algorithm above to understand what happens.
:- use_module(library(clpfd)).
It indicates to SWI-Prolog to load the module containing the predicates for constraint satisfaction problems.
colorGraph(ColorList) :-
findall((X, Y), edge(X, Y), Edges),
findall(X, vertex(X), Vertexes),
findall(hasColor(X, _), member(X, Vertexes), ColorList),
createConstraint(Edges,ColorList),
colorNodes(ColorList).
The predicate colorGraph/1 is the entry point of the algorithm. It converts the clauses of edges/vertexes into lists, constraints the ColorList to have the list of vertexes defined and finally create the constraints on the colors and assign the colors (they are two separated operations).
createConstraint([],_).
createConstraint([(V1,V2)|RL],ColorList):-
member(hasColor(V1,C1),ColorList),
member(hasColor(V2,C2),ColorList),
dif(C1,C2),
createConstraint(RL,ColorList).
The predictate createConstraint/2 simply states that two linked vertexes must have a different color. This is worth mentioning dif/2 is a CSP predicate.
colorNodes([]).
colorNodes([hasColor(_,C)|Nodes]) :-
color(C),
colorNodes(Nodes).
The predicate colorNodes/1 assigns the right color to the vertexes. Prolog is going to take care to assign the right colors based on the constraints defined above.
Finally, the results can be found by calling the predicate colorGraph/1, such as:
?- colorGraph(L).
L = [hasColor(a, red), hasColor(b, blue), hasColor(c, green), hasColor(d, red), hasColor(e, red)] ;
L = [hasColor(a, red), hasColor(b, blue), hasColor(c, green), hasColor(d, red), hasColor(e, blue)] ;
L = [hasColor(a, red), hasColor(b, blue), hasColor(c, green), hasColor(d, red), hasColor(e, green)] ;
L = [hasColor(a, red), hasColor(b, green), hasColor(c, blue), hasColor(d, red), hasColor(e, red)] ;
L = [hasColor(a, red), hasColor(b, green), hasColor(c, blue), hasColor(d, red), hasColor(e, blue)] ;
L = [hasColor(a, red), hasColor(b, green), hasColor(c, blue), hasColor(d, red), hasColor(e, green)] ;
L = [hasColor(a, blue), hasColor(b, red), hasColor(c, green), hasColor(d, blue), hasColor(e, red)] ;
L = [hasColor(a, blue), hasColor(b, red), hasColor(c, green), hasColor(d, blue), hasColor(e, blue)] ;
L = [hasColor(a, blue), hasColor(b, red), hasColor(c, green), hasColor(d, blue), hasColor(e, green)] ;
L = [hasColor(a, blue), hasColor(b, green), hasColor(c, red), hasColor(d, blue), hasColor(e, red)] ;
L = [hasColor(a, blue), hasColor(b, green), hasColor(c, red), hasColor(d, blue), hasColor(e, blue)] ;
L = [hasColor(a, blue), hasColor(b, green), hasColor(c, red), hasColor(d, blue), hasColor(e, green)] ;
L = [hasColor(a, green), hasColor(b, red), hasColor(c, blue), hasColor(d, green), hasColor(e, red)] ;
L = [hasColor(a, green), hasColor(b, red), hasColor(c, blue), hasColor(d, green), hasColor(e, blue)] ;
L = [hasColor(a, green), hasColor(b, red), hasColor(c, blue), hasColor(d, green), hasColor(e, green)] ;
L = [hasColor(a, green), hasColor(b, blue), hasColor(c, red), hasColor(d, green), hasColor(e, red)] ;
L = [hasColor(a, green), hasColor(b, blue), hasColor(c, red), hasColor(d, green), hasColor(e, blue)] ;
L = [hasColor(a, green), hasColor(b, blue), hasColor(c, red), hasColor(d, green), hasColor(e, green)] ;
I think you are trying to think in a way that is not natural for Prolog programs; that is, you are trying not to use recursion :) What I've came up with is the following, which however may not be entirely correct (it's late, and I don't have a good reputation when trying to think at times like this...:) )
Let's assume that you have the graph described by the following facts:
edge(a,b).
edge(b,c).
edge(b,d).
edge(c,d).
and that the available colors are
color(blue).
color(red).
color(green).
(you only need 3 colors to color a planar graph, so let's just use 3 here). Let's also assume that you want the answer to be given as a [Vertex-Color] list, where the list will contain a color for every vertex of your graph. I believe the following is a correct solution:
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.
The first clause says that if there is no edge from V to any other vertex, just try all possible colors. The second clause says that vertex V will get color C, and vertex V1 will get color C1 if there is an edge from V to V1, where V != V1 and C != C1. (I also assumed that your graph is connected, i.e. there are no vertices which are not connected to other vertices).
And since we only want solutions where all the vertices have colors, we will only keep lists of length |V|, where V is the set of vertices you have. You can implement this restriction in various ways; I prefer to use "findall/3":
colors(X) :-
coloring(X),
findall(V,edge(V,_),List),
length(List,Len),
length(X,Len).
Now, by consulting this program and asking |?- colors(X). you will get all the possible color assignments for the vertices of your graph.
If anyone finds a problem I am almost sure there exists in the above solution, please, do let us know :)
Spyros
Related
I'm not sure how to even start to write a prolog predicate for a riddle. It gives statements of fact, but nothing more.
To start with, what are some known facts?
fact(north,green,honest).
fact(north,red,lie).
fact(south,green,lie).
fact(south,red,honest).
The question "I'm red or I'm from the South" is possibly a little ambiguous. Is it a boolean algebra OR or an XOR? Should this be "I'm red or I'm from the South, but not both" or should it be "I'm red or I'm from the South, or both"?
Let's tackle "I'm red or I'm from the South, but not both".
Now we can write these two rules pretty easily:
bogg(R,C) :- fact(R,C,honest), R \= south, C = red.
bogg(R,C) :- fact(R,C,honest), R = south, C \= red.
The lie position on this would then be:
bogg(R,C) :- fact(R,C,lie), R = south, C = red.
bogg(R,C) :- fact(R,C,lie), R \= south, C \= red.
If we run that, we get:
?- bogg(R,C).
false.
Clearly, if there is an answer to this problem the statement isn't "I'm red or I'm from the South, but not both".
So let's try "I'm red or I'm from the South, or both":
bogg(R,C) :- fact(R,C,honest), R = south, C = red, !.
bogg(R,C) :- fact(R,C,honest), R = south.
bogg(R,C) :- fact(R,C,honest), C = red.
bogg(R,C) :- fact(R,C,lie), R \= south, C \= red.
Now when I run it I get:
?- bogg(R,C).
R = south,
C = red.
I have a definition of conc:
conc([], L2, L2).
conc([X1|R1], L2, [X1|RN]) :-
conc(R1, L2, RN).
I don't understand why conc([X | green], Y, [red, green, blue]). returns false rather than
X = [red],
Y = [blue]
What is the process of inference here?
Disclaimer: I don't know Prolog. The rest of this answer is an edumacated guess.
Your proposed solution of X = [red] doesn't make sense because that would make X a one-element list. Let's assume
X = red
instead.
That would give us
conc([red | green], [blue], [red, green, blue]).
With the second equation of conc that turns into
conc(R1, L2, RN).
% with:
% X1 = red
% R1 = green
% L2 = [blue]
% [X1|RN] = [red, green, blue]
% i.e. X1 = red
% RN = [green, blue]
I.e.
conc(green, [blue], [green, blue]).
And now we're stuck because none of your conc rules applies to green.
The problem is [X | green] because green is not the tail of a list.
Did you mean [X, green] instead?
In Prolog list notation, the | separates the elements enumerated at its left from a list of the remaining elements at its right. The issue is in your query. Instead of [X | green] you need to write either [X | [green]] or [X,green]. With one of these fixes, you get correct answer. E.g.
?- conc([X | [green]], Y, [red, green, blue]).
X = red,
Y = [blue].
I am trying to instantiate multiple lists in Prolog of elements with only two states, the states being red and blue. Initially, I instantiate a list of elements that are only blue by creating a list of size n:
generate_list(0, []) :- !.
generate_list(N, [H | T]) :-
N2 is N-1,
H = blue,
generate_list(N2, T).
I have also defined a predicate to change the state of colors
flip(blue, red).
flip(red, blue).
I would like to use this predicate to change the color during the instantiation of a new list, however I am stuck on how to approach this problem. The default permutation and combination predicate requires you use separate predefined elements to instantiate the new list, however I have a list of elements already generated.
It's not clear from your question what you mean by "changing" the color "during the instantiation". It would be great if you could update it with a concrete example of what you want.
However, here is something that may or may not go into the direction of what you want:
color(red).
color(blue).
colorlist([]).
colorlist([C|Cs]) :-
color(C),
colorlist(Cs).
The definition of colorlist/2 says that its argument is a list, with elements satisfying color/1. Either color is fine, so any list of any permutation of elements from red and blue is a solution. We can use this already to check color lists:
?- colorlist([red, blue, blue]).
true.
And also to try to enumerate them, although the enumeration is not fair, i.e., some things that are solutions (in this case, any list containing blue) will never be generated:
?- colorlist(Cs).
Cs = [] ;
Cs = [red] ;
Cs = [red, red] ;
Cs = [red, red, red] ;
Cs = [red, red, red, red] ;
Cs = [red, red, red, red, red] . % etc.
To solve the fairness problem, we can enumerate by length: First all the length-0 lists, then all the length-1 lists, all the length-2 ones, etc. If we expose the length as a parameter, we get something that at least has the same interface as the predicate you are trying to write:
length_colorlist(N, Cs) :-
length(Cs, N),
colorlist(Cs).
This can enumerate solutions fairly and generally:
?- length_colorlist(N, Cs).
N = 0,
Cs = [] ;
N = 1,
Cs = [red] ;
N = 1,
Cs = [blue] ;
N = 2,
Cs = [red, red] ;
N = 2,
Cs = [red, blue] ;
N = 2,
Cs = [blue, red] .
And also answer more specific queries restricted by length:
?- length_colorlist(8, Cs).
Cs = [red, red, red, red, red, red, red, red] ;
Cs = [red, red, red, red, red, red, red, blue] ;
Cs = [red, red, red, red, red, red, blue, red] ;
Cs = [red, red, red, red, red, red, blue, blue] ;
Cs = [red, red, red, red, red, blue, red, red] ;
Cs = [red, red, red, red, red, blue, red, blue] ;
Cs = [red, red, red, red, red, blue, blue, red] ;
Cs = [red, red, red, red, red, blue, blue, blue] ;
Cs = [red, red, red, red, blue, red, red, red] ;
Cs = [red, red, red, red, blue, red, red, blue] .
Note: No cuts needed, and the final definition is built up as a simple composition of more generic, individually useful parts. When stuck on a problem, especially in Prolog, always try to solve individual subparts first. In this case, "how do I define lists (of any length) containing colors?" and "how do I generate lists of specific lengths?" are two distinct subproblems that are best solved separately.
EDIT 2:
I solved it using list in list. Thanks for help.
I try to make Mastermind in Prolog. I have a function
guess(Colors, Size, Possibilities, Answer, Black, White)
which takes count of used colors, size of game field, list of colors and user evaluation of answer. It may looks like:
guess(4, 6, P, [red, red, blue, green, green, yellow], 2, 3)
which means there are 4 colors, 6 places for pegs and the guess
[red, red, blue, green, green, yellow] gets 2 black pegs and 3 white.
When I call this these functions directly like
guess(4, 6, O, [red, red, blue, green, green, yellow], 2, 3),
guess(4, 6, O, [red, yellow, green, blue, red, blue], 0, 4),
guess(4, 6, O, [green, blue, yellow, red, green, yellow], 4, 2),
guess(4, 6, O, [yellow, blue, red, yellow, green, yellow], 5, 0).
it gives me correct answer O = [green, blue, red, yellow, green, yellow]
Now I try to make it more interactive, so I created functions
play:-
write('Size: '), read(Size), nl,
write('Colors: '), read(Colors), nl,
createFirstGuess(Size, Colors, [], A), //initial guess
run(Colors, Size, _, A).
run(Colors, Size, P, A) :-
tryGuess(Colors, Size, J, A), //Possibilities in J
copy(J, X), //First possible result J -> X
J = P, //Unification of all results
run(Colors, Size, J, X). //loop
tryGuess(_, _, _, []) :- !.
tryGuess(Colors, Size, P, A) :-
write('Evaluation of: '), write(A), nl,
write('Black pegs: '), read(B), nl,
write('White pegs: '), read(W), nl,
guess(Colors, Size, P, A, B, W).
copy([],[]) :- !. //Copy list T1 to T2
copy([H|T1],[H|T2]) :- !, copy(T1,T2).
createFirstGuess(0, _, L, L) :- !. //Initial guess (just field of the same colors)
createFirstGuess(N, Colors, R, L) :-
N > 0, N1 is N - 1, color(Colors, H), createFirstGuess(N1, Colors, [H|R], L).
I run 'play', set size and count of colors a start play.
Evaluation of: [red, red, red, red, red, red] //Initial guess
Black pegs: 1.
White pegs: 0.
Evaluation of: [red, green, green, green, green, green] //OK
Black pegs: 1.
White pegs: 2.
Evaluation of: [red, green, green, green, green, blue] //Bad, it goes through the list one-by-one
Black pegs: 1.
White pegs: 2.
Evaluation of: [red, green, green, green, green, yellow] //Bad
Black pegs: 2.
White pegs: 2.
Evaluation of: [red, green, green, green, blue, green] //Bad
Black pegs: 0.
White pegs: 4.
It seems the first two answers are good (one is initial, second is computed), but the next one just goes through all possibilities one-by-one. I think there is a problem with backtracking, so there should be some cuts (!), but I am unable to find where to put them.
Thanks for any help.
EDIT:
Thank you for help.
I would like to get output like this:
Evaluation of: [red, red, red, red, red, red] //Initial guess
Black pegs: 1.
White pegs: 0.
Evaluation of: [red, green, green, green, green, green]
Black pegs: 1.
White pegs: 2.
Evaluation of: [green, red, blue, yellow, green, blue]
Black pegs: 3.
White pegs: 2.
Evaluation of: [green, blue, yellow, yellow, green, red]
Black pegs: 4.
White pegs: 2.
Evaluation of: [green, blue, red, yellow, green, yellow]
Black pegs: 6.
White pegs: 0.
End of Game
But, in my case prolog goes through the list of all possibilities one-by-one but when I use guess (as shown above) it works great. There must be a problem with unification and backtracking. At first I use initial list and get correct possible results. Then I take first of results and let player to evaluate it. This first result with player evaluation I use for next guess, but there is a problem. As I see, because of backtracking is this result (answer) reunified, so player must go through the list one-by-one, no matter the evaluation.
I think, it should work, if the answer, evaluated by player, won't be reunified, but I cannot find a way to do so.
OK, I finally solved it using lists in lists for saving Answers and evaluations. Then I just expand those lists and use it for building more precise solution.
this is simple yet cannot seem to grasp it
I have these "colors"
color(blue).
color(red).
color(white).
using setof I need to get all possible combinations of these colors in a list
It would be great if you can provide a brief explanation. I tried this query
setof(X,color(X),Colors). which failed obviously
Thanks
I suppose you meant this with combinations:
?- setof((X,Y), (color(X), color(Y)), ColorsCombined).
ColorsCombined = [ (blue, blue), (blue, green), (blue, red), (green, blue), (green, green), (green, red), (red, blue), (red, green), (..., ...)].
Or did you mean the superset?
subset([Element|Set], [Element|Subset]):- subset(Set, Subset).
subset([_|Set], Subset):- subset(Set, Subset).
subset([], []).
superset(Set, Superset) :- setof(Subset, subset(Set, Subset), Superset).
This is the output:
?- superset([1,2,3], Superset).
Superset = [[], [1], [1, 2], [1, 2, 3], [1, 3], [2], [2, 3], [3]].
You mean like this ?
all_permutations(Permutations) :-
% get all colors into a list
setof(Color, color(Color), One_Color_List),
% find all combinations using permutation/2 on One_Color_List
setof(Permutation,
permutation(One_Color_List, Permutation),
Permutations).
Results:
?- all_permutations(X).
X = [[blue, red, white], [blue, white, red], [red, blue, white], [red, white, blue], [white, blue, red], [white, red, blue]].
The trick is to get the facts into a list - as you did, then use permutation/2 to generate all permutations of that list.
If that's what you wanted.. wasn't clear...