Append list of lists elements in Prolog - algorithm

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.

Related

Lists size multiplication

I'm new to Prolog and I'm trying to get my head around lists. The problem I'm struggling with is:
Given numbers in the form of lists (1 : [x], 3: [x, x, x]), implement the 'times' predicate /3.
E.g.: times([x, x], [x, x, x], R).
R = [x, x, x, x, x, x].
The plus, and successor predicates where 2 previous points of the exercise. I know I'm not using the successor predicate, but it didn't seem that useful later on.
This is what i've tried so far
successor([], [x]).
successor([X|T], R) :-
append([X|T], [X], R).
plus(L1, L2, R) :- append(L1, L2, R).
times([], _, []).
times(_, [], []).
times([_], L, L).
times(L, [_], L).
times([_|T], L2, R) :- plus(L2, R, RN),
times(T, L2, RN).
The output is:
R is [].
I think you make things too complicated here. You can define successor as:
successor(T, [x|T]).
We can define plus/3 as:
plus([], T, T).
plus([x|R], S, [x|T]) :-
plus(R, S, T).
This is more or less the implementation of append/3, except that here we check if the first list only contains x.
For times/3 we know that if the first item is empty, the result is empty:
times([], _, []).
and for a times/3 where the first item has shape [x|R], we need to add the second item to the result of a call to times/3 with R:
times([x|R], S, T) :-
times(R, S, T1),
plus(S, T1, T).
So putting it all together, we obtain:
successor(T, [x|T]).
plus([], T, T).
plus([x|R], S, [x|T]) :-
plus(R, S, T).
times([], _, []).
times([x|R], S, T) :-
times(R, S, T1),
plus(S, T1, T).

Prolog: Swapping two halves of a list

I am writing a predicate in prolog that will break a list with an even number of variables into two halves and swap them. For example [a,b,c,d] --> [c,d,a,b].
append([], List, List).
append([Head|Tail], List, [Head|Rest]) :-
append(Tail, List, Rest).
divide(L, X, Y) :-
append(X, Y, L),
length(X, N),
length(Y, N).
swap([], []).
swap([A], D) :-
divide(A, B, C),
append(C, B, D).
I would expect this to work by dividing [A] into two smaller equal sized lists, then appending them together in the reverse order, and then assigning the variable "D" to the list.
What I am getting is "false", why does this not work?
I'm very new to prolog so this might be a silly/simple question, thanks!
Your question is why swap([a,b,c,d],[c,d,a,b]) fails. And here is the actual reason:
?- swap([_/*a*/,_/*b*/|_/*,c,d*/],_/*[c,d,a,b]*/).
:- op(950, fy, *).
*(_).
swap([], _/*[]*/).
swap([A], D) :-
* divide(A, B, C),
* append(C, B, D).
So, not only does your original query fail, but even this generalization fails as well. Even if you ask
?- swap([_,_|_],_).
false.
you just get failure. See it?
And you can ask it also the other way round. With above generalization, we can ask:
?- swap(Xs, Ys).
Xs = []
; Xs = [_A].
So your first argument must be the empty list or a one-element list only. You certainly want to describe also longer lists.
Maybe this helps
:- use_module(library(lists), []).
divide(L, X, Y) :-
append(X, Y, L),
length(X, N),
length(Y, N).
swap([], []).
swap(L, D) :-
divide(L, B, C),
append(C, B, D).

prolog - sublist of list - alternative approach

