Using Prolog to find Intersecting Lists - prolog

I'm having trouble trying to debug this code of mine to find the intersection between two lists...
For Example:
List1 = [3, 4, 5, 6] and
List2 = [5, 1, 0, 2, 4].
So, the intersecting lines would be stored into List3 would be [4, 5].
So here's the code for Prolog.
Any help would be appreciated!!!
setIntersection([], [], []).
setIntersection([], _, []).
setIntersection([X|Xs], Y, [Z|W]) :-
keepDuplicates(X, Y, [Z|Zs]),
setIntersection(Xs, Y, W).
keepDuplicates(_, [], []).
keepDuplicates([], _, []).
keepDuplicates([], [], []).
% Check if the head of the first list is not a match to the
% first head of the second list
keepDuplicates(G, [H|Hs], Line) :-
G \= H,
keepDuplicates(G, Hs, Line).
% Check if the head of the first list
% Does match to the head of the second list
keepDuplicates(G, [G|Gs], [G|NewLine]) :-
keepDuplicates(G, Gs, NewLine).

You can find a couple of logically pure, monotone implementations of list intersection and union in my answer to the related question "Intersection and union of 2 lists".
Let's see a sample query:
?- list_list_intersection([3,4,5,6],[5,1,0,2,4],Intersection).
Intersection = [4,5]. % succeeds deterministically
As the proposed implementation is monotone, you can also use it in more general ways and still get logically sound answers:
?- L2 = [_,_,_], list_list_intersection([3,4,5,6],L2,[4,5]).
L2 = [ 4, 5,_A], dif(_A,6), dif(_A,3) ;
L2 = [ 4,_A, 5], dif(_A,6), dif(_A,5), dif(_A,3) ;
L2 = [ 5, 4,_A], dif(_A,6), dif(_A,3) ;
L2 = [_A, 4, 5], dif(_A,6), dif(_A,5), dif(_A,4),dif(_A,3) ;
L2 = [ 5,_A, 4], dif(_A,6), dif(_A,4), dif(_A,3) ;
L2 = [_A, 5, 4], dif(_A,6), dif(_A,5), dif(_A,4),dif(_A,3) ;
false.

Usually sets in Prolog are represented with sorted lists, then avoiding the ambiguity of the representation that arises in presence of duplicate elements. Let's ignore this problem...
This fact setIntersection([], [], []). is subsumed by setIntersection([], _, [])., then can (should!) be deleted.
The same for keepDuplicates([], [], []). (why do you invert clauses order here ?)
You have a singleton Zs: ...,keepDuplicates(X, Y, [Z|Zs]),... and you should pay attention to that warning (of course, if your compiler display it), since it's often symptom of a true mistake.
Also, that predicate cannot cover all the cases: when X is not in Y, what do you associate to Z ?
To be true, I think you're doing it more complicated than required. Ignoring duplicates, the whole could be easy as
?- L1=[3,4,5,6],L2=[5,1,0,2,4],findall(C, (member(C,L1),memberchk(C,L2)), I).

Related

How to check how many elements you've already consumed in Prolog DCGs

