Unique sets that add up to target value n - prolog

The given database:
age(ann, 20).
age(joe, 44).
age(bob, 40).
age(min, 27).
age(cai, 20).
age(ned, 27).
age(deb, 36).
age(pat, 36).
age(edo, 24).
age(tod, 56).
What I have so far:
hundred(L) :-
findall(X, age(X,_), L1),
sum(L1,100,L),
length(L,Len),
Len > 1.
sum(_, 0, []).
sum(L, S, [H|T]) :-
select(H, L, L1),
age(H, A),
S1 is S-A,
S1 >= 0,
sum(L1, S1, T).
I'd like to get the unique sets of persons (of length > 1) in the database whose ages add up to 100. My solution yields all possible permutations whereas I'd like to get the unique sets of persons as below (the listing order in the output example is irrelevant):
L=[joe,tod];
L=[ann,joe,deb];
L=[ann,joe,pat];
L=[ann, edo, tod];
L=[ann, cai, deb, edo];
L=[ann, cai, edo, pat];
L=[cai, edo, tod];
L=[joe, cai, deb];
L=[joe, cai, pat];
L=[bob, deb, edo];
L=[bob, pat, edo];
For clarity: people may have the same age, and that's fine. So the number combinations themselves may include duplicates to get to 100, as long as those ages belong to different persons.
In the end, each solution should be a combination of different persons but should not be a mere permutation of a previous solution.
My solution always takes combinations of different persons, but lists every change in the order as a new solution.
I've tried to get rid of the permutations by putting all solutions in a list of lists and then sorting it to remove duplicates, but it didn't work.

For the numbers, can use generic predicates:
sub_list_sum(Sum, Lst, Sub) :-
compare(C, Sum, 0),
sub_list_sum_(C, Sum, Lst, Sub).
sub_list_sum_(=, 0, _, []).
sub_list_sum_(>, Sum, Lst, [E|Sub]) :-
select_forward(E, Lst, Lst0),
Sum0 is Sum - E,
compare(C, Sum0, 0),
sub_list_sum_(C, Sum0, Lst0, Sub).
% A subsequence variant of select/3
select_forward(E, [H|T], F) :-
select_forward_(T, H, E, F).
select_forward_(T, H, H, T).
select_forward_([H|T], _, E, F) :-
select_forward_(T, H, E, F).
Result in swi-prolog:
?- Dupes = [20, 44, 40, 27, 20, 27, 36, 36, 24, 56],
sort(Dupes, Sorted), sub_list_sum(100, Sorted, S).
S = [20, 24, 56] ;
S = [20, 36, 44] ;
S = [24, 36, 40] ;
S = [44, 56] ;
false.
Customising this for the ages:
age(ann, 20).
age(joe, 44).
age(bob, 40).
age(min, 27).
age(cai, 20).
age(ned, 27).
age(deb, 36).
age(pat, 36).
age(edo, 24).
age(tod, 56).
sub_list_age_sum(Sum, Sub) :-
% Want at least length 2
Sub = [_,_|_],
bagof(age(P, A), age(P, A), Ages),
compare(C, Sum, 0),
sub_list_age_sum_(C, Sum, Ages, Sub).
sub_list_age_sum_(=, 0, _, []).
sub_list_age_sum_(>, Sum, Lst, [P|Sub]) :-
select_forward(age(P, A), Lst, Lst0),
Sum0 is Sum - A,
compare(C, Sum0, 0),
sub_list_age_sum_(C, Sum0, Lst0, Sub).
... and add select_forward code as above - result:
?- sub_list_age_sum(100, L).
L = [ann, joe, deb] ;
L = [ann, joe, pat] ;
L = [ann, cai, deb, edo] ;
L = [ann, cai, pat, edo] ;
L = [ann, edo, tod] ;
L = [joe, cai, deb] ;
L = [joe, cai, pat] ;
L = [joe, tod] ;
L = [bob, deb, edo] ;
L = [bob, pat, edo] ;
L = [cai, edo, tod] ;
false.

