Related
Can anyone help me with the following task: I need to define a predicate eq_set, which succeeds if the sets S1 and S2 are equal when it comes to the number of their elements.
But it works only if they are exactly the same number and order. I want to create a code that shows all varieties and doesn't take order into account. Can you help me,please?
I wrote:
eq_set([],[]).
eq_set([H|T],[H|T1]) :-
eq_set(T,T1).
But it works only if they are exactly the same number and order. I want to create a code that shows all varieties and doesn't take order into account.
The closest translation I have of the assignment, which is in Bulgarian, is: "Define the predicate eq_set, which succeeds if the sets (S1, S2) coincide.
You call them "sets" but the data structure you are using is a list. It is easiest to just sort the two lists:
eq_set(A, B) :-
% prerequisites: A and B are lists without duplicates
sort(A, S),
sort(B, S).
If you want something more complicated (for some reason) you need to be more specific.
With this definition:
?- eq_set([a,b,c], [a,b]).
false. % OK
?- eq_set([a,b,c], [a,b,c]).
true. % OK
?- eq_set([a,c,b], [a,b,c]).
true. % OK
?- eq_set([a,a,b], [a,b,b]).
true. % Not sure....
It really really depends on how the predicate is going to be used.
Assuming that a "set" is indeed a Prolog list without duplicates but not in any particular order; then two sets in that presentation "coincide" if they are permutations of each other. In other words, it would be enough to define eq_set/2 as:
eq_set(A, B) :-
my_permutation(A, B).
and just use the textbook definition of permutation/2 which uses the textbook definition of select/3 (See "The Art of Prolog (Second Edition)" by Sterling and Shapiro, pp 67-9):
my_permutation([], []).
my_permutation(Xs, [Y|Ys]) :-
my_select(Y, Xs, Xs0),
my_permutation(Xs0, Ys).
my_select(X, [X|Xs], Xs).
my_select(X, [Y|Ys], [Y|Zs]) :-
my_select(X, Ys, Zs).
(I renamed those just to make sure I am not using the standard library definitions; SWI-Prolog has both select/3 and permutation/2 in the autoloaded library(lists); the definitions are basically the same, but they do some run-time type-checking on the arguments.)
Here is how you can use it:
?- eq_set([1,2,3], [2,3,1]).
true ;
false.
?- eq_set([1,2,3], S).
S = [1, 2, 3] ;
S = [1, 3, 2] ;
S = [2, 1, 3] ;
S = [2, 3, 1] ;
S = [3, 1, 2] ;
S = [3, 2, 1] ;
false.
?- eq_set([1,2,3], [1,2]).
false.
?- eq_set(A, B).
A = B, B = [] ;
A = B, B = [_4480] ;
A = B, B = [_4480, _4492] ;
...
I am not sure how useful the last query is. You can force it to enumerate solutions in order of increasing size of the "set", like this:
?- length(S1, _), eq_set(S1, S2), numbervars(S1).
S1 = S2, S2 = [] ;
S1 = S2, S2 = [A] ;
S1 = S2, S2 = [A, B] ;
S1 = [A, B],
S2 = [B, A] ;
S1 = S2, S2 = [A, B, C] ;
S1 = [A, B, C],
S2 = [A, C, B] ;
S1 = [A, B, C],
S2 = [B, A, C] ;
S1 = [A, B, C],
S2 = [B, C, A] ;
S1 = [A, B, C],
S2 = [C, A, B] ;
S1 = [A, B, C],
S2 = [C, B, A] ;
S1 = S2, S2 = [A, B, C, D] .
(Don't worry about the numbervars, it is just there to give readable names to all the free variables in the sets. Keep in mind that unifying two free variables makes them the same variable.)
This is a starting point, but maybe it is already good enough. The most glaring omission is that it doesn't require the arguments to be lists without duplicates. One way to define this would be to require that each element is different from all other elements. Since "is different" is commutative, you can define it like this:
is_set([]).
is_set([X|Xs]) :-
all_different(Xs, X),
is_set(Xs).
all_different([], _).
all_different([Y|Ys], X) :-
dif(X, Y),
all_different(Ys, X).
This uses dif/2 which is a widely available predicate (but does your Prolog have it?).
We would have maybe used maplist for that last one:
is_set([]).
is_set([X|Xs]) :-
maplist(dif(X), Xs).
is_set(Xs).
You are pretty close in your solution.
We have two cases
1) The first list argument is bigger
2) The second list argument is bigger
If you already know which one is bigger, you can just do
%in case the left one is longer
eq_set_left(_,[]).
eq_set_left(X,[H|T]):-member(H,X), eq_set_left(X,T).
So a very simple solution and yet very optimal could be this:
%in case the right one is longer
eq_set_right([],_).
eq_set_right([H|T], X):- member(H,X), eq_set_right(T,X).
%in case the left one is longer
eq_set_left(_,[]).
eq_set_left(X,[H|T]):-member(H,X), eq_set_left(X,T).
%both cases, equal length is also included here
eq_set(X,Y):- eq_set_left(X,Y).
eq_set(X,Y):- eq_set_right(X,Y).
eq_set(X, Y) is true if either X is subset of Y, Y is subset of X or they are equal
A set is defined as a collection of distinct things where order is not important, which is to say that sets {a,b,c} and {b,a,c} are identical.
From that, one could say that two sets are identical if neither set contains an element that is not also found in the other (or conversely, two sets are not identical if either set contains an element not found in the other.
From that, one could simply say:
eq_set(Xs,Ys) :-
findall( (Xs,Ys) , ( member(X,Xs), \+ member(X,Ys) ), [] ),
findall( (Xs,Ys) , ( member(Y,Ys), \+ member(Y,Xs) ), [] )
.
Or if you don't want to use the built-in findall/3,
eq_set(Xs,Ys) :-
a_not_in_b( Xs , Ys , [] ) ,
a_not_in_b( Ys , Xs , [] ) .
a_not_in_b( [] , [] , [] ) .
a_not_in_b( [A|As] , Bs , Xs ) :- member(A,Bs) , a_not_in_b( As, Bs, Xs ) .
a_not_in_b( [A|As] , Bs , Xs ) :- a_not_in_b( As, Bs, [A|Xs] ) .
One should note that both of these has roughly O(N2) performance. If the sets in question are large, you might want to first sort each set and then merge the two sorted lists to identify those elements that are not common to both sets:
eq_set(Xs,Ys) :-
sort(Xs,X1),
sort(Ys,Y1),
X1 == Y1.
I'm new to constraint-programming (coming from c#) and I'm trying to solve this problem. Unfortunately I don't have a name for this kind of puzzle so I'm not sure what to search for. The closest examples I can find are Nonogram and Tomography puzzles.
Puzzle description:
The player is given an empty game board (varying size) that they must fill with n-colors, using clue patterns for the rows and columns. Each clue pattern is the sequence of colors in that row/col but with consecutive duplicates removed.
Here is an example easy small 4x4 grid with 3 colors:
rbg,rbr,grb,bgbg <- (top-to-bottom column constraints)
_,_,_,_ rgb <- (row constraints)
_,_,_,_ brg
_,_,_,_ b
_,_,_,_ grbg
Solutions (2):
r,r,g,b
b,?,r,g
b,b,b,b
g,r,b,g
? Can be either red or blue but not green.
Pattern examples below.
Examples given 6-length sequences to pattern:
aaaaaa -> a
aabbcc -> abc
abbbbc -> abc
cabbbc -> cabc
bbbaac -> bac
abbaab -> abab
abcabc -> abcabc
Examples given pattern to potential solution sequences:
abc -> abc (3 length solution)
abc -> abcc, abbc, aabc (4 length solutions)
abc -> abccc, abbcc, abbbc, aabbc, aaabc (5 length solutions)
I've tried to solve it in C# or-tools and MiniZinc but the biggest problem I have is building the constraints. I can generate the patterns from a sequence (in c# imperative way) but then how to turn that into a constraint?
How I'm thinking about it: generate all potential sequences from each clue pattern. Then make a constraint for the corresponding row/col that says it must be one of those sequences.
Example from top row in above puzzle: rgb to [4-length sequences] -> rgbb, rggb, rrgb, and then add a constraint for that row: must equal one of these sequences.
Am I thinking about this right? Any smarter ways to do it?
Thanks for any advice.
=====================================
Edit after some progress:
This MiniZinc correctly solves the top row for the pattern abc which has 3 solutions of 4 length: aabc, abbc, abcc.
include "globals.mzn";
array [1..4, 1..4] of var 1..3: colors;
constraint regular(row(colors, 1), 4, 3,
[|
% a, b, c
2,0,0| % accept 'a'
2,3,0| % accept 'a' or 'b' ?
0,3,4| % accept 'b' or 'c' ?
0,0,4| % accept 'c'
|], 1, {4});
% Don't care about rest of grid for now.
constraint forall(i,j in 1..4 where i > 1) (row(colors, i)[j] = 1);
solve satisfy;
output [show(colors)];
However I'm not sure how to handle larger grids with many patterns other than hardcoding everything like this. I will experiment a bit more.
The constraints you are talking about seem to be easily represented as regular expressions. For example your abc example with varying length can be caught using the regular expression abc.*, which requires one a then one b, and then one c, it will accept anything else afterwards.
In MiniZinc these kinds of constraints are expressed using the regular predicate. The regular predicate simulates an automaton with accepting states. By providing the allowed state-transitions the model is constraint.
The example expression abc.* would be enforced by the following constraint item:
% variables considered, nr states, input values
constraint regular(VARS, 4, 1..3, [|
% a, b, c
2,0,0| % accept 'a'
0,3,0| % accept 'b'
0,0,4| % accept 'c'
4,4,4| % accept all
|], 1, {4}); % initial state, accepting states
In Prolog(language), I use DCG form to describe such problems. It is extended BNF form.
So I suggest finding approach with Extended BNF Form in your environment.
SWI-Prolog example:
color_chunk_list(Encoded,Decoded):-
phrase(chunk_list(Encoded),Decoded),
chk_continuity(Encoded).
chunk_list([])-->[].
chunk_list([First|Rest])-->colorrow(First),chunk_list(Rest).
colorrow(Color)-->[Color],colorrow(Color).
colorrow(Color)-->[Color].
chk_continuity([First,Second|Rest]):-First \= Second,chk_continuity([Second|Rest]).
chk_continuity([_]).
In this program, encodings and decodings are bidirectional.
Tests:
?- length(L,4),color_chunk_list([r,g],L).
L = [r, r, r, g] ;
L = [r, r, g, g] ;
L = [r, g, g, g] ;
false.
?- length(L,6),color_chunk_list([a,b,c],L).
L = [a, a, a, a, b, c] ;
L = [a, a, a, b, b, c] ;
L = [a, a, a, b, c, c] ;
L = [a, a, b, b, b, c] ;
L = [a, a, b, b, c, c] ;
L = [a, a, b, c, c, c] ;
L = [a, b, b, b, b, c] ;
L = [a, b, b, b, c, c] ;
L = [a, b, b, c, c, c] ;
L = [a, b, c, c, c, c] ;
false.
?- color_chunk_list(L,[a,a,b,b,c,c]).
L = [a, b, c] ;
false.
?- color_chunk_list(L,[b,r,b,r,r,g,g,b]).
L = [b, r, b, r, g, b] ;
false.
In ECLiPSe, which is prolog based CLP system (not IDE one),
above predicate(color_chunk_list) can be turned into clp constraint
with propia mechanism and can genarate clp propagation.
I'm working on Problem 26 from 99 Prolog Problems:
P26 (**) Generate the combinations of K distinct objects chosen from
the N elements of a list
Example:
?- combination(3,[a,b,c,d,e,f],L).
L = [a,b,c] ;
L = [a,b,d] ;
L = [a,b,e] ;
So my program is:
:- use_module(library(clpfd)).
combination(0, _, []).
combination(Tot, List, [H|T]) :-
length(List, Length), Tot in 1..Length,
append(Prefix, [H], Stem),
append(Stem, Suffix, List),
append(Prefix, Suffix, SubList),
SubTot #= Tot-1,
combination(SubTot, SubList, T).
My query result starts fine but then returns a Global out of stack error:
?- combination(3,[a,b,c,d,e,f],L).
L = [a, b, c] ;
L = [a, b, d] ;
L = [a, b, e] ;
L = [a, b, f] ;
Out of global stack
I can't understand why it works at first, but then hangs until it gives Out of global stack error. Happens on both SWISH and swi-prolog in the terminal.
if you try to input, at the console prompt, this line of your code, and ask for backtracking:
?- append(Prefix, [H], Stem).
Prefix = [],
Stem = [H] ;
Prefix = [_6442],
Stem = [_6442, H] ;
Prefix = [_6442, _6454],
Stem = [_6442, _6454, H] ;
...
maybe you have a clue about the (main) problem. All 3 vars are free, then Prolog keeps on generating longer and longer lists on backtracking. As Boris already suggested, you should keep your program far simpler... for instance
combination(0, _, []).
combination(Tot, List, [H|T]) :-
Tot #> 0,
select(H, List, SubList),
SubTot #= Tot-1,
combination(SubTot, SubList, T).
that yields
?- aggregate(count,L^combination(3,[a,b,c,d,e],L),N).
N = 60.
IMHO, library(clpfd) isn't going to make your life simpler while you're moving your first steps into Prolog. Modelling and debugging plain Prolog is already difficult with the basic constructs available, and CLP(FD) is an advanced feature...
I can't understand why it works at first, but then hangs until it gives Out of global stack error.
The answers Prolog produces for a specific query are shown incrementally. That is, the actual answers are produced lazily on demand. First, there were some answers you expected, then a loop was encountered. To be sure that a query terminates completely you have to go through all of them, hitting SPACE/or ; all the time. But there is a simpler way:
Simply add false at the end of your query. Now, all the answers are suppressed:
?- combination(3,[a,b,c,d,e,f],L), false.
ERROR: Out of global stack
By adding further false goals into your program, you can localize the actual culprit. See below all my attempts: I started with the first attempt, and then added further false until I found a terminating fragment (failure-slice).
combination(0, _, []) :- false. % 1st
combination(Tot, List, [H|T]) :-
length(List, Length), Tot in 1..Length, % 4th terminating
append(Prefix, [H], Stem), false, % 3rd loops
append(Stem, Suffix, List), false, % 2nd loops
append(Prefix, Suffix, SubList),
SubTot #= Tot-1, false, % 1st loops
combination(SubTot, SubList, T).
To remove the problem with non-termination you have to modify something in the remaining visible part. Evidently, both Prefix and Stem occur here for the first time.
The use of library(clpfd) in this case is very suspicious. After length(List, Length), Length is definitely bound to a non-negative integer, so why the constraint? And your Tot in 1..Length is weird, too, since you keep on making a new constrained variable in every step of the recursion, and you try to unify it with 0. I am not sure I understand your logic overall :-(
If I understand what the exercise is asking for, I would suggest the following somewhat simpler approach. First, make sure your K is not larger than the total number of elements. Then, just pick one element at a time until you have enough. It could go something like this:
k_comb(K, L, C) :-
length(L, N),
length(C, K),
K =< N,
k_comb_1(C, L).
k_comb_1([], _).
k_comb_1([X|Xs], L) :-
select(X, L, L0),
k_comb_1(Xs, L0).
The important message here is that it is the list itself that defines the recursion, and you really don't need a counter, let alone one with constraints on it.
select/3 is a textbook predicate, I guess you should find it in standard libraries too; anyway, see here for an implementation.
This does the following:
?- k_comb(2, [a,b,c], C).
C = [a, b] ;
C = [a, c] ;
C = [b, a] ;
C = [b, c] ;
C = [c, a] ;
C = [c, b] ;
false.
And with your example:
?- k_comb(3, [a,b,c,d,e,f], C).
C = [a, b, c] ;
C = [a, b, d] ;
C = [a, b, e] ;
C = [a, b, f] ;
C = [a, c, b] ;
C = [a, c, d] ;
C = [a, c, e] ;
C = [a, c, f] ;
C = [a, d, b] ;
C = [a, d, c] ;
C = [a, d, e] ;
C = [a, d, f] ;
C = [a, e, b] ;
C = [a, e, c] . % and so on
Note that this does not check that the elements of the list in the second argument are indeed unique; it just takes elements from distinct positions.
This solution still has problems with termination but I don't know if this is relevant for you.
I'm working on my homework for Prolog (SWI) but can't figure out how to get this done:
I have the functor:
palindrome([]).
palindrome([_]).
palindrome([A|T]) :-
append(Middle,[A],T),
palindrome(Middle).
which tells if a given list is a palindrome.
For my homework I have to write a functor palindrome/2 without append/3 and with difference lists.
I know a difference list is a form of [Y|X]-X, but I don't understand how to use this and how this can replace the append functor.
Can somebody please explain this to me?
For a given list of length n, your solution needs some O(n2) inferences: n (actually n/2) for palindrome/1 and i for each append/3 which simply searches and compares the end.
The most straight forward way to reformulate your definition uses grammars (DCGs) that are a convenient way to use difference-lists. Note that each grammar rule corresponds to a clause in your program.
palindrome -->
[].
palindrome -->
[_].
palindrome -->
[A],
palindrome,
[A].
palindrome(T) :-
phrase(palindrome,T).
For convenience, here is the same grammar written more compactly:
palindrome --> [] | [_] | [A], palindrome, [A].
Now, how are these grammar rules implemented? The easiest way is to look at the actual definition with listing(palindrome).
?- listing(palindrome).
palindrome(A, A).
palindrome([_|A], A).
palindrome([C|A], D) :-
palindrome(A, B),
B=[C|D].
So this is now your definition using difference-lists.
Just write it down yourself. You have
palindrome([]). % palindrome(Z-Z).
palindrome([_]). % palindrome([_|Z]-Z).
palindrome([A|T]) :- % palindrome([A|T]-Z):-
append(Middle,[A],T), % append(Middle-Z2,[A|Z3]-Z3,T-Z),
palindrome(Middle). % palindrome(Middle-Z2).
Append for dif-lists is append(A-B,B-C,A-C), so the append call gives us Z2=[A|Z3], Z3=Z, Middle=T, and so (writing out the two halves of a dif-list as two arguments for the predicate),
palindrome(Z,Z).
palindrome([_|Z],Z).
palindrome([A|T],Z) :-
palindrome(T, [A|Z]).
Now you can run it
10 ?- palindrome(X,[]).
X = [] ;
X = [_G340] ;
X = [_G340, _G340] ;
X = [_G340, _G346, _G340] ;
X = [_G340, _G346, _G346, _G340] ;
....
11 ?- X=[a,b,c|_],palindrome(X,[z]).
X = [a, b, c, b, a, z] ;
X = [a, b, c, c, b, a, z] ;
X = [a, b, c, _G460, c, b, a, z] ;
X = [a, b, c, _G460, _G460, c, b, a, z] ;
....
16 ?- palindrome([1,2,2,1,0],Z).
Z = [1, 2, 2, 1, 0] ;
Z = [2, 2, 1, 0] ;
Z = [0] ;
No
Of course, DCG rules provide a comfortable interface to difference-lists.
I have a simple grammar such as
S::=a S b
S::=[] (empty string)
Now i want to write a parser for the above grammar like
cfg('S', [a,'S',b])
which generates a sentence aaabbb by left most derivation.
I'm not good enough to handle dcg/cfg in prolog.
So pls help me with this example so that i can go ahead and try something bigger.
Consider this DCG code:
s-->[].
s-->[a],s,[b].
to run a predicate you defined by DCG you should add two more arguments at the end: the "input" and what it's left. If you want to recognize the whole list you simply put []. So, when you run it you get:
38 ?- s(C,[]).
C = [] ;
C = [a, b] ;
C = [a, a, b, b] ;
C = [a, a, a, b, b, b] ;
C = [a, a, a, a, b, b, b, b] ;
...
If you wanted some sort of "return" string you could add it as an extra arg. To write prolog code in a dcg clause you use {}:
s('')-->[].
s(S)-->
[a],s(SI),[b],
{ atomic_list_concat([a,SI,b],S)}.
and you get:
40 ?- s(R,X,[]).
R = '',
X = [] ;
R = ab,
X = [a, b] ;
R = aabb,
X = [a, a, b, b] ;
R = aaabbb,
X = [a, a, a, b, b, b] ;
R = aaaabbbb,
X = [a, a, a, a, b, b, b, b] ;
R = aaaaabbbbb,
...
we generated all the strings that are recognized by this grammar; usually you just want to check if a string is recognized by the grammar. to do that you simply put it as input:
41 ?- s([a,b],[]).
true
42 ?- s([a,b,b],[]).
false.
note that we put the S::=[] rule first otherwise prolog would fall in a infinite loop if you asked to generate all the solutions. This problem might not be trivial to solve in more complex grammars. To get the solutions you can use length/2:
?- length(X,_),s(X,[]).
X = [] ;
X = [a, b] ;
X = [a, a, b, b] ;
X = [a, a, a, b, b, b] ;
X = [a, a, a, a, b, b, b, b]
even if your code is:
s-->[].
s-->[a],s,[b].