Say I have these DCGs:
zorbs([H|T]) --> zorb(H), zorbs(T).
zorbs([]) --> [].
zorb(a) --> [1,2].
zorb(b) --> [3].
zorb(c) --> [6,1,2,2].
I can do this:
?- phrase(zorbs(X), [1,2,3,6,1,2,2]).
X = [a, b, c] .
I can also "reverse" this by doing:
phrase(zorbs([a,b,c]), X).
X = [1, 2, 3, 6, 1, 2, 2].
Now, what I want to do is find a list of numbers with length less than 4 (for example) which these elements "parse" into, returning the rest.
So, for example, given [a,b,c], which would normally relate to [1, 2, 3, 6, 1, 2, 2], I want it to relate to [1, 2, 3] (which has length less than 4) and also give the remainder that couldn't be "reversed," so [c]. I don't really know where to start, as it seems there's no way to reason about the number of elements you've already consumed in a DCG.
Here's a sort-of solution:
X in 0..4,
indomain(X),
Q = [_|_],
prefix(Q, [a,b,c]),
length(A, X),
phrase(zorbs(Q), A).
but I think this is very inefficient, because I think it basically iterates up from nothing, and I want to find the solution with the biggest Q.
There is no direct way how to do this in this case. So your approach is essentially what can be done. That is, you are enumerating all possible solutions and (what you have not shown) selecting them accordingly.
Questions about the biggest and the like include some quantification that you cannot express directly in first order logic.
However, sometimes you can use a couple of tricks.
Sometimes, a partial list like [a,b,c|_] may be helpful.
?- Xs = [_,_,_,_|_], phrase(zorbs(Xs),[1,2,3,6,1,2,2]).
false.
So here we have proven that there is no list of length 4 or longer that corresponds to that sequence. That is, we have proven this for infinitely many lists!
And sometimes, using phrase/3 in place of phrase/2 may help. Say, you have a number sequence that doesn't parse, and you want to know how far it can parse:
?- Ys0 = [1,2,3,6,1,2,7], phrase(zorbs(Xs),Ys0,Ys).
Ys0 = [1,2,3,6,1,2,7], Xs = [], Ys = [1,2,3,6,1,2,7]
; Ys0 = [1,2,3,6,1,2,7], Xs = "a", Ys = [3,6,1,2,7]
; Ys0 = [1,2,3,6,1,2,7], Xs = "ab", Ys = [6,1,2,7]
; false.
(This is with the two DCG-rules exchanged)
Can use:
% Like "between", but counts down instead of up
count_down(High, Low, N) :-
integer(High),
integer(Low),
count_down_(High, Low, N).
count_down_(H, L, N) :-
compare(C, H, L),
count_down_comp_(C, H, L, N).
count_down_comp_('=', _H, L, N) :-
% All equal, final
N = L.
% Accept H as the counting-down value
count_down_comp_('>', H, _L, H).
count_down_comp_('>', H, L, N) :-
H0 is H - 1,
% Decrement H towards L, and loop
count_down_(H0, L, N).
... and then start with:
count_down(4, 1, Len), length(Lst, Len), phrase...
Another method is to use freeze to limit a list's length, element-by-element:
max_len_freeze(Lst, MaxLen) :-
compare(C, MaxLen, 0),
max_len_freeze_comp_(C, Lst, MaxLen).
max_len_freeze_comp_('=', [], 0).
max_len_freeze_comp_('>', [_|Lst], MaxLen) :-
succ(MaxLen0, MaxLen),
!,
freeze(Lst, max_len_freeze(Lst, MaxLen0)).
max_len_freeze_comp_('>', [], _).
... and then start with:
max_len_freeze(Lst, 4), phrase...
This will work to find the longest list (maximum length 4) first, since your DCG is greedy (i.e. matching [H|T] before []).

(Prolog) Check if a list can be split into 2 sub-lists that have equal sums

I am using Prolog to try and check if a list can be split into 2 sublists(subarrays) that have equal sums.
The following should succeed: [1,2,3,6], [2,1,1], [0], [1,1,2]
The following should fail: [1,4,8], [1,3,2], [2,2,1,1]
I believe my program is creating subsequences instead of sublists. This is causing queries similar to [1,3,2] and [2,2,1,1] to succeed when they should fail.
In the example of the query [1,3,2] it is returning true because the subsequences [1,2] and [3] have equal sums. That should not be allowed. Instead, [1,3,2] should be split into sublists [1]/[3,2] and [1,3]/[2]. Hence, it should fail.
I am unsure how to modify the subL predicate to return sublists instead of subsequences.
Here is what I have so far:
split([]).
split([0]).
split([H|T]) :-
subL([H|T], LEFT, RIGHT),
sum(LEFT, SUM1),
sum(RIGHT, SUM2),
SUM1=SUM2.
subL([],[],[]).
subL([H|T], [H|T2], X) :-
subL(T, T2, X).
subL([H|T], X, [H|T2]) :-
subL(T, X, T2).
sum([H|T], SUM1) :-
sum(T, SUM2),
SUM1 is SUM2 + H.
sum([H], SUM1) :-
H = SUM1.
Any help with this would be greatly appreciated. Thank you
YOu can make use of append to split the list into different lists. Indeed:
?- append(L, R, [1,2,3,6]).
L = [],
R = [1, 2, 3, 6] ;
L = [1],
R = [2, 3, 6] ;
L = [1, 2],
R = [3, 6] ;
L = [1, 2, 3],
R = [6] ;
L = [1, 2, 3, 6],
R = [] ;
false.
so you can write a predicate:
split(X) :-
append(L, R, X),
sum(L, S),
sum(R, S).
Here we thus check if both the left and the right sublist sum up to the same sum S. You however slighly need to change your sum/2 predicate such that the sum for an empty list is 0 as well. I leave that as an exercise.
The above is not very efficient, since it takes O(n2) time. You can make it linear by first calculating the sum of the entire list, and then make a predicate that iterates over the list, each time keeping track of the sum of the elements on the left side, and the remaining sum on the right side. I think that by first solving it the "naive" way, you likely will find it easier to implement that as an improvement.

