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 ≤ 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.
Related
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 []).
Write a function in Scheme or rules in Prolog called countlt that takes a list of numbers, L, and another number, N, and returns the count of numbers less than N in the list L.
?- countlt([6, 1, 9], 4, X).
X = 1.
?- countit([50, 27, 13], 1, X).
X = 0.
Something like this will solve your problem, if you are looking for a solution without that doesn't use any of the built-in or library predicates:
countlt([], _, 0).
countlt([A | B], N, X) :- ((N > A, countlt(B, N, T), X is T + 1); countlt(B, N, X)), !.
You could of course expand this into multiple lines but I find this solution more straightforward and with less tampering with cut operators.
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.
i am trying to write a binary predicate to take one list, compute mod 5 for each element and then put it in another list. so far, i have done this,
mod5(X,L):- R = [], modhelper(R,L), write(R).
modhelper(X,L):- memb(E,L), mod2(E,Z), addtolist(Z,X,X), modhelper(X,L).
%Get an element from the list L.
memb(E,[E|_]).
memb(E,[_|V]):- memb(E,V).
%If element is integer, return that integer mod 5 else return as is.
mod2(N,Z):- isInt(N) -> Z is N mod 5 ; Z = N.
%add this modified element to the output list.
addtolist(Y,[],[Y]).
addtolist(Y,[H|T],[H|N]):- addtolist(Y,T,N).
memb,mod2, addtolist work as expected but I'm doing something wrong in modhelper which I'm not able to figure out.
Any help is appreciated.
In SWI-Prolog:
mod5(X, Y) :-
Y is X mod 5.
apply_mod5_to_list(L1, L2) :-
maplist(mod5, L1, L2).
Usage:
?- apply_mod5_to_list([2, 4, 6, 8], L2).
L2 = [2, 4, 1, 3].
?- apply_mod5_to_list([2, 4.1, 6, 8], L2).
ERROR: mod/2: Type error: `integer' expected, found `4.1'
?- apply_mod5_to_list([2, not_number, 6, 8], L2).
ERROR: is/2: Arithmetic: `not_number/0' is not a function
You can easily modify this code if you want a slightly different behavior, e.g. if you want to tolerate non-integers (why do you want that btw?).
In case you cannot use maplist, you can implement it yourself, at least a more specialized version of it, e.g. something like this:
partition_the_list_into_first_and_rest([X | Xs], X, Xs).
% The result on an empty list is an empty list
apply_mod5_to_list([], []).
% If the input list contains at least one member
apply_mod5_to_list(L1, L2) :-
partition_the_list_into_first_and_rest(L1, X, Xs),
call(mod5, X, Y),
partition_the_list_into_first_and_rest(L2, Y, Ys),
apply_mod5_to_list(Xs, Ys).
To this code you can still apply a lot of syntactic simplification, which you should probably do to turn it into an acceptable homework solution...
How can I write a relation in prolog that determines if there are any two pairs in a list with the same sum. The relation should fail if there exist no pairs whose sums are equal. The relation should also fail if the list contains less than four elements.
list([1 2 3]) fails since it only has 3 elements
list([2 3 4 1]) succeeds since 2+3=4+1
list([3 1 2 4 5 6]) succeds since 5+1=2+4
list([1 8 20 100]) fails since there are no pairs with equal sums
How about this algorithm: take any two pairs of numbers, and see if they match. Here is the code for it:
has_equal_sums(List) :-
select(A, List, List2),
select(B, List2, List3),
select(C, List3, List4),
select(D, List4, _),
A+B =:= C+D.
If you want to make sure it works, or for debug purpose, you can display the two selected pairs as an output:
has_equal_sums(List, [[A, B], [C, D]]) :-
select(A, List, List2),
select(B, List2, List3),
select(C, List3, List4),
select(D, List4, _),
A+B =:= C+D.
Here are a few examples of usage:
?- has_equal_sums([1, 2, 3, 6, 5], X).
X = [[1,6],[2,5]] ? ;
X = [[2,6],[3,5]] ?
?- has_equal_sums([1, 2, 3, 5], X).
no
?- has_equal_sums([1, 2, 3], X).
no
So I checked with my professor and since our deadline has passed, he is OK with me posting my solution to this problem. This is probably not the most succinct way to solve the problem, and I'm leaning on my Scheme a bit, but it appears to work:
%car operations
car([],null).
car([X|_],X).
cadr([_|L],R) :-
car(L,R).
caddr([_|L],R) :-
cadr(L,R).
%cdr operations
cdr([],[]).
cdr([_|L],L).
cddr([_|L],R) :-
cdr(L,R).
cdddr([_|L],R) :-
cddr(L,R).
%two-pair operation
% This algorithm is based on the provided example
% solution for CSC388FA09HW4.
long-enough(L,_) :-
length(L,X),
X>3.
too-long(L,_) :-
length(L,X),
X>4.
two-pair([Head|Tail]) :-
long-enough([Head|Tail],_),
(
(car(Tail,N2),cadr(Tail,N3),caddr(Tail,N4),Head+N2=:=N3+N4);
(cadr(Tail,N2),car(Tail,N3),caddr(Tail,N4),Head+N2=:=N3+N4);
(caddr(Tail,N2),car(Tail,N3),cadr(Tail,N4),Head+N2=:=N3+N4)
);
too-long([Head|Tail],_),
(
two-pair(Tail);
cdr(Tail,N2),two-pair([Head|N2]);
car(Tail,N2),cddr(Tail,N3),two-pair([Head|[N2|N3]]);
car(Tail,N2),cadr(Tail,N3),cdddr(Tail,N4),two-pair([Head|[N2|[N3|N4]]])).