specific sorting in PROLOG - list

I have to write a predicate insort/2 which reduces any list (with possibly
duplicated elements) to a list in which each distinct element appears only once
and a specific order is used. For example,
? - insort([a,[a,a],[a,b],[b,a],[[a,b]],[d],c],X).
X = [a,c,[a],[d],[a,b],[[a,b]]]
yes
? - insort([[a,[a,b]],[a,[c,b]],[[a,b],a]], X).
X = [[a,[a,b]],[a,[b,c]]]
yes
? - insort([[a,b],[a,[a]],[a,b,c]],X).
X = [[a,b],[a,[a]],[a,b,c]]
yes
The order should first examine the total length of the list and the list with smaller total length is “smaller”. If total length is the
same then the natural order of terms in PROLOG should be adopted. But final solution cannot use SWI-Prolog built-in sort/2 and merge/3 predicates.
My work for now is like that:
rlen([],0).
rlen(X,1).
rlen([Head|Tail],N):-rlen(Head,Q1),rlen(Tail,Q2),N is Q1+Q2.
member(Head, [Head|Tail]).
member(X, [Head|Tail]) :- member(X,Tail).
remove_duplicates([],[]).
remove_duplicates([H | T], List) :-
member(H, T),
remove_duplicates( T, List).
remove_duplicates([H | T], [H|T1]) :-
\+member(H, T),
remove_duplicates( T, T1).
count(_,[],0).
count(X,[X],1).
count(X, [X|Y],N):- count(X,Y,W),N is W + 1.
count(Z,[X|Y],N):- count(Z,Y,N),X\=Z.
elsort([],[]).
elsort([A|B],C):-
elsort(B,D),
(is_list(A)->elsort(A, SA);SA=A),
elsortx(SA,D,C).
elsortx(A,[X|B],[X|C]):-
order(X,A),
!,
elsortx(A,B,C).
elsortx(A,B,[A|B]).
order(X,Y) :- is_list(X), is_list(Y), length(X,A),length(Y,B),A<B.
order(A,A2):-
A #< A2.
But still missing some things, I don't know how use here remove_duplicates,
and why order([[a,b]],[a,b]). throws true, should be false
Thanks for help, I really don't know how handle this

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].

Subtracting or adding lists of lists in prolog?