Prolog : Iterating over a list and creating a predicate

I'm creating a predicate enum that takes a list and a number for example [1,2,3,4] and 3 and returns a list that contains lists of length 3 made out of the list introduced. So in the example given enum([1,2,3,4],3,[[1,2,3],[2,3,4]]).
I've created a function take that takes only the first list of length N but I get errors when I try to loop it to get all of the others. Thanks you for helping.
append([],L,L).
append([H|T],L2,[H|L3]):- append(T,L2,L3).
len([],0).
len([_|B],X):- len(B,X1), X is X1+1.
take(_,X,Y) :- X =< 0, !, X =:= 0, Y = [].
take([],_,[]).
take([A|B],X,[A|C]):- Z is X-1, take(B,Z,C).
enum([],_,[]).
enum([N1|N2],N3,N4):-
len([N1|N2],U),
N3=<U,
take([N1|N2],N3,T1),
append([N4],[T1],T2),
!,
enum(N2,N3,T2).
I will focus on the take/3 predicate, which is the core of your question. In order to get a sublist like [2,3,4] of [1,2,3,4], you have to be able to skip the first element and just take a sublist of the rest.
You can achieve this by adding this clause to your definition:
take([_|Xs], N, Ys) :- take(Xs, N, Ys).
With this you now get several different sublists of length 3, but also some other superfluous solutions:
?- take([1,2,3,4], 3, Xs).
Xs = [1, 2, 3] ;
Xs = [1, 2, 4] ;
Xs = [1, 2] ;
Xs = [1, 3, 4] ;
Xs = [1, 3] ;
Xs = [1, 4] ;
Xs = [1] % etc.
This is because your clause take([], _, []) accepts an empty list as a "sublist of any length" of an empty list. I think you only wanted to accept the empty list as a sublist of length 0. If you remove this clause, your first clause will enforce that, and you only get solutions of length exactly 3:
?- take([1,2,3,4], 3, Xs).
Xs = [1, 2, 3] ;
Xs = [1, 2, 4] ;
Xs = [1, 3, 4] ;
Xs = [2, 3, 4] ;
false.
As a side note, your first clause is fine as is, but it can be simplified a bit to:
take(_,X,Y) :- X = 0, !, Y = [].
I would also advise you to use more readable variable names. For numbers like list lengths, we often use N. For lists, it's customary to use names like Xs, Ys, etc., with X, Y, etc. for members of the corresponding list.
Finally, to find all solutions of a predicate, you need to use a system predicate like setof, bagof, or findall. There is no way to write your enum in pure Prolog.
Because I am not sure about the advice in the other answer, here is my take on your problem.
First, don't define your own append/3 and length/2, append/3 is by now Prolog folklore, you can find it in textbooks 30 years old. And length/2 is really difficult to get right on your own, use the built-in.
Now: to take the first N elements at the front of a list L, you can say:
length(Front, N),
append(Front, _, L)
You create a list of the length you need, then use append/3 to split off this the front from the list you have.
With this in mind, it would be enough to define a predicate sliding_window/3:
sliding_window(L, N, [L]) :-
length(L, N).
sliding_window(L, N, [W|Ws]) :-
W = [_|_], % W should be at least one long
length(W, N),
append(W, _, L),
L = [_|L0],
sliding_window(L0, N, Ws).
This kind of works, but it will loop after giving you all useful answers:
?- sliding_window([a,b], N, Ws).
N = 2,
Ws = [[a, b]] ;
N = 1,
Ws = [[a], [b]] ;
% loops
It loops because of the same little snippet:
length(Front, N),
append(Front, _, L)
With length/2, you keep on generating lists of increasing length; once Front is longer than L, the append/3 fails, length/2 makes an even longer list, and so on forever.
One way out of this would be to use between/3 to constrain the length of the front. If you put it in its own predicate:
front_n(L, N, F) :-
length(L, Max),
between(1, Max, N),
length(F, N),
append(F, _, L).
With this:
sliding_window(L, N, [L]) :-
length(L, N).
sliding_window(L, N, [W|Ws]) :-
front_n(L, N, W),
L = [_|L0],
sliding_window(L0, N, Ws).
And now it finally works:
?- sliding_window([a,b,c,d], 3, Ws).
Ws = [[a, b, c], [b, c, d]] ;
false.
?- sliding_window([a,b,c], N, Ws).
N = 3,
Ws = [[a, b, c]] ;
N = 1,
Ws = [[a], [b], [c]] ;
N = 2,
Ws = [[a, b], [b, c]] ;
false.
Exercise: get rid of the harmless, but unnecessary choice point.