Turns out that my initial idea actually works. The only thing needed is to sort each valid group before adding it to the list of lists, so that setof/3 can then recognize the permutations as duplicates and remove them, thus producing a list with unique groups.
Final solution:
hundred(G):-
findall(age(N,A),age(N,A),Ps),
setof(Sorted,
Ns^(sum(100,Ps,Ns),sort(Ns,Sorted)),
Groups),
member(G,Groups), G=[_,_|_].
sum(0,_,[]).
sum(Sum,Ps,[N|Ns]):-
select(age(N,A),Ps,Rem),
NewSum is Sum-A, NewSum >= 0,
sum(NewSum,Rem,Ns).

Related

Swap function in prolog, infinite loop

I am trying to create a swap function in prolog but I ended up with an infinite loop, I tried to debug it using trace()
An example of this function is swap(4, 3, ["You", "Are", "Awesome", "thank", "You"], SwappedList)
With the output being
["You", "Are", "thank", "Awesome", "You"]
In the trace output, it is showing that the problem is in the delete as it is failing and redoes the split
/* Getting the nth element of the list*/
n_thelement(1, [Head|_], Head).
n_thelement(N, [_|Tail], Item):-
NewN is N-1,
n_thelement(NewN, Tail, Item).
/* Deleting the element of the desired Nth element*/
delete(X, [X|Tail], Tail).
delete(X, [Head|Tail], [Head|Item]):-
delete(X, Tail, Item).
/* Adding the deleted element to the beginning of the list*/
append([], Element, Element).
append([Head], Element, [Head|Element]).
swap(X, X, List, List).
swap(X, Y, List, NList):-
n_thelement(X, List, Num1),
n_thelement(Y, List, Num2),
split(X, List, B1, A1),
delete(Num1, A1, L1),
append([Num2], L1, NList1),
append(B1, NList1, NList2),
split(Y, NList2, B2, A2),
delete(Num2, A2, L2),
append([Num1], L2, NList3),
append(B2, NList3, NList).
split(1, [Head|Tail], Head, Tail).
split(N, [Old_List|New_List], Old_List, New_List):-
NewN is N -1,
split(NewN, _, Old_List, New_List).
If I understand your problem statement correctly, given to indices into a list, M and N such that M < N and M and N are both valid indices into the list, you want to swap the elements at those indices.
I would first make the indices zero-relative instead of 1-relative as that makes the math a little easier.
So, you want to break up the list into 5 pieces, 3 of which are themselves lists of any length and two of which are the list entries to be swapped:
As: The lead-in prefix of the list. It is of length M.
B: The 1st item to be swapped.
Cs: The middle segment of the list. It is of length N - (M+1).
D: The 2nd item to be swapped.
Es: The suffix/remainder of the list. It is of any length.
append/3 is useful for deconstruction and reconstruction of lists, making the actual swap easy. You have 3 cases.
First, the special case of both indices being the same, in which case, there is no work to do:
swap( M, M, Ls, Ls ).
Second, the case of the indices being out of order, in which case we just recursively swap them to put them in order:
swap( M, N, Ls, Rs ) :- M > N, swap(N,M,Ls,Rs).
Third, the general case:
swap( M, N, Ls, Rs ) :- % if the 2 indices differ
M < N, % - and are in order
M >= 0, % - and M is greater than or equal to zero
N >= 0, % - and N is greater than or equal to zero
X is N - (M+1), % - compute the length of the middle segment
length( As, M ), % - construct an empty, unbound list of length M, the length of the prefix
length( Cs, X ), % - and construct an empty, unbound list of that length
append( As, [B|T1], Ls), % - get the prefix (As) and the first item (B) to be swapped
append( Cs, [D|Es], T1), % - get the middle segment (Cs), the second item (D) to be swapped, and the suffix (Es)
append( As, [D|Cs], T2), % - concatenate As, D, and Cs, then...
append( T2, [B|Es], Rs ) % - concatenate that with B and the suffix
. % Easy!
You can define a predicate to replace the i-th item of the list for another:
replace(Index, [Old|Rest], [New|Rest], Old, New) :- Index == 0, !.
replace(Index, [First|Rest], [First|NewRest], Old, New) :-
Index > 0,
Previous is Index - 1,
replace(Previous, Rest, NewRest, Old, New).
Examples:
?- replace(1, [a,b,c,d,e], List1, Old1, x).
List1 = [a, x, c, d, e],
Old1 = b.
?- replace(1, [a,b,c,d,e], List1, Old1, New1).
List1 = [a, New1, c, d, e],
Old1 = b.
?- replace(4, [a,b,c,d,e], List2, Old2, New2).
List2 = [a, b, c, d, New2],
Old2 = e.
Then, using this predicate, you can define:
swap(I, J, OldList, NewList) :-
replace(I, OldList, List, X, Y),
replace(J, List, NewList, Y, X).
Examples:
?- swap(3, 2, ["You", "Are", "Awesome", "thank", "You"], L).
L = ["You", "Are", "thank", "Awesome", "You"].
?- swap(1, 4, [a,b,c,d,e], L).
L = [a, e, c, d, b].
?- swap(0, 3, [a,b,c,d,e], L).
L = [d, b, c, a, e].
?- swap(1, 0, [a,b,c,d,e], L).
L = [b, a, c, d, e].
?- swap(2, 2, [a,b,c,d,e], L).
L = [a, b, c, d, e].
?- swap(3, 9, [a,b,c,d,e], L).
false.

