How to implement a not_all_equal/1 predicate - list

How would one implement a not_all_equal/1 predicate, which succeeds if the given list contains at least 2 different elements and fails otherwise?
Here is my attempt (a not very pure one):
not_all_equal(L) :-
( member(H1, L), member(H2, L), H1 \= H2 -> true
; list_to_set(L, S),
not_all_equal_(S)
).
not_all_equal_([H|T]) :-
( member(H1, T), dif(H, H1)
; not_all_equal_(T)
).
This however does not always have the best behaviour:
?- not_all_equal([A,B,C]), A = a, B = b.
A = a,
B = b ;
A = a,
B = b,
dif(a, C) ;
A = a,
B = b,
dif(b, C) ;
false.
In this example, only the first answer should come out, the two other ones are superfluous.

Here is a partial implementation using library(reif) for SICStus|SWI. It's certainly correct, as it produces an error when it is unable to proceed. But it lacks the generality we'd like to have.
not_all_equalp([A,B]) :-
dif(A,B).
not_all_equalp([A,B,C]) :-
if_(( dif(A,B) ; dif(A,C) ; dif(B,C) ), true, false ).
not_all_equalp([A,B,C,D]) :-
if_(( dif(A,B) ; dif(A,C) ; dif(A,D) ; dif(B,C) ; dif(B,D) ), true, false ).
not_all_equalp([_,_,_,_,_|_]) :-
throw(error(representation_error(reified_disjunction),'C\'est trop !')).
?- not_all_equalp(L).
L = [_A,_B], dif(_A,_B)
; L = [_A,_A,_B], dif(_A,_B)
; L = [_A,_B,_C], dif(_A,_B)
; L = [_A,_A,_A,_B], dif(_A,_B)
; L = [_A,_A,_B,_C], dif(_A,_B)
; L = [_A,_B,_C,_D], dif(_A,_B)
; error(representation_error(reified_disjunction),'C\'est trop !').
?- not_all_equalp([A,B,C]), A = a, B = b.
A = a, B = b
; false.
Edit: Now I realize that I do not need to add that many dif/2 goals at all! It suffices that one variable is different to the first one! No need for mutual exclusivity! I still feel a bit insecure to remove the dif(B,C) goals ...
not_all_equalp([A,B]) :-
dif(A,B).
not_all_equalp([A,B,C]) :-
if_(( dif(A,B) ; dif(A,C) ), true, false ).
not_all_equalp([A,B,C,D]) :-
if_(( dif(A,B) ; dif(A,C) ; dif(A,D) ), true, false ).
not_all_equalp([_,_,_,_,_|_]) :-
throw(error(representation_error(reified_disjunction),'C\'est trop !')).
The answers are exactly the same... what is happening here, me thinks. Is this version weaker, that is less consistent?

Here's a straightforward way you can do it and preserve logical-purity!
not_all_equal([E|Es]) :-
some_dif(Es, E).
some_dif([X|Xs], E) :-
( dif(X, E)
; X = E, some_dif(Xs, E)
).
Here are some sample queries using SWI-Prolog 7.7.2.
First, the most general query:
?- not_all_equal(Es).
dif(_A,_B), Es = [_A,_B|_C]
; dif(_A,_B), Es = [_A,_A,_B|_C]
; dif(_A,_B), Es = [_A,_A,_A,_B|_C]
; dif(_A,_B), Es = [_A,_A,_A,_A,_B|_C]
; dif(_A,_B), Es = [_A,_A,_A,_A,_A,_B|_C]
...
Next, the query the OP gave in the question:
?- not_all_equal([A,B,C]), A=a, B=b.
A = a, B = b
; false. % <- the toplevel hints at non-determinism
Last, let's put the subgoal A=a, B=b upfront:
?- A=a, B=b, not_all_equal([A,B,C]).
A = a, B = b
; false. % <- (non-deterministic, like above)
Good, but ideally the last query should have succeeded deterministically!
Enter library(reif)
First argument indexing
takes the principal functor of the first predicate argument (plus a few simple built-in tests) into account to improve the determinism of sufficiently instantiated goals.
This, by itself, does not cover dif/2 satisfactorily.
What can we do? Work with
reified term equality/inequality—effectively indexing dif/2!
some_dif([X|Xs], E) :- % some_dif([X|Xs], E) :-
if_(dif(X,E), true, % ( dif(X,E), true
(X = E, some_dif(Xs,E)) % ; X = E, some_dif(Xs,E)
). % ).
Notice the similarities of the new and the old implementation!
Above, the goal X = E is redundant on the left-hand side. Let's remove it!
some_dif([X|Xs], E) :-
if_(dif(X,E), true, some_dif(Xs,E)).
Sweet! But, alas, we're not quite done (yet)!
?- not_all_equal(Xs).
DOES NOT TERMINATE
What's going on?
It turns out that the implementation of dif/3 prevents us from getting a nice answer sequence for the most general query. To do so—without using additional goals forcing fair enumeration—we need a tweaked implementation of dif/3, which I call diffirst/3:
diffirst(X, Y, T) :-
( X == Y -> T = false
; X \= Y -> T = true
; T = true, dif(X, Y)
; T = false, X = Y
).
Let's use diffirst/3 instead of dif/3 in the definition of predicate some_dif/2:
some_dif([X|Xs], E) :-
if_(diffirst(X,E), true, some_dif(Xs,E)).
So, at long last, here are above queries with the new some_dif/2:
?- not_all_equal(Es). % query #1
dif(_A,_B), Es = [_A,_B|_C]
; dif(_A,_B), Es = [_A,_A,_B|_C]
; dif(_A,_B), Es = [_A,_A,_A,_B|_C]
...
?- not_all_equal([A,B,C]), A=a, B=b. % query #2
A = a, B = b
; false.
?- A=a, B=b, not_all_equal([A,B,C]). % query #3
A = a, B = b.
Query #1 does not terminate, but has the same nice compact answer sequence. Good!
Query #2 is still non-determinstic. Okay. To me this is as good as it gets.
Query #3 has become deterministic: Better now!
The bottom line:
Use library(reif) to tame excess non-determinism while preserving logical purity!
diffirst/3 should find its way into library(reif) :)
EDIT: more general using a meta-predicate (suggested by a comment; thx!)
Let's generalize some_dif/2 like so:
:- meta_predicate some(2,?).
some(P_2, [X|Xs]) :-
if_(call(P_2,X), true, some(P_2,Xs)).
some/2 can be used with reified predicates other than diffirst/3.
Here an update to not_all_equal/1 which now uses some/2 instead of some_dif/2:
not_all_equal([X|Xs]) :-
some(diffirst(X), Xs).
Above sample queries still give the same answers, so I won't show these here.

Related

Remove brackets from a list in Prolog [duplicate]

