I am trying to remove duplicates from a list while keeping the rightmost occurrences. E.g.: [1,2,3,1,2] is transformed in [3,1,2]
It's one of my first tries in Prolog and I don't understand what am I doing wrong. It always returns false. This is my code:
%nrap(L:list,E:element,S:integer)
%L - the initial list, list of integers
%E - the element, integer
%S - the result, nrap of E in L, S integer
%flow model: (i,i,o),(i,i,i)
nrap([],_,0).
nrap([H|T],E,S):-
H=E,
nrap(T,E,S1),
S is S1+1.
nrap([H|T],E,S):-
H\=E,
nrap(T,E,S).
%transform(L:list,L2:list,R:list)
%L - the initial list, list of integers
%L2 - copy of the initial list
%R - the resulted list, without duplicates, list of integers
%flow model: (i,i,o),(i,i,i)
transform([],[],[]).
transform([H|T],L2,[H|R]):-
nrap(L2,H,S),
S=1,
transform(T,L2,R).
transform([H|T],L2,R):-
nrap(L2,H,S),
S>1,
transform(T,L2,R).
Shall I be pure or impure? Why even consider sacrificing logical-purity if we can save it easily!
Using memberd_t/3 and if_/3, we define list_rset/2 and its left "twin" list_lset/2:
list_rset([], []). % keep rightmost occurrences
list_rset([E|Es], Rs0) :-
if_(memberd_t(E, Es),
Rs0 = Rs,
Rs0 = [E|Rs]),
list_rset(Es, Rs).
list_lset([], []). % keep leftmost occurrences
list_lset([E|Es], Ls) :-
post_pre_lset(Es, [E], Ls). % uses internal auxilary predicate
post_pre_lset([], _, []).
post_pre_lset([E|Es], Pre, Ls0) :- % 2nd arg: look-behind accumulator
if_(memberd_t(E, Pre),
Ls0 = Ls,
Ls0 = [E|Ls]),
post_pre_lset(Es, [E|Pre], Ls).
Let's run some queries!
?- _Es = [1,2,3,1,2], list_lset(_Es, Ls), list_rset(_Es, Rs).
Ls = [1,2,3], Rs = [3,1,2]. % succeeds deterministically
In above query 1 precedes 2 both at the beginning and at the end of the list [1,2,3,1,2]. What if 1 precedes 2 at the beginning but follows it at the end (e.g., [1,2,3,2,1])?
?- _Es = [1,2,3,2,1], list_lset(_Es, Ls), list_rset(_Es, Rs).
Ls = [1,2,3], Rs = [3,2,1]. % succeeds deterministically
Next, we look at a more general list_rset/2 goal that uses a list containing variables only. Thanks to #PauloMoura for his suggestion!
?- Es = [A,B,C,A,B], list_rset(Es,Rs).
Es = [C,C,C,C,C], Rs = [ C], A=B , B=C
; Es = [B,B,C,B,B], Rs = [C, B], A=B , dif(B,C)
; Es = [C,B,C,C,B], Rs = [ C,B], A=C , dif(B,C)
; Es = [A,C,C,A,C], Rs = [ A,C], dif(A,C), B=C
; Es = [A,B,C,A,B], Rs = [C,A,B], dif(A,B), dif(A,C), dif(B,C).
What's up with the residual goals (above)?
Without sufficient instantiation, dif/2 is not decidable.
To save logical soundness, the execution of the prolog-dif constraints is delayed.
Last, one more use-case: an "input" list Xs that has both variables and ground terms.
?- Es = [A,B,z], list_rset(Es,Rs).
Es = [z,z,z], Rs = [ z], A=B , B=z
; Es = [B,B,z], Rs = [B, z], A=B , dif(B,z)
; Es = [z,B,z], Rs = [ B,z], A=z , dif(B,z)
; Es = [A,z,z], Rs = [A, z], dif(A,z), B=z
; Es = [A,B,z], Rs = [A,B,z], dif(A,B), dif(A,z), dif(B,z).
This is a follow-up to this previous answer... In this answer we use dcg!
We build lset//1 upon memberd_t/3 and if_//3—the dcg analogue of if_/3:
lset([]) -->
[].
lset([X|Xs]) -->
[X],
lset_pre(Xs,[X]).
lset_pre([],_) -->
[].
lset_pre([X|Xs],Pre) -->
if_(memberd_t(X,Pre), [], [X]),
lset_pre(Xs,[X|Pre]).
Same for rset//1:
rset([]) -->
[].
rset([X|Xs]) -->
if_(memberd_t(X,Xs), [], [X]),
rset(Xs).
Some sample queries:
?- _Es = [1,2,3,1,2], phrase(lset(_Es),Ls), phrase(rset(_Es),Rs).
Ls = [1,2,3], Rs = [3,1,2]. % succeeds deterministically
?- _Es = [1,2,3,2,1], phrase(lset(_Es),Ls), phrase(rset(_Es),Rs).
Ls = [1,2,3], Rs = [3,2,1]. % succeeds deterministically
This is easier than you are making it. Since the elements in the "set" have to be in the order of last appearance, you don't need to keep a copy of the list at all: just compare to the remainder of the list (the tail).
If you know that the first list is always going to be ground (all elements are integers, for example), you could write:
list_set([], []).
list_set([X|Xs], Ys0) :-
( memberchk(X, Xs)
-> Ys0 = Ys
; Ys0 = [X|Ys]
),
list_set(Xs, Ys).
memberchk/2 can be used to check if a ground term is in a list of ground terms. It will succeed or fail exactly once.
A more general solution is to pose a constraint that an element should be in the set if it is different from all the elements following it, and be dropped otherwise:
list_set([], []).
list_set([X|Xs], [X|Ys]) :-
maplist(dif(X), Xs),
list_set(Xs, Ys).
list_set([X|Xs], Ys) :-
\+ maplist(dif(X), Xs),
list_set(Xs, Ys).
Here, maplist(dif(X), Xs) means:
X is different from every element in the list Xs (the tail).
and \+ Goal succeeds then Goal does not succeed.
With this defintion:
?- list_set([1,2,3,1,2], S).
S = [3, 1, 2] ;
false.
?- list_set([1,2,3,3,1,1,2], S).
S = [3, 1, 2] ;
false.
?- list_set([A,B,C,A,B],Xs).
Xs = [C, A, B],
dif(A, B),
dif(C, B),
dif(C, A) ;
false.
Related
I would like to solve a simple problem, but even through I tried many different approaches, I couldn't find a solution for it. I am using SICStus Prolog (if that matters), and I want to get all sublists/subsets (I don't know which term is correct for this) of a list, which contains elements in succession. For example, if I have the list [1, 2, 3, 4], calling the sl/2 predicate as sl([1, 2, 3, 4], R)., the expected result is:
? - sl([1, 2, 3, 4], R).
R = [] ? ;
R = [1] ? ;
R = [1, 2] ? ;
R = [1, 2, 3] ? ;
R = [1, 2, 3, 4] ? ;
R = [2] ? ;
R = [2, 3] ? ;
R = [2, 3, 4] ? ;
R = [3] ? ;
R = [3, 4] ? ;
R = [4] ? ;
no
The best result I could reach until now is:
sl([], []).
sl([X|Xs], [X|Ys]) :-
sl(Xs, Ys).
sl([_|Xs], Ys) :-
sl(Xs, Ys).
But this also gives me the following unwanted results in addition:
R = [1,2,4] ? ;
R = [1,3,4] ? ;
R = [1,3] ? ;
R = [1,4] ? ;
R = [2,4] ? ;
How should I modify my predicates so I can get the desired result?
When writing a predicate in Prolog, you need to think about what the predicate means, or what relation it is defining. The reason your predicate gives non-solutions is that you are mixing meanings in your predicate clauses. They don't all really mean the same thing.
You have the predicate sl/2 which is intended to mean "sublist" (or "subsequence") but, more than that, means a sublist per the description you provided, which is a contiguous sublist (cannot have any "gaps" in it).
Now we can break down your clauses:
sl([], []).
This says the empty list is a contiguous sublist of the empty list. This is true, so is a valid fact.
sl([X|Xs], [X|Ys]) :-
sl(Xs, Ys).
This says that [X|Ys] is a contiguous sublist of [X|Xs] if Ys is a contiguous sublist of Xs. This relation is not true. What would really be true here would be: [X|Ys] is a contiguous sublist of [X|Xs] if Ys is a contiguous prefix sublist of Xs. That is, not only does Ys need to be a sublist of Xs, but it needs to be only from the start of the list and not somewhere within this list. This is a clue that you'll need another predicate since the meaning of the relation is different.
Your final clause says that Ys is a sublist of [_|Xs] if Ys is a sublist of Xs. This appears to be true.
If we simply adjust to the above updated definitions, we get:
subseq([], []).
subseq([_|Xs], Ys) :-
subseq(Xs, Ys).
subseq([X|Xs], [X|Ys]) :-
prefix_subseq(Xs, Ys).
prefix_subseq(_, []).
prefix_subseq([X|Xs], [X|Ys]) :-
prefix_subseq(Xs, Ys).
I offered the prefix_subseq/2 definition above without explanation, but I think you can figure it out.
This now yields:
| ?- subseq([a,b,c,d], R).
R = [a] ? a
R = [a,b]
R = [a,b,c]
R = [a,b,c,d]
R = [b]
R = [b,c]
R = [b,c,d]
R = [c]
R = [c,d]
R = [d]
R = []
(1 ms) yes
An interesting, compact way of defining your sublist (or subsequence) would be using the append/2 predicate:
subseq(L, R) :- append([_, R, _], L).
This says that L is the result of appending lists _, R, and _. The minor flaw in this simple implementation is that you'll get R = [] more than once since it satisfies the append([_, R, _], L) rule in more than one way.
Taking a fresh look at the definition, you can use a DCG to define a subsequence, as a DCG is perfect for dealing with sequences:
% Empty list is a valid subsequence
subseq([]) --> ... .
% Subsequence is any sequence, followed by sequence we want, followed by any sequence
subseq(S) --> ..., non_empty_seq(S), ... .
% Definition of any sequence
... --> [] | [_], ... .
% non-empty sequence we want to capture
non_empty_seq([X]) --> [X].
non_empty_seq([X|T]) --> [X], non_empty_seq(T).
And you can call it with phrase/2:
| ?- phrase(subseq(S), [a,b,c,d]).
S = [] ? ;
S = [a] ? ;
S = [a,b] ? ;
S = [a,b,c] ? ;
S = [a,b,c,d] ? ;
S = [b] ? ;
S = [b,c] ? ;
S = [b,c,d] ? ;
S = [c] ? ;
S = [c,d] ? ;
S = [d] ? ;
no
We can reswizzle this definition a little and make use of a common seq//1 definition to make it more compact:
subseq([]) --> seq(_) .
subseq([X|Xs]) --> seq(_), [X], seq(Xs), seq(_).
% alternatively: seq(_), seq([X|Xs]), seq(_).
seq([]) --> [].
seq([X|Xs]) --> [X], seq(Xs).
I'm trying to make a code that generates all subsets of a set in order.
That is, calling subset([1,2,3], X) should generate
X = [];
X = [1];
X = [2];
X = [3];
X = [1,2];
X = [1,3];
X = [2,3];
X = [1,2,3].
The internal order isn't all that important, only that the smallest subsets are listed first (i.e I don't care if [2,3] comes before [1,2], only that 1, [2] and [3] are before [2,3]).
--
I've tried two approaches thus far. First I tried making the predicate myself...
subset([], []).
subset(List, []).
subset(List, [N]) :-
member(N, List).
subset(List, [N|Rest]) :-
!,
nth0(I, List, N),
findall(E, (nth0(J, List, E), J > I), NewList),
subset2(NewList, Rest).
...but it doesn't even come close to working as intended. Secondly I tried making the powerset (using this subset predicate) and ordering with list_to_ord_set/2, but I couldn't get it to work either.
Help?
Always also consider using DCG notation when describing lists.
For example:
list_sublist(Ls0, Ls) :-
same_length(Ls0, Ls1),
append(Ls, _, Ls1),
phrase(sublist(Ls0), Ls).
sublist([]) --> [].
sublist([L|Ls]) --> ( [] ; [L] ), sublist(Ls).
Sample query:
?- list_sublist([a,b,c], Ls).
Ls = [] ;
Ls = [c] ;
Ls = [b] ;
Ls = [a] ;
Ls = [b, c] ;
Ls = [a, c] ;
Ls = [a, b] ;
Ls = [a, b, c] ;
false.
Another example:
?- list_sublist(Ls, [b,c]).
Ls = [b, c] ;
Ls = [_G511, b, c] ;
Ls = [b, _G514, c] ;
Ls = [b, c, _G517] ;
etc.
Most general case:
?- list_sublist(Xs, Ys).
Xs = Ys, Ys = [] ;
Xs = [_G513],
Ys = [] ;
Xs = Ys, Ys = [_G513]
Xs = [_G513, _G516],
Ys = [] ;
etc.
I've found a not so elegant solution... it requires a cut and some builtins
subset(Xs, Ys) :-
length(Xs, L),
between(0, L, N),
length(Ys, N),
assign(Xs, Ys).
assign(_, []) :- !.
assign([X|Xs], [X|Ys]) :-
assign(Xs, Ys).
assign([_|Xs], Ys) :-
assign(Xs, Ys).
as noted by #Fatalize, we can avoid the cut, just forcing the empty list on first argument of 1^ clause:
assign([], []).
assign([X|Xs], [X|Ys]) :-
assign(Xs, Ys).
assign([_|Xs], Ys) :-
assign(Xs, Ys).
I avoided to swap 2^ and 3^ clauses, so the 'natural' order is still nicely preserved
I need to write a program that finds the intersection of two lists. I can't use cuts and there shouldn't be any duplicate elements in the result list.
This is my code:
intersection([],_,[]).
intersection([X|Xs],Y,[X|Zs]) :-
member(X,Y),
intersection(Xs,Y,Zs).
intersection([_|Xs],Y,Zs) :-
intersection(Xs,Y,Zs).
When I run the following query, I get these answers:
?- intersection([a,b,c,a],[a,v,c],L).
L = [a, c, a] ;
L = [a, c] ; % <---------- this is only answer I want to get
L = [a, a] ;
L = [a] ;
L = [c, a] ;
L = [c] ;
L = [a] ;
L = [].
What can I do? I want to get L = [a,c] and nothing else... Can you help?
In my answer to the related question "Intersection and union of 2 lists" I presented the logically pure predicate list_list_intersectionSet/3. It should fit your requirements to a T!
Here's is a brushed-up version of list_list_intersectionSet/3, which is based on:
monotone conditional if_/3,
meta-predicate tfilter/3,
and the reified test predicates dif/3 and memberd_t/3.
Here we go:
list_list_intersectionSet([] ,_ ,[]).
list_list_intersectionSet([A|As0],Bs,Cs0) :-
if_(memberd_t(A,Bs), Cs0 = [A|Cs], Cs0 = Cs),
tfilter(dif(A),As0,As),
list_list_intersectionSet(As,Bs,Cs).
Let's see it in action!
?- list_list_intersectionSet([a,b,c,a],[a,v,c],L).
L = [a,c].
If by "conjunction" you mean "intersection", you should take a look at the implementation in the SWI-Prolog library(lists) of the predicate intersection/3. It contains cuts, but you can leave them out if you don't mind all the choicepoints.
With it:
?- intersection([a,b,c,a],[a,v,c],I).
I = [a, c, a].
Of course, this doesn't work even in the library predicate, because you need sets with your current definition. (It is enough if only the first argument is a set.)
You can make sets with the sort/2 predicate: if the first argument is a list with repetitions, the second argument will be a sorted list without repetitions, for example:
?- sort([a,b,c,a], S1), intersection(S1, [a,v,c], I).
S1 = [a, b, c],
I = [a, c].
or maybe:
?- sort([a,b,c,a], S1), intersection(S1, [a,v,c,c,a,c], I).
S1 = [a, b, c],
I = [a, c].
?- sort([a,b,c,a,b,c,a,b,c], S1), intersection(S1, [a,v,c,c,a,c], I).
S1 = [a, b, c],
I = [a, c].
If you sort both arguments, you can use a ord_intersection/3 from library(ordsets), implemented in terms of oset_int/3.
?- sort([a,b,c,a], S1), sort([a,v,c,c,a,c], S2), ord_intersection(S1, S2, I).
S1 = [a, b, c],
S2 = [a, c, v],
I = [a, c].
Importantly, oset_int/3 does not use any cuts in its implementation. It however assumes that the first and second arguments are lists of elements sorted by the "standard order of terms" and without duplicates, as done by sort/2.
If for some reason you don't want to use sort/2, you could maybe use an accumulator and check against it before taking an element to the intersection:
my_intersection(Xs, Ys, Zs) :-
my_intersection_1(Xs, Ys, [], Zs).
my_intersection_1([], _, Zs, Zs).
my_intersection_1([X|Xs], Ys, Zs0, Zs) :-
member(X, Ys), \+ member(X, Zs0),
my_intersection_1(Xs, Ys, [X|Zs0], Zs).
my_intersection_1([_|Xs], Ys, Zs0, Zs) :-
my_intersection_1(Xs, Ys, Zs0, Zs).
Of course, the order of the elements in the result will be now reversed. If this is not what you mean by "conjunction", you could for example rewrite the first two clauses of my_intersection_1/4 as:
my_intersection_1([], _, _, []).
my_intersection_1([X|Xs], Ys, Zs0, [X|Zs]) :-
member(X, Ys), \+ member(X, Zs0),
my_intersection_1(Xs, Ys, [X|Zs0], Zs).
The previously shown list_list_intersectionSet/3 restricts the item order in the intersection:
?- list_list_intersectionSet([a,b],[a,b], [a,b]).
true.
?- list_list_intersectionSet([a,b],[a,b], [b,a]).
false.
In this answer we lift that restriction... preserving logical-purity and determinism (for ground cases)!
First, we define none_intersect/2 using Prolog lambdas and
meta-predicate maplist/2.
none_intersect(As,Bs) states that all members in As are different from all members in Bs.
:- use_module(library(lambda)).
none_intersect(As,Bs) :-
maplist(\A^maplist(dif(A),Bs),As).
Next, we define intersection_of_and/3---based on none_intersect/2 (defined above), meta-predicate tpartition/4 and reified term equality (=)/3:
intersection_of_and([],As,Bs) :-
none_intersect(As,Bs).
intersection_of_and([X|Xs],As0,Bs0) :-
tpartition(=(X),As0,[_|_],As), % [_|_] = [X|_]
tpartition(=(X),Bs0,[_|_],Bs), % [_|_] = [X|_]
intersection_of_and(Xs,As,Bs).
intersection_of_and(Xs,As,Bs) states that
all items which occur in both As and Bs also occur in Xs (first clause),
all items in Xs occur in both As and Bs at least once (second clause),
and the list Xs does not contain any duplicates.
intersection_of_and/3 uses a specific argument in order to enable first argument indexing.
Last, we define list_list_intersection/3 which has the argument order that the OP used:
list_list_intersection(As,Bs,Xs) :-
intersection_of_and(Xs,As,Bs).
Let's run some queries! First, the query that the bounty offerer suggested:
?- list_list_intersection([a,b],[a,b], [b,a]).
true.
Next, a similar query with 3 distinct items in 3 lists having 3 different orders:
?- list_list_intersection([a,b,c],[b,a,c], [c,a,b]).
true.
What if some x only occurs in the first/second list?
?- list_list_intersection([a,b,c,x],[b,a,c], [c,a,b]).
true.
?- list_list_intersection([a,b,c],[b,a,c,x], [c,a,b]).
true.
What if some item occurs twice in the first/second list?
?- list_list_intersection([a,b,c],[b,a,c,b], [c,a,b]).
true.
?- list_list_intersection([a,b,c,c],[b,a,c], [c,a,b]).
true.
Last, what if the intersection contains duplicates?
Intersections are not to contain duplicates...
?- list_list_intersection([a,b,c],[b,a,c], [c,c,a,b]).
false. % as expected
Seems like something like this would be the easy way:
intersection( Xs , Ys , Zs ) :-
sort(Xs,X1) , % order and de-dupe the 1st list so as to produce a set
sort(Ys,Y1) , % order and de-dupe the 2nd list so as to produce a set
merge(Xs,Ys,Zs) % merge the two [ordered] sets to produce the result
. % easy!
merge( [] , [] , [] ) .
merge( [] , [_|_] , [] ) .
merge( [_|_] , [] , [] ) .
merge( [X|Xs] , [Y|Ys] , [X|Zs] ) :- X = Y , merge( Xs , Ys , Zs ) .
merge( [X|Xs] , [Y|Ys] , Zs ) :- X < Y , merge( Xs , [Y|Ys] , Zs ) .
merge( [X|Xs] , [Y|Ys] , Zs ) :- X > Y , merge( [X|Xs] , Ys , Zs ) .
Or even just this [not-terribly-performant] one-liner:
intersection( Xs , Ys , Zs ) :- setof(Z,(member(Z,Xs),member(Z,Ys)),Zs).
This can be solved by simple set theory:
intersection(A,B,AnB):-
subtract(A,B,AminusB),
subtract(A,AminusB,K),
sort(K,AnB).
For the query:
?- intersection([a,b,c,a],[a,v,c],L).
output is
L = [a, c].
No more answers.
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
I'm having an issue with SWI-Prolog's delete/3 predicate.
The easiest way is just a quick example:
?- delete([(1,1),(1,2),(3,2)], (1,_), List).
List = [(1,2),(3,2)].
I would expect (1,2) to also be deleted, since (1,_) unifies with (1,2). The SWIPL help says:
Delete all members of List1 that simultaneously unify with Elem and unify the result with List2.
Why is this and how can I delete everything that unifies with (1,_)?
" Delete all members of List1 that simultaneously unify with Elem and unify the result with List2."
(1,X) first unifies with (1,1). therefore, X is unified with 1 and cannot be unified with 2 to delete (1,2).
so the problem is not that it does not delete all of the members; it's that it doesnt unify simultaneously with (1,2) and (1,1)
(try delete([(1,1),(1,2),(1,1),(3,2)],(1,_),List).
btw, according to the swi-prolog manual:
delete(?List1, ?Elem, ?List2)
Is true when Lis1, with all occurences of Elem deleted results in List2.
also, delete/3 is deprecated:
There are too many ways in which one might want to delete elements from a list to justify the name.
Think of matching (= vs. ==), delete first/all, be deterministic or not.
So the easiest way is to write your own predicate. Something like:
my_delete(Pattern,[Pattern|T],TD):-
my_delete(Pattern,T,TD).
my_delete(Pattern,[H|T],[H|TD]):-
my_delete(Pattern,T,TD).
perhaps?
check exclude/3, include/3, partition/4
Use meta-predicate texclude/3 in combination with the
reified term equality predicate
(=)/3!
First, we try using (=)/3 directly...
?- texclude(=((1,V)), [(1,1),(1,2),(3,2)], KVs).
KVs = [ (1,2),(3,2)], V=1 ;
KVs = [(1,1), (3,2)], V=2 ;
KVs = [(1,1),(1,2),(3,2)], dif(V,1), dif(V,2).
Not quite! For our next tries we are going to use lambda expressions.
:- use_module(library(lambda)).
Let's query---once with texclude/3, once with tinclude/3, and once with tpartition/4:
?- texclude( \ (K,_)^(K=1), [(1,1),(1,2),(3,2)], Fs).
Fs = [(3,2)]. % succeeds deterministically
?- tinclude( \ (K,_)^(K=1), [(1,1),(1,2),(3,2)], Ts).
Ts = [(1,1),(1,2)]. % succeeds deterministically
?- tpartition(\ (K,_)^(K=1), [(1,1),(1,2),(3,2)], Ts,Fs).
Ts = [(1,1),(1,2)], Fs = [(3,2)]. % succeeds deterministically
Alright! Do we get the same solutions if the list items are bound after the texclude/3 call?
?- texclude(\ (K,_)^(K=1), [A,B,C], Fs), A = (1,1), B = (1,2), C = (3,2).
A = (1,1), B = (1,2), C = (3,2), Fs = [(3,2)] ; % succeeds with choice point
false.
Yes! At last, consider the following quite general query:
?- texclude(\ (K,_)^(K=1), [A,B], Fs).
Fs = [ ], A = ( 1,_A1), B = ( 1,_B1) ;
Fs = [ B], A = ( 1,_A1), B = (_B0,_B1), dif(_B0,1) ;
Fs = [A ], A = (_A0,_A1), B = ( 1,_B1), dif(_A0,1) ;
Fs = [A,B], A = (_A0,_A1), B = (_B0,_B1), dif(_A0,1), dif(_B0,1).
Note that above goals restrict all list items to have the form (_,_). Thus the following query fails:
?- texclude(\ (K,_)^(K=1), [x,_], _).
false.
This answer tries to generalize the idea presented in previous answer.
Let's define a reified variant of subsumes_term/2:
list_nonvardisj([A],C) :-
!,
C = nonvar(A).
list_nonvardisj([A|As],(nonvar(A);C)) :-
list_nonvardisj(As,C).
subsumes_term_t(General,Specific,Truth) :-
subsumes_term(General,Specific),
!,
term_variables(General,G_vars),
free4evrs(G_vars),
Truth = true.
subsumes_term_t(General,Specific,Truth) :-
Specific \= General,
!,
Truth = false.
subsumes_term_t(General,Specific,Truth) :-
term_variables(Specific,S_vars),
( S_vars = [V]
-> freeze(V,subsumes_term_t(General,Specific,Truth))
; S_vars = [_|_]
-> list_nonvardisj(S_vars,S_wakeup),
when(S_wakeup,subsumes_term_t(General,Specific,Truth))
; throw(error(instantiation_error, subsumes_term_t/3))
),
( Truth = true
; Truth = false
).
The above definition of the reified predicate subsumes_term_t/3 uses free4evrs/1 to ensure that the "generic" term passed to subsumes_term/2 is not instantiated any further.
For SICStus Prolog, we can define it as follows:
:- module(free4evr,[free4evr/1,free4evrs/1]).
:- use_module(library(atts)).
:- attribute nvrb/0. % nvrb ... NeVeR Bound
verify_attributes(V,_,Goals) :-
get_atts(V,nvrb),
!,
Goals = [throw(error(uninstantiation_error(V),free4evr/1))].
verify_attributes(_,_,[]).
attribute_goal(V,free4evr(V)) :-
get_atts(V,nvrb).
free4evr(V) :-
nonvar(V),
!,
throw(error(uninstantiation_error(V),free4evr/1)).
free4evr(V) :-
( get_atts(V,nvrb)
-> true
; put_atts(Fresh,nvrb),
V = Fresh
).
free4evrs([]).
free4evrs([V|Vs]) :-
free4evr(V),
free4evrs(Vs).
Let's put subsumes_term_t/3 to use!
?- texclude(subsumes_term_t(1-X), [A,B,C], Fs), A = 1-1, B = 1-2, C = 3-2.
A = 1-1, B = 1-2, C = 3-2, Fs = [C], free4evr(X) ? ; % succeeds with choice-point
no
?- texclude(subsumes_term_t(1-X), [x,1-Y,2-3], Fs).
Fs = [x,2-3], free4evr(X) ? ;
no
What happens if we instantiate variable X in above query sometime after the call to texclude/3?
?- texclude(subsumes_term_t(1-X), [x,1-Y,2-3], Fs), X=something.
! error(uninstantiation_error(something),free4evr/1)