I am fairly new to prolog and am trying to mess around with lists of lists. I am curious on how to add two lists of lists or subtract them resulting in one list of list. If I have two lists of lists lets say,
SomeList = [[1,2,3,4],[5,6,7,8]]
SomeList2 = [[1,2,3,4],[5,6,7,8]]
How could I add or subtract SomeList and SomeList2 to create a list of lists? Resulting in a sum of say
sumList([[2,4,6,8],[10,12,14,16]])
or vice-versa for subtraction? Any help would be appreciated not looking for code but for insight !
The easiest approach is with maplist:
add(X, Y, Z) :- Z is X + Y.
op_lists(L1, L2, R) :-
maplist(maplist(add), L1, L2, R).
Which gives:
| ?- op_lists([[1,2,3,4],[5,6,7,8]], [[1,2,3,4],[5,6,7,8]], R).
R = [[2,4,6,8],[10,12,14,16]]
yes
| ?-
In the expression:
maplist(maplist(add), L1, L2, R).
maplist(G, L1, L2, R) calls G on each element of L1 and L2, resulting in each element of R. Since each element of L1 and L2 is a list, then G in this case is maplist(add) which calls add on each element of the sublists.
You can obviously modify add(X, Y, Z) to be whatever operation you wish on each pair of elements. You can also make the addition more "relational" by using CLP(FD):
add(X, Y, Z) :- Z #= X + Y.
Then you also get, for example:
| ?- op_lists([[1,2,3,4],[5,6,7,8]], L, [[3,6,9,12],[10,12,14,16]]).
L = [[2,4,6,8],[5,6,7,8]]
yes
| ?-
If you wanted to do this without maplist, you could still use add/3 and use a two-layer approach:
op_lists([], [], []).
op_lists([LX|LXs], [LY|LYs], [LR|LRs]) :-
op_elements(LX, LY, LR),
op_lists(LXs, LYs, LRs).
op_elements([], [], []).
op_elements([X|Xs], [Y|Ys], [R|Rs]) :-
add(X, Y, R),
op_elements(Xs, Ys, Rs).
You can see the simple list processing pattern here, which the use of maplist takes care of for you.
Besides the solutions presented by #lurker (+1), I would also add the possibility to use DCGs, since you are working on lists. For the available operations I suggest to define a slightly more general predicate opfd/4 instead of add/3. Here are exemplary rules for addition and subtraction as asked in your question, you can use these as templates to add other two-place arithmetic operations:
opfd(+,X,Y,Z) :-
Z #= X+Y.
opfd(-,X,Y,Z) :-
Z #= X-Y.
As the desired operation is an argument, you only need one DCG-rule to cover all operations (marked as (1) at the corresponding goal). This way, of course, you have to specify the desired operation as an argument in your relation and pass it on to the DCGs. The structure of these DCGs is very similar to the last solution presented by #lurker, except that the resulting list does not appear as an argument since that is what the DCGs describe. For easier comparison I will stick with the names op_lists//3 and op_elements//3, the calling predicate shall be called lists_op_results/4:
lists_op_results(L1,L2,Op,Rs) :-
phrase(op_lists(Op,L1,L2),Rs).
op_lists(_Op,[],[]) -->
[].
op_lists(Op,[X|Xs],[Y|Ys]) -->
{phrase(op_elements(Op,X,Y),Rs)},
[Rs],
op_lists(Op,Xs,Ys).
op_elements(_Op,[],[]) -->
[].
op_elements(Op,[X|Xs],[Y|Ys]) -->
{opfd(Op,X,Y,R)}, % <-(1)
[R],
op_elements(Op,Xs,Ys).
Example queries:
?- lists_op_results([[1,2,3,4],[5,6,7,8]], [[1,2,3,4],[5,6,7,8]], +, R).
R = [[2,4,6,8],[10,12,14,16]]
?- lists_op_results([[1,2,3,4],[5,6,7,8]], [[1,2,3,4],[5,6,7,8]], -, R).
R = [[0,0,0,0],[0,0,0,0]]
#lurker's example:
?- lists_op_results([[1,2,3,4],[5,6,7,8]], L, +, [[3,6,9,12],[10,12,14,16]]).
L = [[2,4,6,8],[5,6,7,8]]
You can also ask if there is an operation that fits the given lists:
?- lists_op_results([[1,2,3,4],[5,6,7,8]], L, Op, [[3,6,9,12],[10,12,14,16]]).
L = [[2,4,6,8],[5,6,7,8]],
Op = + ? ;
L = [[-2,-4,-6,-8],[-5,-6,-7,-8]],
Op = -
On a sidenote: Since the operation is the first argument of opfd/4 you can also use it with maplist as suggested in #lurker's first solution. You just have to pass it lacking the last three arguments:
?- maplist(maplist(opfd(Op)),[[1,2,3,4],[5,6,7,8]], L, [[3,6,9,12],[10,12,14,16]]).
L = [[2,4,6,8],[5,6,7,8]],
Op = + ? ;
L = [[-2,-4,-6,-8],[-5,-6,-7,-8]],
Op = -

Prolog Sorting a List of Structure, arithmetic error