I am doing some easy exercises to get a feel for the language.
is_list([]).
is_list([_|_]).
my_flatten([],[]).
my_flatten([X|Xs],RR) :-
my_flatten(Xs,R),
(is_list(X), !, append(X,R,RR); RR = [X | R]).
Here is a version using cut, for a predicate that flattens a list one level.
my_flatten([],[]).
my_flatten([X|Xs],RR) :-
my_flatten(Xs,R),
if_(is_list(X), append(X,R,RR), RR = [X | R]).
Here is how I want to write it, but it does not work. Neither does is_list(X) = true as the if_ condition. How am I intended to use if_ here?
(Sorry, I somewhat skipped this)
Please refer to P07. It clearly states that it flattens out [a, [b, [c, d], e]], but you and #Willem produce:
?- my_flatten([a, [b, [c, d], e]], X).
X = [a,b,[c,d],e]. % not flattened!
And the solution given there succeeds for
?- my_flatten(non_list, X).
X = [non_list]. % unexpected, nothing to flatten
Your definition of is_list/1 succeeds for is_list([a|non_list]). Commonly, we want this to fail.
What you need is a safe predicate to test for lists. So let's concentrate on that first:
What is wrong with is_list/1 and if-then-else? It is as non-monotonic, as many other impure type testing predicates.
?- Xs = [], is_list([a|Xs]).
Xs = [].
?- is_list([a|Xs]). % generalization, Xs = [] removed
false. % ?!? unexpected
While the original query succeeds correctly, a generalization of it unexpectedly fails. In the monotonic part of Prolog, we expect that a generalization will succeed (or loop, produce an error, use up all resources, but never ever fail).
You have now two options to improve upon this highly undesirable situation:
Stay safe with safe inferences, _si!
Just take the definition of list_si/1 in place of is_list/1. In problematic situations, your program will now abort with an instantiation error, meaning "well sorry, I don't know how to answer this query". Be happy for that response! You are saved from being misled by incorrect answers.
In other words: There is nothing wrong with ( If_0 -> Then_0 ; Else_0 ), as long as the If_0 handles the situation of insufficient instantiations correctly (and does not refer to a user defined program since otherwise you will be again in non-monotonic behavior).
Here is such a definition:
my_flatten(Es, Fs) :-
list_si(Es),
phrase(flattenl(Es), Fs).
flattenl([]) --> [].
flattenl([E|Es]) -->
( {list_si(E)} -> flattenl(E) ; [E] ),
flattenl(Es).
?- my_flatten([a, [b, [c, d], e]], X).
X = [a,b,c,d,e].
So ( If_0 -> Then_0 ; Else_0 ) has two weaknesses: The condition If_0 might be sensible to insufficient instantiations, and the Else_0 may be the source of non-monotonicity. But otherwise it works. So why do we want more than that?
In many more general situations this definition will now bark back: "Instantiation error"! While not incorrect, this still can be improved. This exercise is not the ideal example for this, but we will give it a try.
Use a reified condition
In order to use if_/3 you need a reified condition, that is, a definition that carries it's truth value as an explicit extra argument. Let's call it list_t/2.
?- list_t([a,b,c], T).
T = true.
?- list_t([a,b,c|non_list], T).
T = false.
?- list_t(Any, T).
Any = [],
T = true
; T = false,
dif(Any,[]),
when(nonvar(Any),Any\=[_|_])
; Any = [_],
T = true
; Any = [_|_Any1],
T = false,
dif(_Any1,[]),
when(nonvar(_Any1),_Any1\=[_|_])
; ... .
So list_t can also be used to enumerate all true and false situations. Let's go through them:
T = true, Any = [] that's the empty list
T = false, dif(Any, []), Any is not [_|_] note how this inequality uses when/2
T = true, Any = [_] that's all lists with one element
T = true, Any = [_|_Any1] ... meaning: we start with an element, but then no list
list_t(Es, T) :-
if_( Es = []
, T = true
, if_(nocons_t(Es), T = false, ( Es = [_|Fs], list_t(Fs, T) ) )
).
nocons_t(NC, true) :-
when(nonvar(NC), NC \= [_|_]).
nocons_t([_|_], false).
So finally, the reified definition:
:- meta_predicate( if_(1, 2, 2, ?,?) ).
my_flatten(Es, Fs) :-
phrase(flattenl(Es), Fs).
flattenl([]) --> [].
flattenl([E|Es]) -->
if_(list_t(E), flattenl(E), [E] ),
flattenl(Es).
if_(C_1, Then__0, Else__0, Xs0,Xs) :-
if_(C_1, phrase(Then__0, Xs0,Xs), phrase(Else__0, Xs0,Xs) ).
?- my_flatten([a|_], [e|_]).
false.
?- my_flatten([e|_], [e|_]).
true
; true
; true
; ... .
?- my_flatten([a|Xs], [a]).
Xs = []
; Xs = [[]]
; Xs = [[],[]]
; ... .
?- my_flatten([X,a], [a]).
X = []
; X = [[]]
; X = [[[]]]
; X = [[[[]]]]
; ... .
?- my_flatten(Xs, [a]).
loops. % at least it does not fail
In Prolog, the equivalen of an if … then … else … in other languages is:
(condition -> if-true; if-false)
With condition, if-true and if-false items you need to fill in.
So in this specific case, you can implement this with:
my_flatten([],[]).
my_flatten([X|Xs],RR) :-
my_flatten(Xs,R),
( is_list(X)
-> append(X,R,RR)
; RR = [X | R] ).
or we can flatten recursively with:
my_flatten([],[]).
my_flatten([X|Xs],RR) :-
my_flatten(Xs,R),
( flatten(X, XF)
-> append(XF,R,RR)
; RR = [X | R] ).
Your if_/3 predicate is used for reified predicates.
This worked for me:
myflat([], []).
myflat([H|T], L) :-
myflat(H, L1),
myflat(T, L2),
append(L1, L2, L).
myflat(L, [L]).

Why does my Prolog predicate invert/2 not work?

