Rule matching regarding lists in SWI Prolog - prolog

Recently I started learning Prolog and as an exercise I tried to implement a predicate penultimate/2 giving the penultimate element of a list that would not backtrack.
This problem is trivial when one use cuts, but I tried to implement a predicate in a similar way to SWI-Prolog implementation of last/2 predicate that would not use cuts:
penultimate([X1, X2 | Rest], Elem) :-
penultimate_([X1, X2 | Rest], X1, X2, Elem).
penultimate_([], X1, _, X1).
penultimate_([_], _, X2, X2).
penultimate_([X1, X2 | Rest], _, _, Penultimate) :-
penultimate_(Rest, X1, X2, Penultimate).
This code works as expected when the length of the list is even, but when fed with a list of odd length, I get the following result:
?- penultimate([1,2,3], X).
X = 2 ;
false.
The only reason why this happens that I can come up with is that the SWI-Prolog matching system treats the rule in my program as a possibility for matching against a one-element list even though the list in the rule head requires at least 2 elements. Is this correct?

Try:
penultimate([X1, X2 | Rest], Penultimate) :-
penultimate(Rest, X1, X2, Penultimate).
penultimate([], Penultimate, _, Penultimate).
penultimate([X3| Rest], _, X2, Penultimate) :-
penultimate([X2, X3| Rest], Penultimate).
Sample calls:
| ?- penultimate([1,2,3,4,5], P).
P = 4
yes
| ?- penultimate([1,2,3,4], P).
P = 3
yes
| ?- penultimate([1,2,3], P).
P = 2
yes
| ?- penultimate([1,2], P).
P = 1
yes
| ?- penultimate([1], P).
no
Indexing on most Prolog systems can distinguish between an empty list (an atom) or a non-empty list (a compound term) but usually would not perform deep-indexing in a list.

Related

PROLOG. Get all objects from list matching a pattern

I am a beginner in prolog and i have a problem with getting objects from list matching a pattern.
If i have a list [1,2,3,4,5,1,1] . I want to use a predicate selectAll(Elem,List,X).
Where i use ?- selectAll(1,[1,2,3,4,5,1,1],X), I get X =[1,1,1], but i also want to use data structures inside the predicate, not only atoms.
I originally wrote this predicate for getting all matching elements, but it works only for simple cases, where only atoms are used:
selectAll(_, [], []).
selectAll(X, [X | LIST], [X | RES]):-
selectAll(X, LIST, RES),!.
selectAll(X, [H | LIST], RES):-
selectAll(X, LIST, RES).
When i use this test predicate, everything works fine. I get X=[1,1,1], the result i want.
test_select_all:-
selectAll(1, [1,2,3,4,5,1,1], X),
write(X),nl,
fail.
I have a data structure called kv_pairs(A,B) where A and B contain atoms of any type.
So when i use the selectAll predicate for this datatype, i get unwanted results. X = [kv_pair(1,a)]. It selects only 1 element at most.
test_select_all_dict:-
selectAll(kv_pair(1,_), [kv_pair(1, a), kv_pair(1, b),kv_pair(3, jkak), kv_pair(15, asdjk), kv_pair(1, c)], X),
write(X),nl,
fail.
I then created this predicate, specifically for finding list elements, where all types are kv_pairs
selectAll(_, [], []).
selectAll(kv_pair(Arg, _), [kv_pair(Arg,_) | LIST], [kv_pair(Arg,_) | RES]):-
selectAll(kv_pair(Arg, _), LIST, RES),!.
selectAll(kv_pair(Arg, X), [kv_pair(A, B) | LIST], RES):-
selectAll(kv_pair(Arg, X), LIST, RES).
But then i get also unwanted results.
X = [kv_pair(1,_8378),kv_pair(1,_8396),kv_pair(1,_8426)]
How can i get
X = [kv_pair(1,a),kv_pair(1,b),kv_pair(1,c)]?
Any help would be appreciated.
You can use the ISO predicate subsumes_term/2 to undo bindings after unification:
select_all(Pattern, List, Result) :-
select_all_loop(List, Pattern, Result).
select_all_loop([], _, []).
select_all_loop([X|Xs], P, R) :-
( subsumes_term(P, X)
-> R = [X|Ys]
; R = Ys ),
select_all_loop(Xs, P, Ys).
Examples:
?- select_all(kv_pair(1,_), [kv_pair(1,a), kv_pair(1,b), kv_pair(3,c), kv_pair(4,d), kv_pair(1,c)], R).
R = [kv_pair(1, a), kv_pair(1, b), kv_pair(1, c)].
?- select_all(p(1,Y), [p(1,a), p(1,b), p(2,b), p(1,c)], L).
L = [p(1, a), p(1, b), p(1, c)].
?- select_all(p(X,b), [p(1,a), p(1,b), p(2,b), p(1,c)], L).
L = [p(1, b), p(2, b)].