ERROR: Out of global stack with append/3

I have a problem. I want to implement a replace(E1, L1, E2, L2) predicate.
This holds when L1 and L2 are the same lists,except that in one place where L1 has the value E1, L2 has E2. In addition, only one occurrence is replaced and it must work in any mode.
For example:
replace(2,[1,2,3,4],5,X) should have only the solution X = [1,5,3,4].
replace(2,[1,2,3,2,1],5,X) should backtrack over the solutions X =
[1,5,3,2,1] and X = [1,2,3,5,1].
replace(2,X,5,[1,5,3,5,1]) should backtrack over the solutions X =
[1,2,3,5,1] and X = [1,5,3,2,1].
replace(X,[a,b,c,d],Y,[a,e,c,d]) should have only the solution X = b,
Y = e.
replace(X,[1,2,3,2,1],Y,[1,5,3,5,1]) should have no solutions (it
should fail).
My implementation:
replace(E1, L1, E2, L2) :-
append(X, [E1|L_Tail], L1),
append(X, [E2|L_Tail], L2).
This code is fine. However when replace(2,X,5,[1,5,3,5,1]), it should return X = [1,2,3,5,1] and X = [1,5,3,2,1] and false. It only return the first 2 results, and the false didn't came up. The program end up with ERROR: Out of global stack.
This question has been asked and it has two answers: the one you used and a better one. However, I will answer the question "why does this solution not work and how to fix it?".
When the third argument to append/3 is a variable or a partial list, it gives infinitely many solutions:
?- append(X, Y, [a|Z]).
X = [],
Y = [a|Z] ;
X = [a],
Y = Z ;
X = [a, _1860],
Z = [_1860|Y] ;
X = [a, _1860, _1872],
Z = [_1860, _1872|Y] ;
X = [a, _1860, _1872, _1884],
Z = [_1860, _1872, _1884|Y] . % and so on
So, when the first list L1 is a partial list, the call to append(X, [E1|Y], L1) will keep "hallucinating" longer and longer lists. The second call to append/3 will fail every time, Prolog will backtrack, make an even longer list with the first append/3, and so on. This is why you are caught in an infinite loop and will eventually run out of memory (when the lists get too long).
One cheap way to avoid this is to make sure that both lists are proper lists of the same length before giving them to the two appends. For example:
same_length([], []).
same_length([_|A], [_|B]) :- same_length(A, B).
If you are using SWI-Prolog you could do this with maplist and a yall lambda:
maplist([_,_]>>true, L1, L2)
The example query:
?- L2 = [1,5,3,5,1],
maplist([_,_]>>true, L1, L2),
append(X, [2|Y], L1),
append(X, [5|Y], L2).
L2 = [1, 5, 3, 5, 1],
L1 = [1, 2, 3, 5, 1],
X = [1],
Y = [3, 5, 1] ;
L2 = [1, 5, 3, 5, 1],
L1 = [1, 5, 3, 2, 1],
X = [1, 5, 3],
Y = [1] ;
false.

How to create a list of numbers that add up to a specific number

