memberchk/2 is a commonly defined predicate that is defined in terms of member/2 like so:
memberchk(X, Xs) :-
once(member(X, Xs)).
It therefore succeeds only for the first answer of member/2. Its full procedural meaning does not fit into a pure relation. As an example for its non-relational behavior consider
?- memberchk(b, [X,b]), X = a.
false.
?- X = a, memberchk(b, [X,b]).
X = a.
On the other hand, in many cases memberchk/2 will be called with sufficiently instantiated arguments, where it can be seen as an efficient approximation of a pure relation.
One such pure relation behind is memberd/2 (using if_/3):
memberd(E, [X|Xs]) :-
if_(E = X, true, memberd(E, Xs) ).
Are there any other pure relations that can be approximated by memberchk/2 for sufficiently instantiated cases?
In other words: Is memberd/2 a full, declarative replacement for memberchk/2 or are there still legitimate cases where memberchk/2 cannot be replaced by memberd/2?
Here is a well-known example use of member/2 that cannot be represented by memberd/2: bridge.pl the bridge scheduling problem given by Pascal Van Hentenryck.
In the setup phase member/2 is used:
setup(K,Ende,Disj):-
jobs(L),
make_vars(L,K),
member([stop,_,Ende],K),
....
So here, effectively the first element in the three-element list is used to select a particular task whereas memberd/2 uses the entire element for comparison. As a consequence this setup/3 leaves open a lot of choicepoints (actually, 219). Some (like SICStus) use memberchk/2 in that situation, thereby risking non-monotonicity.
Using the following pure replacement, all choicepoints are avoided.
member3l([N,D,A], Plan) :-
tmember(l3_t(N,D,A), Plan).
l3_t(N,D,A, X, T) :-
X = [Ni|_],
if_(N = Ni, ( X=[N,D,A], T = true ), T = false ).
tmember(P_2, [X|Xs]) :-
if_( call(P_2, X), true, tmember(P_2, Xs) ).
Alternatively using library(lambda):
member3li([N,Nd,Na], Plan) :-
tmember([N,Nd,Na]+\X^T^
( X=[Nk|_],
if_( Nk = N, ( X=[N,Nd,Na], T = true ), T = false ) ),
Plan).
Other uses of tmember/2:
old_member(X, Xs) :-
tmember( X+\E^T^( X = E, T = true ; T = false ), Xs).
old_memberd(X, Xs) :-
tmember(=(X), Xs).
Here is a more compact representation:
member3l([N,D,A], Plan) :-
tmember({N,D,A}+\[Ni,Di,Ai]^cond_t(N = Ni, [D,A] = [Di,Ai] ), Plan).
Using library(lambda)and cond_t/3:
cond_t(If_1, Then_0, T) :-
if_(If_1, ( Then_0, T = true ), T = false ).
The following answer does not directly relate to the original question regarding memberchk/2; instead, it is a follow-up to this previous answer which defined meta-predicate tmember/2.
We propose generalizing the idiom tmember/2 like so:
t_non_empty_suffix(P_3, [X|Xs]) :-
if_(call(P_3,Xs,X), true, t_non_empty_suffix(P_3,Xs)).
Building on t_non_empty_suffix/2 and Prolog lambdas, we can define tmemberX/2 like so:
:- use_module(library(lambda)).
tmemberX(P_2, Xs) :-
t_non_empty_suffix(P_2+\_^call(P_2), Xs).
The following old_memberX/2 and old_memberdX/2 use tmemberX/2 instead of tmember/2:
old_memberX(X, Xs) :-
tmemberX(X+\E^T^( X = E, T = true ; T = false ), Xs).
old_memberdX(X, Xs) :-
tmemberX(=(X), Xs).
Let's compare old_member/2 to old_memberX/2 ...
?- old_member(X, [1,2,3,2,3,4,3,4,5]).
X = 1 ; X = 2 ; X = 3 ; X = 2 ; X = 3 ; X = 4 ; X = 3 ; X = 4 ; X = 5 ; false.
?- old_memberX(X, [1,2,3,2,3,4,3,4,5]).
X = 1 ; X = 2 ; X = 3 ; X = 2 ; X = 3 ; X = 4 ; X = 3 ; X = 4 ; X = 5 ; false.
... and old_memberd/2 to old_memberdX/2!
?- old_memberd(X, [1,2,3,2,3,4,3,4,5]).
X = 1 ; X = 2 ; X = 3 ; X = 4 ; X = 5 ; false.
?- old_memberdX(X, [1,2,3,2,3,4,3,4,5]).
X = 1 ; X = 2 ; X = 3 ; X = 4 ; X = 5 ; false.
OK! How about defining old_member / old_memberd directly based on t_non_empty_suffix/2?
old_memberSFX(X, Xs) :-
t_non_empty_suffix(X+\_^E^T^( X = E, T = true ; T = false ), Xs).
old_memberdSFX(X, Xs) :-
t_non_empty_suffix(X+\_^E^( X = E ), Xs).
Running above queries with these predicates we get:
?- old_memberSFX(X, [1,2,3,2,3,4,3,4,5]).
X = 1 ; X = 2 ; X = 3 ; X = 2 ; X = 3 ; X = 4 ; X = 3 ; X = 4 ; X = 5 ; false.
?- old_memberdSFX(X, [1,2,3,2,3,4,3,4,5]).
X = 1 ; X = 2 ; X = 3 ; X = 4 ; X = 5 ; false.
Alright! Same results as before.
Let's dig a bit deeper! As a show-case for t_non_empty_suffix/2 consider duplicate_in/2.
Using t_non_empty_suffix/2, Prolog lambdas, (=)/3, and memberd_t/3 we define:
','(P_1, Q_1, T) :-
if_(P_1, call(Q_1,T), T = false).
duplicate_in(X, Xs) :-
t_non_empty_suffix(X+\Es^E^( X = E, memberd_t(E, Es) ), Xs).
Sample query:
?- duplicate_in(X, [1,2,3,2,3,4,3,4,5]).
X = 2 % [1,2,3,2,3,4,3,4,5] (2 occurs twice)
; X = 3 % [1,2,3,2,3,4,3,4,5] (3 occurs thrice)
; X = 4 % [1,2,3,2,3,4,3,4,5] (4 occurs twice)
; false.
memberb/2 is a typical example from constructive negation. You can turn the requirement upside down, and for example require:
?- ~ member(X, [a,b,c]).
dif(X, a),
dif(X, b),
dif(X, c)
Where ~ would be constructive negation. For a discussion on how constructive negation relates to if_ see for example here.
The disadvantage of fully declarative inductive definitions, for memberd/2 or somesuch is that the Prolog disjunction (;)/2 is not able to simplify
constraints, and that Prolog doesn't have a forall that would also simplify constraints such as diff/2.
So that in the end when you do it correctly with the limited (;)/2 and missig forall you get in the best case complete solutions that contain a lot of redundant constraints when you look at the full solution sets that the interpreter would produce.
Here is an example in Jekejeke Prolog, it requires the Minlog extension for the predicate dif/2 to be available:
:- use_module(library(term/herbrand)).
:- use_module(library(basic/lists)).
test(Y) :- dif(X, a), member(Y, [a,X]).
?- test(X).
X = a,
dif(_A, a) ;
dif(X, a)
The above two answers basically say X = a or ~(X = a) which is in most logics the same as a single answer true.
You would need a Prolog interpreter, that at some points works set oriented. And maybe some operators that would force a set oriented processing. But it might break traditional Prolog code. You can probably not just sneak in fully declarative definitions into code that was based on not so declarative definitions.
Bye
Related
I'm trying to write an alternative definition to member/2 which will won't return repetitions of numbers (i.e. will only succeed once for each element). I've currently got this code working using the cut procedurally:
once_member(X,[H|T]) :-
member(H,T),
!,
once_member(X,T).
once_member(H,[H|_]).
once_member(X,[_|T]) :-
once_member(X,T).
However, I'm aware that you can also use negation in a declarative approach to do this but I can't work out how to do it. If anyone could point me in the right direction that'd be great.
It is very simple using dif/2:
once_member(X, [X|_]).
once_member(X, [Y|T]) :-
dif(X, Y),
once_member(X, T).
1 ?- once_member(A, [1,2,3,3,4]).
A = 1 ;
A = 2 ;
A = 3 ;
A = 4 ;
false.
2 ?- X = a, once_member(X,[A,b]).
X = A, A = a ;
false.
3 ?- once_member(X,[A,b]), X = a.
X = A, A = a ;
false.
First of all I am completely new to prolog and I am trying to write a predicate length(M,X,N) which is true, if M differs from N more than X.
I wrote the following testcase which is true if M(=dec.5) and N(=dec.2) differ more than X(=dec.2). And it is true in this case because 5 and 2 have a difference of 3 which is more than 2:
?- length(s(s(s(s(s(0))))), s(s(0)), s(s(0))).
true .
I know that prolog works recursively so I am wondering if I can construct such a predicate with conditions (for example <,>) like in languages like C, or if there is another way to do this in prolog. Sorry for this simple question but I just started with prolog.
You could construct predicates for greater or less. For example:
greater_than(s(_), 0).
greater_than(s(X), s(Y)) :-
greater_than(X, Y).
And similarly:
less_than(0, s(_)).
less_than(s(X), s(Y)) :-
less_than(X, Y).
If you want to find the absolute difference, you could do something like this:
abs_diff(0, 0, 0).
abs_diff(s(X), 0, s(X)).
abs_diff(0, s(X), s(X)).
abs_diff(s(X), s(Y), D) :-
abs_diff(X, Y, D).
Those concepts should help kick start some ideas for how to solve the rest of the problem.
This answer follows up on #lurker's fine answer and improves the determinism of the auxiliary predicate abs_diff/3 by utilizing
first argument clause indexing.
Introducing x_y_dist/3:
x_y_dist(0, Y, Y).
x_y_dist(s(X), Y, Z) :-
y_sx_dist(Y, X, Z).
y_sx_dist(0, X, s(X)).
y_sx_dist(s(Y), X, Z) :-
x_y_dist(X, Y, Z).
Sample query:
?- x_y_dist(X, Y, s(s(0))). % |X-Y| = 2
( X = 0 , Y = s(s(0)) % |0-2| = 2
; X = s(s(0)) , Y = 0 % |2-0| = 2
; X = s(0) , Y = s(s(s(0))) % |1-3| = 2
; X = s(s(s(0))) , Y = s(0) % |3-1| = 2
; X = s(s(0)) , Y = s(s(s(s(0)))) % |2-4| = 2
; X = s(s(s(s(0)))) , Y = s(s(0)) % |4-2| = 2
; X = s(s(s(0))) , Y = s(s(s(s(s(0))))) % |3-5| = 2
; X = s(s(s(s(s(0))))), Y = s(s(s(0))) % |5-3| = 2
; X = s(s(s(s(0)))) , Y = s(s(s(s(s(s(0)))))) % |4-6| = 2
; .........
)
Try this:
?- length(s(s(s(s(s(0))))), s(s(0)), s(s(0))).
length(s(_),0,0).
length(s(M),s(X),s(N)) :- length(M,X,N).
Do keep in mind that Prolog's predicates do not return values - so they don't return true or false. They either succeed or they don't. The interpreter is just telling you if your program succeeds or not.
i´m trying to create a predicate that returns me the element of a list that contains a certain number given by me.
Example:
?- where_is_it( [ [1,2,3] , [1,2,7] , [4,5] , [8] ] , 7 , X ).
X=[1,2,7].
I am a relatively new prolog programmer so this is my code:
where_is_it([],_,[]).
where_is_it([H|T],Num,H):-
member([Num],H),!,
where_is_it(T,Num,[]).
Thank you very much
You could use if_/3 and memberd_t/2 from module reif in order to be more deterministic:
where_is_it([H|T], X, L) :-
if_(memberd_t(X,H), L=H, where_is_it(T, X, L)).
Here is an implementation using tmember/2:
where_is_it(InList, X, L):- tmember(check(X,L),InList).
check(X,L,L1,T):- if_( memberd_t(X,L1), (T = true, L = L1), T = false).
where_is_it(Xss, X, Xs) :-
member(Xs, Xss),
member(X, Xs).
Here is a version using only tmember/2 and (=)/3 without any explicit recursion:
where_is_it(Xss,X,Xs) :-
tmember(=(Xs),Xss),
tmember(=(X),Xs).
The query given by the OP works as expected:
?- where_is_it([[1,2,3],[1,2,7],[4,5],[8]],7,X).
X = [1,2,7] ? ;
no
Some of the features of this version: If the element occurs in more than one list (differs from version with if_/3 and memberd_t):
?- where_is_it([[1,2,3],[1,2,7],[4,5],[8]],1,X).
X = [1,2,3] ? ;
X = [1,2,7] ? ;
no
Multiple occurrences of the element in one list are matched only once (differs from version with member/2):
?- where_is_it([[1,2,3,1],[4,5],[8]],1,X).
X = [1,2,3,1] ? ;
no
Multiple occurrences of the same list are matched only once (differs from version with member/2):
?- where_is_it([[1,2,3],[1,2,3],[4,5],[8]],1,X).
X = [1,2,3] ? ;
no
Even with an open list (differs from version with member/2 as well as from version with if_/3 and memberd_t):
?- where_is_it([[1,2,3],[1,2,7],[4,5],[8],[1|_]],1,X).
X = [1,2,3] ? ;
X = [1,2,7] ? ;
X = [1|_A],
dif([1|_A],[1,2,3]),
dif([1|_A],[1,2,7]) ? ;
no
If the actual element is variable:
?- where_is_it([[1,2,3],[8]],Y,X).
X = [1,2,3],
Y = 1 ? ;
X = [1,2,3],
Y = 2 ? ;
X = [1,2,3],
Y = 3 ? ;
X = [8],
Y = 8 ? ;
no
The most general query (differs from version with member/2 (only slightly) as well as from version with if_/3 and memberd_t):
?- where_is_it(Xss,X,Xs).
Xs = [X|_A],
Xss = [[X|_A]|_B] ? ;
Xs = [_A,X|_B],
Xss = [[_A,X|_B]|_C],
dif(X,_A) ? ;
Xs = [_A,_B,X|_C],
Xss = [[_A,_B,X|_C]|_D],
dif(X,_B),
dif(X,_A) ? ;
...
With some constraints (differs from version with member/2 (only slightly) as well as from version with if_/3 and memberd_t):
?- Xss=[_,_],Xs=[_,_],where_is_it(Xss,X,Xs).
Xs = [X,_A],
Xss = [[X,_A],_B] ? ;
Xs = [_A,X],
Xss = [[_A,X],_B],
dif(X,_A) ? ;
Xs = [X,_A],
Xss = [_B,[X,_A]],
dif([X,_A],_B) ? ;
Xs = [_A,X],
Xss = [_B,[_A,X]],
dif(X,_A) ? ;
no
You should maybe read what your clauses say? You need maybe one clause which says, "If X is member of H, then H is solution":
where_is_it([H|_], X, H) :-
member(X, H).
and then you still need another clause that says that maybe you have a solution in the rest of the list:
where_is_it([_|T], X, H) :-
where_is_it(T, X, H).
Maybe this is enough for beginning?
Ok, let us look at your code. The first clause is fine, whatever we are looking for it is not in the empty list.
where_is_it([],_,[]).
This is your second clause:
where_is_it([H|T],Num,H):-
member([Num],H),!,
where_is_it(T,Num,[]).
Here we have several problems:
First, instead of member([Num],H) you probably need member(Num,H) expressing that Num is an element of the list H.
Second, If this is the clause for the cases where Num is a member of H, your recursion should be as follows:
where_is_it([H|T],Num,[H|Found]):-
member(Num,H),!,
where_is_it(T,Num,Found).
This clause now expresses that whenever Num is a member of H, H belongs to our solution list and we have to look for further solutions in the tail of our list (that is in T) and collect them in Found.
You need an additional clause for the case that Num is not a member of H:
where_is_it([H|T],Num,Found):-
where_is_it(T,Num,Found).
This clause does not change your list of found solutions.
Hence the full code is:
where_is_it([],_,[]).
where_is_it([H|T],Num,[H|Found]):-
member(Num,H),!,
where_is_it(T,Num,Found).
where_is_it([_H|T],Num,Found):-
where_is_it(T,Num,Found).
I'm trying to write a predicate twice(El,L) which will return true. when El is on list exactly twice. Here is what I have:
twice(El,L) :- select(El,L,L1), member(El,L1), \+ twice(El,L1).
It works nice for twice(2,[1,2,2,3,4])
but for twice(X,[1,1,2,2,3,3]) it doubles every number X = 1 ; X = 1 ; X = 2... How could I avoid this without using any accumulator?
You want to describe a sequence of elements. For such, there is a special formalism in Prolog called Definite Clause Grammars. Before using the formalism, let's try to figure out how a sequence with E occurring exactly twice looks like:
First, is a possibly empty sequence which does not contain E
then, there is one occurrence of E
then again a possibly empty sequence without E
then, there is the second occurrence of E
then again a possibly empty sequence without E.
Now, to put this into the DCG formalism
twice(E, L) :-
phrase(twice_occurring(E), L). % Interface
twice_occurring(E) -->
seq_without(E), % 1.
[E], % 2.
seq_without(E), % 3.
[E], % 4.
seq_without(E). % 5.
seq_without(_E) -->
[].
seq_without(E) -->
[X],
{dif(X,E)},
seq_without(E).
Or, more compactly by using all//1 and avoiding auxiliary definitions:
twice(E, L) :-
phrase(( all(dif(E)), [E], all(dif(E)), [E], all(dif(E)) ), L).
There is essentially only one drawback with these definitions: On current systems, they are not optimally implemented. See this if you want to know more.
Stay both logically pure and efficient by using if_/3 and
(=)/3 by #false. It goes like this:
list_member1x([X|Xs],E) :-
if_(X=E, maplist(dif(E),Xs), list_member1x(Xs,E)).
list_member2x([X|Xs],E) :-
if_(X=E, list_member1x(Xs,E), list_member2x(Xs,E)).
twice(E,Xs) :-
list_member2x(Xs,E).
That's it. Let's run some queries!
?- twice(E,[1,2,3,4,5,2,3,4]).
E = 2 ;
E = 3 ;
E = 4 ;
false.
Now something a little more general:
?- twice(X,[A,B,C,D]).
A=X , B=X , dif(C,X), dif(D,X) ;
A=X , dif(B,X), C=X , dif(D,X) ;
A=X , dif(B,X), dif(C,X), D=X ;
dif(A,X), B=X , C=X , dif(D,X) ;
dif(A,X), B=X , dif(C,X), D=X ;
dif(A,X), dif(B,X), C=X , D=X ;
false.
Here are the queries the OP gave:
?- twice(2,[1,2,2,3,4]).
true.
?- twice(E,[1,1,2,2,3,3]).
E = 1 ;
E = 2 ;
E = 3 ;
false.
Edit
As an alternative, use meta-predicate tcount/3 in combination with (=)/3 like this:
twice(E,Xs) :- tcount(=(E),Xs,2).
Try:
twice(E,L) :-
append(B1,[E|A1],L),
\+ member(E,B1),
append(B2,[E|A2],A1),
\+ member(E,B2),
\+ member(E,A2).
Addendum
In case that the list of number could be (partially) unbound, following variant solves the issues. It uses "dif" instead of "\=", "+". In addition, it is a few optimized ("append" and "member" have been joined to a single "appendchk"):
appendchk(L,L).
appendchk([E|Q2],[H|R]) :-
dif(H,E),
appendchk([E|Q2],R).
notmember(_,[]).
notmember(X,[H|Q]) :-
dif(X,H),
notmember(X,Q).
twice(E,L) :-
appendchk([E|A1],L),
appendchk([E|A2],A1),
notmember(E,A2).
Examples:
twice(1,[1,2,3,4,2,3,2]).
false
twice(2,[1,2,3,4,2,3,2]).
false
twice(3,[1,2,3,4,2,3,2]).
true
twice(X,[1,2,3,4,2,3,2]).
X = 3
false
twice(X,[A,B]).
A = B, B = X
twice(X,[A,B,C]).
A = B, B = X,
dif(X, C)
A = C, C = X,
dif(B, X)
B = C, C = X,
dif(A, X)
Here is how we can declare, courtesy library(aggregate), the required constraint:
twice(El, L) :-
aggregate(count, P^nth1(P,L,El), 2).
Where list' elements are restricted to integers, library(clpfd) reification hint hosts another solution:
twice(El, L) :- vs_n_num(L,El,2).
% aggregate(count, P^nth1(P,L,El), 2).
I want to return all elements in a list like the result below in X
?return_list_members([1,2,3,4,5], X).
X = 1 ;
X = 2 ;
X = 3 ;
X = 4 ;
X = 5.
I have the following code but it also returns the empty list element [] witch is not desirable.
return_member(X, X).
return_list_members([], []).
return_list_members([H|T], X) :- return_member(H, X); return_list_members(T, X).
output when questioned
?return_list_members([1,2,3,4,5], X).
X = 1 ;
X = 2 ;
X = 3 ;
X = 4 ;
X = 5 ;
X = [].
also the true or false at the end values are not desirable at the end.
The goal is to achieve a function witch outputs like the built-in function between/3 to be used in a foreach statement
Note that the procedure you are trying to write is the builtin predicate member/2.
?- member(X, [1,2,3,4,5]).
X = 1 ;
X = 2 ;
X = 3 ;
X = 4 ;
X = 5.
You can also write your own definition, e.g.:
return_list_members([X|_], X).
return_list_members([_|T], X):-
return_list_members(T, X).
and if you don't want the interpreter to return 'false' at the end, you can add another clause at the beginning (as the first clause):
return_list_members([X], X):- !.
Note however that this clause will have side effects if you call this procedure with the first parameter uninstantiated.
I tried to write between_/3:
between_(X, X, X) :-
!.
between_(X, Y, X) :-
X < Y.
between_(X, Y, N) :-
X < Y,
T is X + 1,
between_(T, Y, N).
The first clause it's required to avoid the final false (as already noticed by gusbro).