I'm new to Prolog and as an exercise I want to make an list invertion predicate. It uses the add_tail predicate that I made earlier—some parts might be redundant, but I don't care:
add_tail(A, [], A) :-
!.
add_tail([A|[]], H, [A,H]) :-
!.
add_tail([A|B], H, [A|C]) :-
add_tail(B,H,C).
It works same as builtin predicate append/3:
?- add_tail([a,b,c], d, A).
A = [a, b, c, d].
?- append([a,b,c], [d], A).
A = [a, b, c, d].
When I use append in my invert predicate, it works fine, but if I use add_tail, it fails:
invert([], []).
invert([A|B], C) :-
invert(B, D),
append(D, [A], C).
invert2([], []).
invert2([A|B], C) :-
invert2(B, D),
add_tail(D, A, C).
?- invert([a,b,c,d], A).
A = [d, c, b, a].
?- invert2([a,b,c,d], A).
false. % expected answer A = [d,c,b,a], like above
What exactly is my mistake? Thank you!
The implementation of add_tail/3 does not quite behave the way you expect it to.
Consider:
?- append([], [d], Xs).
Xs = [d].
?- add_tail([], d, Xs).
false.
That's bad... But it gets worse! There are even more issues with the code you presented:
By using (!)/0 you needlessly limit the versatility of your predicate.
Even though [A|[]] maybe correct, it obfuscates your code. Use [A] instead!
add_tail is a bad name for a predicate that works in more than one direction.
The variable names could be better, too! Why not use more descriptive names like As?
Look again at the variables you used in the last clause of add_tail/3!
add_tail([A|B], H, [A|C]) :-
add_tail(B, H, C).
Consider the improved variable names:
add_tail([A|As], E, [A|Xs]) :-
add_tail(As, E, Xs).
I suggest starting over like so:
list_item_appended([], X, [X]).
list_item_appended([E|Es], X, [E|Xs]) :-
list_item_appended(Es, X, Xs).
Let's put list_item_appended/3 to use in list_reverted/2!
list_reverted([], []).
list_reverted([E|Es], Xs) :-
list_reverted(Es, Fs),
list_item_appended(Fs, E, Xs).
Sample query:
?- list_reverted([a,b,c,d], Xs).
Xs = [d, c, b, a].
It is difficult to pinpoint your exact mistake, but the first two clauses of add_tail/3, the ones with the cuts, are wrong (unless I am misunderstanding what the predicate is supposed to do). Already the name is a bit misleading, and you should should care that you have redundant code.
list_back([], B, [B]).
list_back([X|Xs], B, [X|Ys]) :-
list_back(Xs, B, Ys).
This is a drop-in replacement for your add_tail/3 in your definition of invert/2. But as you are probably aware, this is not a very clever way of reversing a list. The textbook example of how to do it:
list_rev(L, R) :-
list_rev_1(L, [], R).
list_rev_1([], R, R).
list_rev_1([X|Xs], R0, R) :-
list_rev_1(Xs, [X|R0], R).
First try the most general query, to see which solutions exist in the most general case:
?- add_tail(X, Y, Z).
yielding the single answer:
X = Z,
Y = []
That's probably not the relation you intend to define here.
Hint: !/0 typically destroys all logical properties of your code, including the ability to use your predicates in all directions.
The first clause of add_tail/3 has a list as second argument, so it will never apply to your test case. Then we are left with 2 clauses (simplified)
add_tail([A],H,[A,H]):-!.
add_tail([A|B],H,[A|C]) :- add_tail(B,H,C).
You can see that we miss a matching clause for the empty list as first argument. Of course, append/3 instead has such match.
based on previous answer of "#mat" the problem is residue in the first two lines
your predicate add_tail is not like append because
with append i get this
| ?- append(X,Y,Z).
Z = Y,
X = [] ? ;
X = [_A],
Z = [_A|Y] ? ;
X = [_A,_B],
Z = [_A,_B|Y] ? ;
X = [_A,_B,_C],
Z = [_A,_B,_C|Y] ? ;
X = [_A,_B,_C,_D],
Z = [_A,_B,_C,_D|Y] ? ;
X = [_A,_B,_C,_D,_E],
Z = [_A,_B,_C,_D,_E|Y] ? ;y
and unfortunately with ur add_tail i get this result
| ?- add_tail(X,Y,Z).
Z = X,
Y = [] ? ;
X = [_A],
Z = [_A|Y] ? ;
X = [_A|_B],
Y = [],
Z = [_A|_B] ? ;
X = [_A,_B],
Z = [_A,_B|Y] ? ;
X = [_A,_B|_C],
Y = [],
Z = [_A,_B|_C] ?
X = [_A,_B,_C],
Z = [_A,_B,_C|Y] ? y
yes
after a simple modification in your add_tail code i obtained your expected result
code
% add_tail(A,[],A):-! . comment
add_tail([],H,H) :-!.
add_tail([A|B],H,[A|C]) :- add_tail(B,H,C).
test add_tail
| ?- add_tail(X,Y,Z).
Z = Y,
X = [] ? ;
X = [_A],
Z = [_A|Y] ? ;
X = [_A,_B],
Z = [_A,_B|Y] ? ;
X = [_A,_B,_C],
Z = [_A,_B,_C|Y] ? ;
X = [_A,_B,_C,_D],
Z = [_A,_B,_C,_D|Y] ? ;
X = [_A,_B,_C,_D,_E],
Z = [_A,_B,_C,_D,_E|Y] ? y
yes
finaly
i test ur invert predicate without modification
| ?- invert([_A,_B,_C],L).
L = [_C,_B,_A] ? ;
no
I hope this post help you to explain how the predicate done inside
enjoy

Numbers in a list smaller than a given number

