Friendly lists prolog - list

I am given 2 lists for example K=[a,b,c,d,e,f,g] and L=[a,b,1,d,e,2,g]. When these 2 lists have 2 different elements, then they are friendly.
This is what I've tried:
friendly(K,L):-
append(L1,[Z],A1),
append(A1,L2,A2),
append(A2,[Q],A3),
append(A3,L3,K),
append(L1,[Y],B1),
append(B1,L2,B2),
append(B2,[W],B3),
append(B3,L3,L),
Z\=Y,
Q\=W.
Thank you all so much, at last I found the correct code:
friend(L1,L2):-
append(A,Y,L1),
append([Z|T],[F|TT],Y),
append(A,Q,L2),
append([R|T],[O|TT],Q),
Z\=R,
F\=O.

You can use append/3 in this way to locate the first different elements.
first_different(L1,L2, R1,R2) :-
append(H, [E1|R1], L1),
append(H, [E2|R2], L2),
E1 \= E2.
H is the common part, R1,R2 are the 'remainders'. This code is more in line with your second comment above.
Now you must apply two times this helper predicate, and the second time also 'remainders' must be equal, or one of them must be empty. That is
friendly(L1,L2) :-
first_different(L1,L2,R1,R2),
first_different(R1,R2,T1,T2),
once((T1=T2;T1=[];T2=[])).
Alternatively, using some builtin can be rewarding. This should work
friendly(L1,L2) :- findall(_,(nth1(I,L1,E1),nth1(I,L2,E2),E1\=E2),[_,_]).

Wouldn't it be better to do something like the following?
diff([], [], []).
diff([], K, K).
diff(L, [], L).
diff([H | TL], [H | TK], D) :- diff(TL, TK, D),!.
diff([HL | TL], [HK | TK], [HL, HK | D]) :- diff(TL, TK, D),!.
friendly(K, L) :- diff(K, L, D), length(D, Length), Length < 3.
But your problem really is underspecified. For example my program really cares about order so [a,x,b] and [a,b] are not friendly by my definition.

I'm still a little uncertain about the total definition of "friendly" list, but I think this might answer it:
friendly(A, B) :-
friendly(A, B, 2).
friendly([H|TA], [H|TB], C) :-
C > 0,
friendly(TA, TB, C).
friendly([HA|TA], [HB|TB], C) :-
HA \= HB,
C > 0,
C1 is C-1,
friendly(TA, TB, C1).
friendly(A, [], C) :-
length(A, L),
L =< C.
friendly([], B, C) :-
length(B, L),
L =< C.
friendly(A, A, 0).
I'm assuming that the definition of friendly means the lists are in "lock step" outside of the maximum of two differences.

