Related
I am doing some easy exercises to get a feel for the language.
is_list([]).
is_list([_|_]).
my_flatten([],[]).
my_flatten([X|Xs],RR) :-
my_flatten(Xs,R),
(is_list(X), !, append(X,R,RR); RR = [X | R]).
Here is a version using cut, for a predicate that flattens a list one level.
my_flatten([],[]).
my_flatten([X|Xs],RR) :-
my_flatten(Xs,R),
if_(is_list(X), append(X,R,RR), RR = [X | R]).
Here is how I want to write it, but it does not work. Neither does is_list(X) = true as the if_ condition. How am I intended to use if_ here?
(Sorry, I somewhat skipped this)
Please refer to P07. It clearly states that it flattens out [a, [b, [c, d], e]], but you and #Willem produce:
?- my_flatten([a, [b, [c, d], e]], X).
X = [a,b,[c,d],e]. % not flattened!
And the solution given there succeeds for
?- my_flatten(non_list, X).
X = [non_list]. % unexpected, nothing to flatten
Your definition of is_list/1 succeeds for is_list([a|non_list]). Commonly, we want this to fail.
What you need is a safe predicate to test for lists. So let's concentrate on that first:
What is wrong with is_list/1 and if-then-else? It is as non-monotonic, as many other impure type testing predicates.
?- Xs = [], is_list([a|Xs]).
Xs = [].
?- is_list([a|Xs]). % generalization, Xs = [] removed
false. % ?!? unexpected
While the original query succeeds correctly, a generalization of it unexpectedly fails. In the monotonic part of Prolog, we expect that a generalization will succeed (or loop, produce an error, use up all resources, but never ever fail).
You have now two options to improve upon this highly undesirable situation:
Stay safe with safe inferences, _si!
Just take the definition of list_si/1 in place of is_list/1. In problematic situations, your program will now abort with an instantiation error, meaning "well sorry, I don't know how to answer this query". Be happy for that response! You are saved from being misled by incorrect answers.
In other words: There is nothing wrong with ( If_0 -> Then_0 ; Else_0 ), as long as the If_0 handles the situation of insufficient instantiations correctly (and does not refer to a user defined program since otherwise you will be again in non-monotonic behavior).
Here is such a definition:
my_flatten(Es, Fs) :-
list_si(Es),
phrase(flattenl(Es), Fs).
flattenl([]) --> [].
flattenl([E|Es]) -->
( {list_si(E)} -> flattenl(E) ; [E] ),
flattenl(Es).
?- my_flatten([a, [b, [c, d], e]], X).
X = [a,b,c,d,e].
So ( If_0 -> Then_0 ; Else_0 ) has two weaknesses: The condition If_0 might be sensible to insufficient instantiations, and the Else_0 may be the source of non-monotonicity. But otherwise it works. So why do we want more than that?
In many more general situations this definition will now bark back: "Instantiation error"! While not incorrect, this still can be improved. This exercise is not the ideal example for this, but we will give it a try.
Use a reified condition
In order to use if_/3 you need a reified condition, that is, a definition that carries it's truth value as an explicit extra argument. Let's call it list_t/2.
?- list_t([a,b,c], T).
T = true.
?- list_t([a,b,c|non_list], T).
T = false.
?- list_t(Any, T).
Any = [],
T = true
; T = false,
dif(Any,[]),
when(nonvar(Any),Any\=[_|_])
; Any = [_],
T = true
; Any = [_|_Any1],
T = false,
dif(_Any1,[]),
when(nonvar(_Any1),_Any1\=[_|_])
; ... .
So list_t can also be used to enumerate all true and false situations. Let's go through them:
T = true, Any = [] that's the empty list
T = false, dif(Any, []), Any is not [_|_] note how this inequality uses when/2
T = true, Any = [_] that's all lists with one element
T = true, Any = [_|_Any1] ... meaning: we start with an element, but then no list
list_t(Es, T) :-
if_( Es = []
, T = true
, if_(nocons_t(Es), T = false, ( Es = [_|Fs], list_t(Fs, T) ) )
).
nocons_t(NC, true) :-
when(nonvar(NC), NC \= [_|_]).
nocons_t([_|_], false).
So finally, the reified definition:
:- meta_predicate( if_(1, 2, 2, ?,?) ).
my_flatten(Es, Fs) :-
phrase(flattenl(Es), Fs).
flattenl([]) --> [].
flattenl([E|Es]) -->
if_(list_t(E), flattenl(E), [E] ),
flattenl(Es).
if_(C_1, Then__0, Else__0, Xs0,Xs) :-
if_(C_1, phrase(Then__0, Xs0,Xs), phrase(Else__0, Xs0,Xs) ).
?- my_flatten([a|_], [e|_]).
false.
?- my_flatten([e|_], [e|_]).
true
; true
; true
; ... .
?- my_flatten([a|Xs], [a]).
Xs = []
; Xs = [[]]
; Xs = [[],[]]
; ... .
?- my_flatten([X,a], [a]).
X = []
; X = [[]]
; X = [[[]]]
; X = [[[[]]]]
; ... .
?- my_flatten(Xs, [a]).
loops. % at least it does not fail
In Prolog, the equivalen of an if … then … else … in other languages is:
(condition -> if-true; if-false)
With condition, if-true and if-false items you need to fill in.
So in this specific case, you can implement this with:
my_flatten([],[]).
my_flatten([X|Xs],RR) :-
my_flatten(Xs,R),
( is_list(X)
-> append(X,R,RR)
; RR = [X | R] ).
or we can flatten recursively with:
my_flatten([],[]).
my_flatten([X|Xs],RR) :-
my_flatten(Xs,R),
( flatten(X, XF)
-> append(XF,R,RR)
; RR = [X | R] ).
Your if_/3 predicate is used for reified predicates.
This worked for me:
myflat([], []).
myflat([H|T], L) :-
myflat(H, L1),
myflat(T, L2),
append(L1, L2, L).
myflat(L, [L]).
I tried to create something what would work like this:
?- unpacking([[1], [1,2], [3]], Lst1, NewLst).
NewLst=[1,3]
I wrote it like this:
unpacking([], Lst1, Lst1).
unpacking([[H]|T], Lst1, NewLst):-
append([H], Lst2),
unpacking(T, Lst2, NewLst).
unpacking([_|T], Lst1, NewLst):-
unpacking(T, Lst1, NewLst).
and I know that I am doing something wrong. I am starting in Prolog so, need to learn from my mistakes :)
You probably meant:
unpacking([], []).
unpacking([[E]|T], [E|L]) :-
unpacking(T, L).
unpacking([[]|T], L) :-
unpacking(T, L).
unpacking([[_,_|_]|T], L) :-
unpacking(T, L).
There are more concise ways to write this - and more efficient, too.
What about this :
%?-unpacking([[a,b,c],[a],[b],[c,d]],Items).
unpacking(Lists,Items):-
my_tpartition(length_t(1),Lists,Items,Falses).
my_tpartition(P_2,List,Ts,Fs) :- my_tpartition_ts_fs_(List,Ts,Fs,P_2).
my_tpartition_ts_fs_([],[],[],_).
my_tpartition_ts_fs_([X|Xs0],Ts,Fs,P_2) :-
if_(call(P_2,X), (X=[NX],Ts = [NX|Ts0], Fs = Fs0),
(Ts = Ts0, Fs = [X|Fs0])),
my_tpartition_ts_fs_(Xs0,Ts0,Fs0,P_2).
length_t(X,Y,T):-
length(Y,L1),
=(X,L1,T).
This is based on Most general higher-order constraint describing a sequence of integers ordered with respect to a relation
* Update*
You could change to
length_t(X,Y,T):-
L1 #=< X,
fd_length(Y,L1),
=(X,L1,T),!.
length_t(_X,_Y,false).
fd_length(L, N) :-
N #>= 0,
fd_length(L, N, 0).
fd_length([], N, N0) :-
N #= N0.
fd_length([_|L], N, N0) :-
N1 is N0+1,
N #>= N1,
fd_length(L, N, N1).
giving:
?-unpacking([[1],[2,3],[4],[_,_|_]],U).
U= [1,4].
but:
?-unpacking([X],Xs).
X = Xs, Xs = [].
Based on #coder's solution, I made my own attempt using if_ and DCGs:
one_element_([], true).
one_element_([_|_],false).
one_element([], false).
one_element([_|Xs], T) :-
one_element_(Xs, T).
f([]) -->
[].
f([X|Xs]) -->
{ if_(one_element(X), Y=X, Y=[]) },
Y,
f(Xs).
unpack(Xs,Ys) :-
phrase(f(Xs),Ys).
I only tried for about 30s, but the queries:
?- Xs = [[] | Xs], unpack(Xs,Ys).
?- Xs = [[_] | Xs], unpack(Xs,Ys).
?- Xs = [[_, _ | _] | Xs], unpack(Xs,Ys).
didn't stop with a stack overflow. In my opinion, the critical one should be the last query, but apparently, SWI Prolog manages to optimize:
?- L = [_,_|_], one_element(L,T).
L = [_3162, _3168|_3170],
T = false.
Edit: I improved the solution and gave it a shot with argument indexing. According to the SWI Manual, indexing happens if there is exactly a case distinction between the empty list [] and the non-empty list [_|_]. I rewrote one_element such that it does exactly that and repeated the trick with the auxiliary predicate one_element_. Now that one_element is pure again, we don't lose solutions anymore:
?- unpack([A,B],[]).
A = [_5574, _5580|_5582],
B = [_5628, _5634|_5636] ;
A = [_5574, _5580|_5582],
B = [] ;
A = [],
B = [_5616, _5622|_5624] ;
A = B, B = [].
but
?- unpack([[a,b,c],[a],[b],[c,d]],Items).
Items = [a, b].
is still deterministic. I have not tried this solution in other Prologs, which might be missing the indexing, but it seems for SWI, this is a solution.
Update: Apparently GNU Prolog does not do this kind of indexing and overflows on cyclic lists:
| ?- Xs = [[] | Xs], unpack(Xs,Ys).
Fatal Error: global stack overflow (size: 32770 Kb, reached: 32768 Kb, environment variable used: GLOBALSZ)
After some thought, here is my implementation using if_/3:
unpacking(L,L1):-if_( =(L,[]), L1=[], unpack(L,L1)).
unpack([H|T],L):-if_(one_element(H), (H = [X],L=[X|T1],unpacking(T,T1)), unpacking(T,L)).
one_element(X, T) :-
( var(X) ->(T=true,X=[_]; T=false,X=[])
; X = [_] -> T = true
; X \= [_] -> T = false).
Some testcases:
?- unpacking([Xss],[]).
Xss = [].
?- unpacking([[1],[2,3],[4],[_,_|_]],U).
U = [1, 4].
?- unpacking([[1],[2,3],[4]],U).
U = [1, 4].
?- unpacking([[E]],[1]), E = 2.
false.
?- unpacking(non_list, []).
false.
?- unpacking([Xs],Xs).
Xs = [_G6221] ;
Xs = [].
UPDATE
To fix the case that #false referred in the comment we could define:
one_element([],false).
one_element([_],true).
one_element([_,_|_],false).
But this leaves some choice points...
One way to do it is with a findall I dont think its what the bounty is for though ;)
unpacking(Lists,L1):-
findall(I,(member(M,Lists),length(M,1),M=[I]),L1).
or
unpacking2(Lists,L1):-
findall(I,member([I],Lists),L1).
I got a problem with lists. What I need to do is to split one list [1,-2,3,-4], into two lists [1,3] and [-2,-4]. My code looks like the following:
lists([],_,_).
lists([X|Xs],Y,Z):- lists(Xs,Y,Z), X>0 -> append([X],Y,Y) ; append([X],Z,Z).
and I'm getting
Y = [1|Y],
Z = [-2|Z].
What am I doing wrong?
If your Prolog system offers clpfd you could preserve logical-purity. Want to know how? Read on!
We take the second definition of lists/3 that #CapelliC wrote in
his answer as a starting point, and replace partition/4 by tpartition/4 and (<)/2 by (#<)/3:
lists(A,B,C) :- tpartition(#<(0),A,B,C).
Let's run a sample query!
?- As = [0,1,2,-2,3,4,-4,5,6,7,0], lists(As,Bs,Cs).
As = [0,1,2,-2,3,4,-4,5,6,7,0],
Bs = [ 1,2, 3,4, 5,6,7 ],
Cs = [0, -2, -4, 0].
As we use monotone code, we get logically sound answers for more general queries:
?- As = [X,Y], lists(As,Bs,Cs).
As = [X,Y], Bs = [X,Y], Cs = [ ], X in 1..sup, Y in 1..sup ;
As = [X,Y], Bs = [X ], Cs = [ Y], X in 1..sup, Y in inf..0 ;
As = [X,Y], Bs = [ Y], Cs = [X ], X in inf..0 , Y in 1..sup ;
As = [X,Y], Bs = [ ], Cs = [X,Y], X in inf..0 , Y in inf..0 .
Here you have. It splits a list, and does not matter if have odd or even items number.
div(L, A, B) :-
append(A, B, L),
length(A, N),
length(B, N).
div(L, A, B) :-
append(A, B, L),
length(A, N),
N1 is N + 1,
length(B, N1).
div(L, A, B) :-
append(A, B, L),
length(A, N),
N1 is N - 1,
length(B, N1).
Refer this:
domains
list=integer*
predicates
split(list,list,list)
clauses
split([],[],[]).
split([X|L],[X|L1],L2):-
X>= 0,
!,
split(L,L1,L2).
split([X|L],L1,[X|L2]):-
split(L,L1,L2).
Output :
Goal: split([1,2,-3,4,-5,2],X,Y)
Solution: X=[1,2,4,2], Y=[-3,-5]
See, if that helps.
Just for variety, this can also be done with a DCG, which is easy to read for a problem like this:
split([], []) --> [].
split([X|T], N) --> [X], { X >= 0 }, split(T, N).
split(P, [X|T]) --> [X], { X < 0 }, split(P, T).
split(L, A, B) :-
phrase(split(A, B), L).
As in:
| ?- split([1,2,-4,3,-5], A, B).
A = [1,2,3]
B = [-4,-5] ? ;
no
It also provides all the possible solutions in reverse:
| ?- split(L, [1,2,3], [-4,-5]).
L = [1,2,3,-4,-5] ? ;
L = [1,2,-4,3,-5] ? ;
L = [1,2,-4,-5,3] ? ;
L = [1,-4,2,3,-5] ? ;
L = [1,-4,2,-5,3] ? ;
L = [1,-4,-5,2,3] ? ;
L = [-4,1,2,3,-5] ? ;
L = [-4,1,2,-5,3] ? ;
L = [-4,1,-5,2,3] ? ;
L = [-4,-5,1,2,3] ? ;
(2 ms) no
Gaurav's solution will also do this if the cut is removed and an explicit X < 0 check placed in the third clause of the split/3 predicate.
There are several corrections to be done in your code.
If you enjoy compact (as readable) code, a possibility is
lists([],[],[]).
lists([X|Xs],Y,Z) :-
( X>0 -> (Y,Z)=([X|Ys],Zs) ; (Y,Z)=(Ys,[X|Zs]) ), lists(Xs,Ys,Zs).
But since (SWI)Prolog offers libraries to handle common list processing tasks, could be as easy as
lists(A,B,C) :- partition(<(0),A,B,C).
Pure Prolog programs that distinguish between the equality and inequality of terms in a clean manner suffer from execution inefficiencies ; even when all terms of relevance are ground.
A recent example on SO is this answer. All answers and all failures are correct in this definition. Consider:
?- Es = [E1,E2], occurrences(E, Es, Fs).
Es = Fs, Fs = [E, E],
E1 = E2, E2 = E ;
Es = [E, E2],
E1 = E,
Fs = [E],
dif(E, E2) ;
Es = [E1, E],
E2 = E,
Fs = [E],
dif(E, E1) ;
Es = [E1, E2],
Fs = [],
dif(E, E1),
dif(E, E2).
While the program is flawless from a declarative viewpoint, its direct execution on current systems like B, SICStus, SWI, YAP is unnecessarily inefficient. For the following goal, a choicepoint is left open for each element of the list.
?- occurrences(a,[a,a,a,a,a],M).
M = [a, a, a, a, a] ;
false.
This can be observed by using a sufficiently large list of as as follows. You might need to adapt the I such that the list can still be represented ; in SWI this would mean that
1mo the I must be small enough to prevent a resource error for the global stack like the following:
?- 24=I,N is 2^I,length(L,N), maplist(=(a),L).
ERROR: Out of global stack
2do the I must be large enough to provoke a resource error for the local stack:
?- 22=I,N is 2^I,length(L,N), maplist(=(a),L), ( Length=ok ; occurrences(a,L,M) ).
I = 22,
N = 4194304,
L = [a, a, a, a, a, a, a, a, a|...],
Length = ok ;
ERROR: Out of local stack
To overcome this problem and still retain the nice declarative properties some comparison predicate is needed.
How should this comparison predicate be defined?
Here is such a possible definition:
equality_reified(X, X, true).
equality_reified(X, Y, false) :-
dif(X, Y).
Edit: Maybe the argument order should be reversed similar to the ISO built-in compare/3 (link links to draft only).
An efficient implementation of it would handle the fast determinate cases first:
equality_reified(X, Y, R) :- X == Y, !, R = true.
equality_reified(X, Y, R) :- ?=(X, Y), !, R = false. % syntactically different
equality_reified(X, Y, R) :- X \= Y, !, R = false. % semantically different
equality_reified(X, X, true).
equality_reified(X, Y, false) :-
dif(X, Y).
Edit: it is not clear to me whether or not X \= Y is a suitable guard in the presence of constraints. Without constraints, ?=(X, Y) or X \= Y are the same.
Example
As suggested by #user1638891, here is an example how one might use such a primitive. The original code by mats was:
occurrences_mats(_, [], []).
occurrences_mats(X, [X|Ls], [X|Rest]) :-
occurrences_mats(X, Ls, Rest).
occurrences_mats(X, [L|Ls], Rest) :-
dif(X, L),
occurrences_mats(X, Ls, Rest).
Which can be rewritten to something like:
occurrences(_, [], []).
occurrences(E, [X|Xs], Ys0) :-
reified_equality(Bool, E, X),
( Bool == true -> Ys0 = [X|Ys] ; Ys0 = Ys ),
% ( Bool = true, Ys0 = [X|Ys] ; Bool = true, Ys0 = Ys ),
occurrences(E, Xs, Ys).
reified_equality(R, X, Y) :- X == Y, !, R = true.
reified_equality(R, X, Y) :- ?=(X, Y), !, R = false.
reified_equality(true, X, X).
reified_equality(false, X, Y) :-
dif(X, Y).
Please note that SWI's second-argument indexing is only activated, after you enter a query like occurrences(_,[],_). Also, SWI need the inherently nonmonotonic if-then-else, since it does not index on (;)/2 – disjunction. SICStus does so, but has only first argument indexing. So it leaves one (1) choice-point open (at the end with []).
Well for one thing, the name should be more declarative, like equality_truth/2.
The following code is based on if_/3 and (=)/3 (a.k.a. equal_truth/3), as implemented by #false in Prolog union for A U B U C:
=(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).
if_(C_1, Then_0, Else_0) :-
call(C_1, Truth),
functor(Truth,_,0), % safety check
( Truth == true -> Then_0 ; Truth == false, Else_0 ).
Compared to occurrences/3, the auxiliary occurrences_aux/3 uses a different argument order that passes the list Es as the first argument, which can enable first-argument indexing:
occurrences_aux([], _, []).
occurrences_aux([X|Xs], E, Ys0) :-
if_(E = X, Ys0 = [X|Ys], Ys0 = Ys),
occurrences_aux(Xs, E, Ys).
As pointed out by #migfilg, the goal Fs=[1,2], occurrences_aux(Es,E,Fs) should fail, as it is logically false:
occurrences_aux(_,E,Fs) states that all elements in Fs are equal to E.
However, on its own, occurrences_aux/3 does not terminate in cases like this.
We can use an auxiliary predicate allEqual_to__lazy/2 to improve termination behaviour:
allEqual_to__lazy(Xs,E) :-
freeze(Xs, allEqual_to__lazy_aux(Xs,E)).
allEqual_to__lazy_aux([],_).
allEqual_to__lazy_aux([E|Es],E) :-
allEqual_to__lazy(Es,E).
With all auxiliary predicates in place, let's define occurrences/3:
occurrences(E,Es,Fs) :-
allEqual_to__lazy(Fs,E), % enforce redundant equality constraint lazily
occurrences_aux(Es,E,Fs). % flip args to enable first argument indexing
Let's have some queries:
?- occurrences(E,Es,Fs). % first, the most general query
Es = Fs, Fs = [] ;
Es = Fs, Fs = [E] ;
Es = Fs, Fs = [E,E] ;
Es = Fs, Fs = [E,E,E] ;
Es = Fs, Fs = [E,E,E,E] ... % will never terminate universally, but ...
% that's ok: solution set size is infinite
?- Fs = [1,2], occurrences(E,Es,Fs).
false. % terminates thanks to allEqual_to__lazy/2
?- occurrences(E,[1,2,3,1,2,3,1],Fs).
Fs = [1,1,1], E=1 ;
Fs = [2,2], E=2 ;
Fs = [3,3], E=3 ;
Fs = [], dif(E,1), dif(E,2), dif(E,3).
?- occurrences(1,[1,2,3,1,2,3,1],Fs).
Fs = [1,1,1]. % succeeds deterministically
?- Es = [E1,E2], occurrences(E,Es,Fs).
Es = [E, E], Fs = [E,E], E1=E , E2=E ;
Es = [E, E2], Fs = [E], E1=E , dif(E2,E) ;
Es = [E1, E], Fs = [E], dif(E1,E), E2=E ;
Es = [E1,E2], Fs = [], dif(E1,E), dif(E2,E).
?- occurrences(1,[E1,1,2,1,E2],Fs).
E1=1 , E2=1 , Fs = [1,1,1,1] ;
E1=1 , dif(E2,1), Fs = [1,1,1] ;
dif(E1,1), E2=1 , Fs = [1,1,1] ;
dif(E1,1), dif(E2,1), Fs = [1,1].
Edit 2015-04-27
Some more queries for testing if the occurrences/3 universal terminates in certain cases:
?- occurrences(1,L,[1,2]).
false.
?- L = [_|_],occurrences(1,L,[1,2]).
false.
?- L = [X|X],occurrences(1,L,[1,2]).
false.
?- L = [L|L],occurrences(1,L,[1,2]).
false.
It seems to be best to call this predicate with the same arguments (=)/3. In this manner, conditions like if_/3 are now much more readable. And to use rather the suffix _t in place of _truth:
memberd_t(_X, [], false).
memberd_t(X, [Y|Ys], Truth) :-
if_( X = Y, Truth=true, memberd_t(X, Ys, Truth) ).
Which used to be:
memberd_truth(_X, [], false).
memberd_truth(X, [Y|Ys], Truth) :-
if_( equal_truth(X, Y), Truth=true, memberd_truth(X, Ys, Truth) ).
UPDATE: This answer has been superseded by mine of 18 April. I do not propose that it be deleted because of the comments below.
My previous answer was wrong. The following one runs against the test case in the question and the implementation has the desired feature of avoiding superfluous choice-points. I assume the top predicate mode to be ?,+,? although other modes could easily be implemented.
The program has 4 clauses in all: the list in the 2nd argument is visited and for each member there are two possibilities: it either unifies with the 1st argument of the top predicate or is different from it in which case a dif constraint applies:
occurrences(X, L, Os) :- occs(L, X, Os).
occs([],_,[]).
occs([X|R], X, [X|ROs]) :- occs(R, X, ROs).
occs([X|R], Y, ROs) :- dif(Y, X), occs(R, Y, ROs).
Sample runs, using YAP:
?- occurrences(1,[E1,1,2,1,E2],Fs).
E1 = E2 = 1,
Fs = [1,1,1,1] ? ;
E1 = 1,
Fs = [1,1,1],
dif(1,E2) ? ;
E2 = 1,
Fs = [1,1,1],
dif(1,E1) ? ;
Fs = [1,1],
dif(1,E1),
dif(1,E2) ? ;
no
?- occurrences(E,[E1,E2],Fs).
E = E1 = E2,
Fs = [E,E] ? ;
E = E1,
Fs = [E],
dif(E,E2) ? ;
E = E2,
Fs = [E],
dif(E,E1) ? ;
Fs = [],
dif(E,E1),
dif(E,E2) ? ;
no
Here's an even shorter logically-pure implementation of occurrences/3.
We build it upon the meta-predicate tfilter/3, the
reified term equality predicate (=)/3, and the coroutine allEqual_to__lazy/2 (defined in my previous answer to this question):
occurrences(E,Xs,Es) :-
allEqual_to__lazy(Es,E),
tfilter(=(E),Xs,Es).
Done! To ease the comparison, we re-run exactly the same queries I used in my previous answer:
?- Fs = [1,2], occurrences(E,Es,Fs).
false.
?- occurrences(E,[1,2,3,1,2,3,1],Fs).
Fs = [1,1,1], E=1 ;
Fs = [2,2], E=2 ;
Fs = [3,3], E=3 ;
Fs = [], dif(E,1), dif(E,2), dif(E,3).
?- occurrences(1,[1,2,3,1,2,3,1],Fs).
Fs = [1,1,1].
?- Es = [E1,E2], occurrences(E,Es,Fs).
Es = [E, E ], Fs = [E,E], E1=E , E2=E ;
Es = [E, E2], Fs = [E], E1=E , dif(E2,E) ;
Es = [E1,E ], Fs = [E], dif(E1,E), E2=E ;
Es = [E1,E2], Fs = [], dif(E1,E), dif(E2,E).
?- occurrences(1,[E1,1,2,1,E2],Fs).
E1=1 , E2=1 , Fs = [1,1,1,1] ;
E1=1 , dif(E2,1), Fs = [1,1,1] ;
dif(E1,1), E2=1 , Fs = [1,1,1] ;
dif(E1,1), dif(E2,1), Fs = [1,1].
?- occurrences(1,L,[1,2]).
false.
?- L = [_|_],occurrences(1,L,[1,2]).
false.
?- L = [X|X],occurrences(1,L,[1,2]).
false.
?- L = [L|L],occurrences(1,L,[1,2]).
false.
At last, the most general query:
?- occurrences(E,Es,Fs).
Es = Fs, Fs = [] ;
Es = Fs, Fs = [E] ;
Es = Fs, Fs = [E,E] ;
Es = Fs, Fs = [E,E,E] % ... and so on ad infinitum ...
We get the same answers.
The implementation of occurrences/3 below is based on my previous answers, namely by profiting from the clause-indexing mechanism on the 1st argument to avoid some choice-points, and addresses all the issues that were raised.
Moreover it copes with a problem in all submited implementations up to now, including the one referred to in the question, namely that they all enter an infinite loop when the query has the 2 first arguments free and the 3rd a list with different ground elements. The correct behaviour is to fail, of course.
Use of a comparison predicate
I think that in order to avoid unused choice-points and keeping a good degree of the implementation declarativity there is no need for a comparison predicate as the one proposed in the question, but I agree this may be a question of taste or inclination.
Implementation
Three exclusive cases are considered in this order: if the 2nd argument is ground then it is visited recursively; otherwise if the 3rd argument is ground it is checked and then visited recursively; otherwise suitable lists are generated for the 2nd and 3rd arguments.
occurrences(X, L, Os) :-
( nonvar(L) -> occs(L, X, Os) ;
( nonvar(Os) -> check(Os, X), glist(Os, X, L) ; v_occs(L, X, Os) ) ).
The visit to the ground 2nd argument has three cases when the list is not empty: if its head and X above are both ground and unifiable X is in the head of the resulting list of occurrences and there is no other alternative; otherwise there are two alternatives with X being different from the head or unifying with it:
occs([],_,[]).
occs([X|R], Y, ROs) :-
( X==Y -> ROs=[X|Rr] ; foccs(X, Y, ROs, Rr) ), occs(R, Y, Rr).
foccs(X, Y, ROs, ROs) :- dif(X, Y).
foccs(X, X, [X|ROs], ROs).
Checking the ground 3rd argument consists in making sure all its members unify with X. In principle this check could be performed by glist/3 but in this way unused choice-points are avoided.
check([], _).
check([X|R], X) :- check(R, X).
The visit to the ground 3rd argument with a free 2nd argument must terminate by adding variables different from X to the generated list. At each recursion step there are two alternatives: the current head of the generated list is the current head of the visited list, that must be unifiable with X or is a free variable different from X. This is a theoretic-only description because in fact there is an infinite number of solutions and the 3rd clause will never be reached when the list head is a variable. Therefore the third clause below is commented out in order to avoid unusable choice-points.
glist([], X, L) :- gdlist(L,X).
glist([X|R], X, [X|Rr]) :- glist(R, X, Rr).
%% glist([X|R], Y, [Y|Rr]) :- dif(X, Y), glist([X|R], Y, Rr).
gdlist([], _).
gdlist([Y|R], X) :- dif(X, Y), gdlist(R, X).
Finally the case where all arguments are free is dealt with in a way similar to the previous case and having a similar problem of some solution patterns not being in practice generated:
v_occs([], _, []).
v_occs([X|R], X, [X|ROs]) :- v_occs(R, X, ROs).
%% v_occs([X|R], Y, ROs) :- dif(Y, X), v_occs(R, Y, ROs). % never used
Sample tests
?- occurrences(1,[E1,1,2,1,E2],Fs).
Fs = [1,1],
dif(E1,1),
dif(E2,1) ? ;
E2 = 1,
Fs = [1,1,1],
dif(E1,1) ? ;
E1 = 1,
Fs = [1,1,1],
dif(E2,1) ? ;
E1 = E2 = 1,
Fs = [1,1,1,1] ? ;
no
?- occurrences(1,L,[1,2]).
no
?- occurrences(1,L,[1,E,1]).
E = 1,
L = [1,1,1] ? ;
E = 1,
L = [1,1,1,_A],
dif(1,_A) ? ;
E = 1,
L = [1,1,1,_A,_B],
dif(1,_A),
dif(1,_B) ? ;
...
I want to make a Prolog program.
Predicate will be like this:
name(name, failedCourse, age)
Database of the program is:
name(george, math, 20).
name(steve, phys, 21).
name(jane, chem, 22).
I want to implement the predicate nameList(A, B). A means list of names, B means number of names on the list. For example:
nameList([george, steve],2). returns true
nameList([george, steve],X). returns X=2
nameList(X,2). returns X=[george, steve]; X=[george, jane]; X=[steve, jane]
nameList([martin],1). returns false (because martin is not included database.)
I wanted to make a list that includes all names on the database. For that reason I made a findall.
descend(X,Y,A) :- name(X,Y,A).
descend(X,Y,A) :- name(X,Z,A),descend(Z,Y,A).
findall(director(X),descend(Y,X),Z).
?- findall(B,descend(B,X,Y),A). returns A = [george, steve, jane].
But I could not figure it out to use list A in predicates :( I cannot search the list for A in the nameList.
If you help me, I will be very grateful.
The main thing you need is a predicate that calculates combinations of a given length and of a given list:
comb(0, _, []).
comb(N, [X | T], [X | Comb]) :-
N > 0,
N1 is N - 1,
comb(N1, T, Comb).
comb(N, [_ | T], Comb) :-
N > 0,
comb(N, T, Comb).
Usage:
?- comb(2, [a, b, a], Comb).
Comb = [a, b] ;
Comb = [a, a] ;
Comb = [b, a] ;
false.
(See more here.)
Now you can just apply this predicate on your data:
name(george, math, 20).
name(steve, phys, 21).
name(jane, chem, 22).
name_list(L, N) :-
findall(X, name(X, _, _), Xs),
length(Xs, Len),
between(0, Len, N),
comb(N, Xs, L).
Usage examples:
?- name_list(L, N).
L = [],
N = 0 ;
L = [george],
N = 1 ;
L = [steve],
N = 1 ;
L = [jane],
N = 1 ;
L = [george, steve],
N = 2 ;
L = [george, jane],
N = 2 ;
L = [steve, jane],
N = 2 ;
L = [george, steve, jane],
N = 3 ;
false.
?- name_list([george, steve], N).
N = 2 ;
false.
?- name_list(L, 2).
L = [george, steve] ;
L = [george, jane] ;
L = [steve, jane] ;
false.
name(george, math, 20).
name(steve, phys, 21).
name(jane, chem, 22).
name_list(Name_List,N) :-
integer(N),
findall(Name,name(Name,_,_),L),
combination(L,N,Name_List).
name_list(Name_List,N) :-
var(N),
findall(Name,name(Name,_,_),L),
length(L,Len),
for(1,N,Len),
combination(L,N,Name_List).
combination(X,1,[A]) :-
member(A,X).
combination([A|Y],N,[A|X]) :-
N > 1,
M is N - 1,
combination(Y,M,X).
combination([_|Y],N,A) :-
N > 1,
combination(Y,N,A).