Eliminate consecutive duplicates of list elements with prolog

The original problem was to come up with a way to get the following
remove([a,a,a,b,q,q,q,q,e,e,e]),X)
X = [a,b,q,e]
We can solve this problem by one iteration along the list. At any point in the list we check the current element and the next element, if they are the same then we ignore the current element, else if they are different we take the current element.
rm_dup([], []).
rm_dup([X], [X]).
rm_dup([X1, X2 | Xs], [X1 | Ys]) :-
dif(X1, X2), rm_dup([X2|Xs], Ys).
rm_dup([X, X | Xs], Ys) :-
rm_dup([X | Xs], Ys).
The first and second clauses are base clauses in which there are no duplicate elements. The third and fourth clauses are recursive rules.
In third clause we state that if the input list has two values X1 and X2 and they are different dif(X1, X2), then keep the current value.
In fourth clause if we have same consecutive values then we ignore the current value.
The third and fourth clauses are mutually exclusive and hence to make the predicate deterministic it is better to combine them as follows
rm_dup([X], [X]) :- !.
rm_dup([X1, X2 | Xs], Ys) :-
dif(X1, X2) -> (rm_dup([X2 | Xs], Ys1), Ys = [X1 | Ys1]);
rm_dup([X2 | Xs], Ys).
Even better is to just use equality as a condition and flip the then and else clauses.
rm_dup([X], [X]) :- !.
rm_dup([X1, X2 | Xs], Ys) :-
X1 = X2 -> rm_dup([X2 | Xs], Ys);
rm_dup([X2 | Xs], Ys1), Ys = [X1 | Ys1].
Kinda long, but this solved it.
delete(_,[],[]).
delete(X,[X|T],R):- delete(X,T,R).
delete(X,[H|T],[H|R]) :- delete(X,T,R).
remove([],[]).
remove([H|T], [H|R]) :-
member(H,T),!,
delete(H,T,R1),
remove(R1,R).
remove([H|T],[H|R]):-
remove(T,R).
You can simply use sort.
First: In the base class if the List are empty stop.
Second: In the second predicate, take the list and sort it. Display the answer in K.
remove_extras([],[]).
remove_extras([H|T],K):-
sort([H|T], K).
?-remove_extras([a,a,a,b,q,q,q,q,e,e,e],X).
X = [a, b, e, q]
?-remove_extras([1,3,2,5,1,6,1,2,7],X).
X = [1, 2, 3, 5, 6, 7]
If you don't want to use sort, you can use the following predicates:
Remove duplicates checks for elements existing more than once and keeps them in the list.
First: The base case says that if the lists are empty stop.
Second: The second predicate checks if an element exist in the remaining list (member) then don't add it to the final list.
Third: The third predicate says, if the element is in not the remaining list then add it to the final list.
remove_duplicates([],[]).
remove_duplicates([H | T], List) :-
member(H, T),
remove_duplicates( T, List).
remove_duplicates([H | T], [H|T1]) :-
\+ member(H, T),
remove_duplicates( T, T1).

Remove duplicates in backtracking