I need some help writing a predicate in Prolog that, given a number as input, returns a list of lists with numbers that add up to it.
Let's call the predicate addUpList/2, it should work like this:
?- addUpList(3,P).
P = [[1,2], [2,1], [1,1,1]]. % expected result
I'm having so much trouble figuring this out I'm beginning to think it's impossible. Any ideas? Thanks in advance.
Try this:
condense([], Rs, Rs).
condense([X|Xs], Ys, Zs) :-
condense(Xs, [X|Ys], Zs).
condense([X, Y|Xs], Ys, Zs) :-
Z is X + Y,
condense([Z|Xs], Ys, Zs).
condense(Xs, Rs) :-
condense(Xs, [], Rs).
expand(0, []).
expand(N, [1|Ns]) :-
N > 0,
N1 is N - 1,
expand(N1, Ns).
addUpList(N, Zs) :-
expand(N, Xs),
findall(Ys, condense(Xs, Ys), Zs).
Let me know what marks I get. :-)
The rule num_split/2 generates ways of splitting a number into a list, where the first element X is any number between 1 and N and the rest of the list is a split of N-X.
num_split(0, []).
num_split(N, [X | List]) :-
between(1, N, X),
plus(X, Y, N),
num_split(Y, List).
In order to get all such splits, just call findall/3 on num_split/2.
add_up_list(N, Splits) :-
findall(Split, num_split(N, Split), Splits).
Usage example:
?- add_up_list(4, Splits).
Splits =
[[1, 1, 1, 1], [1, 1, 2], [1, 2, 1], [1, 3], [2, 1, 1], [2, 2], [3, 1], [4]].
See also the post by #hardmath which gives the same answer with a bit more explanation.
The example given in the Question suggests that compositions (ordered partitions) of any positive integer N &leq; 10 are wanted. Note however that the solution [3] for N=3 seems to have been omitted/overlooked. The number of compositions of N is 2^(N-1), so N=10 gives a long list but not an unmanageable one.
It is also desired to collect all such solutions into a list, something that findall/3 can do generically after we write a predicate composition/2 that generates them.
The idea is to pick the first summand, anything between 1 and N, subtract it from the total and recurse (stopping with an empty list when the total reaches zero). SWI-Prolog provides a predicate between/3 that can generate those possible first summands, and Amzi! Prolog provides a similar predicate for/4. For the sake of portability we write our own version here.
summand(Low,High,_) :-
Low > High,
!,
fail.
summand(Low,High,Low).
summand(Low,High,Val) :-
Now is Low + 1,
summand(Now,High,Val).
composition(0,[ ]).
composition(N,[H|T]) :-
summand(1,N,H),
M is N - H,
composition(M,T).
Given the above Prolog source code, compiled or interpreted, a list of all solutions can be had in this way:
?- findall(C,composition(3,C),L).
C = H126
L = [[1, 1, 1], [1, 2], [2, 1], [3]]
Of course some arrangement of such a list of solutions or the omission of the singleton list might be required for your specific application, but this isn't clear as the Question is currently worded.
There are plenty of great answers to this question already, but here is another solution to this problem for you to consider. This program differs from the others in that it is very efficient, and generates non-redundant solutions of lists which are assumed to represent sets of integers which add up to the specified number.
gen(N, L) :-
gen(N-1, N, N, FL),
dup_n(FL, L).
gen(C-F, M, M, [C-F]).
gen(C-F, S, M, [C-F|R]) :-
S < M, C > 1,
C0 is C - 1,
F0 is floor(M / C0),
S0 is S + (C0 * F0),
gen(C0-F0, S0, M, R).
gen(C-F, S, M, R) :-
F > 0,
F0 is F - 1,
S0 is S - C,
gen(C-F0, S0, M, R).
dup_n([], []).
dup_n([_-0|R], L) :-
!, dup_n(R, L).
dup_n([V-F|R], [V|L]) :-
F0 is F - 1,
dup_n([V-F0|R], L).
Your implementation of addUpList/2 can be achieved by:
addUpList(N, P) :-
findall(L, gen(N, L), P).
Which should give you the following behaviour:
?- addUpList(4,L).
L = [[4], [3, 1], [2, 2], [2, 1, 1], [1, 1, 1, 1]].
Note that the list containing one 2 and two 1s only appears once in this result set; this is because gen/4 computes unique sets of integers which add up to the specified number.
This answer is somewhere between
#Kaarel's answer and
#sharky's "efficient" answer.
Like #sharky's code, we impose an ordering relation between adjacent list items to restrict the size of the solution space---knowing how to inflate it if we ever need to. So the solution sets of break_down/2 and gen/2 by #sharky are equal (disregarding list reversal).
And as for performance, consider:
?- time((break_down(40,_),false)).
% 861,232 inferences, 0.066 CPU in 0.066 seconds (100% CPU, 13127147 Lips)
false.
?- time((gen(40,_),false)).
% 8,580,839 inferences, 0.842 CPU in 0.842 seconds (100% CPU, 10185807 Lips)
false.

Resources