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]]]
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 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 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'm new in Prolog and trying to do some programming with Lists
I want to do this :
?- count_occurrences([a,b,c,a,b,c,d], X).
X = [[d, 1], [c, 2], [b, 2], [a, 2]].
and this is my code I know it's not complete but I'm trying:
count_occurrences([],[]).
count_occurrences([X|Y],A):-
occurrences([X|Y],X,N).
occurrences([],_,0).
occurrences([X|Y],X,N):- occurrences(Y,X,W), N is W + 1.
occurrences([X|Y],Z,N):- occurrences(Y,Z,N), X\=Z.
My code is wrong so i need some hits or help plz..
Here's my solution using bagof/3 and findall/3:
count_occurrences(List, Occ):-
findall([X,L], (bagof(true,member(X,List),Xs), length(Xs,L)), Occ).
An example
?- count_occurrences([a,b,c,b,e,d,a,b,a], Occ).
Occ = [[a, 3], [b, 3], [c, 1], [d, 1], [e, 1]].
How it works
bagof(true,member(X,List),Xs) is satisfied for each distinct element of the list X with Xs being a list with its length equal to the number of occurrences of X in List:
?- bagof(true,member(X,[a,b,c,b,e,d,a,b,a]),Xs).
X = a,
Xs = [true, true, true] ;
X = b,
Xs = [true, true, true] ;
X = c,
Xs = [true] ;
X = d,
Xs = [true] ;
X = e,
Xs = [true].
The outer findall/3 collects element X and the length of the associated list Xs in a list that represents the solution.
Edit I: the original answer was improved thanks to suggestions from CapelliC and Boris.
Edit II: setof/3 can be used instead of findall/3 if there are free variables in the given list. The problem with setof/3 is that for an empty list it will fail, hence a special clause must be introduced.
count_occurrences([],[]).
count_occurrences(List, Occ):-
setof([X,L], Xs^(bagof(a,member(X,List),Xs), length(Xs,L)), Occ).
Note that so far all proposals have difficulties with lists that contain also variables. Think of the case:
?- count_occurrences([a,X], D).
There should be two different answers.
X = a, D = [a-2]
; dif(X, a), D = [a-1,X-1].
The first answer means: the list [a,a] contains a twice, and thus D = [a-2]. The second answer covers all terms X that are different to a, for those, we have one occurrence of a and one occurrence of that other term. Note that this second answer includes an infinity of possible solutions including X = b or X = c or whatever else you wish.
And if an implementation is unable to produce these answers, an instantiation error should protect the programmer from further damage. Something along:
count_occurrences(Xs, D) :-
( ground(Xs) -> true ; throw(error(instantiation_error,_)) ),
... .
Ideally, a Prolog predicate is defined as a pure relation, like this one. But often, pure definitions are quite inefficient.
Here is a version that is pure and efficient. Efficient in the sense that it does not leave open any unnecessary choice points. I took #dasblinkenlight's definition as source of inspiration.
Ideally, such definitions use some form of if-then-else. However, the traditional (;)/2 written
( If_0 -> Then_0 ; Else_0 )
is an inherently non-monotonic construct. I will use a monotonic counterpart
if_( If_1, Then_0, Else_0)
instead. The major difference is the condition. The traditional control constructs relies upon the success or failure of If_0 which destroys all purity. If you write ( X = Y -> Then_0 ; Else_0 ) the variables X and Y are unified and at that very point in time the final decision is made whether to go for Then_0 or Else_0. What, if the variables are not sufficiently instantiated? Well, then we have bad luck and get some random result by insisting on Then_0 only.
Contrast this to if_( If_1, Then_0, Else_0). Here, the first argument must be some goal that will describe in its last argument whether Then_0 or Else_0 is the case. And should the goal be undecided, it can opt for both.
count_occurrences(Xs, D) :-
foldl(el_dict, Xs, [], D).
el_dict(K, [], [K-1]).
el_dict(K, [KV0|KVs0], [KV|KVs]) :-
KV0 = K0-V0,
if_( K = K0,
( KV = K-V1, V1 is V0+1, KVs0 = KVs ),
( KV = KV0, el_dict(K, KVs0, KVs ) ) ).
=(X, Y, R) :-
equal_truth(X, Y, R).
This definition requires the following auxiliary definitions:
if_/3, equal_truth/3, foldl/4.
If you use SWI-Prolog, you can do :
:- use_module(library(lambda)).
count_occurrences(L, R) :-
foldl(\X^Y^Z^(member([X,N], Y)
-> N1 is N+1,
select([X,N], Y, [X,N1], Z)
; Z = [[X,1] | Y]),
L, [], R).
One thing that should make solving the problem easier would be to design a helper predicate to increment the count.
Imagine a predicate that takes a list of pairs [SomeAtom,Count] and an atom whose count needs to be incremented, and produces a list that has the incremented count, or [SomeAtom,1] for the first occurrence of the atom. This predicate is easy to design:
increment([], E, [[E,1]]).
increment([[H,C]|T], H, [[H,CplusOne]|T]) :-
CplusOne is C + 1.
increment([[H,C]|T], E, [[H,C]|R]) :-
H \= E,
increment(T, E, R).
The first clause serves as the base case, when we add the first occurrence. The second clause serves as another base case when the head element matches the desired element. The last case is the recursive call for the situation when the head element does not match the desired element.
With this predicate in hand, writing count_occ becomes really easy:
count_occ([], []).
count_occ([H|T], R) :-
count_occ(T, Temp),
increment(Temp, H, R).
This is Prolog's run-of-the-mill recursive predicate, with a trivial base clause and a recursive call that processes the tail, and then uses increment to account for the head element of the list.
Demo.
You have gotten answers. Prolog is a language which often offers multiple "correct" ways to approach a problem. It is not clear from your answer if you insist on any sort of order in your answers. So, ignoring order, one way to do it would be:
Sort the list using a stable sort (one that does not drop duplicates)
Apply a run-length encoding on the sorted list
The main virtue of this approach is that it deconstructs your problem to two well-defined (and solved) sub-problems.
The first is easy: msort(List, Sorted)
The second one is a bit more involved, but still straight forward if you want the predicate to only work one way, that is, List --> Encoding. One possibility (quite explicit):
list_to_rle([], []).
list_to_rle([X|Xs], RLE) :-
list_to_rle_1(Xs, [[X, 1]], RLE).
list_to_rle_1([], RLE, RLE).
list_to_rle_1([X|Xs], [[Y, N]|Rest], RLE) :-
( dif(X, Y)
-> list_to_rle_1(Xs, [[X, 1],[Y, N]|Rest], RLE)
; succ(N, N1),
list_to_rle_1(Xs, [[X, N1]|Rest], RLE)
).
So now, from the top level:
?- msort([a,b,c,a,b,c,d], Sorted), list_to_rle(Sorted, RLE).
Sorted = [a, a, b, b, c, c, d],
RLE = [[d, 1], [c, 2], [b, 2], [a, 2]].
On a side note, it is almost always better to prefer "pairs", as in X-N, instead of lists with two elements exactly, as in [X, N]. Furthermore, you should keep the original order of the elements in the list, if you want to be correct. From this answer:
rle([], []).
rle([First|Rest],Encoded):-
rle_1(Rest, First, 1, Encoded).
rle_1([], Last, N, [Last-N]).
rle_1([H|T], Prev, N, Encoded) :-
( dif(H, Prev)
-> Encoded = [Prev-N|Rest],
rle_1(T, H, 1, Rest)
; succ(N, N1),
rle_1(T, H, N1, Encoded)
).
Why is it better?
we got rid of 4 pairs of unnecessary brackets in the code
we got rid of clutter in the reported solution
we got rid of a whole lot of unnecessary nested terms: compare .(a, .(1, [])) to -(a, 1)
we made the intention of the program clearer to the reader (this is the conventional way to represent pairs in Prolog)
From the top level:
?- msort([a,b,c,a,b,c,d], Sorted), rle(Sorted, RLE).
Sorted = [a, a, b, b, c, c, d],
RLE = [a-2, b-2, c-2, d-1].
The presented run-length encoder is very explicit in its definition, which has of course its pros and cons. See this answer for a much more succinct way of doing it.
refining joel76 answer:
count_occurrences(L, R) :-
foldl(\X^Y^Z^(select([X,N], Y, [X,N1], Z)
-> N1 is N+1
; Z = [[X,1] | Y]),
L, [], R).
I am new to Prolog and when I query
sortedUnion([1,1,1,2,3,4,4,5], [0,1,3,3,6,7], [0,1,2,3,4,5,6,7]).
I get an error
Exception: (7) unite([_G114, _G162, _G201, _G231, _G243], [_G249, _G297, _G336, _G357, _G369], [0, 1, 2, 3, 4, 5, 6, 7]) ?
So I am hoping someone will be able to tell me where my code is mistaken and why it is wrong?
%undup(L, U) holds precisely when U can be obtained from L by eliminating repeating occurrences of the same element
undup([], []).
undup([X|Xs], [_|B]) :- remove(X,Xs,K), undup(K, B).
remove(_,[],[]).
remove(Y,[Y|T],D) :- remove(Y,T,D).
remove(Y,[S|T],[S|R]) :- not(Y = S), remove(Y,T,R).
%sortedUnion(L1,L2,U) holds when U contains exactly one instance of each element
%of L1 and L2
sortedunion([H|T], [S|R], [F|B]) :- undup([H|T], N), undup([S|R], M), unite(N,M,[F|B]).
unite([], [], []).
unite([X], [], [X]).
unite([], [X], [X]).
unite([H|T], [S|R], [X|Xs]) :- S=H, X is S, unite(T, R, Xs).
unite([H|T], [S|R], [X|Xs]) :- H<S, X is H, unite(T, [S|R], Xs).
unite([H|T], [S|R], [X|Xs]) :- S<H, X is S, unite([H|T], R, Xs).
An advice first: try to keep your code as simple as possible. Your code can reduce to this (that surely works)
sortedunion(A, B, S) :-
append(A, B, C),
sort(C, S).
but of course it's instructive to attempt to solve by yourself. Anyway, try to avoid useless complications.
sortedunion(A, B, S) :-
undup(A, N),
undup(B, M),
unite(N, M, S).
it's equivalent to your code, just simpler, because A = [H|T] and so on.
Then test undup/2:
1 ?- undup([1,1,1,2,3,4,4,5],L).
L = [_G2760, _G2808, _G2847, _G2877, _G2889] ;
false.
Clearly, not what you expect. The culprit should that anon var. Indeed, this works:
undup([], []).
undup([X|Xs], [X|B]) :- remove(X,Xs,K), undup(K, B).
2 ?- undup([1,1,1,2,3,4,4,5],L).
L = [1, 2, 3, 4, 5] ;
false.
Now, unite/3. First of all, is/2 is abused. It introduces arithmetic, then plain unification suffices here: X = S.
Then the base cases are hardcoded to work where lists' length differs at most by 1. Again, simpler code should work better:
unite([], [], []).
unite( X, [], X).
unite([], X, X).
...
Also, note the first clause is useless, being already covered by (both) second and third clauses.