Related
I'm learning Prolog for about a week, so I'm a newbie.
I'm trying to do a function, that appends, the elements of a list of lists.
So the input would be: [ [[a,b,c],[g,h,i]], [[j,k,l],[m,n,o]], [[s,t,u],[v,w,x]] ].
And the output would be : [ [a,b,c,j,k,l,s,t,u], [g,h,i,m,n,o,v,w,x] ].
Or
Input: [ [[a,b], [c,d]], [[e,f], [g,h]], [[i,j],[k,l]] ].
Output: [ [a,b,e,f,i,j], [c,d,g,h,k,l] ].
It would be important, that it has to work with a lot of elements, not only 3.
I wrote this, but it only works with 2 elements, so i can only do it, with pairs.
merge([],[],[]).
merge(L1,[],L1).
merge([H1|T1],[H2|T2],LL):-
append(H1, H2, HE),
merge(T1,T2,TE),
append([HE], TE, LL).
If I understand your question correctly...
First, if you know that your input has exactly two levels of nesting in it, and if your Prolog had higher-order predicates for mapping and for folding, and if you could compose them, you could simply write:
merge_foldl([], []).
merge_foldl([X|Xs], R) :-
reverse([X|Xs], [Y|Ys]),
foldl(maplist(append), Ys, Y, R).
This works as expected for SWI-Prolog.
Here it is with your two examples:
?- merge_foldl([ [[a,b,c],[g,h,i]], [[j,k,l],[m,n,o]], [[s,t,u],[v,w,x]] ], R).
R = [[a, b, c, j, k, l, s, t, u], [g, h, i, m, n, o, v, w, x]].
?- merge_foldl([ [[a,b], [c,d], [e,f]], [[g,h], [i,j], [k,l]] ], R).
R = [[a, b, g, h], [c, d, i, j], [e, f, k, l]].
If you don't have access to neither foldr nor foldl, you would have to hardcode the folding:
merge([], []).
merge([X|Xs], Result) :-
merge_maplist(Xs, X, Result).
merge_maplist([], Result, Result).
This is not all, but it says that if you are at the end of the list of lists, the last element is the result.
Now you have to define the step where you append to the front of each sublist. This is easier with maplist:
merge_maplist([X|Xs], Prev, Result) :-
merge_maplist(Xs, X, Result0),
maplist(append, Prev, Result0, Result).
Note that here we are "emulating" a right fold by using a non-tail-recursive definition: we are doing the appending in reverse, after the recursive step. For a tail-recursive definition (identical to hard-coded left fold), you would have to reverse the original list first!
So you keep on peeling off one list of lists from your input until you are done. Then, you use maplist to apply append/3 to each pair of lists from the previous element and the result so far, to get the final result.
If you don't have access to maplist either, you'd have to hardcode the mapping as well. For the three arguments that append/3 takes:
map_append([], [], []).
map_append([X|Xs], [Y|Ys], [Z|Zs]) :-
append(X, Y, Z),
map_append(Xs, Ys, Zs).
and your merge/2 and merge_/3 become:
merge([], []).
merge([X|Xs], Result) :-
merge_(Xs, X, Result).
merge_([], Result, Result).
merge_([X|Xs], Prev, Result) :-
merge_(Xs, X, Result0),
map_append(Prev, Result0, Result).
This is a lot of code for something that can be solved quite nicely if you have higher-order predicates.
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).
I'm trying to write a Prolog predicate (SWI) that would select N elements from a List, like this:
selectn(+N, ?Elems, ?List1, ?List2) is true when List1, with all Elems removed, results in List2.
selectn(N,Lps,L1s,[]) :- length(L1s,L), N >= L, permutation(L1s,Lps).
selectn(0,[],L1s,Lps) :- permutation(L1s,Lps).
selectn(N,[E|Es],L1s,L2s) :-
select(E,L1s,L0s),
N0 is N-1,
selectn(N0,Es,L0s,L2s).
My problem is that in some cases, I get duplicated results and I don't know how to avoid them:
?- findall(L,selectn(2,Es,[a,b,c],L),Ls),length(Ls,Solutions).
Ls = [[c], [b], [c], [a], [b], [a]],
Solutions = 6.
This is no homework, but if you want to help me as if it was, I'll be pleased as well.
this could answer your question (albeit I don't understand your first clause selectn/4, permutation is already done by 'nested' select/3)
selectn(0, [], Rest, Rest).
selectn(N, [A|B], C, Rest) :-
append(H, [A|T], C),
M is N-1,
selectn(M, B, T, S),
append(H, S, Rest).
yields
?- findall(L,selectn(2,Es,[a,b,c],L),Ls),length(Ls,Solutions).
Ls = [[c], [b], [a]],
Solutions = 3.
I'm trying to write a union function in Prolog and I'm running into some trouble. I have looked up examples and listed the built in example for union but I am writing my own for an assignment. I have noticed some strange results when a list has duplicate values and/or when the order of the list is not ascending.
The following is the built in union code:
union([], A, A) :- !.
union([A|C], B, D) :-
memberchk(A, B), !,
union(C, B, D).
union([A|B], C, [A|D]) :-
union(B, C, D).
I believe that the pseudocode here is that we're looking to find all of list 1 inside of our result and once it's exhausted, we compare list 2 and list 3. They should be the same. However, this does not check for order.
30 ?- union([1,2,3],[],[3,2,1]).
false.
Why is this false? List 1 and List 3 are the same set even though the order is different!
24 ?- union([a],[a,a],[a,a]).
true.
25 ?- union([a,a],[a],[a,a]).
false.
What is different between these two? They should yield the same result. However, due to the way that the function is written, in the end we just compare list 2 and list 3 which are different for line 25.
My question is. . . Is there a better way to write these functions such that duplicates are handled properly and order does not matter? One would assume that the built in methods would do the trick but no dice.
First, it's easier to read a code written with consistent naming:
union([], A, A) :- !.
union([A|B], C, D) :-
memberchk(A, B), !,
union(B, C, D).
union([A|B], C, [A|D]) :-
union(B, C, D).
What does it do? Given two lists A and B, it produces the result with a prefix of all elements of A not present in B, and then B itself. So, union([1,2,3],[],[1,2,3]). And also union([1,2,3],[2],[1,3,2]). You see that order is preserved here. So if you want to compare lists regardless of their order, you should write a special, additional predicate for that: union([1,2,3],[],X), regardless(X,[3,2,1]) should work then.
Same with the duplicates - your set equality predicate should disregard any. union as presented above OTOH is not about sets, but about lists. There are many different lists representing the same set, but as lists they are considered different.
In your 25 you hit the issue of duplicates: union([a,a],[a],X) produces X=[a]. Again, as set it is the same as [a,a], but as lists they are different.
One strategy for coping with this is to represent sets as strictly increasing lists - if your elements have order well defined for them. Then we can write union such that given two sets according to that definition, it will also produce a set, and it will work efficiently at that:
union([],X,X):-!.
union(X,[],X):-!.
union([A|B],[C|D],[H|T]):-
A #< C -> H=A, union(B,[C|D],T) ;
C #< A -> H=C, union([A|B],D,T) ;
H=A, union(B,D,T).
We will have to define make_set/2 predicate here too. Even better (in some respects) is representing sets (again, of comparable elements) by self-balancing binary trees.
you are implementing a concept using the 'tools' that the language (Prolog, in your case) put in your hands. Then you should better define (in natural language, first) what's your target, considering that also append/3 could fit the union concept.
you can call list C a union among lists A,B if....
I would fill the ellipsis this way
each A element appears once in C and
each B element appears once in C and
each C element appears in A or B
If you agree on this definition, then an implementation could be
union(A, B, C) :-
elems_once(A, [], C1),
elems_once(A, C1, C2),
each_elems(C2, A, B, C).
That is far less efficient that the library code shown, but it's the price of generality...
To have a union(?A, ?B, ?C) (that is, you can use any variable as input or output) I create a new union
uniao(?A, ?B, ?C)
that uses list:union among other stuff, as:
uniao([], [], []) :- !.
uniao(X, [], X) :- !.
uniao([], X, X) :- !.
uniao(X, Y, Z) :-
nonvar(X),
nonvar(Y),
var(Z),
list_to_set(X, Xs),
list_to_set(Y, Ys),
union(Xs, Ys, Z),
!.
uniao(X, Y, Z) :-
nonvar(X),
var(Y),
nonvar(Z),
list_to_set(X, Xs),
list_to_set(Z, Zs),
subset(Xs, Zs),
subtract(Zs, Xs, Y),
!.
uniao(X, Y, Z) :-
var(X),
nonvar(Y),
nonvar(Z),
list_to_set(Y, Ys),
list_to_set(Z, Zs),
subset(Ys, Zs),
subtract(Zs, Ys, X),
!.
uniao(X, Y, Z) :-
nonvar(X),
nonvar(Y),
nonvar(Z),
list_to_set(X, Xs),
list_to_set(Y, Ys),
list_to_set(Z, Zs),
union(Xs, Ys, Ts),
subtract(Zs, Ts, []),
subtract(Ts, Zs, []),
!.
I can easily write a predicate to get unique elements from a given list in Prolog e.g.
no_doubles( [], [] ).
no_doubles( [H|T], F ) :-
member( H, T ),
no_doubles( T, F ).
no_doubles( [H|T], [H|F] ) :-
\+ member( H, T ),
no_doubles( T, F ).
However, how can you do the same thing but for something other than a normal list i.e. not something like [a,b,c...]? So in my case, I want to extract unique atoms for a propositional formula e.g. unique_atoms(and(x,and(x,y),z),[x,y,z]). is satisfied. Do you use recursion just like in my no_doubles example but for a formula like this?
Any ideas are welcomed :). Thanks.
So you need to process a general term (i.e. a tree structure) and get a list of its atomic leaf nodes, without duplicates. Does the result list have to have a specific order (e.g. depth-first left-to-right), or is this not important?
If you have an option to use variables instead of atoms in your formulas then you can use the (SWI-Prolog) builtin term_variables/2, e.g.
?- term_variables(and(X, and(X, Y), Z), Vars).
Vars = [X, Y, Z].
Otherwise you have to go with a solution similar to:
term_atoms(Term, AtomSet) :-
term_to_atomlist(Term, AtomList),
list_to_set(AtomList, AtomSet).
term_to_atomlist(Atom, [Atom]) :-
atom(Atom),
!.
term_to_atomlist(Term, AtomList) :-
compound(Term),
Term =.. [_ | SubTerms],
terms_to_atomlist(SubTerms, AtomList).
terms_to_atomlist([], []).
terms_to_atomlist([Term | Terms], AtomList) :-
term_to_atomlist(Term, AtomList1),
terms_to_atomlist(Terms, AtomList2),
append(AtomList1, AtomList2, AtomList).
Usage example:
?- term_atoms(f(x^a1+a3*a3/a4)='P'-l, Atoms).
Atoms = [x, a1, a3, a4, 'P', l].
You might want to extend it to deal with numbers and variables in the leaf nodes.
?- setof(X, member(X,[a,b,c,a,b,c]), L).
L = [a, b, c].
?- sort([a,b,c,a,b,c], L).
L = [a, b, c].
Propositional formulas:
get_atoms(X,[X]) :-
atom(X).
get_atoms(and(P,Q),Atoms) :-
get_atoms(P,Left),
get_atoms(Q,Right),
append(Left,Right,Atoms).
etc. Optimize using difference lists if necessary.
unique_atoms(P,UniqueAtoms) :- get_atoms(P,Atoms), sort(Atoms,UniqueAtoms).
A more direct way is to use sets.