I've been trying to sort a list of structure.
The structure is like this
% person(Name, Weight).
person(tom, 65).
person(dan, 70).
person(mike, 80).
And the list would be like this
List = [person(tom, 65), person(dan, 70), person(mike, 80)].
I want to sort the list from greatest weight to least. Like this:
SortList = [person(mike, 80), person(dan, 70), person(tom, 65)].
So far I have this:
sortListPerson([], []).
sortListPerson([person(NameP, WP)|Rest], Result):-
sortListPerson(Rest, List),
insertPerson(person(NameP, WP), List, Result).
insertPerson(person(NameP, WP), [], [person(NameP, WP)]).
insertPerson(person(NameP1, WP1), [person(NameP2, WP2)|Rest], [person(NameP1, WP1)|List]):-
integer(WP1),
integer(WP2),
WP1 #>= WP2,
insertPerson(person(NameP2, WP2), Rest, List).
insertPerson(person(NameP1, WP1), [person(NameP2, WP2)|Rest], [person(NameP2, WP2)|List]):-
integer(WP1),
integer(WP2),
WP1 #< WP2,
insertInPlace(person(NameP1, WP1), Rest, List).
I've tried with a list of two persons and it works:
?- sortListPerson([person(a, 10), person(b, 30)], SortList).
SortList = [person(b,30),person(a,10)] ? ;
But when I try with a list of 3 or more person appears an error:
?- sortListPerson([person(a, 10), person(b, 30), person(c, 40)], SortList).
{ERROR: arithmetic:>=/2 - expected an arithmetically evaluable expression, found person(a,10)}
no
?-
Can anybody help?
The way I see it your insertion-sort is okay, except for the second clause of insertPerson/3:
:- use_module(library(clpfd)).
insertPerson(person(N,W), [], [person(N,W)]).
insertPerson(person(N1,W1), [person(N2,W2)|Ps], [person(N1,W1),person(N2,W2)|Ps]) :-
W1 #>= W2. % If Ps is in order, we're done!
insertPerson(person(N1,W1), [person(N2,W2)|Ps], [person(N2,W2)|Qs]) :-
W1 #< W2,
insertPerson(person(N1,W1), Ps, Qs).
Sample query:
?- sortListPerson([person(tom,65),person(dan,70),person(mike,80)], Xs).
Xs = [person(mike,80),person(dan,70),person(tom,65)] ;
false.
The error comes from the fact that the built-in arithmetic operators like < and =< only work on instantiated terms (i.e. 1 < 2 is true but 1 < X throws the exception you mentioned). If you use constraints, the code becomes something like:
:- use_module(library(clpfd)).
smallest_in_rest_vars(person(N,A), [person(N,A)], [], [A]).
smallest_in_rest_vars(person(N,A), [person(N1,A1) | Ps], % <-- this one fails without clpfd
[person(N1,A1) | Rs], [A1|Vs] ) :-
A #=< A1,
smallest_in_rest_vars(person(N,A), Ps, Rs, Vs).
smallest_in_rest_vars(person(N1,A1), [person(N1,A1) | Ps],
[person(N,A) | Rs], [A1|Vs] ) :-
A #> A1,
smallest_in_rest_vars(person(N,A), Ps, Rs, Vs).
list_sorted([],[], []).
list_sorted(L, [Smallest|SortedRest], Vars) :-
smallest_in_rest_vars(Smallest, L, Rest, Vars0),
list_sorted(Rest, SortedRest, Vars1),
append(Vars0, Vars1, Vars).
I assume your insertInPlace predicate is similar to smallest_in_rest_vars, only without the explicit list of variables Vs which is useful for labeling (which we don't need in this case). If I would not use constraints, I'd get the following error when I query with your list:
ERROR: =</2: Arguments are not sufficiently instantiated
Exception: (9) smallest_in_rest_vars(_G400, [person(tom, 65), person(dan, 70), person(mike, 80)], [person(_G406, _G407)], _G462) ?
The reason is that the clause which is marked in the example, we don't know anything about the new person N1 yet, which leads to a comparison 80 < A1. I found using clpfd much easier to think about, but when you give us your insertInPlace, we might find a non-clp solution too.

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([],[]).

Friendly lists prolog

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, [_,_]).