I have a predicate next which essentially removes numbers from a list, in the attempt to decrease the overall size of the list.
So for example I have a list:
[3,2,1]
next will remove certain values from the list, so it'll return something like this
[3,2] or [3,1] or [3] or [2,1] etc
I'm running a script to find all possible moves:
findall(T, next([2,3], T), U).
The problem is for a list which repeats values such as:
L = [1,1,1,1].
the call
findall(T, next([1,1,1,1], T), U).
will unify U with [[1,1,1], [1,1,1], [1,1,1], [1,1,1]]
Is there a way to make the Prolog understand that it is returning the same output multiple times?
next([_ | T], T).
next([H | Tin], [H | Tout]) :-
next(Tin, Tout).
It seems a works for setof/3
setof(T, next([1,1,1,1], T), U)
--- EDIT ---
The OP say
This does do it but it's a bit of a hacky fix, I'm looking for an alteration in the next predicate
I don't think the following it's a great solution and I suspect that it's better use setof/3 with the original next/2 but...
next(Lin, LLout) :-
nextH(Lin, [], LLout).
nextH([], _, []).
nextH([H | Tin], Pre, LLout1) :-
append(Pre, Tin, L),
append(Pre, [H], Pre0),
nextH(Tin, Pre0, LLout0),
( member(L, LLout0)
-> LLout1 = LLout0
; LLout1 = [L | LLout0] ).
--- EDIT 2 ---
The OP ask
how could you use setof in the next predicate?
If you use your original next/2 predicate that generate singles lists (but I recall it nextH, "next helper")
nextH([_ | T], T).
nextH([H | Tin], [H | Tout]) :-
nextH(Tin, Tout).
the next/2 predicate that return a list of unique list become simply (using setof/3)
next(Lin, LLout) :-
setof(Lout, nextH(Lin, Lout), LLout).

Prolog list of predicates to list of lists

I have a list like: [a([x,y]), b([u,v])] and I want my result as [[x,y], [u,v]].
Here is my code:
p(L, Res) :-
findall(X, (member(a(X), L)), A1), append([A1],[],L1),
findall(Y, (member(b(Y), L)), A2), append(L1,[A2],L2),
append(L2, Res).
This provides a partially good result but if my list is [a([x,y]), c([u,v])], I would like the result to be: [[x,y],[]] and it is [[x,y]].
More examples:
p([b([u,v]), a([x,y]), c([s,t]), d([e,f])], R)
The result I get: [[x,y],[u,v]] (as expected).
p([b([u,v]), z([x,y]), c([s,t]), d([e,f])], R)
The result I get: [[u,v]]'.
The result I want: [[],[u,v]].
EDIT: Added more examples.
Now that it's clear what the problem statement really is, the solution is a little more understood. Your current solution is a little bit overdone and can be simplified. Also, the case where you want to have a [] element when the term isn't found falls a little outside of the paradigm, so can be handled as an exception. #AnsPiter has the right idea about using =../2, particularly if you need a solution that handles multiple occurrences of a and/or b in the list.
p(L, Res) :-
find_term(a, L, As), % Find the a terms
find_term(b, L, Bs), % Find the b terms
append(As, Bs, Res). % Append the results
find_term(F, L, Terms) :-
Term =.. [F, X],
findall(X, member(Term, L), Ts),
( Ts = [] % No results?
-> Terms = [[]] % yes, then list is single element, []
; Terms = Ts % no, then result is the list of terms
).
Usage:
| ?- p([b([u,v]), z([x,y]), c([s,t]), d([e,f])], R).
R = [[],[u,v]]
yes
| ?- p([b([x,y]), a([u,v])], L).
L = [[u,v],[x,y]]
yes
| ?-
The above solution will handle multiple occurrences of a and b.
If the problem really is restricted to one occurrence of each, then findall/3 and append/3 are way overkill and the predicate can be written:
p(L, [A,B]) :-
( member(a(A), L)
-> true
; A = []
),
( member(b(B), L)
-> true
; B = []
).
Term =.. List : Unifies List with a list whose head is the atom corresponding to the principal functor of
Term and whose tail is a list of the arguments of Term.
Example :
| ?- foo(n,n+1,n+2)=..List.
List = [foo,n,n+1,n+2] ?
| ?- Term=..[foo,n,n+1,n+2].
Term = foo(n,n+1,n+2)
rely on your suggestion; you have a term contains a single argument List
so ;
p([],[]).
p([X|Xs], Result) :-
X=..[F,Y],
(%IF
\+(F='c')-> % not(F=c)
Result=[Y|Res];
%ELSE
Result = Res % Result = [Res] ==> [[x,y],[]]
),
p(Xs,Res).
Test :
| ?- p([a([x,y]), c([u,v])],R).
R = [[x,y]] ?
yes
| ?- p([a([x,y]), b([u,v])],R).
R = [[x,y],[u,v]] ?
yes

