Related
Given a list of possible summands I want to determine which, if any, can form a given sum. For example, with [1,2,3,4,5] I can make the sum of 9 with [4,5], [5,3,1], and [4,3,2].
I am using GNU Prolog and have something like the following which does not work
numbers([1,2,3,4,5]).
all_unique(_, []).
all_unique(L, [V|T]) :-
fd_exactly(1, L, V),
all_unique(L, T).
fd_sum([], Sum).
fd_sum([H|T], Sum):-
S = Sum + H,
fd_sum(T, S).
sum_clp(N, Summands):-
numbers(Numbers),
length(Numbers, F),
between(1, F, X),
length(S, X),
fd_domain(S, Numbers),
fd_domain(Y, [N]),
all_unique(S, Numbers),
fd_sum(S, Sum),
Sum #= Y,
fd_labeling(S).
I think the main problem is that I am not representing the constraint on the sum properly? Or maybe it is something else?
Just in case you're really interested in CLP(FD), here is your corrected program.
numbers([1,2,3,4,5]).
% note: use builtins where available, both for efficiency and correctness
%all_unique(_, []).
%all_unique(L, [V|T]) :-
% fd_exactly(1, L, V),
% all_unique(L, T).
fd_sum([], 0). % sum_fd_SO.pl:8: warning: singleton variables [Sum] for fd_sum/2
fd_sum([H|T], Sum):-
% note: use CLP(FD) operators and the correct operands
Sum #= S + H,
fd_sum(T, S).
sum_clp(N, S):- % sum_fd_SO.pl:13-23: warning: singleton variables [Summands] for sum_clp/2
numbers(Numbers),
length(Numbers, F),
between(1, F, X),
length(S, X),
fd_domain(S, Numbers),
%fd_domain(Y, [N]),
%all_unique(S, Numbers),
fd_all_different(S),
fd_sum(S, N),
%Sum #= Y,
fd_labeling(S).
test
?- sum_clp(3,L).
L = [3] ? ;
L = [1,2] ? ;
L = [2,1] ? ;
no
I think mixing the code for sublist into clp code is causing some confusion. GNU-Prolog has a sublist/2 predicate, you can use that.
You seem to be building the arithmetic expression with fd_sum but it is incorrectly implemented.
sum_exp([], 0).
sum_exp([X|Xs], X+Xse) :-
sum_exp(Xs, Xse).
sum_c(X, N, Xsub) :-
sublist(Xsub, X),
sum_exp(Xsub, Xe),
N #= Xe.
| ?- sum_exp([A, B, C, D], X).
X = A+(B+(C+(D+0)))
yes
| ?- sum_c([1, 2, 3, 4, 5], 9, X).
X = [4,5] ? ;
X = [2,3,4] ? ;
X = [1,3,5] ? ;
(1 ms) no
| ?- length(X, 4), sum_c(X, 4, [A, B]), member(A, [1, 2, 3]).
A = 1
B = 3
X = [_,_,1,3] ? ;
A = 2
B = 2
X = [_,_,2,2] ? ;
A = 3
B = 1
X = [_,_,3,1] ?
yes
The following Prolog program defines a predicate sorted/2 for sorting by permutation (permutation sort) in ascending order a list passed in first argument, which results in the list passed in second argument:
sorted(X, Y) :-
permuted(X, Y),
ordered(Y).
permuted([], []).
permuted(U, [V|W]) :-
permuted(X, W),
deleted(V, U, X).
deleted(X, [X|Y], Y).
deleted(U, [V|W], [V|X]) :-
deleted(U, W, X).
ordered([]).
ordered([_]).
ordered([X, Y|Z]) :-
ordered([Y|Z]), X =< Y.
How to solve the following issues?
The program duplicates solutions for queries in which a list with duplicate elements is passed in second argument:
?- sorted(X, [1, 1, 2]).
X = [1, 1, 2]
; X = [1, 1, 2]
; X = [1, 2, 1]
; X = [1, 2, 1]
; X = [2, 1, 1]
; X = [2, 1, 1]
; false.
The program exhausts resources for queries in which a free variable is passed in second argument:
?- sorted([2, 1, 1], Y).
Y = [1, 1, 2]
; Y = [1, 1, 2]
;
Time limit exceeded
The Prolog program is based on the Horn clause program given at section 11 of Robert Kowalski’s famous paper Predicate Logic as Programming Language:
To solve non-termination, you can add same_length/2 to sorted/2 as #false suggested:
sorted(X, Y) :-
same_length(X, Y),
permuted(X, Y),
ordered(Y).
same_length([], []).
same_length([_|Xs], [_|Ys]) :-
same_length(Xs, Ys).
Or you may embed it into permuted/2 by adding a new argument:
sorted(X, Y) :-
permuted(X, X, Y),
ordered(Y).
permuted([], [], []).
permuted(U, [_|L1], [V|W]) :-
permuted(X, L1, W),
deleted(V, U, X).
The program will still return duplicates as it only sees one item at a time.
To solve duplication, you can either generate all permutations and discard the repeated ones (which is not efficient), or only generate distinct permutations. The following modification does the latter by taking the idea of the recursive procedure permuted/2 + deleted/2 which for each item puts it at the beginning of the list and does a recursive call on the remaining list, and changes it to another recursive procedure permuted_all/2 + deleted_all/2 which for each group of same items puts them at the beginning of the list and does a recursive call on the remaining list. This program uses difference lists for better efficiency:
sorted(X, Y) :-
same_length(X, Y),
permuted_all(X, Y),
ordered(Y).
permuted_all([], []).
permuted_all(U, [V|W]) :-
deleted_all(V, U, X, n-T, [V|W]),
permuted_all(X, T).
% deleted_all(Item, List, Remainder, n-T, Items|T)
deleted_all(_, [], [], y-[X|Xs], [X|Xs]).
deleted_all(X, [V|Y], [V|Y1], y-[X|Xs], Xs1) :-
dif(X, V),
deleted_all(X, Y, Y1, y-[X|Xs], Xs1).
deleted_all(X, [X|Y], Y1, _-Xs, Xs1) :-
deleted_all(X, Y, Y1, y-[X|Xs], Xs1).
deleted_all(U, [V|W], [V|X], n-T, Xs) :-
dif(U, V),
deleted_all(U, W, X, n-T, Xs).
Sample runs:
?- sorted(X, [1, 1, 2]).
X = [1, 2, 1]
; X = [1, 1, 2]
; X = [2, 1, 1]
; false.
?- sorted([2, 1, 1], Y).
Y = [1, 1, 2]
; false.
As per OPs comment asking for a version which does not use difference lists, here goes one which instead obtains the remainder using same_length/2 + append/3 and with added comments:
permuted_all([], []).
permuted_all(U, [V|W]) :-
deleted_all(V, U, X, n, [V|W]),
same_length(X, T), % the remaining list X has the same length as T
append(_, T, [V|W]), % T corresponds to the last items of [V|W]
permuted_all(X, T). % T is a permutation of X
% deleted_all(Item, List, Remainder, n, Items|_)
deleted_all(_, [], [], y, _). % base case
deleted_all(X, [V|Y], [V|Y1], y, Xs1) :-
% recursive step when the current item is not the one we are gathering
dif(X, V),
deleted_all(X, Y, Y1, y, Xs1).
deleted_all(X, [X|Y], Y1, _, [X|Xs1]) :-
% recursive step when the current item is the one we are gathering
deleted_all(X, Y, Y1, y, Xs1).
deleted_all(U, [V|W], [V|X], n, Xs) :-
% recursive step when we have not selected yet the item we will be gathering
dif(U, V),
deleted_all(U, W, X, n, Xs).
Your second problem can by solved by replacing first line with
sorted(X, Y) :-
permuted(X, Y),
ordered(Y),
!.
or
sorted(X, Y) :-
permuted(X, Y),
ordered(Y),
length(X, Z),
length(Y, Z).
The first one is not so easy to solve because of the implementation of this algorithm. Both 1st [1, 1, 2] and 2nd [1, 1, 2] are valid permutations since your code that generated permutations generates all permutations not unique permutations.
As a beginner, I am trying to solve a matrix problem, in which the solution is either the summation or the multiplication of the distinct digit in the matrix. For example,[[14,_,_,_],[15,_,_,_],[28,_,1,_]]. The predicate should generate the solution according to the matrix. However, I bumped into a problem that my combined predicate failed, but each of them succeeded independently.
I broke the problem down to summation and multiplication. Therefore, using clpfd library, and some predicates, for summation:
removeHead([Head|Tail],Tail).
get_head_element([],_).
get_head_element([Head|Rest],Head).
solve_sum(Row,RestRow):-
get_head_element(Row, Goal),
removeHead(Row,RestRow),
RestRow ins 1..9,
all_distinct(RestRow),
sum(RestRow, #=, Goal).
For multiplication:
multiply(List,Result):-
multiply(List,1,Result).
multiply([Element|RestList],PrevResult,Result):-
NextResult #= PrevResult * Element,
multiply(RestList,NextResult, Result).
multiply([], Result, Result).
solve_multiply(Row,RestRow):-
get_head_element(Row, Goal),
removeHead(Row,RestRow),
RestRow ins 1..9,
multiply(RestRow,Goal),
all_distinct(RestRow).
Both solve_sum and solve_multiply works for a single row, but here I combine these two predicates to:
solve_row_sum_or_multiply([],_).
solve_row_sum_or_multiply([HeadRow|Matrix],Solution):-
maplist(all_distinct,Matrix),
get_head_element(HeadRow,Goal),
( Goal >= 25
-> solve_multiply(HeadRow,Solution),
write(Solution)
; ( solve_sum(HeadRow,Solution),
write(Solution)
; solve_multiply(HeadRow,Solution),
write(Solution))
),solve_row_sum_or_multiply(Matrix,Solution).
When I use the solve_row_sum_or_multiply([[14,_,_,_],[15,_,_,_],[28,_,_,_]],X), it will give me the possible combinations. However, when solve_row_sum_or_multiply([[14,_,_,_],[15,_,_,_],[28,_,1,_]],X), it gave me false, but there's a solution possible there, such as [[14,7,2,1],[15,3,7,5],[28,4,1,7]].
I am wondering what could be wrong. Any help is highly appreciated!
EDIT
The problem is inside the combined predicate, and it's better to write the predicate which the answer suggests instead of a nested if-then-else predicate.
Let's review this code.
intro code
:- use_module(library(clpfd)).
% ---
% Make sure you see all the information in a list printed at the
% toplevel, i.e. tell the toplevel to not elide large lists (print
% them in full, don't use '...')
% ---
my_print :-
Depth=100,
Options=[quoted(true), portray(true), max_depth(Depth), attributes(portray)],
set_prolog_flag(answer_write_options,Options),
set_prolog_flag(debugger_write_options,Options).
:- my_print.
multiply/2
Recode the multiply/2 predicate so that it can be read more easily. Add test code to make sure it actually does what we think it does:
% ---
% Set up constraint: all the elements in List, multiplied
% together, must yield Result. If the List is empty, the
% Result must be 1.
% ---
multiply(Factors,Product):-
multiply_2(Factors,1,Product).
multiply_2([Factor|Factors],PartialProduct,Product):-
PartialProduct2 #= PartialProduct * Factor,
multiply_2(Factors,PartialProduct2,Product).
multiply_2([],Product,Product).
solve_multiply([Product|Factors]):-
Factors ins 1..9,
multiply(Factors,Product),
all_distinct(Factors).
% ---
% Testing
% ---
:- begin_tests(multiply).
test(1) :-
multiply([X,Y,Z],6),
[X,Y,Z] ins 1..9,
X #=< Y, Y #=< Z,
bagof([X,Y,Z],label([X,Y,Z]),Bag),
sort(Bag,BagS),
assertion(BagS == [[1, 1, 6], [1, 2, 3]]).
test(2) :-
multiply([],Result),
assertion(Result == 1).
test(3) :-
multiply([X,Y],3),
[X,Y] ins 1..9,
X #=< Y,
bagof([X,Y],label([X,Y]),Bag),
sort(Bag,BagS),
assertion(BagS == [[1,3]]).
test(4) :-
solve_multiply([6,X,Y,Z]),
bagof([X,Y,Z],label([X,Y,Z]),Bag),
sort(Bag,BagS),
assertion(BagS == [[1,2,3],[1,3,2],[2,1,3],[2,3,1],[3,1,2],[3,2,1]]).
test(5) :-
solve_multiply([362880,F1,F2,F3,F4,F5,F6,F7,F8,F9]),
F1 #=< F2,
F2 #=< F3,
F3 #=< F4,
F4 #=< F5,
F5 #=< F6,
F6 #=< F7,
F7 #=< F8,
F8 #=< F9,
bagof([F1,F2,F3,F4,F5,F6,F7,F8,F9],label([F1,F2,F3,F4,F5,F6,F7,F8,F9]),Bag),
sort(Bag,BagS),
assertion(BagS == [[1,2,3,4,5,6,7,8,9]]).
test(6,fail) :-
solve_multiply([-1,X,Y,Z]).
:- end_tests(multiply).
solve_sum/1
For summation, after simplifying and re-coding to Prolog's "pattern matching" style instead of (for want of a better word) "Algol calling style" as is used in the original the question (which confused me greatly I have to say).
This looks ok too. Note that the predicate solve_sum/1 is quite different-in-argument-style from multiply/2 It is better - and easier on the reader (and oneself) - if one keeps the same calling conventions.
solve_sum([Sum|Terms]):-
Terms ins 1..9,
all_distinct(Terms),
sum(Terms, #=, Sum).
% ---
% Testing
% ---
:- begin_tests(sum).
test(0) :-
solve_sum([0]).
test(1) :-
solve_sum([6,X,Y,Z]),
X #=< Y, Y #=< Z,
bagof([X,Y,Z],label([X,Y,Z]),Bag),
sort(Bag,BagS),
assertion(BagS == [[1, 2, 3]]).
test(2) :-
solve_sum([9,X,Y,Z]),
X #=< Y, Y #=< Z,
bagof([X,Y,Z],label([X,Y,Z]),Bag),
sort(Bag,BagS),
assertion(BagS == [[1,2,6],[1,3,5],[2,3,4]]).
test(3,fail) :-
solve_sum([1,_X,_Y,_Z]).
:- end_tests(sum).
A printing predicate to get nice results
Prolog makes it easy to construct arbitrary structures "on the fly", one just has to stipulate exactly how the structure shall look.
Our "solution" is:
A list
With each element of the list a "row" (standing for one of the expressions)
And the row a term: row(Result,Op,RowValues) where Result is the left-hand-side of an equation, Op is one of add or mult and RowValues is a list with the values found for the values in the equation.
print_solution([]).
print_solution([Labeling|Labelings]) :-
format("---~n"),
print_rows_of_solution(Labeling),
format("---~n"),
print_solution(Labelings).
print_rows_of_solution([]).
print_rows_of_solution([row(Result,Op,RowValues)|Rows]) :-
print_row(Result,RowValues,Op),
print_rows_of_solution(Rows).
print_row(Result,[RowEntry|RowEntries],Op) :-
format("~q = ~q",[Result,RowEntry]),
print_row_2(RowEntries,Op).
print_row_2([RowEntry|RowEntries],Op) :-
((Op == mult) -> OpChar = '*'
; (Op == add) -> OpChar = '+'
; OpChar = '?'),
format(" ~q ~q",[OpChar,RowEntry]),
print_row_2(RowEntries,Op).
print_row_2([],_) :-
format("~n").
solve_row_sum_or_multiply/2
This has been modified to also collect the operation selected in a second argument (a list).
Note that the "maplist-all-distinct over the matrix" is not done here because that seems wrong.
solve_row_sum_or_multiply([],[]).
solve_row_sum_or_multiply([Row|MoreRows],[mult|Ops]) :-
Row = [X|_Xs],
X >= 25,
solve_multiply(Row), % we now have imposed a product constraint on the current Row
solve_row_sum_or_multiply(MoreRows,Ops).
solve_row_sum_or_multiply([Row|MoreRows],[add|Ops]) :-
Row = [X|_Xs],
X < 25,
solve_sum(Row), % we now have imposed a sum constraint on the current Row
solve_row_sum_or_multiply(MoreRows,Ops).
solve_row_sum_or_multiply([Row|MoreRows],[mult|Ops]) :-
Row = [X|_Xs],
X < 25,
solve_multiply(Row), % alternatively, we now have imposed a product constraint on the current Row
solve_row_sum_or_multiply(MoreRows,Ops).
And finally a "main" predicate
In trial_run/1 we stipulate that all variables except X32 be distinct and that X32 be 1. If X32 were in the "distinct set", none of the variables could take on the value 1 - there is no solution in that case.
We also impose a sorting to get only a set of "canonical" solutions:
We collect all possible solutions for solving and labeling using bagof/3:
trial_run(Solutions) :-
all_distinct([X11,X12,X13,X21,X22,X23,X31,X33]),
X32=1,
X11 #=< X12, X12 #=< X13,
X21 #=< X22, X22 #=< X23,
X31 #=< X33,
% multiple solutions solving x labeling may exist; collect them all
bagof(
[
row(14,Op1,[X11,X12,X13]),
row(15,Op2,[X21,X22,X23]),
row(28,Op3,[X31,X32,X33])
],
(
solve_row_sum_or_multiply( [[14,X11,X12,X13],[15,X21,X22,X23],[28,X31,X32,X33]], [Op1,Op2,Op3] ),
label([X11,X12,X13,X21,X22,X23,X31,X32,X33])
),
Solutions).
Does it work?
Apparently yes, and there is only one solution:
?- trial_run(Solutions),print_solution(Solutions).
---
14 = 2 + 3 + 9
15 = 1 + 6 + 8
28 = 4 * 1 * 7
---
Solutions = [[row(14,add,[2,3,9]),row(15,add,[1,6,8]),row(28,mult,[4,1,7])]].
I've written a tail-recursive predicate in Prolog which outputs the integers between A and B in a list K. I've used "reverse" to bring the numbers into the right order:
numbers(A,B,K) :- numbers(A,B,[],K).
numbers(Y,Y,X,K) :- !, reverse([Y|X],K).
numbers(A,B,X,K) :- A<B, C is A+1, numbers(C,B,[A|X],K).
Query:
?- numbers(3,6, K).
K=[3,4,5,6]
All works fine. What I now want to do is that I only want to have odd numbers of the range between A and B in the list K. How can I do that? Thanks in advance!
Firstly, I would try to avoid using reverse/2. If you have such a solution, it's often an indicator that there's a better way to get the answer forwards more directly. Not always, but most often. reverse/2 is probably the 2nd favorite band-aid in Prolog right behind use of the cut. :)
In many problems, an auxiliary accumulator is needed. In this particular case, it is not. Also, I would tend to use CLP(FD) operations when involving integers since it's the more relational approach to reasoning over integers. But you can use the solution below with is/2, etc, if you wish. It just won't be as general.
numbers(S, E, []) :- S #> E. % null case
numbers(X, X, [X]).
numbers(S, E, [S|T]) :-
S #< E,
S1 #= S + 1,
numbers(S1, E, T).
| ?- numbers(3, 8, L).
L = [3,4,5,6,7,8] ? ;
no
| ?- numbers(A, B, [2,3,4,5]).
A = 2
B = 5 ? ;
no
| ?-
This solution avoids reverse/2 and is tail recursive.
To update it for odd integers, the first thought is that we can easily modify the above to do every other number by just adding 2 instead of 1:
every_other_number(S, E, []) :- S #> E.
every_other_number(X, X, [X]).
every_other_number(S, E, [S|T]) :-
S #< E,
S1 #= S + 2,
every_other_number(S1, E, T).
| ?- every_other_number(3, 7, L).
L = [3,5,7] ? ;
no
| ?- every_other_number(3, 8, L).
L = [3,5,7] ? ;
no
| ?- every_other_number(4, 8, L).
L = [4,6,8] ? ;
no
| ?-
Then we can do odd numbers by creating an initial predicate to ensure the condition that the first value is odd and calling every_other_number/3:
odd_numbers(S, E, L) :-
S rem 2 #= 1,
every_other_number(S, E, L).
odd_numbers(S, E, L) :-
S rem 2 #= 0,
S1 #= S + 1,
every_other_number(S1, E, L).
| ?- odd_numbers(2, 8, L).
L = [3,5,7] ? ;
no
| ?- odd_numbers(2, 9, L).
L = [3,5,7,9] ? ;
no
| ?- odd_numbers(3, 8, L).
L = [3,5,7] ? ;
no
| ?-
This could be a solution, using mod/2 operator.
numbers(A,B,K) :-
B1 is B+1,
numbers(A,B1,[],K).
numbers(Y,Y1,X,K) :-
Y = Y1,
reverse(X,K).
numbers(A,B,X,K) :-
A<B,
C is A+1,
C1 is mod(C,2),
(C1 = 0 ->
numbers(C,B,[A|X],K)
; numbers(C,B,X,K)).
Another possibility is to use DCG :
numbers(A,B,K) :-
phrase(odd(A,B), K).
odd(A,B) --> {A > B, !}, [].
odd(A,B) --> {A mod2 =:= 0, !, C is A+1}, odd(C,B).
odd(A,B) --> {C is A+2}, [A], odd(C, B).
It is folk knowledge that append(X,[Y],Z) finds the last element
Y of the list Z and the remaining list X.
But there is some advantage of having a customized predicate last/3,
namely it can react without leaving a choice point:
?- last([1,2,3],X,Y).
X = 3,
Y = [1,2]
?- append(Y,[X],[1,2,3]).
Y = [1,2],
X = 3 ;
No
Is there a way to realize a different implementation of
append/3 which would also not leave a choice point in the
above example?
P.S.: I am comparing:
/**
* append(L1, L2, L3):
* The predicate succeeds whenever L3 unifies with the concatenation of L1 and L2.
*/
% append(+List, +List, -List)
:- public append/3.
append([], X, X).
append([X|Y], Z, [X|T]) :- append(Y, Z, T).
And (à la Gertjan van Noord):
/**
* last(L, E, R):
* The predicate succeeds with E being the last element of the list L
* and R being the remainder of the list.
*/
% last(+List, -Elem, -List)
:- public last/3.
last([X|Y], Z, T) :- last2(Y, X, Z, T).
% last2(+List, +Elem, -Elem, -List)
:- private last2/4.
last2([], X, X, []).
last2([X|Y], U, Z, [U|T]) :- last2(Y, X, Z, T).
One way to do it is to use foldl/4 with the appropriate help predicate:
swap(A, B, B, A).
list_front_last([X|Xs], F, L) :-
is_list(Xs),
foldl(swap, Xs, F, X, L).
This should be it:
?- list_front_last([a,b,c,d], F, L).
F = [a, b, c],
L = d.
?- list_front_last([], F, L).
false.
?- list_front_last([c], F, L).
F = [],
L = c.
?- Ys = [y|Ys], list_front_last(Ys, F, L).
false.
Try to see if you can leave out the is_list/1 from the definition.
As I posted:
append2(Start, End, Both) :-
% Preventing unwanted choicepoint with append(X, [1], [1]).
is_list(Both),
is_list(End),
!,
append(Start, End, Both),
!.
append2(Start, End, Both) :-
append(Start, End, Both),
% Preventing unwanted choicepoint with append(X, Y, [1]).
(End == [] -> ! ; true).
Result in swi-prolog:
?- append2(Y, [X], [1,2,3]).
Y = [1, 2],
X = 3.