Related
I am trying to implement a partition predicate in Prolog that splits a list into its two halves, a Prefix and a Suffix, of approximately same lengths.
partition(L,P,S)
Where prefixes and suffixes are defined as such:
prefix(P,L) :- append(P,_,L).
suffix(S,L) :- append(_,S,L).
If L is [], then Prefix and S are [].
If L is [H], then P is [H] and S is [].
If L has two or more elements, this is how the list is partitioned into its prefix and suffix:
Length of L is N and the length of P is div(N,2). The length of S is N - div(N,2).
So for instance:
?- partition([a,b,c,d],X,Y).
X = [a,b]
Y = [c,d]
?- partition([a],X,Y).
X = [a]
Y = [ ]
Here is my code and the error I get:
partition([],[],[]).
partition([H],[H],[]).
partition(L, P, S) :-
length(L, N),
Plen is div(N,2),
Slen is N - div(N,2),
length(Pre, Plen),
length(Suff, Slen),
prefix(Pre, L),
suffix(Suff, L),
P is Pre,
S is Suff.
partition([a,b,c,d],X,Y).
>>> Type error: `[]' expected, found `[a,b]' (a list)
("x" must hold one character)
I don't understand this error message but this is wrong:
P is Pre,
S is Suff.
This is for arithmetic evaluation whereby the Right-Hand-Side is evaluated as an arithmetic expression and unified with the Left-Hand-Side.
You just want to unify the variables:
P = Pre,
S = Suff.
Alternatively, you can use the same same for P and Pre / S and Suff throughout.
If you change is to to = as suggested by David Tonhofer's answer, the whole thing works.
But I would like to add that you are complicating things a bit. You have identified correctly that append/3 can be used to compute list prefixes and suffixes. But for any list to be partitioned and any prefix, the suffix is unique, and is already computed by append/3! And the other way round: If you ask it to compute a suffix, it will also compute the prefix you seek. But then you throw these answers away and try to recompute a matching prefix or suffix. There is no need to do that.
If we make your prefix and suffix predicates a bit more explicit:
list_prefix_theonlypossiblematchingsuffix(List, Prefix, TheOnlyPossibleMatchingSuffix) :-
append(Prefix, TheOnlyPossibleMatchingSuffix, List).
list_suffix_theonlypossiblematchingprefix(List, Suffix, TheOnlyPossibleMatchingPrefix) :-
append(TheOnlyPossibleMatchingPrefix, Suffix, List).
We can see that once we have a given prefix for a list, there really is no more choice for the suffix (and vice versa):
?- list_prefix_theonlypossiblematchingsuffix([a, b, c, d], Prefix, MatchingSuffix).
Prefix = [],
MatchingSuffix = [a, b, c, d] ;
Prefix = [a],
MatchingSuffix = [b, c, d] ;
Prefix = [a, b],
MatchingSuffix = [c, d] ;
Prefix = [a, b, c],
MatchingSuffix = [d] ;
Prefix = [a, b, c, d],
MatchingSuffix = [] ;
false.
So there is no need to try to compute the prefix and suffix separately and to match up their lengths. It's enough to restrict the prefix, as the suffix will follow:
partition(List, Prefix, TheOnlyPossibleMatchingSuffix) :-
length(List, N),
PrefixLength is N div 2,
length(Prefix, PrefixLength),
list_prefix_theonlypossiblematchingsuffix(List, Prefix, TheOnlyPossibleMatchingSuffix).
This works as you want:
?- partition([a, b, c, d], Prefix, Suffix).
Prefix = [a, b],
Suffix = [c, d].
?- partition([a, b, c, d, e], Prefix, Suffix).
Prefix = [a, b],
Suffix = [c, d, e].
Once you have this, it's much clearer to replace the goal involving list_prefix_verylongpredicatename with what is really meant:
partition(List, Prefix, Suffix) :-
length(List, N),
PrefixLength is N div 2,
length(Prefix, PrefixLength),
append(Prefix, Suffix, List).
Coming from other programming languages it may be a bit unusual that a predicate like append/3 computes several things at once that have a deep relationship with each other, i.e., a prefix and the unique matching suffix. But this is one of the things that makes Prolog so expressive and powerful. Get used to it and profit from it!
It seems to me that you're doing a lot of unnecessary work here.
This is all I think you need:
partition(L,P,S) :-
partition(L,L,P,S).
partition(L,[],[],L).
partition(([H|L],[_],[H],L).
partition([H|L],[_,_|L2],[H|P],S) :-
partition(L,L2,P,S).
If I query ?- partition([a],X,Y), write([X,Y]). then I get:
[[a], []]
true.
If I query ?- partition([a,b,c,d,e],X,Y), write([X,Y]). then I get:
[[a, b, c], [d, e]]
true.
Since you've already defined your prefixes and suffixes as
prefix(P,L) :- append(P, _, L). % prefix
suffix(S,L) :- append(_, S, L). % suffix
just smash the two together into one call,
partition(L,P,S) :-
append(P, S, L),
and this would be it, except you have additional conditions about the comparative lengths of the two near-halves, so just add them into the mix:
length( P, N), length( A, N), % same length, fresh list A
(A = [_|S] ; A = S). % S one shorter than P, or same length
And that's that. Testing:
2 ?- partition( [1,2,3], A, B ).
A = [1, 2],
B = [3].
3 ?- partition( L, [1,2], [3] ).
L = [1, 2, 3].
15 ?- partition( L, A, B ).
L = A, A = B, B = [] ;
L = A, A = [_G2477],
B = [] ;
L = [_G2477, _G2483],
A = [_G2477],
B = [_G2483] ;
L = [_G2477, _G2483, _G2492],
A = [_G2477, _G2483],
B = [_G2492] ;
L = [_G2477, _G2483, _G2489, _G2492],
A = [_G2477, _G2483],
B = [_G2489, _G2492]
....
I just started learning prolog and i don't understand why this returning false. I tried find solutions, but i not found. Can someone tell me why this return false?
[[A],B,C]=[[a,b,c],[d,e,f],1].
Short answer: [A] is a singleton list, but the corresponding element [a,b,c] has three elements.
You aim to match [[A], B, C] with [[a,b,c], [d,e,f], 1]. This thus means that you want to match a list with three elements with [[a,b,c], [d,e,f], 1]. Furthermore it means that you want to match [A] = [a,b,c], B = [d,e,f] and C = 1. The [A] can however not match with [a,b,c], since [A] means a singleton list.
You probably want to match this with [A,B,C] instead:
?- [[A],B,C]=[[a,b,c],[d,e,f],1].
false.
?- [A,B,C]=[[a,b,c],[d,e,f],1].
A = [a, b, c],
B = [d, e, f],
C = 1.
If you want to match with a non-empty list, with A the first element, you can match this with [A|_] instead:
?- [[A|_],B,C]=[[a,b,c],[d,e,f],1].
A = a,
B = [d, e, f],
C = 1.
Here is another way to answer why your query fails using library(diadem):
?- [[A],B,C]=[[a,b,c],[d,e,f],1].
false.
?- [[A],B,C]=[[a,b,c],[d,e,f],1].?X.
X = ([[A]|_]=[[_,_|_]|_]) /* 1 */
; X = (dif(A100,B100),[[A|A100]|_]=[[_|B100]|_]) /* 2 */
; X = (dif(A100,B100),[A100|_]=[B100|_]) /* 3 */
; X = (dif(A100,B100),A100=B100) /* 4 */
; ... .
Here the system generates most general generalizations that still fail.
The first generalization removes all irrelevant parts, what remains is this [A] and [_,_|_].
The second generalization insists that the tail of both lists is just different (instead of insisting that they are [] and [_|_] as stated in the first generalization).
The third and fourth are just more general views of it.
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.
Is there a simple way of getting all the combinations of a list without doubles. Without doubles I mean also no permutations of each other. So no [a,b,c] and [c,a,b] or [c,b,a].
So for the input [a,b,c] the output would be:
[a]
[b]
[c]
[a,b]
[a,c]
[b,c]
[a,b,c]
I can only find solutions WITH the doubles (permutations)
The solution to this problem is rather simple: there is evidently only one combination out of the empty set: the empty set:
combs([],[]).
Furthermore for each element, you can decide whether you add it or not:
combs([H|T],[H|T2]) :-
combs(T,T2).
combs([_|T],T2) :-
combs(T,T2).
Since you pick (or drop) in the order of the list, this guarantees you that you later will not redecide to pick a. If you feed it [a,b,c], it will never generate something like [b,a,c], because once it has decided to pick/drop a, it cannot add b and re-decide on a.
Running this gives:
?- combs([a,b,c],L).
L = [a, b, c] ;
L = [a, b] ;
L = [a, c] ;
L = [a] ;
L = [b, c] ;
L = [b] ;
L = [c] ;
L = [].
In case you want to generate it the opposite way (have more of a test to first drop elements, instead of adding them, you can simply swap the recursive statements):
combs([],[]).
combs([_|T],T2) :-
combs(T,T2).
combs([H|T],[H|T2]) :-
combs(T,T2).
In that case the result will be:
?- combs([a,b,c],L).
L = [] ;
L = [c] ;
L = [b] ;
L = [b, c] ;
L = [a] ;
L = [a, c] ;
L = [a, b] ;
L = [a, b, c].
EDIT
Given you want to exclude the empty list, either you can do it simply by adding another check in your call:
?- combs([a,b,c],L),L \= [].
You can define this in a function like:
combs_without_empty1(LA,LB) :-
combs_without_empty1(LA,LB),
LB \= [].
Or by rewriting the comb/2 function. In that case you better use an accumulator that counts the current amount of selected elements:
combs_without_empty(L,C) :-
combs_without_empty(L,0,C).
The combs_without_empty/3 is a bit more complicated. In case the list contains only one element, one should check if N is greater than zero. If that is the case, we can choose whether to add the element or not. If N is zero, we have to include it. So:
combs_without_empty([A],_,[A]).
combs_without_empty([_],N,[]) :-
N > 0.
We also have to implement a recursive part that will increment N given we select an element:
combs_without_empty([_|T],N,T2) :-
combs_without_empty(T,N,T2).
combs_without_empty([H|T],N,[H|T2]) :-
N1 is N+1,
combs_without_empty(T,N1,T2).
Putting it all together gives:
combs_without_empty(L,C) :-
combs_without_empty(L,0,C).
combs_without_empty([A],_,[A]).
combs_without_empty([_],N,[]) :-
N > 0.
combs_without_empty([_|T],N,T2) :-
combs_without_empty(T,N,T2).
combs_without_empty([H|T],N,[H|T2]) :-
N1 is N+1,
combs_without_empty(T,N1,T2).
Which produces:
?- combs_without_empty([a,b,c],L).
L = [c] ;
L = [b, c] ;
L = [b] ;
L = [a, c] ;
L = [a] ;
L = [a, b, c] ;
L = [a, b] ;
false.
A clean solution without ancillary checks for empty list would be simply to exclude empty lists from the rules. The base case should be a single element combination:
comb_without_empty([H|_], [H]). % Simple case of one element comb
comb_without_empty([_|T], C) :- % Combinations of the tail w/o head
comb_without_empty(T, C).
comb_without_empty([H|T], [H|C]) :- % Combinations of the tail including head
comb_without_empty(T, C).
| ?- comb_without_empty([a,b,c], L).
L = [a] ? a
L = [b]
L = [c]
L = [b,c]
L = [a,b]
L = [a,c]
L = [a,b,c]
(1 ms) no
| ?-
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.