Prolog: decompose number into its digits

I am studying prolog and I am faced with a problem that I cannot deal with.
Given a number, I have to check if the sum of the factorial of each digit that composes it is equal to the number itself.
Example:
145
1! + 4! + 5! = 1 + 24 + 120
Now my problem is just how to decompose the number so that I can factorial and sum each digit.
EDIT1.
thank to #slago I understand how decompose the number, but now I have a problem to sum the factorial terms:
fact(N):-
fact(N, N, _ListNumber).
fact(N, 0, ListNumber):-
factorial(ListNumber, 1, Sum),
Sum == N.
fact(N, Number, [D|R]):-
D is Number mod 10,
Number1 is Number div 10,
fact(N, Number1, R).
factorial([], Counter, Counter).
factorial([D|R], Counter, Sum):-
print([D|R]),
checksum(D, Counter),
factorial(R, Counter, Sum).
checksum(D, Counter):-
Counter1 is Counter * D,
M is D - 1,
M >= 2, !,
checksum(M, Counter1).
I have tried like this, but I noticed [D|R] results empty, and I don't understand why.
Your code is organized in a very confusing way. It is best to code independent predicates (for more specific purposes) and, after that, use them together to get the answer you want.
Start by creating a predicate to decompose a natural number into digits.
decompose(N, [N]) :- N<10, !.
decompose(N, [D|R]) :- N>=10, D is N mod 10, M is N//10, decompose(M, R).
Example of decomposition:
?- decompose(145, D).
D = [5, 4, 1].
Then, create a predicate to compute the factorial of a natural number.
fact(N, F) :- fact(N, 1, F).
fact(0, A, A) :- !.
fact(N, A, F) :- N>0, M is N-1, B is N*A, fact(M, B, F).
Example of factorial:
?- fact(5, F).
F = 120.
After that, create a predicate to map each number of a list into its corresponding factorial (alternatively, you could use the predefined predicate maplist/3).
map_fact([], []).
map_fact([X|Xs], [Y|Ys]) :- fact(X,Y), map_fact(Xs, Ys).
Example of mapping:
?- decompose(145, D), map_fact(D, F).
D = [5, 4, 1],
F = [120, 24, 1].
You must also create a predicate to compute the sum of the items of a list (alternatively, you could use the predefined predicate sum_list/2).
sum(L, S) :- sum(L, 0, S).
sum([], A, A).
sum([X|Xs], A, S) :- B is A+X, sum(Xs, B, S).
Example of summation:
?- decompose(145, D), map_fact(D, F), sum(F, S).
D = [5, 4, 1],
F = [120, 24, 1],
S = 145.
Finally, create the predicate to check the desired number property.
check(N) :- decompose(N, D), map_fact(D, F), sum(F, N).
Example:
?- check(145).
true.
?- check(146).
false.

PROLOG : Given a number X, find all multiples of 4 less or equal than X