I implemented function to get sublist of list, for example:
sublist([1,2,4], [1,2,3,4,5,1,2,4,6]).
true
sublist([1,2,4], [1,2,3,4,5,1,2,6]).
false
look at my solution:
my_equals([], _).
my_equals([H1|T1], [H1|T2]) :- my_equals(T1, T2).
sublist([], _).
sublist(L1, [H2|T2]) :- my_equals(L1, [H2|T2]); sublist(L1, T2).
Could you give me another solution ? Maybe there is exists some predefined predicate as my_equals ?
You can unify a sublist using append/3, like this:
sublist(SubList, List):-
append(_, Tail, List),
append(SubList, _, Tail).
The first call to append/3 will split List into two parts (i.e. dismiss the some "leading" items from List.
The second call to append/3 will check whether SubList is itself a sublist of Tail.
As #false's suggests it would be better, at least for ground terms, to exchange goals,
sublist(SubList, List):-
append(SubList, _, Tail),
append(_, Tail, List).
There's also a DCG approach to the problem:
substr(Sub) --> seq(_), seq(Sub), seq(_).
seq([]) --> [].
seq([Next|Rest]) --> [Next], seq(Rest).
Which you would call with:
phrase(substr([1,2,4]), [1,2,3,4,5,1,2,4,6]).
You can define:
sublist(Sub, List) :-
phrase(substr(Sub), List).
So you could call it by, sublist([1,2,4], [1,2,3,4,5,1,2,4,6])..
Per #mat's suggestion:
substr(Sub) --> ..., seq(Sub), ... .
... --> [] | [_], ... .
Yes, you can have a predicate named .... :)
Per suggestions from #repeat and #false, I changed the name from subseq (subsequence) to substr (substring) since the meaning of "subsequence" embraces non-contiguous sequences.
This is an alternative solution to Lurkers, which is slightly faster,
assuming S is much shorter than L in length and thus the phrase/3 DCG
translation time is negligible:
sublist(S, L) :-
phrase((..., S), L, _).
If S=[X1,..,Xn] it will DCG translate this into a match I=[X1,..,Xn|O]
before execution, thus delegating my_equals/2 completely to Prolog
unification. Here is an example run:
?- phrase((..., [a,b]), [a,c,a,b,a,c,a,b,a,c], X).
X = [a, c, a, b, a, c] ;
X = [a, c] ;
false.
Bye
P.S.: Works also for other patterns S than only terminals.
Maybe there is exists some predefined predicate
If your Prolog has append/2 from library(lists):
sublist(S, L) :- append([_,S,_], L).
Another fairly compact definition, available in every (I guess) Prolog out there:
sublist(S, L) :- append(S, _, L).
sublist(S, [_|L]) :- sublist(S, L).
Solution in the original question is valid just, as has been said, remark that "my_equals" can be replaced by "append" and "sublist" loop by another append providing slices of the original list.
However, prolog is (or it was) about artificial intelligence. Any person can answer immediately "no" to this example:
sublist([1,1,1,2], [1,1,1,1,1,1,1,1,1,1] ).
because a person, with simple observation of the list, infers some characteristics of it, like that there are no a "2".
Instead, the proposals are really inefficient on this case. By example, in the area of DNA analysis, where long sequences of only four elements are studied, this kind of algorithms are not applicable.
Some easy changes can be done, with the objective of look first for the most strongest condition. By example:
/* common( X, Y, C, QX, QY ) => X=C+QX, Y=C+QY */
common( [H|S2], [H|L2], [H|C2], DS, DL ) :- !,
common( S2, L2, C2, DS, DL ).
common( S, L, [], S, L ).
sublist( S, L ) :-
sublist( [], S, L ).
sublist( P, Q, L ) :- /* S=P+Q */
writeln( Q ),
length( P, N ),
length( PD, N ), /* PD is P with all unbound */
append( PD, T, L ), /* L=PD+T */
common( Q, T, C, Q2, _DL ), /* S=P+C+Q2; L=PD+C+_DL */
analysis( L, P, PD, C, Q2 ).
analysis( _L, P, P, _C, [] ) :- !. /* found sublist */
analysis( [_|L2], P, _PD, C, [] ) :- !,
sublist( P, C, L2 ).
analysis( [_|L2], P, _PD, C, Q2 ) :-
append( P, C, P2 ),
sublist( P2, Q2, L2 ).
Lets us try it:
?- sublist([1,1,1,2], [1,1,1,1,1,1,1,1,1,1]).
[1,1,1,2]
[2]
[2]
[2]
[2]
[2]
[2]
[2]
[2]
false.
see how "analysis" has decided that is better look for the "2".
Obviously, this is a strongly simplified solution, in a real situation better "analysis" can be done and patterns to find must be more flexible (the proposal is restricted to patterns at the tail of the original S pattern).

Intersection of two lists of variables

