Related
The usual vanilla interpreter uses Prolog backtracking
itself to archive backtacking. I guess this is the reason
why its called "vanilla":
solve(true).
solve((A,B)) :- solve(A), solve(B).
solve(H) :- clause(H, B), solve(B).
How about a "chili" interpreter, that doesn't use any
Prolog backtracking. Basically a predicate first/? to obtain
a first solution and a predicate next/? to obtain further solutions.
How would one go about it and realize such an interpreter in Prolog. The solution needs not be pure, could also use findall and cut. Although a purer solution could be also illustrative.
This solution is a slightly dumbed-down version of the interpreter given in Markus Triska's A Couple of Meta-interpreters in Prolog (part of The Power of Prolog) under Reifying backtracking. It is a bit more verbose and less efficient, but possibly a bit more immediately understandable than that code.
first(Goal, Answer, Choices) :-
body_append(Goal, [], Goals),
next([Goals-Goal], Answer, Choices).
next([Goals-Query|Choices0], Answer, Choices) :-
next(Goals, Query, Answer, Choices0, Choices).
next([], Answer, Answer, Choices, Choices).
next([Goal|Goals0], Query, Answer, Choices0, Choices) :-
findall(Goals-Query, clause_append(Goal, Goals0, Goals), Choices1),
append(Choices1, Choices0, Choices2),
next(Choices2, Answer, Choices).
clause_append(Goal, Goals0, Goals) :-
clause(Goal, Body),
body_append(Body, Goals0, Goals).
body_append((A, B), List0, List) :-
!,
body_append(B, List0, List1),
body_append(A, List1, List).
body_append(true, List, List) :-
!.
body_append(A, As, [A|As]).
The idea is that the Prolog engine state is represented as a list of disjunctive Choices, playing the role of a stack of choice points. Each choice is of the form Goals-Query, where Goals is a conjunctive list of goals still to be satisfied, i.e. the resolvent at that node of the SLD tree, and Query is an instance of the original query term whose variables have been instantiated according to the unifications made in the path leading up to that node.
If the resolvent of a choice becomes empty, it's Query instantiation is returned as an Answer and we continue with other choices. Note how when no clauses are found for a goal, i.e. it "fails", Choices1 unifies with [] and we "backtrack" by proceeding through the remaining choices in Choices0. Also note that when there are no choices in the list, next/3 fails.
An example session:
?- assertz(mem(X, [X|_])), assertz(mem(X, [_|Xs]) :- mem(X, Xs)).
true.
?- first(mem(X, [1, 2, 3]), A0, S0), next(S0, A1, S1), next(S1, A2, S2).
A0 = mem(1, [1, 2, 3]),
S0 = [[mem(_G507, [2, 3])]-mem(_G507, [1, 2, 3])],
A1 = mem(2, [1, 2, 3]),
S1 = [[mem(_G579, [3])]-mem(_G579, [1, 2, 3])],
A2 = mem(3, [1, 2, 3]),
S2 = [[mem(_G651, [])]-mem(_G651, [1, 2, 3])].
The problem with this approach is that findall/3 does a lot of copying of the resolvent i.e. the remaining conjunction of goals to be proved in a disjunctive branch. I would love to see a more efficient solution where terms are copied and variables shared more cleverly.
Here is a slight variation of reified backtracking, using difference lists.
first(G, [[]|L], R) :- !, first(G, L, R). %% choice point elimination
first([A], L, [A|L]) :- !.
first([H|T], L, R) :- findall(B, rule(H,B,T), [B|C]), !, first(B, [C|L], R).
first(_, L, R) :- next(L, R).
next([[B|C]|L], R) :- !, first(B, [C|L], R).
next([_|L], R) :- next(L, R).
Representation of rules and facts via difference lists looks for Peano arithmetic as follows:
rule(add(n,X,X),T,T).
rule(add(s(X),Y,s(Z)),[add(X,Y,Z)|T],T).
rule(mul(n,_,n),T,T).
rule(mul(s(X),Y,Z),[mul(X,Y,H),add(Y,H,Z)|T],T).
And you can run queries as follows:
?- first([mul(s(s(n)),s(s(s(n))),X),X],[],[X|L]).
X = s(s(s(s(s(s(n))))))
L = []
?- first([add(X,Y,s(s(s(n)))),X-Y],[],[X-Y|L]).
X = n
Y = s(s(s(n)))
L = [[[add(_A,_B,s(s(n))),s(_A)-_B]]]
?- first([add(X,Y,s(s(s(n)))),X-Y],[],[_|L]), next(L,[X-Y|R]).
L = [[[add(_A,_B,s(s(n))),s(_A)-_B]]],
X = s(n)
Y = s(s(n))
R = [[[add(_C,_D,s(n)),s(s(_C))-_D]]]
I am using a higher order Prolog variant that lacks findall.
There is another question on implementing our own findall here: Getting list of solutions in Prolog.
The inefficient implementation is:
parent(pam, bob). %pam is a parent of bob
parent(george, bob). %george is a parent of bob
list_parents(A, Es, [X|Xs]) :-
parent(X, A),
\+ member(X, Es),
list_parents(A, [X|Es], Xs).
list_parents(A, Es, []).
The efficient one
need a "solutions" higher-order predicate:
list_parents(X, Ys) :- solutions(parent, [X, W], 1, Ys)
What is solutions? Can I implement my own solutions predicate in higher order lambda Prolog?
Yes, if findall/3 were not available, you could implement it for example via the dynamic database.
For example, for the concrete use case of parents:
list_parents(_) :-
parent(P, _),
assertz(parent(P)),
false.
list_parents(Ps) :-
phrase(retract_parents, Ps).
retract_parents -->
( { retract(parent(P)) } ->
[P],
retract_parents
; []
).
Sample query:
?- list_parents(Ps).
Ps = [pam, george].
You can combine this with sort/2 for asymptotically optimal performance, avoiding the quadratic overhead of the "naive" solution to remove duplicates.
Beware though: First, this is not thread-safe. To make it thread-safe you need to add more information pertaining to the current thread.
Second, if you implement full-fledged findall/3 in this way, you must take care of nested findall/3 calls.
One way to do this is to assert two kinds of terms:
solution(S), such as solution(parent(pam)), indicating a concrete solution that was found on backtracking via the most recent findall/3 call
mark, indicating that a new findall/3 starts here
When collecting solutions, you only proceed to the most recent mark.
See Richard O'Keefe's book for a good introduction to these issues.
If your Prolog has some kind of non backtrackable assignment, like SWI-Prolog 'global' variables, you could implement (beware, simple minded code) in this way:
:- meta_predicate solutions(0, ?).
:- meta_predicate solutions(+, 0, ?).
solutions(G, L) :-
solutions(G, G, L).
solutions(P, G, L) :-
( nb_current(solutions_depth, C) -> true ; C=1 ),
D is C+1,
nb_setval(solutions_depth, D),
atom_concat(solutions_depth_, D, Store),
nb_setval(Store, []),
( G,
nb_getval(Store, T),
nb_setval(Store, [P|T]),
fail
; nb_getval(Store, R)
),
nb_delete(Store),
nb_setval(solutions_depth, C),
reverse(R, L).
Usage of 'global' variables results in more efficient execution WRT the dynamic database (assert/retract), and (in SWI-prolog) can be used even in multithreaded applications.
edit
Thanks to #false comment, moved the cut(s) before reverse/2, and introduced a stack for reentrant calls: for instance
?- solutions(X-Ys,(between(1,3,X),solutions(Y,between(1,5,Y),Ys)),S).
S = [1-[1, 2, 3, 4, 5], 2-[1, 2, 3, 4, 5], 3-[1, 2, 3, 4, 5]].
edit
Here is a variant of solutions/3, building the result list in order, to avoid the final reverse/2 call. Adding results to the list tail is a bit tricky...
solutions(P, G, L) :-
( nb_current(solutions_depth, C) -> true ; C=1 ),
D is C+1,
nb_setval(solutions_depth, D),
atom_concat(solutions_depth_, D, Store),
( G,
( nb_current(Store, U/B) -> B = [P|R], Q = U/R ; Q = [P|T]/T ),
nb_setval(Store, Q),
fail
; ( nb_current(Store, L/[]) -> true ; L = [] )
),
nb_delete(Store),
nb_setval(solutions_depth, C).
I'm writing prolog code that finds a certain number; a number is the right number if it's between 0 and 9 and not present in a given list. To do this I wrote a predicate number/3 that has the possible numbers as the first argument, the list in which the Rightnumber cannot be present and the mystery RightNumber as third argument:
number([XH|XT], [H|T], RightNumber):-
member(XH, [H|T]), !,
number(XT, [H|T], RightNumber).
number([XH|_], [H|T], XH):-
\+ member(XH, [H|T]).
so this code basically says that if the Head of the possible numbers list is already a member of the second list, to cut of the head and continue in recursion with the tail.
If the element is not present in the second list, the second clause triggers and tells prolog that that number is the RightNumber. It's okay that it only gives the first number that is possible, that's how I want to use it.
This code works in theory, but I was wondering if there's a better way to write it down? I'm using this predicate in another predicate later on in my code and it doesn't work as part of that. I think it's only reading the first clause, not the second and fails as a result.
Does anybody have an idea that might improve my code?
sample queries:
?- number([0,1,2,3,4,5,6,7,8,9], [1,2], X).
X = 3
?- number([0,1,2,3,4,5,6,7,8,9], [1,2,3,4,5,6,7,8,0], X).
X = 9
First, the code does not work. Consider:
?- number(Xs, Ys, N).
nontermination
This is obviously bad: For this so-called most general query, we expect to obtain answers, but Prolog does not give us any answer with this program!
So, I first suggest you eliminate all impurities from your program, and focus on a clean declarative description of what you want.
I give you a start:
good_number(N, Ls) :-
N in 0..9,
maplist(#\=(N), Ls).
This states that the relation is true if N is between 0 and 9, and N is different from any integer in Ls. See clpfd for more information about CLP(FD) constraints.
Importantly, this works in all directions. For example:
?- good_number(4, [1,2,3]).
true.
?- good_number(11, [1,2,3]).
false.
?- good_number(N, [1,2,3]).
N in 0\/4..9.
And also in the most general case:
?- good_number(N, Ls).
Ls = [],
N in 0..9 ;
Ls = [_2540],
N in 0..9,
N#\=_2540 ;
Ls = [_2750, _2756],
N in 0..9,
N#\=_2756,
N#\=_2750 .
This, with only two lines of code, we have implemented a very general relation.
Also see logical-purity for more information.
First of all, your predicate does not work, nor does it check all the required constraints (between 0 and 9 for instance).
Several things:
you unpack the second list [H|T], but you re-pack it when you call member(XH, [H|T]); instead you can use a list L (this however slightly alters the semantics of the predicate, but is more accurate towards the description);
you check twice member/2ship;
you do not check whether the value is a number between 0 and 9 (and an integer anyway).
A better approach is to construct a simple clause:
number(Ns, L, Number) :-
member(Number, Ns),
integer(Number),
0 =< Number,
Number =< 9,
\+ member(Number, L).
A problem that remains is that Number can be a variable. In that case integer(Number) will fail. In logic we would however expect that Prolog unifies it with a number. We can achieve this by using the between/3 predicate:
number(Ns, L, Number) :-
member(Number, Ns),
between(0, 9, Number),
\+ member(Number, L).
We can also use the Constraint Logic Programming over Finite Domains library and use the in/2 predicate:
:- use_module(library(clpfd)).
number(Ns, L, Number) :-
member(Number, Ns),
Number in 0..9,
\+ member(Number, L).
There are still other things that can go wrong. For instance we check non-membership with \+ member(Number, L). but in case L is not grounded, this will fail, instead of suggesting lists where none of the elements is equal to Number, we can use the meta-predicate maplist to construct lists and then call a predicate over every element. The predicate we want to call over every element is that that element is not equal to Number, so we can use:
:- use_module(library(clpfd)).
number(Ns, L, Number) :-
member(Number, Ns),
Number in 0..9,
maplist(#\=(Number), L).
I have two dynamics of /2.
One of the lists, lets call it D2 has set values inside of it. For example: 2 and 3, 4 and 5.
How can I check if my dynamic 1 aka. D1 has all the values inside of it that D2 has and then return true if it does?
I tried to use
member(E, D1(_,_)), member(E, D2(_, _)). So far but without much luck.
This is pretty icky as far as data models go and whatever it is you're trying to do with this is going to at least be inefficient, if it can even be made to work. You'd be far better off defining an arity 3 fact with the first arg being an atom that identifies the type.
That said, you can probably do enough introspection to handle it.
dif(Q, P),
predicate_property(QR, dynamic),
predicate_property(PR, dynamic),
QR =.. [Q, _, _],
PR =.. [P, _, _].
This says, find me two predicates with arity 2, whose heads are different. Ideally, you want just the user-defined predicates. SWI-Prolog cannot do this, but GNU Prolog can, you could add some extra constraints:
predicate_property(QR, user),
predicate_property(PR, user),
This is my solution:
matching(Q, P) :-
dif(Q, P), % different predicates, please
predicate_property(QR, dynamic), % both dynamic
predicate_property(PR, dynamic),
QR =.. [Q, Q1, Q2], % arity-2 predicates, please
PR =.. [P, P1, P2],
findall([Q1, Q2], clause(QR, true), Qs), % find all facts (:- true)
findall([P1, P2], clause(PR, true), Ps),
forall(member(PV, Ps), member(PV, Qs)), % ensure the fact sets are equal
forall(member(QV, Qs), member(QV, Ps)).
Please, please, please DO NOT DO THIS!
I'm trying to figure out a way to check if two lists are equal regardless of their order of elements.
My first attempt was:
areq([],[]).
areq([],[_|_]).
areq([H1|T1], L):- member(H1, L), areq(T1, L).
However, this only checks if all elements of the list on the left exist in the list on the right; meaning areq([1,2,3],[1,2,3,4]) => true. At this point, I need to find a way to be able to test thing in a bi-directional sense. My second attempt was the following:
areq([],[]).
areq([],[_|_]).
areq([H1|T1], L):- member(H1, L), areq(T1, L), append([H1], T1, U), areq(U, L).
Where I would try to rebuild the lest on the left and swap lists in the end; but this failed miserably.
My sense of recursion is extremely poor and simply don't know how to improve it, especially with Prolog. Any hints or suggestions would be appreciated at this point.
As a starting point, let's take the second implementation of equal_elements/2 by #CapelliC:
equal_elements([], []).
equal_elements([X|Xs], Ys) :-
select(X, Ys, Zs),
equal_elements(Xs, Zs).
Above implementation leaves useless choicepoints for queries like this one:
?- equal_elements([1,2,3],[3,2,1]).
true ; % succeeds, but leaves choicepoint
false.
What could we do? We could fix the efficiency issue by using
selectchk/3 instead of
select/3, but by doing so we would lose logical-purity! Can we do better?
We can!
Introducing selectd/3, a logically pure predicate that combines the determinism of selectchk/3 and the purity of select/3. selectd/3 is based on
if_/3 and (=)/3:
selectd(E,[A|As],Bs1) :-
if_(A = E, As = Bs1,
(Bs1 = [A|Bs], selectd(E,As,Bs))).
selectd/3 can be used a drop-in replacement for select/3, so putting it to use is easy!
equal_elementsB([], []).
equal_elementsB([X|Xs], Ys) :-
selectd(X, Ys, Zs),
equal_elementsB(Xs, Zs).
Let's see it in action!
?- equal_elementsB([1,2,3],[3,2,1]).
true. % succeeds deterministically
?- equal_elementsB([1,2,3],[A,B,C]), C=3,B=2,A=1.
A = 1, B = 2, C = 3 ; % still logically pure
false.
Edit 2015-05-14
The OP wasn't specific if the predicate
should enforce that items occur on both sides with
the same multiplicities.
equal_elementsB/2 does it like that, as shown by these two queries:
?- equal_elementsB([1,2,3,2,3],[3,3,2,1,2]).
true.
?- equal_elementsB([1,2,3,2,3],[3,3,2,1,2,3]).
false.
If we wanted the second query to succeed, we could relax the definition in a logically pure way by using meta-predicate
tfilter/3 and
reified inequality dif/3:
equal_elementsC([],[]).
equal_elementsC([X|Xs],Ys2) :-
selectd(X,Ys2,Ys1),
tfilter(dif(X),Ys1,Ys0),
tfilter(dif(X),Xs ,Xs0),
equal_elementsC(Xs0,Ys0).
Let's run two queries like the ones above, this time using equal_elementsC/2:
?- equal_elementsC([1,2,3,2,3],[3,3,2,1,2]).
true.
?- equal_elementsC([1,2,3,2,3],[3,3,2,1,2,3]).
true.
Edit 2015-05-17
As it is, equal_elementsB/2 does not universally terminate in cases like the following:
?- equal_elementsB([],Xs), false. % terminates universally
false.
?- equal_elementsB([_],Xs), false. % gives a single answer, but ...
%%% wait forever % ... does not terminate universally
If we flip the first and second argument, however, we get termination!
?- equal_elementsB(Xs,[]), false. % terminates universally
false.
?- equal_elementsB(Xs,[_]), false. % terminates universally
false.
Inspired by an answer given by #AmiTavory, we can improve the implementation of equal_elementsB/2 by "sharpening" the solution set like so:
equal_elementsBB(Xs,Ys) :-
same_length(Xs,Ys),
equal_elementsB(Xs,Ys).
To check if non-termination is gone, we put queries using both predicates head to head:
?- equal_elementsB([_],Xs), false.
%%% wait forever % does not terminate universally
?- equal_elementsBB([_],Xs), false.
false. % terminates universally
Note that the same "trick" does not work with equal_elementsC/2,
because of the size of solution set is infinite (for all but the most trivial instances of interest).
A simple solution using the sort/2 ISO standard built-in predicate, assuming that neither list contains duplicated elements:
equal_elements(List1, List2) :-
sort(List1, Sorted1),
sort(List2, Sorted2),
Sorted1 == Sorted2.
Some sample queries:
| ?- equal_elements([1,2,3],[1,2,3,4]).
no
| ?- equal_elements([1,2,3],[3,1,2]).
yes
| ?- equal_elements([a(X),a(Y),a(Z)],[a(1),a(2),a(3)]).
no
| ?- equal_elements([a(X),a(Y),a(Z)],[a(Z),a(X),a(Y)]).
yes
In Prolog you often can do exactly what you say
areq([],_).
areq([H1|T1], L):- member(H1, L), areq(T1, L).
bi_areq(L1, L2) :- areq(L1, L2), areq(L2, L1).
Rename if necessary.
a compact form:
member_(Ys, X) :- member(X, Ys).
equal_elements(Xs, Xs) :- maplist(member_(Ys), Xs).
but, using member/2 seems inefficient, and leave space to ambiguity about duplicates (on both sides). Instead, I would use select/3
?- [user].
equal_elements([], []).
equal_elements([X|Xs], Ys) :-
select(X, Ys, Zs),
equal_elements(Xs, Zs).
^D here
1 ?- equal_elements(X, [1,2,3]).
X = [1, 2, 3] ;
X = [1, 3, 2] ;
X = [2, 1, 3] ;
X = [2, 3, 1] ;
X = [3, 1, 2] ;
X = [3, 2, 1] ;
false.
2 ?- equal_elements([1,2,3,3], [1,2,3]).
false.
or, better,
equal_elements(Xs, Ys) :- permutation(Xs, Ys).
The other answers are all elegant (way above my own Prolog level), but it struck me that the question stated
efficient for the regular uses.
The accepted answer is O(max(|A| log(|A|), |B|log(|B|)), irrespective of whether the lists are equal (up to permutation) or not.
At the very least, it would pay to check the lengths before bothering to sort, which would decrease the runtime to something linear in the lengths of the lists in the case where they are not of equal length.
Expanding this, it is not difficult to modify the solution so that its runtime is effectively linear in the general case where the lists are not equal (up to permutation), using random digests.
Suppose we define
digest(L, D) :- digest(L, 1, D).
digest([], D, D) :- !.
digest([H|T], Acc, D) :-
term_hash(H, TH),
NewAcc is mod(Acc * TH, 1610612741),
digest(T, NewAcc, D).
This is the Prolog version of the mathematical function Prod_i h(a_i) | p, where h is the hash, and p is a prime. It effectively maps each list to a random (in the hashing sense) value in the range 0, ...., p - 1 (in the above, p is the large prime 1610612741).
We can now check if two lists have the same digest:
same_digests(A, B) :-
digest(A, DA),
digest(B, DB),
DA =:= DB.
If two lists have different digests, they cannot be equal. If two lists have the same digest, then there is a tiny chance that they are unequal, but this still needs to be checked. For this case I shamelessly stole Paulo Moura's excellent answer.
The final code is this:
equal_elements(A, B) :-
same_digests(A, B),
sort(A, SortedA),
sort(B, SortedB),
SortedA == SortedB.
same_digests(A, B) :-
digest(A, DA),
digest(B, DB),
DA =:= DB.
digest(L, D) :- digest(L, 1, D).
digest([], D, D) :- !.
digest([H|T], Acc, D) :-
term_hash(H, TH),
NewAcc is mod(Acc * TH, 1610612741),
digest(T, NewAcc, D).
One possibility, inspired on qsort:
split(_,[],[],[],[]) :- !.
split(X,[H|Q],S,E,G) :-
compare(R,X,H),
split(R,X,[H|Q],S,E,G).
split(<,X,[H|Q],[H|S],E,G) :-
split(X,Q,S,E,G).
split(=,X,[X|Q],S,[X|E],G) :-
split(X,Q,S,E,G).
split(>,X,[H|Q],S,E,[H|G]) :-
split(X,Q,S,E,G).
cmp([],[]).
cmp([H|Q],L2) :-
split(H,Q,S1,E1,G1),
split(H,L2,S2,[H|E1],G2),
cmp(S1,S2),
cmp(G1,G2).
A simple solution using cut.
areq(A,A):-!.
areq([A|B],[C|D]):-areq(A,C,D,E),areq(B,E).
areq(A,A,B,B):-!.
areq(A,B,[C|D],[B|E]):-areq(A,C,D,E).
Some sample queries:
?- areq([],[]).
true.
?- areq([1],[]).
false.
?- areq([],[1]).
false.
?- areq([1,2,3],[3,2,1]).
true.
?- areq([1,1,2,2],[2,1,2,1]).
true.