I have the following program:
list4(N, L) :-
list4(0, N, L).
list4(N, N, [N]).
list4(N0, N, [N0| List]) :-
N0 < N,
N1 is N0+1,
list4(N1, N, List).
When i change the line N1 is N0+1 to N1 is 4*N0 i get stack limit exceeded error.
My expected result is
list4(10,L).
L = [4,8]
Two problems with the 4*N0 version:
In list4/2 you initialize list4/3 with N0=0, which, multiplied with anything, always stays 0. That causes the infinite recursion. As you want multiples of four, you can just keep increasing N0 by one in each step and multiply it by 4 before putting it into the list.
The anchor relies on your count variable arriving at N exactly, but N0 * 4 overshoots. The first rule of list4/3 has to cover the rest of the cases with N0*4 > N as well. To also include the upper limit in the result, we can make the anchor stop at values larger than the limit and handle the upper bound itself in the second rule.
Expressed in code:
list4(N, L) :-
list4(1, N, L).
list4(N0, N, []) :- N4Times is N0*4,N4Times > N.
list4(N0, N, [N4Times| List]) :-
N4Times is N0*4,
N4Times =< N,
N1 is N0 + 1,
list4(N1, N, List).
Results in:
?- list4(10,L).
L = [4, 8] ;
false.
?- list4(8,L).
L = [4, 8] ;
false.
You can initialize the accumulator with 0 and increment it by 4 at each step.
% list4(+Upperbound, -MultiplesOfFour)
list4(U, M) :-
list4(0, U, M).
list4(A, U, L) :-
M is A+4,
( M =< U
-> L = [M|Ms],
list4(M, U, Ms)
; L = [] ).
Examples:
?- list4(10, L).
L = [4, 8].
?- list4(8, L).
L = [4, 8].
?- list4(20, L).
L = [4, 8, 12, 16, 20].
?- list4(30, L).
L = [4, 8, 12, 16, 20, 24, 28].
?- list4(3, L).
L = [].

How to populate a list in Prolog?

Say you have the following predicate:
random_int(X/Y):-
random(1,100,X),
random(1,100,Y),
X\=Y.
How can I populate a list of size n using the result of this predicate?
I tried the following code but it only populates the list if random_int(X) is true at the first attempt, i.e. it does not backtrack to try other combinations of X and Y.
findall(X,(between(1,N,_), random_int(X)),L).
I find this small 'application' of clpfd interesting:
?- N=10,M=12, repeat, findall(X, (between(1,N,_),random(1,M,X)), L), clpfd:all_different(L).
N = 10,
M = 12,
L = [5, 4, 6, 7, 9, 11, 2, 3, 8|...]
.
note: M must be > N
I guess a simple way to do it is to make a list of 1:100, and draw 100 times from it a sample of size 2, without replacement. Since this is Prolog and not R, you can instead do:
:- use_module(library(lists)).
:- use_module(library(random)).
random_pairs(Pairs) :-
findall(X/Y,
( between(1, 100, _),
randseq(2, 100, [X,Y])
), R).
This is available in SWI-Prolog at least, but it is free software and the source to randseq/3 is available on the web site.
And since it's better to not use findall unless strictly necessary, it would probable better to write:
random_pairs(Pairs) :-
length(Pairs, 100),
maplist(randseq(2, 100), Pairs).
or, if the X/Y is important,
random_pairs(Pairs) :-
length(Pairs, 100),
maplist(rand_couple(100), Pairs).
rand_couple(N, X/Y) :-
randseq(2, N, [X,Y]).
TL;DR Use the available libraries
You could do it with findall/3:
random_list(N, L) :-
findall(X, (between(1,N,_), random(50,100,X)), L).
Another tidy way to do this would be:
random_list(N, L) :-
length(L, N),
maplist(random(50, 100), L).
Which results in:
| ?- random_list(5, L).
L = [69,89,89,95,59]
yes
| ?-
In general, if you have a predicate, p(X1,X2,...,Xn,Y), and a list you want to fill with result Y using successive calls to p/(n+1), you can use length(List, Length) to set the length of your list, and then maplist(p(X1,...,Xn), List) to populate the list. Or, using the findall/3, you can do findall(X, (between(1,N,_), p(X1,...,Xn,X)), L)..
EDIT based upon the updated conditions of the question that the generated list be unique values...
The random predicates are not generators, so they don't create new random numbers on backtracking (either unique or otherwise). So this solution, likewise, will generate one list which meets the requirements, and then just succeed without generating more such lists on backtracking:
% Generate a random number X between A and B which is not in L
rand_not_in(A, B, L, X) :-
random(A, B, X1),
( memberchk(X1, L)
-> rand_not_in(A, B, L, X)
; X = X1
).
% Generate a list L of length N consisting of unique random numbers
% between A and B
random_list(N, L) :-
random_list(N, 50, 100, [], L).
random_list(N, A, B, Acc, L) :-
N > 0,
rand_not_in(A, B, A, X),
N1 is N - 1,
random_list(N1, A, B, [X|A], L).
random_list(0, _, _, L, L).
Yet another approach, in SWI Prolog, you can use randseq, which will give a random sequence in a range 1 to N. Just scale it:
random_list(N, A, B, L) :-
A < B,
Count is B - A + 1,
randseq(N, Count, L1),
Offset is A - 1,
maplist(offset(Offset), L1, L).
offset(X, Offset, Y) :-
Y is X + Offset.
?- random_list(5, 50, 100, L).
L = [54, 91, 90, 78, 75].
?-
random_len([],0).
random_len([Q|T],N) :-
random(1,100,Q),
random_len(T,X),
N is X+1.