How to define in ISO Prolog a (meta-logical) predicate for the intersection of two lists of variables that runs in linear time? The variables may appear in any determined order. No implementation dependent property like the "age" of variables must influence the outcome.
In analogy to library(ordsets), let's call the relation varset_intersection(As, Bs, As_cap_Bs).
?- varset_intersection([A,B], [C,D], []).
true.
?-varset_intersection([A,B], [B,A], []).
false.
?- varset_intersection([A,B,C], [C,A,D], Inter).
Inter = [A,C].
or
Inter = [C,A].
?- varset_intersection([A,B],[A,B],[A,C]).
B = C
or
A = B, A = C
?- varset_intersection([A,B,C],[A,B],[A,C]).
idem
That is, the third argument is an output argument, that unifies with the intersection of the first two arguments.
See this list of the built-ins from the current ISO standard (ISO/IEC 13211-1:1995 including Cor.2).
(Note, that I did answer this question in the course of another one several years ago. However, it remains hidden and invisible to Google.)
If term_variables/2 works in a time linear with the size of its first argument, then this might work:
varset_intersection(As, Bs, As_cap_Bs):-
term_variables([As, Bs], As_and_Bs),
term_variables(As, SetAs),
append(SetAs, OnlyBs, As_and_Bs),
term_variables([OnlyBs, Bs], SetBs),
append(OnlyBs, As_cap_Bs, SetBs).
Each common variable appears only once in the result list no matter how many times it appears in the two given lists.
?- varset_intersection2([A,_C,A,A,A], [A,_B,A,A,A], L).
L = [A].
Also, it might give strange results as in this case:
?- varset_intersection([A,_X,B,C], [B,C,_Y,A], [C, A, B]).
A = B, B = C.
(permutation/2 might help here).
If copy_term/2 uses linear time, I believe the following works:
varset_intersection(As, Bs, Cs) :-
copy_term(As-Bs, CopyAs-CopyBs),
ground_list(CopyAs),
select_grounded(CopyBs, Bs, Cs).
ground_list([]).
ground_list([a|Xs]) :-
ground_list(Xs).
select_grounded([], [], []).
select_grounded([X|Xs], [_|Bs], Cs) :-
var(X),
!,
select_grounded(Xs, Bs, Cs).
select_grounded([_|Xs], [B|Bs], [B|Cs]) :-
select_grounded(Xs, Bs, Cs).
The idea is to copy both lists in one call to copy_term/2 to preserve shared variables between them, then ground the variables of the first copy, then pick out the original variables of the second list corresponding to the grounded positions of the second copy.
If unify_with_occurs_check(Var, ListOfVars) fails or succeeds in constant time, this implementation should yield answers in linear time:
filter_vars([], _, Acc, Acc).
filter_vars([A|As], Bs, Acc, As_cap_Bs):-
(
\+ unify_with_occurs_check(A, Bs)
->
filter_vars(As, Bs, [A|Acc], As_cap_Bs)
;
filter_vars(As, Bs, Acc, As_cap_Bs)
).
varset_intersection(As, Bs, As_cap_Bs):-
filter_vars(As, Bs, [], Inter),
permutation(Inter, As_cap_Bs).
This implementation has problems when given lists contain duplicates:
?- varset_intersection1([A,A,A,A,B], [B,A], L).
L = [B, A, A, A, A] ;
?- varset_intersection1([B,A], [A,A,A,A,B], L).
L = [A, B] ;
Edited : changed bagof/3 to a manually written filter thanks to observation by #false in comments below.
A possible solution is to use a Bloom filter. In case of collision, the result might be wrong, but functions with better collision resistance exist. Here is an implementation that uses a single hash function.
sum_codes([], _, Sum, Sum).
sum_codes([Head|Tail], K, Acc,Sum):-
Acc1 is Head * (256 ** K) + Acc,
K1 is (K + 1) mod 4,
sum_codes(Tail, K1, Acc1, Sum).
hash_func(Var, HashValue):-
with_output_to(atom(A), write(Var)),
atom_codes(A, Codes),
sum_codes(Codes, 0, 0, Sum),
HashValue is Sum mod 1024.
add_to_bitarray(Var, BAIn, BAOut):-
hash_func(Var, HashValue),
BAOut is BAIn \/ (1 << HashValue).
bitarray_contains(BA, Var):-
hash_func(Var, HashValue),
R is BA /\ (1 << HashValue),
R > 0.
varset_intersection(As, Bs, As_cap_Bs):-
foldl(add_to_bitarray, As, 0, BA),
include(bitarray_contains(BA), Bs, As_cap_Bs).
I know that foldl/4 and include/3 are not ISO, but their implementation is easy.

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