Related
I am trying to solve this puzzle in prolog
Five people were eating apples, A finished before B, but behind C. D finished before E, but behind B. What was the finishing order?
My current solution has singleton variable, I am not sure how to fix this.
finishbefore(A, B, Ls) :- append(_, [A,B|_], Ls).
order(Al):-
length(Al,5),
finishbefore(A,B,Al),
finishbefore(C,A,Al),
finishbefore(D,E,Al),
finishbefore(B,D,Al).
%%query
%%?- order(Al).
Here is a pure version using constraints of library(clpz) or library(clpfd). The idea is to ask for a slightly different problem.
How can an endpoint in time be associated to each person respecting the constraints given?
Since we have five persons, five different points in time are sufficient but not strictly necessary, like 1..5.
:- use_module(library(clpz)). % or clpfd
:- set_prolog_flag(double_quotes, chars). % for "abcde" below.
appleeating_(Ends, Zs) :-
Ends = [A,B,C,D,E],
Zs = Ends,
Ends ins 1..5,
% alldifferent(Ends),
A #< B,
C #< A,
D #< E,
B #< D.
?- appleeating_(Ends, Zs).
Ends = [2, 3, 1, 4, 5], Zs = [2, 3, 1, 4, 5].
There is exactly one solution! Note that alldifferent/1 is not directly needed since nowhere is it stated that two persons are not allowed to end at precisely the same time. In fact, above proves that there is no shorter solution. #CapelliC's solution imposes an order, even if two persons finish ex aequo. But for the sake of compatibility, lets now map the solution back to your representation.
list_nth1(Es, N, E) :-
nth1(N, Es, E).
appleeatingorder(OrderedPeople) :-
appleeating_(Ends, Zs),
same_length(OrderedPeople, Ends),
labeling([], Zs), % not strictly needed
maplist(list_nth1(OrderedPeople), Ends,"abcde"). % effectively enforces alldifferent/1
?- appleeatingorder(OrderedPeople).
OrderedPeople = [c,a,b,d,e].
?- appleeatingorder(OrderedPeople).
OrderedPeople = "cabde".
The last solution using double quotes produces Scryer directly. In SWI use library(double_quotes).
(The extra argument Zs of appleeating_/2 is not strictly needed in this case, but it is a very useful convention for CLP predicates in general. It separates the modelling part (appleeating_/2) from the search part (labeling([], Zs)) such that you can easily try various versions for search/labeling at the same time. In order to become actually solved, all variables in Zs have to have an actual value.)
Let's correct finishbefore/3:
finishbefore(X, Y, L) :-
append(_, [X|R], L),
memberchk(Y, R).
then let's encode the known constraints:
check_finish_time(Order) :-
forall(
member(X<Y, [a<b,c<a, d<e,d<b]),
finishbefore(X,Y,Order)).
and now let's test all possible orderings
?- permutation([a,b,c,d,e],P),check_finish_time(P).
I get 9 solutions, backtracking with ;... maybe there are implicit constraints that should be encoded.
edit
Sorry for the noise, have found the bug. Swap the last constraint order, that is b<d instead of d<b, and now only 1 solution is allowed...
I want to know if it's possible to get a list of numbers from nested predicates in prolog.
I'll make an example, from:
?- elements(p(f(0,5,1), k(8, f(7,3), h(6)), 5), X).
I want in X this:
X = [0,5,1,8,7,3,6,5].
Thank you if you can help me =)
Whenever you write predicates involving general term traversal, always keep in mind that such predicates will be limited in the way they can be used. Let's call your relation term_subtermnumbers/2 which relates a term to the list of numbers that occur in it as subterms in the order of their left-to-right appearance, including multiple occurrences. First, you may think of examples you gave, like
?- term_subtermnumbers(p(f(0,5,1), k(8, f(7,3), h(6)), 5), Numbers).
Numbers = [0, 5, 1, 8, 7, 3, 6, 5].
But what if you turn the query around, and ask instead:
?- term_subtermnumbers(Term, [0, 5, 1, 8, 7, 3, 6, 5]).
There are many possibilities for solutions. In fact, infinitely many. Or take a simpler query:
?- term_subtermnumbers(Term, []).
That is, all the Terms that do not contain numbers.
Since the set of solutions is infinite here, and there is no way to abbreviate that set meaningfully as answers, it really makes sense to produce in that case a special error called an instantiation error.
Some - not all - Prolog built-ins ensure this property. (=..)/2 and functor/3 are faithfully guaranteeing that property. Helas, number/1 is not. As a consequence, always use (=..)/2 or functor/3 prior to number/1, atom/1, atomic/1 and some others.
term_subtermnumbers(Term, Numbers) :-
phrase(subtermnumbers(Term), Numbers).
subtermnumbers(Term) -->
{ Term =.. [_| Args] },
( {number(Term)} -> [Term]
; args_subtermnumbers(Args)
).
args_subtermnumbers([]) --> [].
args_subtermnumbers([Arg|Args]) -->
subtermnumbers(Arg),
args_subtermnumbers(Args).
If your Prolog has append/2 and maplist/3:
elements(N, [N]) :- number(N), !.
elements(S, Ss) :- S=..[_|Es], maplist(elements, Es, Ts), append(Ts, Ss).
This worked for me:
?- elements(p(f(0,5,1), k(8, f(7,3), h(6)), 5), X), writenl(X), fail.
elements(X,X) :- integer(X).
elements([],[]).
elements([X|Y],Z) :- integer(X), elements(Y,V), Z=[X|V].
elements([X|Y],Z) :- elements(X,W), elements(Y,V), append(W,V,Z).
elements(_(|Y),Z) :- elements(Y,Z).
writenl(X) :- write(X), nl.
It gave me [0, 5, 1, 8, 7, 3, 6, 5].
Try this instead:
?- elements(p(f(0,5,1), k(8, f(7,3), h(6)), 5), X), writenl(X), fail.
elements(X,X) :- integer(X).
elements([],[]).
elements([X|Y],Z) :- integer(X), elements(Y,V), Z=[X|V].
elements([X|Y],Z) :- elements(X,W), elements(Y,V), append(W,V,Z).
elements(X,Z) :- X=..[_|Y], elements(Y,Z).
writenl(X) :- write(X), nl.
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.
i am trying to write a binary predicate to take one list, compute mod 5 for each element and then put it in another list. so far, i have done this,
mod5(X,L):- R = [], modhelper(R,L), write(R).
modhelper(X,L):- memb(E,L), mod2(E,Z), addtolist(Z,X,X), modhelper(X,L).
%Get an element from the list L.
memb(E,[E|_]).
memb(E,[_|V]):- memb(E,V).
%If element is integer, return that integer mod 5 else return as is.
mod2(N,Z):- isInt(N) -> Z is N mod 5 ; Z = N.
%add this modified element to the output list.
addtolist(Y,[],[Y]).
addtolist(Y,[H|T],[H|N]):- addtolist(Y,T,N).
memb,mod2, addtolist work as expected but I'm doing something wrong in modhelper which I'm not able to figure out.
Any help is appreciated.
In SWI-Prolog:
mod5(X, Y) :-
Y is X mod 5.
apply_mod5_to_list(L1, L2) :-
maplist(mod5, L1, L2).
Usage:
?- apply_mod5_to_list([2, 4, 6, 8], L2).
L2 = [2, 4, 1, 3].
?- apply_mod5_to_list([2, 4.1, 6, 8], L2).
ERROR: mod/2: Type error: `integer' expected, found `4.1'
?- apply_mod5_to_list([2, not_number, 6, 8], L2).
ERROR: is/2: Arithmetic: `not_number/0' is not a function
You can easily modify this code if you want a slightly different behavior, e.g. if you want to tolerate non-integers (why do you want that btw?).
In case you cannot use maplist, you can implement it yourself, at least a more specialized version of it, e.g. something like this:
partition_the_list_into_first_and_rest([X | Xs], X, Xs).
% The result on an empty list is an empty list
apply_mod5_to_list([], []).
% If the input list contains at least one member
apply_mod5_to_list(L1, L2) :-
partition_the_list_into_first_and_rest(L1, X, Xs),
call(mod5, X, Y),
partition_the_list_into_first_and_rest(L2, Y, Ys),
apply_mod5_to_list(Xs, Ys).
To this code you can still apply a lot of syntactic simplification, which you should probably do to turn it into an acceptable homework solution...
How can I write a relation in prolog that determines if there are any two pairs in a list with the same sum. The relation should fail if there exist no pairs whose sums are equal. The relation should also fail if the list contains less than four elements.
list([1 2 3]) fails since it only has 3 elements
list([2 3 4 1]) succeeds since 2+3=4+1
list([3 1 2 4 5 6]) succeds since 5+1=2+4
list([1 8 20 100]) fails since there are no pairs with equal sums
How about this algorithm: take any two pairs of numbers, and see if they match. Here is the code for it:
has_equal_sums(List) :-
select(A, List, List2),
select(B, List2, List3),
select(C, List3, List4),
select(D, List4, _),
A+B =:= C+D.
If you want to make sure it works, or for debug purpose, you can display the two selected pairs as an output:
has_equal_sums(List, [[A, B], [C, D]]) :-
select(A, List, List2),
select(B, List2, List3),
select(C, List3, List4),
select(D, List4, _),
A+B =:= C+D.
Here are a few examples of usage:
?- has_equal_sums([1, 2, 3, 6, 5], X).
X = [[1,6],[2,5]] ? ;
X = [[2,6],[3,5]] ?
?- has_equal_sums([1, 2, 3, 5], X).
no
?- has_equal_sums([1, 2, 3], X).
no
So I checked with my professor and since our deadline has passed, he is OK with me posting my solution to this problem. This is probably not the most succinct way to solve the problem, and I'm leaning on my Scheme a bit, but it appears to work:
%car operations
car([],null).
car([X|_],X).
cadr([_|L],R) :-
car(L,R).
caddr([_|L],R) :-
cadr(L,R).
%cdr operations
cdr([],[]).
cdr([_|L],L).
cddr([_|L],R) :-
cdr(L,R).
cdddr([_|L],R) :-
cddr(L,R).
%two-pair operation
% This algorithm is based on the provided example
% solution for CSC388FA09HW4.
long-enough(L,_) :-
length(L,X),
X>3.
too-long(L,_) :-
length(L,X),
X>4.
two-pair([Head|Tail]) :-
long-enough([Head|Tail],_),
(
(car(Tail,N2),cadr(Tail,N3),caddr(Tail,N4),Head+N2=:=N3+N4);
(cadr(Tail,N2),car(Tail,N3),caddr(Tail,N4),Head+N2=:=N3+N4);
(caddr(Tail,N2),car(Tail,N3),cadr(Tail,N4),Head+N2=:=N3+N4)
);
too-long([Head|Tail],_),
(
two-pair(Tail);
cdr(Tail,N2),two-pair([Head|N2]);
car(Tail,N2),cddr(Tail,N3),two-pair([Head|[N2|N3]]);
car(Tail,N2),cadr(Tail,N3),cdddr(Tail,N4),two-pair([Head|[N2|[N3|N4]]])).