Getting the product of a list from left to right

How do you get the product of a list from left to right?
For example:
?- product([1,2,3,4], P).
P = [1, 2, 6, 24] .
I think one way is to overload the functor and use 3 arguments:
product([H|T], Lst) :- product(T, H, Lst).
I'm not sure where to go from here.
You can use library(lambda) found here : http://www.complang.tuwien.ac.at/ulrich/Prolog-inedit/lambda.pl
Quite unreadable :
:- use_module(library(lambda)).
:- use_module(library(clpfd)).
product(L, R) :-
foldl(\X^Y^Z^(Y = []
-> Z = [X, [X]]
; Y = [M, Lst],
T #= X * M,
append(Lst, [T], Lst1),
Z = [T, Lst1]),
L, [], [_, R]).
Thanks to #Mike_Hartl for his advice, the code is much simple :
product([], []).
product([H | T], R) :-
scanl(\X^Y^Z^( Z #= X * Y), T, H, R).
seems like a list copy, just multiplying by last element handled. Let's start from 1 for the leftmost element:
product(L, P) :-
product(L, 1, P).
product([X|Xs], A, [Y|Ys]) :-
Y is X * A,
product(Xs, Y, Ys).
product([], _, []).
if we use library(clpfd):
:- [library(clpfd)].
product([X|Xs], A, [Y|Ys]) :-
Y #= X * A,
product(Xs, Y, Ys).
product([], _, []).
it works (only for integers) 'backward'
?- product(L, [1,2,6,24]).
L = [1, 2, 3, 4].
Probably very dirty solution (I am new to Prolog):
product([ListHead|ListTail], Answer) :-
product_acc(ListTail, [ListHead], Answer).
product_acc([ListHead|ListTail], [AccHead|AccTail], Answer) :-
Product is ListHead * AccHead,
append([Product, AccHead], AccTail, TempList),
product_acc(ListTail, TempList, Answer).
product_acc([], ReversedList, Answer) :-
reverse(ReversedList, Answer).
So basically at the beginning we call another predicate which has
extra "variable" Acc which is accumulator list.
So we take out head (first number) from original list and put it in
to Accumulator list.
Then we always take head (first number) from original list and
multiply it with head (first number) from accumulator list.
Then we have to append our new number which we got by multiplying
with the head from accumulator and later with the tail
Then we call same predicate again until original list becomes empty
and at the end obviously we need to reverse it.
And it seems to work
?- product([1,2,3,4], L).
L = [1, 2, 6, 24].
?- product([5], L).
L = [5].
?- product([5,4,3], L).
L = [5, 20, 60].
Sorry if my explanation is not very clear. Feel free to comment.

Resources