Does order matter? Are the lists sets (each element is unique) or bags (duplicates allowed)?
Assuming that
Order doesn't matter ([1,2,3] and [1,3,2]) are treated as identical), and
Duplicates don't matter ([1,2,3,1] and [1,2,3]) are treated as identical
Something like this might be along the lines of what you're looking for:
friendly(Xs,Ys) :-
set_of(
E ,
(
( member(E,Xs) ,
not( member(E,Ys) )
)
;
(
member(E,Ys) ,
not( member(E,Xs) )
) ,
Zs
) ,
length( Zs , L ) ,
L =< 2
.
Find the set of all elements of each list that aren't in the other and succeed if the resulting list is of length 0, 1 or 2.

I came up with something similar to others.. I just keep a list of '_' items (final param of diff_list) - one for each difference, be that a value difference at the same index, or a difference in the length, then finally in friendly/2, check that has 2 items.
% recursion base
diff_list([], [], []).
% the head of both lists are the same, don't add to diff list
diff_list([HK|TK], [HK|TL], Diff) :-
diff_list(TK, TL, Diff).
% the above rule failed, so must be a difference, add a '_'
diff_list([_|TK], [_|TL], [_|Diff]) :-
diff_list(TK, TL, Diff).
% 1st list is empty, but the 2nd isn't. That's a diff again.
diff_list([], [_|TL], [_|Diff]) :-
diff_list([], TL, Diff).
% 2nd list is empty, but the 1st isn't. Another diff.
diff_list([_|TK], [], [_|Diff]) :-
diff_list(TK, [], Diff).
% friendly is true if the diff list length unifies with 2 item length list [_,_]
friendly(K, L) :-
diff_list(K, L, [_,_]).

Related

Perfoming member check on a difference list, but how?

I tried to answer another question (wrongly though) and this led to a question on "difference lists" (or "list differences", which seems a more appropriate name, unless "Escherian Construction" isn't preferred)
We have a fully ground list of elements obj(X,Y) (both X and Y ground). We want to retain only the first obj(X,_) where X hasn't been encountered yet when going through the list front to back. Those "first elements" must appear in order of appearance in the result.
Let's specify the problem through test cases:
% Testing
:- begin_tests(collapse_dl).
test(one) :- collapse_dl([],[]).
test(two) :- collapse_dl([obj(a,b)],
[obj(a,b)]).
test(three) :- collapse_dl([obj(a,b),obj(a,c)],
[obj(a,b)]).
test(four) :- collapse_dl([obj(a,b),obj(a,c),obj(b,j)],
[obj(a,b),obj(b,j)]).
test(five) :- collapse_dl([obj(a,b),obj(a,c),obj(b,j),obj(a,x),obj(b,y)],
[obj(a,b),obj(b,j)]).
:- end_tests(collapse_dl).
rt :- run_tests(collapse_dl).
Now, this is easy to implement using filtering, list prepend and reverse/2, but what about using difference lists and list append?
however, I'm not able to get the seen/2 predicate to work. It checks whether obj(A,_) is already in the difference list. But what's a proper termination for this predicate?
% This is called
collapse_dl([],[]) :- !.
collapse_dl([X|Xs],Out) :-
Dlist = [X|Back]-Back, % create a difflist for the result; X is surely in there (as not yet seen)
collapse_dl(Xs,Dlist,Out). % call helper predicate
% Helper predicate
collapse_dl([],Ldown,Lup):- % end of recursion; bounce proper list back up
Ldown = Lup-[]. % the "back" of the difflist is unified with [], so "front" becomes a real list, and is also Lup
collapse_dl([obj(A,_)|Objs],Ldown,Out) :-
seen(obj(A,_),Ldown), % guard: already seen in Ldown?
!, % then commit
collapse_dl(Objs,Ldown,Out). % move down chain of induction
collapse_dl([obj(A,B)|Objs],Ldown,Out) :-
\+seen(obj(A,_),Ldown), % guard: not yet seen in Ldown?
!, % then commit
Ldown = Front-Back, % decompose difference list
Back = [obj(A,B)|NewTail], % NewTail is fresh! Append via difflist unification magic
collapse_dl(Objs,Front-NewTail,Out). % move down chain of induction; Front has been refined to a longer list
% Membership check in a difference list
seen(obj(A,_),[obj(A,_)|_Objs]-[]) :- !. % Yup, it's in there. Cut retry.
seen(Obj,[_|Objs]-[]) :- ... % But now???
Update
With Paulo's code snippet:
% Membership check in a difference list
seen(Element, List-Back) :-
List \== Back,
List = [Element|_].
seen(Element, List-Back) :-
List \== Back,
List = [_| Tail],
seen(Element, Tail-Back).
So, term equivalence, or dis-equivalence in this case, is the solution!
We now pass all the test.
Try (taken from Logtalk difflist library object):
member(Element, List-Back) :-
List \== Back,
List = [Element|_].
member(Element, List-Back) :-
List \== Back,
List = [_| Tail],
member(Element, Tail-Back).
memberchk/2 should do it. Using the approach from here,
%% collapse_dl( ++Full, -Short )
collapse_dl( [obj(K,V) | A], B ) :-
memberchk( obj(K,X), B ),
( X = V -> true ; true ),
collapse_dl( A, B ).
collapse_dl( [], B ) :-
length( B, _), !.
Doing what (functional) Prolog does best, instantiating an open-ended list in a top-down manner.
Passes the tests included in the question.
Addendum: With printouts
%% collapse_dl( ++Full, -Short )
collapse_dl( [obj(K,V) | A], B ) :-
format("Enter : ~w relatedto ~w\n", [[obj(K,V) | A], B]),
% Necessarily find (find or insert) obj(K, X) (thanks to the
% uninstantiated X) in list B which has an "unobserved" tail:
memberchk( obj(K,X), B ),
% Unify X with V if you can; ignore failure if you can't!
( X = V -> true ; true ),
format("Mid : ~w relatedto ~w\n", [[obj(K,V) | A], B]),
collapse_dl( A, B ),
format("Return: ~w relatedto ~w\n", [[obj(K,V) | A], B]).
collapse_dl( [], B ) :-
format("Termination: From unobserved-tail-list ~w ",[B]),
length(B, _),
format("to ~w (and don't come back!)\n",[B]),
!.
Because of the added printouts this code is no longer tail-recursive. The original is, and so has no "return" in its trace: it just goes forward and stops working right away when the input list is traversed to its end.
See more about the distinction e.g. here.
This "open-ended list" technique is not difference list, but the two are very closely related. And we don't actually need the explicit tail anywhere here, except for the final freezing. So we just do the O(n) length call instead of the explicit O(1) Tail = [] we'd do with difference lists, no biggie.
Of bigger impact is the choice of list instead of e.g. tree data structure. Trees can be open-ended too, just need to use var/1 here and there. Next step is the tree's structure. Top-down open-leaved tree can't be rotated (as all the calls reference the same top node) so its depth will depend on the input's orderedness. To maintain good balance the trees need to be rotated on occasion, hence closed; and we're back to the traditional state-passing code, were each call gets two tree arguments -- the one before update, and the other after it: the
upd(T1, T2), next(T2, T3), more(T3, T4), ...
kind of thing. It ought to be used in real code. There are some libraries that do that.
This answer's code is simplistic, in order to be simple and illustrative.
Since I currently need it, I got a simpler solution. Assuming the
difference list is open, means for the pair List-Back, we have var(Back).
Then we can short cut, only passing List:
member_open(_, List) :- var(List), !, fail.
member_open(Element, [Element|_]).
member_open(Element, [_|List]) :- member_open(Element, List).
If we want to append an element to the List, since for example we didn't find it via member_open/2, we simply make Back = [NewElement|Back2] and continue with Back2.
Here is variables/2 (ISO term_variables/2) written this way, so that it doesn't need reverse/1:
variables(T, L) :-
variables(T, B, B, B2),
B2 = [],
L = B.
variables(V, L, B, B) :- var(V), member_open(W, L), V == W, !.
variables(V, L, [V|B], B) :- var(V), !.
variables(T, L, B, B2) :-
T =.. [_|A],
variables_list(A, L, B, B2).
variables_list([T|A], L, B, B2) :-
variables(T, L, B, H),
variables_list(A, L, H, B2).
variables_list([], _, B, B).
Seems to work:
?- variables(f(X,g(X,Y),Y), L).
L = [X, Y].

Prolog - get middle element of List

I would like to get the middle element of a list in Prolog.
The predicates middle([1,2,3],M) and middle([1,2,3,4],M) should both return 2 as a result.
And I am allowed to use the predicate deleteLast.
I know that there are similar posts that solve that question but I have not found one that just uses deleteLast.
Even the syntax is not correct - however this is my solution so far:
middle([], _).
middle([X|XTail|Y], E) :-
1 is mod(list_length([X|XTail|Y], 2)),
middle([XTail], E).
middle([X|XTail|Y], E) :-
0 is mod(list_length([X|XTail|Y], 2)),
middle([X|XTail], E).
middle([X], X).
Question: Is that partly correct or am I completely on the wrong path ?
Sorry, the attempted solution you have is completely on the wrong path.
It doesn't use deleteLast/2 as you stated you require
You are using list_length/2 as if it were an arithmetic function, which it is not. It's a predicate.
You have a term with invalid syntax and unknown semantics, [X|XTail|Y]
In Prolog, you just need to think about it in terms of the rules. Here's an approach using deleteLast/2:
middle([X], X). % `X` is the middle of the single element list `[X]`
middle([X,_], X). % `X` is the middle of the two-element list `[X,_]`
% X is the middle of the list `[H|T]` if X is the middle of the list TWithoutLast
% where TWithoutLast is T with its last element removed
%
middle([H|T], X) :-
deleteLast(T, TWithoutLast),
middle(TWithoutLast, X).
I assume deleteLast/2 is well-behaved and just fails if T is empty.
You can also do this with same_length/2 and append/3, but, alas, doesn't use deleteLast/2:
middle(L, M) :-
same_length(L1, L2),
append(L1, [M|L2], L).
middle(L, M) :-
same_length(L1, L2),
append(L1, [M,_|L2], L).
So much unnecessary work, and unnecessary code. length/2 is very efficient, and a true relation. Its second argument is guaranteed to be a non-negative integer. So:
middle(List, Middle) :-
List = [_|_], % at least one element
length(List, Len),
divmod(Len, 2, Q, R), % if not available do in two separate steps
N is Q + R,
nth1(N, List, Middle).
And you are about ready:
?- middle(L, M), numbervars(L).
L = [A],
M = A ;
L = [A, B],
M = A ;
L = [A, B, C],
M = B ;
L = [A, B, C, D],
M = B ;
L = [A, B, C, D, E],
M = C ;
L = [A, B, C, D, E, F],
M = C .
I understand that this doesn't solve your problem (the answer by #lurker does) but it answers your question. :-(
Here is my attempt:
middle(L,M):- append(L1,L2,L),length(L1,N),length(L2,N), reverse(L1,[M|_]).
middle(L,M):- append(L1,L2,L),length(L1,N),length(L2,N1), N is N1+1 ,
reverse(L1,[M|_]).
Example:
?- middle([1,2,3],M).
M = 2 ;
false.
?- middle([1,2,3,4],M).
M = 2 ;
false.
In your implementation the problem is that by writing for example:
list_length([X|XTail|Y], 2)
The above does not give you as X the first element and as Y the last so I think it has some major problems...
As well pointed out by lurker you could write the above solution in one clause without using reverse/2:
middle(L, M) :- append(L1, [M|T], L), length(L1, N), length([M|T], N1),
(N1 is N + 1 ; N1 is N + 2).
Also to make the solution more relational (also see mat's comment below) you could use CLPFD library and replace is/2 with #= like:
middle(L, M) :- append(L1, [M|T], L), length(L1, N), length([M|T], N1),
(N1 #= N + 1 ; N1 #= N + 2).
Another interesting solution is to consider this predicate for splitting a list in half:
half(List, Left, Right) :-
half(List, List, Left, Right).
half(L, [], [], L).
half(L, [_], [], L).
half([H|T], [_,_|T2], [H|Left], Right) :-
half(T, T2, Left, Right).
This predicate divides an even list into two equal halves, or an odd list into two pieces where the right half has one more element than the left. It does so by reducing the original list, via the second argument, by two elements, each recursive call, while at the same time reducing the original list by one element each recursive call via the first argument. When it recurses down to the second argument being zero or one elements in length, then the first argument represents the half that's left, which is the right-hand list.
Example results for half/3 are:
| ?- half([a,b,c], L, R).
L = [a]
R = [b,c] ? a
(1 ms) no
| ?- half([a,b,c,d], L, R).
L = [a,b]
R = [c,d] ? a
no
| ?-
We can't quite use this to easily find the middle element because, in the even case, we want the last element of the left hand list. If we could bias the right-hand list by an extra element, we could then pick off the head of the right-hand half as the "middle" element. We can accomplish this using the deleteLast/2 here:
middle([X], X).
middle(List, Middle) :-
deleteLast(List, ListWithoutLast),
half(ListWithoutLast, _, [Middle|_]).
The head of the right half list of the original list, with the last element deleted, is the "middle" element. We can also simply half/3 and combine it with middle/2 since we don't really need everything half/3 does (e.g., we don't need the left-hand list, or the tail of the right hand list):
middle([X], X).
middle(List, Middle) :-
deleteLast(List, ListWithoutLast),
middle(ListWithoutLast, ListWithoutLast, Middle).
middle([M|_], [], M).
middle([M|_], [_], M).
middle([_|T], [_,_|T2], Right) :-
middle(T, T2, Right).
Another approach would be to modify half/3 to bias the splitting of the original list in half toward the right-hand half, which eliminates the need for using deleteLast/2.
modified_half(List, Left, Right) :-
modified_half(List, List, Left, Right).
modified_half(L, [_], [], L).
modified_half(L, [_,_], [], L).
modified_half([H|T], [_,_,X|T2], [H|Left], Right) :-
modified_half(T, [X|T2], Left, Right).
This will bias the right hand list to have an extra element at the "expense" of the left:
| ?- modified_half([a,b,c,d,e], L, R).
L = [a,b]
R = [c,d,e] ? a
no
| ?- modified_half([a,b,c,d,e,f], L, R).
L = [a,b]
R = [c,d,e,f] ? a
no
| ?-
Now we can see that the middle element, per the original definition, is just the head of the right hand list. We can create a new definition for middle/2 using the above. As we did before with half/3, we can ignore everything but the head in the right half, and we can eliminate the left half since we don't need it, and create a consolidated middle/2 predicate:
middle(List, Middle) :-
middle(List, List, Middle).
middle([M|_], [_,_], M).
middle([M|_], [_], M).
middle([_|T], [_,_,X|T2], Middle) :-
middle(T, [X|T2], Middle).
This reduces the original list down one element at a time (first argument) and two elements at a time (second argument) until the second argument is reduced to one or two elements. It then considers the head first argument to be the middle element:
This gives:
| ?- middle([a,b,c], M).
M = b ? ;
no
| ?- middle([a,b,c,d], M).
M = b ? ;
no
| ?- middle(L, M).
L = [M,_] ? ;
L = [M] ? ;
L = [_,M,_,_] ? ;
L = [_,M,_] ? ;
L = [_,_,M,_,_,_] ? ;
L = [_,_,M,_,_] ? ;
L = [_,_,_,M,_,_,_,_] ?
...

Excluding all occurrences of the minimum number in a list

As a Prolog newbie, I try to define a predicate filter_min/2 which takes two lists to determine if the second list is the same as the first, but with all occurrences of the minimum number removed.
Sample queries with expected results:
?- filter_min([3,2,7,8], N).
N = [3,7,8].
?- filter_min([3,2,7,8], [3,7,8]).
true.
I tried but I always get the same result: false. I don't know what the problem is. I need help!
Here is my code:
filter_min(X,Y) :-
X == [],
write("ERROR: List parameter is empty!"),
!;
min_list(X,Z),
filter(X,Y,Z).
filter([],[],0).
filter([H1|T1],[H2|T2],Z) :-
\+ number(H1),
write("ERROR: List parameter contains a non-number element"),
!;
H1 \= Z -> H2 is H1, filter(T1,T2,Z);
filter(T1,T2,Z).
There are a couple of problems with your code:
filter([],[],0). will not unify when working with any list that does not have 0 as its minimum value, which is not what you want. You want it to unify regardless of the minimum value to end your recursion.
The way you wrote filter([H1|T1],[H2|T2],Z) and its body will make it so that the two lists always have the same number of elements, when in fact the second one should have at least one less.
A correct implementation of filter/3 would be the following:
filter([],[],_).
filter([H1|T1],L2,Z):-
\+ number(H1),
write("ERROR: List parameter contains a non-number element"),
!;
H1 \= Z -> filter(T1,T2,Z), L2 = [H1|T2];
filter(T1,L2,Z).
A bounty was offered...
... for a pure solution that terminates for (certain) cases where neither the length of the first nor of the second argument is known.
Here's a candidate implementation handling integer values, built on clpfd:
:- use_module(library(clpfd)).
filter_min(Xs,Ys) :-
filter_min_picked_gt(Xs,_,false,Ys).
filter_min_picked_gt([] ,_,true ,[]).
filter_min_picked_gt([Z|Xs],M,Picked,[Z|Zs]) :-
Z #> M,
filter_min_picked_gt(Xs,M,Picked,Zs).
filter_min_picked_gt([M|Xs],M,_,Zs) :-
filter_min_picked_gt(Xs,M,true,Zs).
Some sample queries:
?- filter_min([3,2,7,8],[3,7,8]).
true ; false. % correct, but leaves choicepoint
?- filter_min([3,2,7,8],Zs).
Zs = [3,7,8] ; false. % correct, but leaves choicepoint
Now, some queries terminate even though both list lengths are unknown:
?- filter_min([2,1|_],[1|_]).
false. % terminates
?- filter_min([1,2|_],[3,2|_]).
false. % terminates
Note that the implementation doesn't always finitely fail (terminate) in cases that are logically false:
?- filter_min([1,2|_],[2,1|_]). % does _not_ terminate
For a Prolog newbie, better start with the basics. The following works when first argument is fully instantiated, and the second is an uninstantiated variable, computing the result in one pass over the input list.
% remmin( +From, -Result).
% remmin([],[]). % no min elem to remove from empty list
remmin([A|B], R):-
remmin(B, A, [A], [], R). % remove A from B to get R, keeping [A]
% in case a smaller elem will be found
remmin([C|B], A, Rev, Rem, R):-
C > A -> remmin(B, A, [C|Rev], [C|Rem], R) ;
C==A -> remmin(B, A, [C|Rev], Rem, R) ;
C < A -> remmin(B, C, [C|Rev], Rev, R).
remmin([], _, _, Rem, R) :- reverse(Rem, R).
First, we can get the minimum number using the predicate list_minnum/2:
?- list_minnum([3,2,7,8],M).
M = 2.
We can define list_minnum/2 like this:
list_minnum([E|Es],M) :-
V is E,
list_minnum0_minnum(Es,V,M).
list_minnum0_minnum([],M,M).
list_minnum0_minnum([E|Es],M0,M) :-
M1 is min(E,M0),
list_minnum0_minnum(Es,M1,M).
For the sake of completeness, here's the super-similar list_maxnum/2:
list_maxnum([E|Es],M) :-
V is E,
list_maxnum0_maxnum(Es,V,M).
list_maxnum0_maxnum([],M,M).
list_maxnum0_maxnum([E|Es],M0,M) :-
M1 is max(E,M0),
list_maxnum0_maxnum(Es,M1,M).
Next, we use meta-predicate tfilter/3 in tandem with dif/3 to exclude all occurrences of M:
?- M=2, tfilter(dif(M),[2,3,2,7,2,8,2],Xs).
Xs = [3,7,8].
Put the two steps together and define min_excluded/2:
min_excluded(Xs,Ys) :-
list_minnum(Xs,M),
tfilter(dif(M),Xs,Ys).
Let's run some queries!
?- min_excluded([3,2,7,8],Xs).
Xs = [3,7,8].
?- min_excluded([3,2,7,8,2],Xs).
Xs = [3,7,8].

Swapping a specific number in list 1 with a specific number in list 2

I have been brushing up on some Prolog recently. I kind of enjoy just coming up with random problems to try and solve and then working them out. This one is quite tough though, and I'm not one to give up on a problem that I have set out to solve.
The problem: I want to make a predicate that will have 2 predetermined lists, 2 numbers to swap, and then output the lists after the swapping is done.
Further Explanation: I made it a little harder on myself by wanting to find a specific unique number from list 1, and swapping this with a specific unique number from list 2 so that if I have 2 lists...
[7,2,7,8,5], and [1,2,3,8,7,9,8], and then give the predicate 2 numbers(Lets just say 8 and 7), then the number 8 and the number 7 will be swapped between the lists IF AND ONLY IF the number 8 is in the first list and the number 7 is in the second list. (It would disregard an 8 in the second list and a 7 in the first list).
Sample query with expected answer:
?- bothSwap([7,2,7,8,5],[1,2,3,8,7,9,8],8,7,X,Y).
X = [7,2,7,7,5], Y = [1,2,3,8,8,9,8].
I kind of got stuck at this point:
bothSwap([],L2,N1,N2,[],L2).
bothSwap(L1,[],N1,N2,L1,[]).
bothSwap([H1|T1],[H2|T2],N1,N2,X,Y) :- H1 == N1, H2 == N2, bothSwap(T1,T2,N1,N2,D1,D2), append(D1,[H2],X), append(D2,[H1],Y).
bothSwap([H1|T1],[H2|T2],N1,N2,X,Y) :- H1 == N1, H2 =\= N2, bothSwap([H1|T1],T2,N1,N2,D1,D2).
bothSwap([H1|T1],[H2|T2],N1,N2,X,Y) :- H1 =\= N1, H2 == N2, bothSwap(T1,[H2|T2],N1,N2,D1,D2).
Any bright minds out there willing to tackle this problem with me? :)
Imagine how easy this problem would be if we could just "wish" for a list to be split up at the occurrence of the desired element, like this:
?- splitsies([1,2,3,4,5,6,7,8], 4, Prefix, Suffix).
Prefix = [1, 2, 3],
Suffix = [5, 6, 7, 8] ;
Guess what? :) append/3 can do that:
% splitsies is true if X splits list into a prefix/suffix pair.
splitsies(List, X, Start, Finish) :-
append(Start, [X|Finish], List).
Now the problem seems pretty simple!
bothSwap(Left, Right, A, B, AfterLeft, AfterRight) :-
% break up the inputs
splitsies(Left, A, LPre, LPost),
splitsies(Right, B, RPre, RPost),
% glue together the outputs (note that A and B are switched)
splitsies(AfterLeft, B, LPre, LPost),
splitsies(AfterRight, A, RPre, RPost).
I wouldn't pretend that this solution is efficient… but it's so hot you better wear oven mitts when you type it in. Oh, and check this out:
?- bothSwap([7,2,7,8,5],[1,2,3,8,7,9,8], X, Y, [7,2,7,7,5], [1,2,3,8,8,9,8]).
X = 8,
Y = 7 ;
false.
Let's start, what you mean by swapping.
swap(X0,X, S0,S) :-
if_(X0 = S0, S = X, S = S0).
bothSwap0(Xs0, Ys0, X0,X, Xs,Ys) :-
maplist(swap(X0,X), Xs0,Xs),
maplist(swap(X,X0), Ys0,Ys).
if_( C_1, Then_0, Else_0) :-
call(C_1, Truth),
functor(Truth,_,0), % safety check
( Truth == true -> Then_0 ; Truth == false, Else_0 ).
=(X, Y, R) :- X == Y, !, R = true.
=(X, Y, R) :- ?=(X, Y), !, R = false. % syntactically different
=(X, Y, R) :- X \= Y, !, R = false. % semantically different
=(X, Y, R) :- R == true, !, X = Y.
=(X, X, true).
=(X, Y, false) :-
dif(X, Y).
Now you wanted a particular condition - it is not clear how to apply it. I see two interpretations:
bothSwap(Xs0, Ys0, X0,X, Xs,Ys) :-
memberd(X0, Xs0),
memberd(X, Ys0),
maplist(swap(X0,X), Xs0,Xs),
maplist(swap(X,X0), Ys0,Ys).
Which means that bothSwap/6 will fail should the two elements not occur in their respective list.
Another interpretation might be that you want that otherwise the lists remain the same. To express this (in a pure monotonic fashion):
bothSwap(Xs0, Ys0, X0,X, Xs,Ys) :-
if_( ( memberd_t(X0, Xs0), memberd_t(X, Ys0) ),
( maplist(swap(X0,X), Xs0,Xs), maplist(swap(X,X0), Ys0,Ys) ),
( Xs0 = Xs, Ys0 = Ys) ).
memberd_t(E, Xs, T) :-
list_memberd(Xs, E, T).
list_memberd([], _, false).
list_memberd([X|Xs], E, T) :-
if_(E = X, T = true, list_memberd(Xs, E, T) ).
','( A_1, B_1, T) :-
if_( A_1, call(B_1, T), T = false ).
Since Prolog is a descriptive language (that is, we describe what constitutes a solution and let Prolog work it out), If I understand your problem statement correctly, something like this ought to suffice:
both_swap(L1, L2, A, B, S1, S2 ) :- % to do the swap,
memberchk(A,L1) , % - L1 must contain an A
memberchk(B,L2) , % - L2 must contain a B
replace(L1,A,B,S1) , % - replace all As in L1 with a B
replace(L2,B,A,S2) % - replace all Bs in L2 with an A
. % Easy!
replace([],_,_,[]) . % if the list is empty, we're done.
replace([H|T],A,B,[S|Ss]) :- % otherwise...
( H = A -> S=B ; S=H ) , % - do the swap (if necessary),
replace(T,A,B,Ss) % - and recurse down
. % Also easy!
This replicates the implementation that uses splitsies/4
swap_two(A,B,C,D,E,F) :-
nth0(I1,A,C,L1),
dif(A,L1),
nth0(I2,B,D,L2),
dif(B,L2),
nth0(I1,E,D,L1),
nth0(I2,F,C,L2).

Prolog compressing list

I have a strange problem that I do not know how to solve.
I have written a predicate that compresses lists by removing repeating items.
So if the input is [a,a,a,a,b,c,c,a,a], output should be [a,b,c,a]. My first code worked, but the item order was wrong. So I add a append/3 goal and it stopped working altogether.
Can't figure out why. I tried to trace and debug but don't know what is wrong.
Here is my code which works but gets the item order wrong:
p08([Z], X, [Z|X]).
p08([H1,H2|T], O, X) :-
H1 \= H2,
p08([H2|T], [H1|O], X).
p08([H1,H1|T], O, X) :-
p08([H1|T], O, X).
Here's the newer version, but it does not work at all:
p08([Z], X, [Z|X]).
p08([H1,H2|T], O, X) :-
H1 \= H2,
append(H1, O, N),
p08([H2|T], N, X).
p08([H1,H1|T], O, X) :-
p08([H1|T], O, X).
H1 is not a list, that's why append(H1, O, N) fails.
And if you change H1 to [H1] you actually get a solution identical to your first one. In order to really reverse the list in the accumulator you should change the order of the first two arguments: append(O, [H1], N). Also, you should change the first rule with one that matches the empty list p08([], X, X) (without it, the goal p08([], [], Out) fails).
Now, to solve your problem, here is the simplest solution (which is already tail recursive, as #false stated in the comments to this answer, so there is no need for an accumulator)
p([], []). % Rule for empty list
p([Head, Head|Rest], Out):- % Ignore the Head if it unifies with the 2nd element
!,
p([Head|Rest], Out).
p([Head|Tail], [Head|Out]):- % otherwise, Head must be part of the second list
p(Tail, Out).
and if you want one similar to yours (using an accumulator):
p08(List, Out):-p08(List, [], Out).
p08([], Acc, Acc).
p08([Head, Head|Rest], Acc, Out):-
!,
p08([Head|Rest], Acc, Out).
p08([Head|Tail], Acc, Out):-
append(Acc, [Head], Acc2),
p08(Tail, Acc2, Out).
Pure and simple:
list_withoutAdjacentDuplicates([],[]).
list_withoutAdjacentDuplicates([X],[X]).
list_withoutAdjacentDuplicates([X,X|Xs],Ys) :-
list_withoutAdjacentDuplicates([X|Xs],Ys).
list_withoutAdjacentDuplicates([X1,X2|Xs],[X1|Ys]) :-
dif(X1,X2),
list_withoutAdjacentDuplicates([X2|Xs],Ys).
Sample query:
?- list_withoutAdjacentDuplicates([a,a,a,a,b,c,c,a,a],Xs).
Xs = [a,b,c,a] ; % succeeds, but leaves useless choicepoint(s) behind
false
Edit 2015-06-03
The following code is based on if_/3 and reified term equality (=)/3 by #false, which---in combination with first argument indexing---helps us avoid above creation of useless choicepoints.
list_without_adjacent_duplicates([],[]).
list_without_adjacent_duplicates([X|Xs],Ys) :-
list_prev_wo_adj_dups(Xs,X,Ys).
list_prev_wo_adj_dups([],X,[X]).
list_prev_wo_adj_dups([X1|Xs],X0,Ys1) :-
if_(X0 = X1, Ys1 = Ys0, Ys1 = [X0|Ys0]),
list_prev_wo_adj_dups(Xs,X1,Ys0).
Let's see it in action!
?- list_without_adjacent_duplicates([a,a,a,a,b,c,c,a,a],Xs).
Xs = [a,b,c,a]. % succeeds deterministically
In this answer we use meta-predicate foldl/4 and
Prolog lambdas.
:- use_module(library(apply)).
:- use_module(library(lambda)).
We define the logically pure predicatelist_adj_dif/2 based on if_/3 and (=)/3:
list_adj_dif([],[]).
list_adj_dif([X|Xs],Ys) :-
foldl(\E^(E0-Es0)^(E-Es)^if_(E=E0,Es0=Es,Es0=[E0|Es]),Xs,X-Ys,E1-[E1]).
Let's run the query given by the OP!
?- list_adj_dif([a,a,a,a,b,c,c,a,a],Xs).
Xs = [a,b,c,a]. % succeeds deterministically
How about a more general query? Do we get all solutions we expect?
?- list_adj_dif([A,B,C],Xs).
A=B , B=C , Xs = [C]
; A=B , dif(B,C), Xs = [B,C]
; dif(A,B), B=C , Xs = [A,C]
; dif(A,B), dif(B,C), Xs = [A,B,C].
Yes, we do! So... the bottom line is?
Like many times before, the monotone if-then-else construct if_/3 enables us to ...
..., preserve logical-purity, ...
..., prevent the creation of useless choicepoints (in many cases), ...
..., and remain monotone—lest we lose solutions in the name of efficiency.
More easily:
compress([X],[X]).
compress([X,Y|Zs],Ls):-
X = Y,
compress([Y|Zs],Ls).
compress([X,Y|Zs],[X|Ls]):-
X \= Y,
compress([Y|Zs],Ls).
The code works recursevely and it goes deep to the base case, where the list include only one element, and then it comes up, if the found element is equal to the one on his right , such element is not added to the 'Ls' list (list of no duplicates ), otherwise it is.
compr([X1,X1|L1],[X1|L2]) :-
compr([X1|L1],[X1|L2]),
!.
compr([X1|L1],[X1|L2]) :-
compr(L1,L2).
compr([],[]).