Python counter in Prolog

In Python you can do
>>> import from collections counter
>>> Counter(['a','b','b','c'])
>>> Counter({'b': 2, 'a': 1, 'c': 1})
Is there something similar in Prolog? Like so:
counter([a,b,b,c],S).
S=[a/1,b/2,c/1].
This is my implementation:
counter([],List,Counts,Counts).
counter([H|T],List,Counts0,[H/N|Counts]):-
findall(H, member(H,List), S),
length(S,N),
counter(T,List,Counts0,Counts).
counter(List,Counts):-
list_to_set(List,Set),
counter(Set,List,[],Counts).
It's rather verbose, so I wondered if there was a builtin predicate or a more terse implementation.
There is no builtin predicate, here is another way to do that :
counter([X], [X/1]).
counter([H | T], R) :-
counter(T, R1),
( select(H/V, R1, R2)
-> V1 is V+1,
R = [H/V1 | R2]
; R = [H/1 | R1]).
I like #joel76's solution. I will add a few more variations on the theme.
VARIATION I
Here's another simple approach, which sorts the list first:
counter(L, C) :-
msort(L, S), % Use 'msort' instead of 'sort' to preserve dups
counter(S, 1, C).
counter([X], A, [X-A]).
counter([X,X|T], A, C) :-
A1 is A + 1,
counter([X|T], A1, C).
counter([X,Y|T], A, [X-A|C]) :-
X \= Y,
counter([Y|T], 1, C).
Quick trial:
| ?- counter([a,b,b,c], S).
S = [a-1,b-2,c-1] ?
yes
This will fail on counter([], C). but you can simply include the clause counter([], []). if you want it to succeed. It doesn't maintain the initial order of appearance of the elements (it's unclear whether this is a requirement). This implementation is fairly efficient and is tail recursive, and it will work as long as the first argument is instantiated.
VARIATION II
This version will maintain order of appearance of elements, and it succeeds on counter([], []).. It's also tail recursive:
counter(L, C) :-
length(L, N),
counter(L, N, C).
counter([H|T], L, [H-C|CT]) :-
delete(T, H, T1), % Remove all the H's
length(T1, L1), % Length of list without the H's
C is L - L1, % Count is the difference in lengths
counter(T1, L1, CT). % Recursively do the sublist
counter([], _, []).
With some results:
| ?- counter([a,b,a,a,b,c], L).
L = [a-3,b-2,c-1]
yes
| ?- counter([], L).
L = []
yes
VARIATION III
This one uses a helper which isn't tail recursive, but it preserves the original order of elements, is fairly concise, and I think more efficient.
counter([X|T], [X-C|CT]) :-
remove_and_count(X, [X|T], C, L), % Remove and count X from the list
counter(L, CT). % Count remaining elements
counter([], []).
% Remove all (C) instances of X from L leaving R
remove_and_count(X, L, C, R) :-
select(X, L, L1), !, % Cut to prevent backtrack to other clause
remove_and_count(X, L1, C1, R),
C is C1 + 1.
remove_and_count(_, L, 0, L).
This implementation will work as long as the first argument to counter is instantiated.
SIDEBAR
In the above predicates, I used the Element-Count pattern rather than Element/Count since some Prolog interpreters, SWI in particular, offer a number of predicates that know how to operate on associative lists of Key-Value pairs (see SWI library(pairs) and ISO predicate keysort/2).
I also like #joel76 solution (and #mbratch suggestions, also). Here I'm just to note that library(aggregate), if available, has a count aggregate operation, that can be used with the ISO builtin setof/3:
counter(L, Cs) :-
setof(K-N, (member(K, L), aggregate(count, member(K, L), N)), Cs).
yields
?- counter([a,b,b,c], L).
L = [a-1, b-2, c-1].
If the selection operation was more complex, a nice way to avoid textually repeating the code could be
counter(L, Cs) :-
P = member(K, L),
setof(K-N, (P, aggregate(count, P, N)), Cs).
edit
Since I'm assuming library(aggregate) available, could be better to task it the set construction also:
counter(L, Cs) :-
P = member(E,L), aggregate(set(E-C), (P, aggregate(count,P,C)), Cs).

Resources