Prolog Permutation Colors Right Amount of Combination Error

Question

I'm having problem of printing the right amount of solutions for this puzzle program. It prints the correct puzzle, but not the right amount of solutions needed.

Here's what each situation does:

Puzzle 1 - You have five colors: 2 blue, 2 green and 1 yellow No same color may be adjacent to one another.

Puzzle 2 - You have six colors: 1 red, 1 blue and 4 blacks There are no more than 2 black in a row.

Puzzle 3 -

You have eight colors: 3 greens, 2 whites, 2 reds and 1 black. The whites are never in A nor H. There are same colors for both position D and H. The colors in both A and G must be different colors. The reds are never in F nor G. The greens are never in B nor C. On the left of every red, there's a green.

% a program that find solutions for each of the following colored ball problems with  different sets of constraints.

% to run, type either
% sit1, sit2 or sit3.

% select an element for use in permutation test
%
% If the element is the head of the list, then it is in the list, and the tail is left
selectE(Element, [Element|Tail], Tail).        
% If the two lists have the same head, check for more elements in the rest of the lists
selectE(Element, [Head|Tail1], [Head|Tail2]) :-
        selectE(Element, Tail1, Tail2).

% generate permutations
%
% The empty list is a permutation of itself
permutationQ([],[]).
% List1 is a permutation of List2 if each element occurs in both lists 
%    the same number of times
permutationQ(List, [Head|Tail]) :- selectE(Head, List, Rest),
                                  permutationQ(Rest, Tail).
%

% There are 5 colors - 2 blues, 2 greens, 1 yellow
% 
sit1 :- permutationQ([green,green,blue,blue,yellow],[A,B,C,D,E]),
    \+ A=B, \+ B=C, \+ C=D, \+ D=E,    
    printout([A,B,C,D,E]).   % print any solution you find

% print solutions of sit1
printout([A,B,C,D,E]) :-
    nl,
    write('The order of colors from top to bottom is: '), nl,
    write(A),nl,
        write(B),nl,
        write(C),nl,
    write(D),nl,
    write(E),nl.

% There are 6 colors - 1 red, 1 blue, 4 blacks,
% 
sit2 :- permutationQ([black,black,black,black,red,blue],[A,B,C,D,E,F]),  
    ((A==red -> D==blue);
         (A==blue -> D==red);
         (B==red -> E==blue);  
         (B==blue -> E==red); 
         (C==red -> F==blue);   
         (C==blue -> F==red); 
         (D==red -> C==blue);   
         (D==blue -> C==red)),
    printout2([A,B,C,D,E,F]).   % print any solution you find

% print solutions of sit2
printout2([A,B,C,D,E,F]) :-
    nl,
    write('The order of colors from top to bottom is: '), nl,
    write(A),nl,
        write(B),nl,
        write(C),nl,
    write(D),nl,
    write(E),nl,
    write(F),nl.

% There are 8 colors - 3 greens, 2 whites, 2 reds, 1 black 
sit3 :- permutationQ([black,white,white,red,red,green,green,green],[A,B,C,D,E,F,G,H]),
    % The colors in B and C are not green. 
    \+ B=green, 
    \+ C=green, 
    % The colors in E and F are not green because the colors in F and G are not red. 
    \+ E=green,
    \+ F=green,
    % Since red can't be in H, green can't be in G.
    \+ G=green,
    % The colors in D and H are the same color. 
    D=H, 
    % The colors in A and G are of different colors. 
    \+ A=G, 
    % The color in F and G are not red. 
    \+ F=red, 
    \+ G=red, 
    % Red can't be in A because there isn't any other position on the left for the green.
    \+ A=red,
    % The colors in C and D are not red because the colors in B and C are not green. 
    \+ C=red,
    \+ D=red,
    % Whites are neither A nor H. 
    \+ A=white, 
    \+ H=white,
        % White is not on D because white can't be on H.
    \+ D=white, 
    printout3([A,B,C,D,E,F,G,H]).   % print any solution you find

% print solutions of sit3
printout3([A,B,C,D,E,F,G,H]) :-
    nl,
    write('The order of colors from top to bottom is: '), nl,
    write(A),nl,
        write(B),nl,
        write(C),nl,
    write(D),nl,
    write(E),nl,
    write(F),nl,
    write(G),nl,
    write(H),nl.

What do you mean, "not the right amount of solutions needed"? Too many (repeats)? Too few (missing some)? If it's repeated solutions, then it's due to the fact that your permutations aren't unique (due to non-unique elements in the list being permuted). — lurker

false false · Accepted Answer · 2014-04-21T03:54:14

The source of your redundancies lies in the way how you use permutationQ/2. To see this, consider the goal

| ?- permutationQ([red,red],P).
P = [red,red] ? ;
P = [red,red] ? ;
no

You are expecting one answer/solution, but you will get one solution and one redundant solution. The reason behind is that permutationQ/2 just describes all possible permutations, regardless of their actual content. To see this:

| ?- permutationQ([X,Y],P).
P = [X,Y] ? ;
P = [Y,X] ? ;
no

The cheapest way to solve this problem is to wrap a setof(t, Goal, _) around each permutationQ/1 goal, thereby eliminating redundant solutions:

| ?- setof(t,permutationQ([red,red],P),_).
P = [red,red] ? ;
no

Generally speaking, consider to use (=)/2 and dif/2 in place of (==)/2 and (\+)/2. Also, combinatorial problems are most aptly solved with clpfd.

Prolog Permutation Colors Right Amount of Combination Error

1 Answers