xMenores(_,[],[]).
xMenores(X,[H|T],[R|Z]) :-
xMenores(X,T,Z),
X > H,
R is H.
xMenores takes three parameters:
The first one is a number.
The second is a list of numbers.
The third is a list and is the variable that will contain the result.
The objective of the rule xMenores is obtain a list with the numbers of the list (Second parameter) that are smaller than the value on the first parameter. For example:
?- xMenores(3,[1,2,3],X).
X = [1,2]. % expected result
The problem is that xMenores returns false when X > H is false and my programming skills are almost null at prolog. So:
?- xMenores(4,[1,2,3],X).
X = [1,2,3]. % Perfect.
?- xMenores(2,[1,2,3],X).
false. % Wrong! "X = [1]" would be perfect.
I consider X > H, R is H. because I need that whenever X is bigger than H, R takes the value of H. But I don't know a control structure like an if or something in Prolog to handle this.
Please, any solution? Thanks.
Using ( if -> then ; else )
The control structure you might be looking for is ( if -> then ; else ).
Warning: you should probably swap the order of the first two arguments:
lessthan_if([], _, []).
lessthan_if([X|Xs], Y, Zs) :-
( X < Y
-> Zs = [X|Zs1]
; Zs = Zs1
),
lessthan_if(Xs, Y, Zs1).
However, if you are writing real code, you should almost certainly go with one of the predicates in library(apply), for example include/3, as suggested by #CapelliC:
?- include(>(3), [1,2,3], R).
R = [1, 2].
?- include(>(4), [1,2,3], R).
R = [1, 2, 3].
?- include(<(2), [1,2,3], R).
R = [3].
See the implementation of include/3 if you want to know how this kind of problems are solved. You will notice that lessthan/3 above is nothing but a specialization of the more general include/3 in library(apply): include/3 will reorder the arguments and use the ( if -> then ; else ).
"Declarative" solution
Alternatively, a less "procedural" and more "declarative" predicate:
lessthan_decl([], _, []).
lessthan_decl([X|Xs], Y, [X|Zs]) :- X < Y,
lessthan_decl(Xs, Y, Zs).
lessthan_decl([X|Xs], Y, Zs) :- X >= Y,
lessthan_decl(Xs, Y, Zs).
(lessthan_if/3 and lessthan_decl/3 are nearly identical to the solutions by Nicholas Carey, except for the order of arguments.)
On the downside, lessthan_decl/3 leaves behind choice points. However, it is a good starting point for a general, readable solution. We need two code transformations:
Replace the arithmetic comparisons < and >= with CLP(FD) constraints: #< and #>=;
Use a DCG rule to get rid of arguments in the definition.
You will arrive at the solution by lurker.
A different approach
The most general comparison predicate in Prolog is compare/3. A common pattern using it is to explicitly enumerate the three possible values for Order:
lessthan_compare([], _, []).
lessthan_compare([H|T], X, R) :-
compare(Order, H, X),
lessthan_compare_1(Order, H, T, X, R).
lessthan_compare_1(<, H, T, X, [H|R]) :-
lessthan_compare(T, X, R).
lessthan_compare_1(=, _, T, X, R) :-
lessthan_compare(T, X, R).
lessthan_compare_1(>, _, T, X, R) :-
lessthan_compare(T, X, R).
(Compared to any of the other solutions, this one would work with any terms, not just integers or arithmetic expressions.)
Replacing compare/3 with zcompare/3:
:- use_module(library(clpfd)).
lessthan_clpfd([], _, []).
lessthan_clpfd([H|T], X, R) :-
zcompare(ZOrder, H, X),
lessthan_clpfd_1(ZOrder, H, T, X, R).
lessthan_clpfd_1(<, H, T, X, [H|R]) :-
lessthan_clpfd(T, X, R).
lessthan_clpfd_1(=, _, T, X, R) :-
lessthan_clpfd(T, X, R).
lessthan_clpfd_1(>, _, T, X, R) :-
lessthan_clpfd(T, X, R).
This is definitely more code than any of the other solutions, but it does not leave behind unnecessary choice points:
?- lessthan_clpfd(3, [1,3,2], Xs).
Xs = [1, 2]. % no dangling choice points!
In the other cases, it behaves just as the DCG solution by lurker:
?- lessthan_clpfd(X, [1,3,2], Xs).
Xs = [1, 3, 2],
X in 4..sup ;
X = 3,
Xs = [1, 2] ;
X = 2,
Xs = [1] ;
X = 1,
Xs = [] .
?- lessthan_clpfd(X, [1,3,2], Xs), X = 3. %
X = 3,
Xs = [1, 2] ; % no error!
false.
?- lessthan_clpfd([1,3,2], X, R), R = [1, 2].
X = 3,
R = [1, 2] ;
false.
Unless you need such a general approach, include(>(X), List, Result) is good enough.
This can also be done using a DCG:
less_than([], _) --> [].
less_than([H|T], N) --> [H], { H #< N }, less_than(T, N).
less_than(L, N) --> [H], { H #>= N }, less_than(L, N).
| ?- phrase(less_than(R, 4), [1,2,3,4,5,6]).
R = [1,2,3] ? ;
You can write your predicate as:
xMenores(N, NumberList, Result) :- phrase(less_than(Result, N), NumberList).
You could write it as a one-liner using findall\3:
filter( N , Xs , Zs ) :- findall( X, ( member(X,Xs), X < N ) , Zs ) .
However, I suspect that the point of the exercise is to learn about recursion, so something like this would work:
filter( _ , [] , [] ) .
filter( N , [X|Xs] , [X|Zs] ) :- X < N , filter(N,Xs,Zs) .
filter( N , [X|Xs] , Zs ) :- X >= N , filter(N,Xs,Zs) .
It does, however, unpack the list twice on backtracking. An optimization here would be to combine the 2nd and 3rd clauses by introducing a soft cut like so:
filter( _ , [] , [] ) .
filter( N , [X|Xs] , [X|Zs] ) :-
( X < N -> Zs = [X|Z1] ; Zs = Z1 ) ,
filter(N,Xs,Zs)
.
(This is more like a comment than an answer, but too long for a comment.)
Some previous answers and comments have suggested using "if-then-else" (->)/2 or using library(apply) meta-predicate include/3. Both methods work alright, as long as only plain-old Prolog arithmetics—is/2, (>)/2, and the like—are used ...
?- X = 3, include(>(X),[1,3,2,5,4],Xs).
X = 3, Xs = [1,2].
?- include(>(X),[1,3,2,5,4],Xs), X = 3.
ERROR: >/2: Arguments are not sufficiently instantiated
% This is OK. When instantiation is insufficient, an exception is raised.
..., but when doing the seemingly benign switch from (>)/2 to (#>)/2, we lose soundness!
?- X = 3, include(#>(X),[1,3,2,5,4],Xs).
X = 3, Xs = [1,2].
?- include(#>(X),[1,3,2,5,4],Xs), X = 3.
false.
% This is BAD! Expected success with answer substitutions `X = 3, Xs = [1,2]`.
No new code is presented in this answer.
In the following we take a detailed look at different revisions of this answer by #lurker.
Revision #1, renamed to less_than_ver1//2. By using dcg and clpfd, the code is both very readable and versatile:
less_than_ver1(_, []) --> [].
less_than_ver1(N, [H|T]) --> [H], { H #< N }, less_than_ver1(N, T).
less_than_ver1(N, L) --> [H], { H #>= N }, less_than_ver1(N, L).
Let's query!
?- phrase(less_than_ver1(N,Zs),[1,2,3,4,5]).
N in 6..sup, Zs = [1,2,3,4,5]
; N = 5 , Zs = [1,2,3,4]
; N = 4 , Zs = [1,2,3]
; N = 3 , Zs = [1,2]
; N = 2 , Zs = [1]
; N in inf..1, Zs = []
; false.
?- N = 3, phrase(less_than_ver1(N,Zs),[1,2,3,4,5]).
N = 3, Zs = [1,2] % succeeds, but leaves useless choicepoint
; false.
?- phrase(less_than_ver1(N,Zs),[1,2,3,4,5]), N = 3.
N = 3, Zs = [1,2]
; false.
As a small imperfection, less_than_ver1//2 leaves some useless choicepoints.
Let's see how things went with the newer revision...
Revision #3, renamed to less_than_ver3//2:
less_than_ver3([],_) --> [].
less_than_ver3(L,N) --> [X], { X #< N -> L=[X|T] ; L=T }, less_than_ver3(L,N).
This code uses the if-then-else ((->)/2 + (;)/2) in order to improve determinism.
Let's simply re-run the above queries!
?- phrase(less_than_ver3(Zs,N),[1,2,3,4,5]).
N in 6..sup, Zs = [1,2,3,4,5]
; false. % all other solutions are missing!
?- N = 3, phrase(less_than_ver3(Zs,N),[1,2,3,4,5]).
N = 3, Zs = [1,2] % works as before, but no better.
; false. % we still got the useless choicepoint
?- phrase(less_than_ver3(Zs,N),[1,2,3,4,5]), N = 3.
false. % no solution!
% we got one with revision #1!
Surprise! Two cases that worked before are now (somewhat) broken, and the determinism in the ground case is no better... Why?
The vanilla if-then-else often cuts too much too soon, which is particularly problematic with code which uses coroutining and/or constraints.
Note that (*->)/2 (a.k.a. "soft-cut" or if/3), fares only a bit better, not a lot!
As if_/3 never ever cuts more (often than) the vanilla if-then-else (->)/2, it cannot be used in above code to improve determinism.
If you want to use if_/3 in combination with constraints, take a step back and write code that is non-dcg as the first shot.
If you're lazy like me, consider using a meta-predicate like tfilter/3 and (#>)/3.
This answer by #Boris presented a logically pure solution which utilizes clpfd:zcompare/3 to help improve determinism in certain (ground) cases.
In this answer we will explore different ways of coding logically pure Prolog while trying to avoid the creation of useless choicepoints.
Let's get started with zcompare/3 and (#<)/3!
zcompare/3 implements three-way comparison of finite domain variables and reifies the trichotomy into one of <, =, or >.
As the inclusion criterion used by the OP was a arithmetic less-than test, we propose using
(#<)/3 for reifying the dichotomy into one of true or false.
Consider the answers of the following queries:
?- zcompare(Ord,1,5), #<(1,5,B).
Ord = (<), B = true.
?- zcompare(Ord,5,5), #<(5,5,B).
Ord = (=), B = false.
?- zcompare(Ord,9,5), #<(9,5,B).
Ord = (>), B = false.
Note that for all items to be selected both Ord = (<) and B = true holds.
Here's a side-by-side comparison of three non-dcg solutions based on clpfd:
The left one uses zcompare/3 and first-argument indexing on the three cases <, =, and >.
The middle one uses (#<)/3 and first-argument indexing on the two cases true and false.
The right one uses (#<)/3 in combination with if_/3.
Note that we do not need to define auxiliary predicates in the right column!
less_than([],[],_). % less_than([],[],_). % less_than([],[],_).
less_than([Z|Zs],Ls,X) :- % less_than([Z|Zs],Ls,X) :- % less_than([Z|Zs],Ls,X) :-
zcompare(Ord,Z,X), % #<(Z,X,B), % if_(Z #< X,
ord_lt_(Ord,Z,Ls,Rs), % incl_lt_(B,Z,Ls,Rs), % Ls = [Z|Rs],
less_than(Zs,Rs,X). % less_than(Zs,Rs,X). % Ls = Rs),
% % less_than(Zs,Rs,X).
ord_lt_(<,Z,[Z|Ls],Ls). % incl_lt_(true ,Z,[Z|Ls],Ls). %
ord_lt_(=,_, Ls ,Ls). % incl_lt_(false,_, Ls ,Ls). %
ord_lt_(>,_, Ls ,Ls). % %
Next, let's use dcg!
In the right column we use if_//3 instead of if_/3.
Note the different argument orders of dcg and non-dcg solutions: less_than([1,2,3],Zs,3) vs phrase(less_than([1,2,3],3),Zs).
The following dcg implementations correspond to above non-dcg codes:
less_than([],_) --> []. % less_than([],_) --> []. % less_than([],_) --> [].
less_than([Z|Zs],X) --> % less_than([Z|Zs],X) --> % less_than([Z|Zs],X) -->
{ zcompare(Ord,Z,X) }, % { #<(Z,X,B) }, % if_(Z #< X,[Z],[]),
ord_lt_(Ord,Z), % incl_lt_(B,Z), % less_than(Zs,X).
less_than(Zs,X). % less_than(Zs,X). %
% %
ord_lt_(<,Z) --> [Z]. % incl_lt_(true ,Z) --> [Z]. %
ord_lt_(=,_) --> []. % incl_lt_(false,_) --> []. %
ord_lt_(>,_) --> []. % %
OK! Saving the best for last... Simply use meta-predicate tfilter/3 together with (#>)/3!
less_than(Xs,Zs,P) :-
tfilter(#>(P),Xs,Zs).
The dcg variant in this previous answer is our starting point.
Consider the auxiliary non-terminal ord_lt_//2:
ord_lt_(<,Z) --> [Z].
ord_lt_(=,_) --> [].
ord_lt_(>,_) --> [].
These three clauses can be covered using two conditions:
Ord = (<): the item should be included.
dif(Ord, (<)): it should not be included.
We can express this "either-or choice" using if_//3:
less_than([],_) --> [].
less_than([Z|Zs],X) -->
{ zcompare(Ord,Z,X) },
if_(Ord = (<), [Z], []),
less_than(Zs,X).
Thus ord_lt_//2 becomes redundant.
Net gain? 3 lines-of-code !-)

Prolog removing unique elements only

I want to return a list that removes all unique elements for example
remUniqueVals([1,1,2,2,3,4,4,5,6,6,6],Q).
Q = [1,1,2,2,4,4,6,6,6].
My problem is that currently I have code that returns
remUniqueVals([1,1,2,2,3,4,4,5,6,6,6],Q).
Q = [1, 2, 4, 6, 6].
So that only the first instance of these non-unique values are returned.
Here is my code:
remUniqueVals([], []).
remUniqueVals([Q1|RestQ],[Q1|Xs]) :-
member(Q1,RestQ),
remUniqueVals(RestQ,Xs).
remUniqueVals([Q1|RestQ],Xs) :-
remove(Q1,[Q1|RestQ], NewQ),
remUniqueVals(NewQ,Xs).
I can see that member(Q1,RestQ) fails when it checks 1,2,4 the second time because they are now no longer in the list and so removes them. I'd like some helping solving this problem, my thoughts are to check member(Q1, PreviousQ), where this is the elements already in the final Q. Not sure how to go about implementing that though any help would be appreciated.
Update:
Ok so thanks for the suggestions I ended up going with this in the end:
remUniqueVals(_,[], []).
remUniqueVals(_,[Q1|RestQ],[Q1|Xs]) :-
member(Q1,RestQ),
remUniqueVals(Q1,RestQ,Xs).
remUniqueVals(PrevQ,[Q1|RestQ],[Q1|Xs]) :-
Q1 = PrevQ,
remUniqueVals(PrevQ,RestQ,Xs).
remUniqueVals(PrevQ,[_|RestQ],Xs) :-
remUniqueVals(PrevQ,RestQ,Xs).
remUniqueVals(0,[4,1,1,3,2,2,5,5],Q).
Q = [1, 1, 2, 2, 5, 5].
remUniqueVals(0, [A,B,C], [1,1]).
A = 1,
B = 1,
C = 1.
Prolog rules are read independently of each other, so you need one rule for the case where the element is unique and one where it is not. Provided the order of the elements is not relevant, you might use:
?- remUniqueVals([A,B,C], [1,1]).
A = 1, B = 1, dif(1,C)
; A = 1, C = 1, dif(1,B)
; B = 1, C = 1, dif(A,1)
; false.
?- remUniqueVals([1,1,2,2,3,4,4,5,6,6,6],Q).
Q = [1,1,2,2,4,4,6,6,6]
; false.
remUniqueVals([], []).
remUniqueVals([Q1|RestQ],[Q1|Xs0]) :-
memberd(Q1, RestQ),
phrase(delall(Q1, RestQ, NewQ), Xs0, Xs),
remUniqueVals(NewQ, Xs).
remUniqueVals([Q1|RestQ],Xs) :-
maplist(dif(Q1), RestQ),
remUniqueVals(RestQ,Xs).
memberd(X, [X|_Xs]).
memberd(X, [Y|Xs]) :-
dif(X,Y),
memberd(X, Xs).
delall(_X, [], []) --> [].
delall(X, [X|Xs], Ys) -->
[X],
delall(X, Xs, Ys).
delall(X, [Y|Xs], [Y|Ys]) -->
{dif(X,Y)},
delall(X, Xs, Ys).
Here is an alternate definition for memberd/2 which might be more efficient using if_/3:
memberd(E, [X|Xs]) :-
if_(E = X, true, memberd(E, Xs) ).
This is similar to the original solution but it collects the non-unique values in an auxiliary list and checks it to avoid removing the last one from the original:
remove_uniq_vals(L, R) :-
remove_uniq_vals(L, [], R).
remove_uniq_vals([], _, []).
remove_uniq_vals([X|T], A, R) :-
( member(X, A)
-> R = [X|T1], A1 = A
; member(X, T)
-> R = [X|T1], A1 = [X|A]
; R = T1, A1 = A
),
remove_uniq_vals(T, A1, T1).
Testing...
| ?- remove_uniq_vals([1,2,3,1,2,3,1,2,3,4,3], Q).
Q = [1,2,3,1,2,3,1,2,3,3]
(1 ms) yes
| ?- remove_uniq_vals([1,1,2,2,3,4,4,5,6,6,6], Q).
Q = [1,1,2,2,4,4,6,6,6]
yes
So the predicate works great if the first argument is an input, and it maintains the original order of the remaining elements in the list.
However, this predicate is not completely relational in that it will fail a case in which the first argument is an uninstantiated list of a known number of elements and the second argument is a list of a different fixed number of elements. So something like this will work:
| ?- remove_uniq_vals([A,B,C], L).
B = A
C = A
L = [A,A,A]
(1 ms) yes
But something like the following fails:
| ?- remove_uniq_vals([A,B,C], [1,1]).
no
This is another pure, relational solution inspired by #CapelliC's solution. This one now retains the order of the duplicates. What is interesting to see is how the implicit quantification happening in #CapelliC's solution now has to be done explicitly.
The biggest advantage of having a pure, relational definition is that noes are noes. And ayes are ayes. That is: You do not have to worry whether or not the answer you get happens to be correct or not. It is correct (or incorrect — but it is not partially correct). Non-relational solutions can often be cleansed by producing instantiation_error in case the method fails. But as you can verify yourself, both have "forgotten" such tests thereby preparing a nice habitat for bugs. A safe test for those other solutions would have been ground(Xs) or ground(Xs), acyclic_term(Xs) but much too often this is considered too restricted.
remUniqueVals2(Xs, Ys) :-
tfilter(list_withduplicate_truth(Xs),Xs,Ys).
list_withduplicate_truth(L, E, Truth) :-
phrase(
( all(dif(E)),
( {Truth = false}
| [E],
all(dif(E)),
( {Truth = false}
| {Truth = true},
[E],
...
)
)
), L).
all(_) --> [].
all(P_1) -->
[E],
{call(P_1,E)},
all(P_1).
... --> [] | [_], ... .
tfilter( _, [], []).
tfilter(TFilter_2, [E|Es], Fs0) :-
call(TFilter_2,E,Truth),
( Truth = false,
Fs0 = Fs
; Truth = true,
Fs0 = [E|Fs]
),
tfilter(TFilter_2, Es, Fs).
Another, more compact way using if_/3
tfilter( _, [], []).
tfilter(TFilter_2, [E|Es], Fs0) :-
if_(call(TFilter_2,E), Fs0 = [E|Fs], Fs0 = Fs ),
tfilter(TFilter_2, Es, Fs).
Preserve logical-purity! Based on if_/3, (=)/3, and meta-predicate tpartition/4 we define:
remUniqueValues([], []).
remUniqueValues([X|Xs1], Ys1) :-
tpartition(=(X), Xs1, Eqs, Xs0),
if_(Eqs = [],
Ys1 = Ys0,
append([X|Eqs], Ys0, Ys1)),
remUniqueValues(Xs0, Ys0).
Let's see it in action!
?- remUniqueValues([A,B,C], [1,1]).
A=1 , B=1 , dif(C,1)
; A=1 , dif(B,1), C=1
; dif(A,1), B=1 , C=1
; false.
?- remUniqueValues([1,1,2,2,3,4,4,5,6,6,6], Vs).
Vs = [1,1,2,2,4,4,6,6,6]. % succeeds deterministically
This is a purified version of #mbratch's solution. It uses a reïfied version of member/2 which is free of redundant answers like for member(X,[a,a]).
memberd_truth_dcg(X, Xs, Truth) :-
phrase(( all(dif(X)), ( [X], {Truth = true}, ... | {Truth = false} ) ), Xs).
A slightly generalized version which only requires to have a list prefix, but not a list:
memberd_truth(_X, [], false).
memberd_truth(X, [X|_], true).
memberd_truth(X, [Y|Ys], Truth) :-
dif(X,Y),
memberd_truth(X, Ys, Truth).
The variables are named in the same manner as in #mbratch's solution:
remove_uniq_valsBR(L, R) :-
remove_uniq_valsBR(L, [], R).
remove_uniq_valsBR([], _, []).
remove_uniq_valsBR([X|T], A, R) :-
memberd_truth(X, A, MemT1),
( MemT1 = true,
R = [X|T1], A1 = A
; MemT1 = false,
memberd_truth(X, T, MemT2),
( MemT2 = true,
R = [X|T1], A1 = [X|A]
; MemT2 = false,
R = T1, A1 = A
)
),
remove_uniq_valsBR(T, A1, T1).
More compactly using if/3:
remove_uniq_valsBR([], _, []).
remove_uniq_valsBR([X|T], A, R) :-
if_( memberd_truth(X, A),
( R = [X|T1], A1 = A ),
if_( memberd_truth(X, T),
( R = [X|T1], A1 = [X|A] ),
( R = T1, A1 = A ) ) )
),
remove_uniq_valsBR(T, A1, T1).
What I do not like is the many redundant dif/2 constraints. I hoped this version would have less of them:
?- length(L,_),remove_uniq_valsBR(L,L).
L = []
; L = [_A,_A]
; L = [_A,_A,_A]
; L = [_A,_A,_A,_A]
; L = [_A,_A,_B,_B], dif(_B,_A)
; L = [_A,_B,_A,_B],
dif(_A,_B), dif(_B,_A), dif(_B,_A), dif(_A,_B)
; ... .
Of course it is possible to check whether or not a dif/2 is already present, but I'd prefer a version where there are fewer dif/2 goals posted right from the beginning.
a solution based on 3 builtins:
remUniqueVals(Es, NUs) :-
findall(E, (select(E, Es, R), memberchk(E, R)), NUs).
can be read as
find all elements that still appear in list after have been selected

Add two more occurrences using prolog

I have a list [a, b, a, a, a, c, c]
and I need to add two more occurrences of each element.
The end result should look like this:
[a, a, a, b, b, b, a, a, a, a, a, c, c, c, c]
If I have an item on the list that is the same as the next item, then it keeps going until there is a new item, when it finds the new item, it adds two occurrences of the previous item then moves on.
This is my code so far, but I can't figure out how to add two...
dbl([], []).
dbl([X], [X,X]).
dbl([H|T], [H,H|T], [H,H|R]) :- dbl(T, R).
Your code looks a bit strange because the last rule takes three parameters. You only call the binary version, so no recursion will ever try to derive it.
You already had a good idea to look at the parts of the list, where elements change. So there are 4 cases:
1) Your list is empty.
2) You have exactly one element.
3) Your list starts with two equal elements.
4) Your list starts with two different elements.
Case 1 is not specified, so you might need to find a sensible choice for that. Case 2 is somehow similar to case 4, since the end of the list can be seen as a change in elements, where you need to append two copies, but then you are done. Case 3 is quite simple, we can just keep the element and recurse on the rest. Case 4 is where you need to insert the two copies again.
This means your code will look something like this:
% Case 1
dbl([],[]).
% Case 2
dbl([X],[X,X,X]).
% Case 3
dbl([X,X|Xs], [X|Ys]) :-
% [...] recursion skipping the leading X
% Case 4
dbl([X,Y|Xs], [X,X,X|Ys]) :-
dif(X,Y),
% [...] we inserted the copies, so recursion on [Y|Xs] and Ys
Case 3 should be easy to finish, we just drop the first X from both lists and recurse on dbl([X|Xs],Ys). Note that we implicitly made the first two elements equal (i.e. we unified them) by writing the same variable twice.
If you look at the head of case 4, you can directly imitate the pattern you described: supposed the list starts with X, then Y and they are different (dif(X,Y)), the X is repeated 3 times instead of just copied and we then continue with the recursion on the rest starting with Y: dbl([Y|Xs],Ys).
So let's try out the predicate:
?- dbl([a,b,a,a,a,c,c],[a,a,a,b,b,b,a,a,a,a,a,c,c,c,c]).
true ;
false.
Our test case is accepted (true) and we don't find more than one solution (false).
Let's see if we find a wrong solution:
?- dif(Xs,[a,a,a,b,b,b,a,a,a,a,a,c,c,c,c]), dbl([a,b,a,a,a,c,c],Xs).
false.
No, that's also good. What happens, if we have variables in our list?
?- dbl([a,X,a],Ys).
X = a,
Ys = [a, a, a, a, a] ;
Ys = [a, a, a, X, X, X, a, a, a],
dif(X, a),
dif(X, a) ;
false.
Either X = a, then Ys is single run of 5 as; or X is not equal to a, then we need to append the copies in all three runs. Looks also fine. (*)
Now lets see, what happens if we only specify the solution:
?- dbl(X,[a,a,a,b,b]).
false.
Right, a list with a run of only two bs can not be a result of our specification. So lets try to add one:
?- dbl(X,[a,a,a,b,b,b]).
X = [a, b] ;
false.
Hooray, it worked! So lets as a last test look what happens, if we just call our predicate with two variables:
?- dbl(Xs,Ys).
Xs = Ys, Ys = [] ;
Xs = [_G15],
Ys = [_G15, _G15, _G15] ;
Xs = [_G15, _G15],
Ys = [_G15, _G15, _G15, _G15] ;
Xs = [_G15, _G15, _G15],
Ys = [_G15, _G15, _G15, _G15, _G15] ;
Xs = [_G15, _G15, _G15, _G15],
Ys = [_G15, _G15, _G15, _G15, _G15, _G15] ;
[...]
It seems we get the correct answers, but we see only cases for a single run. This is a result of prolog's search strategy(which i will not explain in here). But if we look at shorter lists before we generate longer ones, we can see all the solutions:
?- length(Xs,_), dbl(Xs,Ys).
Xs = Ys, Ys = [] ;
Xs = [_G16],
Ys = [_G16, _G16, _G16] ;
Xs = [_G16, _G16],
Ys = [_G16, _G16, _G16, _G16] ;
Xs = [_G86, _G89],
Ys = [_G86, _G86, _G86, _G89, _G89, _G89],
dif(_G86, _G89) ;
Xs = [_G16, _G16, _G16],
Ys = [_G16, _G16, _G16, _G16, _G16] ;
Xs = [_G188, _G188, _G194],
Ys = [_G188, _G188, _G188, _G188, _G194, _G194, _G194],
dif(_G188, _G194) ;
[...]
So it seems we have a working predicate (**), supposed you filled in the missing goals from the text :)
(*) A remark here: this case only works because we are using dif. The first predicates with equality, one usually encounters are =, == and their respective negations \= and \==. The = stands for unifyability (substituting variables in the arguments s.t. they become equal) and the == stands for syntactic equality (terms being exactly equal). E.g.:
?- f(X) = f(a).
X = a.
?- f(X) \= f(a).
false.
?- f(X) == f(a).
false.
?- f(X) \== f(a).
true.
This means, we can make f(X) equal to f(a), if we substitute X by a. This means if we ask if they can not be made equal (\=), we get the answer false. On the other hand, the two terms are not equal, so == returns false, and its negation \== answers true.
What this also means is that X \== Y is always true, so we can not use \== in our code. In contrast to that, dif waits until it can decide wether its arguments are equal or not. If this is still undecided after finding an answer, the "dif(X,a)" statements are printed.
(**) One last remark here: There is also a solution with the if-then-else construct (test -> goals_if_true; goals_if_false, which merges cases 3 and 4. Since i prefer this solution, you might need to look into the other version yourself.
TL;DR:
From a declarative point of view, the code sketched by #lambda.xy.x is perfect.
Its determinacy can be improved without sacrificing logical-purity.
Code variant #0: #lambda.xy.x's code
Here's the code we want to improve:
dbl0([], []).
dbl0([X], [X,X,X]).
dbl0([X,X|Xs], [X|Ys]) :-
dbl0([X|Xs], Ys).
dbl0([X,Y|Xs], [X,X,X|Ys]) :-
dif(X, Y),
dbl0([Y|Xs], Ys).
Consider the following query and the answer SWI-Prolog gives us:
?- dbl0([a],Xs).
Xs = [a,a,a] ;
false.
With ; false the SWI prolog-toplevel
indicates a choicepoint was left when proving the goal.
For the first answer, Prolog did not search the entire proof tree.
Instead, it replied "here's an answer, there may be more".
Then, when asked for more solutions, Prolog traversed the remaining branches of the proof tree but finds no more answers.
In other words: Prolog needs to think twice to prove something we knew all along!
So, how can we give determinacy hints to Prolog?
By utilizing:
control constructs !/0 and / or (->)/2 (potentially impure)
first argument indexing on the principal functor (never impure)
The code presented in the earlier answer by #CapelliC—which is based on !/0, (->)/2, and the meta-logical predicate (\=)/2—runs well if all arguments are sufficiently instantiated. If not, erratic answers may result—as #lambda.xy.x's comment shows.
Code variant #1: indexing
Indexing can improve determinacy without ever rendering the code non-monotonic. While different Prolog processors have distinct advanced indexing capabilities, the "first-argument principal-functor" indexing variant is widely available.
Principal? This is why executing the goal dbl0([a],Xs) leaves a choicepoint behind: Yes, the goal only matches one clause—dbl0([X],[X,X,X]).—but looking no deeper than the principal functor Prolog assumes that any of the last three clauses could eventually get used. Of course, we know better...
To tell Prolog we utilize principal-functor first-argument indexing:
dbl1([], []).
dbl1([E|Es], Xs) :-
dbl1_(Es, Xs, E).
dbl1_([], [E,E,E], E).
dbl1_([E|Es], [E|Xs], E) :-
dbl1_(Es, Xs, E).
dbl1_([E|Es], [E0,E0,E0|Xs], E0) :-
dif(E0, E),
dbl1_(Es, Xs, E).
Better? Somewhat, but determinacy could be better still...
Code variant #2: indexing on reified term equality
To make Prolog see that the two recursive clauses of dbl1_/3 are mutually exclusive (in certain cases), we reify the truth value of
term equality and then index on that value:
This is where reified term equality (=)/3 comes into play:
dbl2([], []).
dbl2([E|Es], Xs) :-
dbl2_(Es, Xs, E).
dbl2_([], [E,E,E], E).
dbl2_([E|Es], Xs, E0) :-
=(E0, E, T),
t_dbl2_(T, Xs, E0, E, Es).
t_dbl2_(true, [E|Xs], _, E, Es) :-
dbl2_(Es, Xs, E).
t_dbl2_(false, [E0,E0,E0|Xs], E0, E, Es) :-
dbl2_(Es, Xs, E).
Sample queries using SWI-Prolog:
?- dbl0([a],Xs).
Xs = [a, a, a] ;
false.
?- dbl1([a],Xs).
Xs = [a, a, a].
?- dbl2([a],Xs).
Xs = [a, a, a].
?- dbl0([a,b,b],Xs).
Xs = [a, a, a, b, b, b, b] ;
false.
?- dbl1([a,b,b],Xs).
Xs = [a, a, a, b, b, b, b] ;
false.
?- dbl2([a,b,b],Xs).
Xs = [a, a, a, b, b, b, b].
To make above code more compact, use control construct if_/3 .
I was just about to throw this version with if_/3 and (=)/3 in the hat when I saw #repeat already suggested it. So this is essentially the more compact version as outlined by #repeat:
list_dbl([],[]).
list_dbl([X],[X,X,X]).
list_dbl([A,B|Xs],DBL) :-
if_(A=B,DBL=[A,B|Ys],DBL=[A,A,A,B|Ys]),
list_dbl([B|Xs],[B|Ys]).
It yields the same results as dbl2/2 by #repeat:
?- list_dbl([a],DBL).
DBL = [a,a,a]
?- list_dbl([a,b,b],DBL).
DBL = [a,a,a,b,b,b,b]
The example query by the OP works as expected:
?- list_dbl([a,b,a,a,a,c,c],DBL).
DBL = [a,a,a,b,b,b,a,a,a,a,a,c,c,c,c]
Plus here are some of the example queries provided by #lambda.xy.x. They yield the same results as #repeat's dbl/2 and #lambda.xy.x's dbl/2:
?- dif(Xs,[a,a,a,b,b,b,a,a,a,a,a,c,c,c,c]), list_dbl([a,b,a,a,a,c,c],Xs).
no
?- list_dbl(X,[a,a,a,b,b]).
no
?- list_dbl(L,[a,a,a,b,b,b]).
L = [a,b] ? ;
no
?- list_dbl(L,DBL).
DBL = L = [] ? ;
DBL = [_A,_A,_A],
L = [_A] ? ;
DBL = [_A,_A,_A,_A],
L = [_A,_A] ? ;
DBL = [_A,_A,_A,_A,_A],
L = [_A,_A,_A] ? ;
...
?- list_dbl([a,X,a],DBL).
DBL = [a,a,a,a,a],
X = a ? ;
DBL = [a,a,a,X,X,X,a,a,a],
dif(X,a),
dif(a,X)
?- length(L,_), list_dbl(L,DBL).
DBL = L = [] ? ;
DBL = [_A,_A,_A],
L = [_A] ? ;
DBL = [_A,_A,_A,_A],
L = [_A,_A] ? ;
DBL = [_A,_A,_A,_B,_B,_B],
L = [_A,_B],
dif(_A,_B) ? ;
DBL = [_A,_A,_A,_A,_A],
L = [_A,_A,_A] ?
dbl([X,Y|T], [X,X,X|R]) :- X \= Y, !, dbl([Y|T], R).
dbl([H|T], R) :-
T = []
-> R = [H,H,H]
; R = [H|Q], dbl(T, Q).
The first clause handles the basic requirement, adding two elements on sequence change.
The second one handles list termination as a sequence change, otherwise, does a plain copy.