I'm trying to figure out if I have an infinite loop in my Prolog program, or if I just did a bad job of writing it, so its slow. I'm trying to solve the square sum chains problem from the dailyprogrammer subreddit. Given a number N, find an ordering of the numbers 1-N (inclusive) such that the sum of each pair of adjacent numbers in the ordering is a perfect square. The smallest N that this holds for is 15, with the ordering [8, 1, 15, 10, 6, 3, 13, 12, 4, 5, 11, 14, 2, 7, 9]. This is the code that I'm trying to use to solve the problem:
is_square(Num):- is_square_help(Num, 0).
is_square_help(Num, S):- Num =:= S * S.
is_square_help(Num, S):-
Num > S * S,
T is S+1,
is_square_help(Num, T).
is_square_help(Num, S):- Num < S * S, fail.
contains(_, []):- fail.
contains(Needle, [Needle|_]).
contains(Needle, [_|Tail]):- contains(Needle, Tail).
nums(0, []).
nums(Num, List) :- length(List, Num), nums_help(Num, List).
nums_help(0, _).
nums_help(Num, List) :-
contains(Num, List),
X is Num - 1,
nums_help(X, List).
square_sum(Num, List) :-
nums(Num, List),
square_sum_help(List).
square_sum_help([X, Y|T]) :-
Z is X + Y,
is_square(Z),
square_sum_help(T).
Currently, when I run square_sum(15, List)., the program does not terminate. I've left it alone for about 10 minutes, and it just keeps running. I know that there are problems that take a long time to solve, but others are reportedly generating answers in the order of milliseconds. What am I doing wrong here?
SWI-Prolog allows this compact implementation
square_sum(N,L) :-
numlist(1,N,T),
select(D,T,R),
adj_squares(R,[D],L).
adj_squares([],L,R) :- reverse(L,R).
adj_squares(T,[S|Ss],L) :-
select(D,T,R),
float_fractional_part(sqrt(S+D))=:=0,
adj_squares(R,[D,S|Ss],L).
that completes really fast for N=15
edit as suggested, building the list in order yields better code:
square_sum(N,L) :-
numlist(1,N,T),
select(D,T,R),
adj_squares(R,D,L).
adj_squares([],L,[L]).
adj_squares(T,S,[S|L]) :-
select(D,T,R),
float_fractional_part(sqrt(S+D))=:=0,
adj_squares(R,D,L).
edit
the code above becomes too slow when N grows. I've changed strategy, and attempt now to find an Hamiltonian path into the graph induced by the binary relation. For N=15 it looks like
(here is the code to generate the Graphviz script:
square_pairs(N,I,J) :-
between(1,N,I),
I1 is I+1,
between(I1,N,J),
float_fractional_part(sqrt(I+J))=:=0.
square_pairs_graph(N) :-
format('graph square_pairs_N_~d {~n', [N]),
forall(square_pairs(N,I,J), format(' ~d -- ~d;~n', [I,J])),
writeln('}').
)
and here the code for lookup a path
hamiltonian_path(N,P) :-
square_pairs_struct(N,G),
between(1,N,S),
extend_front(1,N,G,[S],P).
extend_front(N,N,_,P,P) :- !.
extend_front(Len,Tot,G,[Node|Ins],P) :-
arg(Node,G,Arcs),
member(T,Arcs),
\+memberchk(T,Ins),
Len1 is Len+1,
extend_front(Len1,Tot,G,[T,Node|Ins],P).
struct_N_of_E(N,E,S) :-
findall(E,between(1,N,_),As),
S=..[graph|As].
square_pairs_struct(N,G) :-
struct_N_of_E(N,[],G),
forall(square_pairs(N,I,J), (edge(G,I,J),edge(G,J,I))).
edge(G,I,J) :-
arg(I,G,A), B=[J|A], nb_setarg(I,G,B).
Here is a solution using Constraint Logic Programming:
squares_chain(N, Cs) :-
numlist(1, N, Ns),
phrase(nums_partners(Ns, []), NPs),
group_pairs_by_key(NPs, Pairs),
same_length(Ns, Pairs),
pairs_values(Pairs, Partners),
maplist(domain, Is0, Partners),
circuit([D|Is0]),
labeling([ff], Is0),
phrase(chain_(D, [_|Is0]), Cs).
chain_(1, _) --> [].
chain_(Pos0, Ls0) --> [Pos],
{ Pos0 #> 1, Pos #= Pos0 - 1,
element(Pos0, Ls0, E) },
chain_(E, Ls0).
plus_one(A, B) :- B #= A + 1.
domain(V, Ls0) :-
maplist(plus_one, Ls0, Ls),
foldl(union_, Ls, 1, Domain),
V in Domain.
union_(N, Dom0, Dom0\/N).
nums_partners([], _) --> [].
nums_partners([N|Rs], Ls) -->
partners(Ls, N), partners(Rs, N),
nums_partners(Rs, [N|Ls]).
partners([], _) --> [].
partners([L|Ls], N) -->
( { L + N #= _^2 } -> [N-L]
; []
),
partners(Ls, N).
Sample query and answers:
?- squares_chain(15, Cs).
Cs = [9, 7, 2, 14, 11, 5, 4, 12, 13|...] ;
Cs = [8, 1, 15, 10, 6, 3, 13, 12, 4|...] ;
false.
A longer sequence:
?- time(squares_chain(100, Cs)).
15,050,570 inferences, 1.576 CPU in 1.584 seconds (99% CPU, 9549812 Lips)
Cs = [82, 87, 57, 24, 97, 72, 28, 21, 60|...] .
What you are doing wrong is mainly that you generate the whole list before you start testing.
The two clauses that call fail are pointless. Removing them will not change the program. The only reason for doing that is if you do something side-effect-y, like printing output.
Your code for generating the list, and all permutations, seems to work, but it can be done much simpler by using select/3.
You don't seem to have a base case in square_sum_help/1, and you also seem to only check every other pair, which would have lead to problems in some years or whatever when your program had gotten around to checking the correct ordering.
So, by interleaving the generation and testing, like this
square_sum(Num,List) :-
upto(Num,[],List0),
select(X,List0,List1),
square_sum_helper(X,List1,[],List).
square_sum_helper(X1,Rest0,List0,List) :-
select(X2,Rest0,Rest),
Z is X1 + X2,
is_square(Z,0),
square_sum_helper(X2,Rest,[X1|List0],List).
square_sum_helper(_,[],List0,List) :- reverse(List0,List).
is_square(Num,S) :-
Sqr is S * S,
( Num =:= Sqr ->
true
; Num > Sqr,
T is S + 1,
is_square(Num,T) ).
upto(N,List0,List) :-
( N > 0 ->
M is N - 1,
upto(M,[N|List0],List)
; List = List0 ).
the correct result is produced in around 9 msec (SWI Prolog).
?- ( square_sum(15,List), write(List), nl, fail ; true ).
[8,1,15,10,6,3,13,12,4,5,11,14,2,7,9]
[9,7,2,14,11,5,4,12,13,3,6,10,15,1,8]
?- time(square_sum(15,_)).
% 37,449 inferences, 0.009 CPU in 0.009 seconds (100% CPU, 4276412 Lips)
Edit: fixed some typos.
contains/2:
clause contains(_, []):- fail. is buggy and redundant at best.
you should type in the body !, fail.
But it's not needed because that what is unprovable shouldn't be mentioned (closed world assumption).
btw contains/2 is in fact member/2 (built-in)
Related
How can I get a list of power of two until N in prolog. Such that if I write func(5,L) I will get L = [2,4,8,16,32].
This is what I do, but result is not good. Can you help me correct my code and explain what is the problem.
func(N,L):- helpstwo(N,R), reverse(R, L).
helpstwo(1,[2]):- !.
helpstwo(N,[H|[H1,T]]):- N1 is N-1, helpstwo(N1,[H1|T]), H is H1*2.
This is what I get
L = [[8, [4, [2, []]]], 16, 32]
Thanks
powers_of_2(Len, Lst) :-
% Conveniently avoids having to keep an element count
length(Lst, Len),
powers_of_2_(Lst, 1).
% Reached end of list when Tail is empty
powers_of_2_([], _).
powers_of_2_([H|T], N) :-
% Simply multiply the previous number by 2
H is N * 2,
powers_of_2_(T, H).
This is nicely performant - e.g. in swi-prolog:
?- time(powers_of_2(50_000, L)).
% 100,005 inferences, 0.434 CPU in 0.465 seconds (93% CPU, 230470 Lips)
L = [2,4,8,16,32,64,128,256,512,1024,2048,4096,8192, ...
A simple 1-liner:
powers_of_2(N , Ps ) :- findall( P , ( between(0,N,E), P is 2^E ) , Ps ) .
I want to write predicate that generates the Fibonacci series for given N.
fibon(6, X) -> X = [0,1,1,2,3,5].
I have a predicate to generate the N-th element of the Fibonacci series:
fib(0, 0).
fib(1, 1).
fib(N, F) :-
N > 1,
N1 is N - 1,
N2 is N - 2,
fib(N1, F1),
fib(N2, F2),
F is F1 + F2.
And I try to write fibon/2, but it doesn't work:
fibon(N, [H|T]) :-
fib(N, H),
N1 is N - 1,
fibon(N1, T).
I solved it like the following:
at_the_end(X, [], [X]).
at_the_end(X, [H|T], [H|T2]) :-
at_the_end(X, T, T2).
revert([], []).
revert([H|T], Out) :-
revert(T, Out1),
at_the_end(H, Out1, Out).
fib(0, 0).
fib(1, 1).
fib(N, F) :-
N > 1,
N1 is N - 1,
N2 is N - 2,
fib(N1, F1),
fib(N2, F2),
F is F1 + F2.
fibon(0, [0]).
fibon(N, [H|T]) :-
fib(N, H),
N1 is N - 1,
fibon(N1, T).
fibonacci(In, Out) :-
fibon(In, Out1),
revert(Out1, Out).
You can squeeze out a little more speed by making the recursive predicate tail recursive:
fib_seq(0,[0]). % <- base case 1
fib_seq(1,[0,1]). % <- base case 2
fib_seq(N,Seq) :-
N > 1,
fib_seq_(N,SeqR,1,[1,0]), % <- actual relation (all other cases)
reverse(SeqR,Seq). % <- reverse/2 from library(lists)
fib_seq_(N,Seq,N,Seq).
fib_seq_(N,Seq,N0,[B,A|Fs]) :-
N > N0,
N1 is N0+1,
C is A+B,
fib_seq_(N,Seq,N1,[C,B,A|Fs]). % <- tail recursion
First let's observe that your example query works as expected:
?- fib_seq(6,L).
L = [0, 1, 1, 2, 3, 5, 8] ;
false.
Note that the list doesn't have six elements, as in your example at the beginning of your post, but seven. This is because the predicate starts counting at zero (BTW this is the same behaviour as that of the predicate fibonacci/2 that you added to your post).
For comparison (with fib/2 from #Enigmativity's post) reasons, let's either remove the goal reverse/2 from fib_seq/2 (then you'd get all solutions except N=0 and N=1 in reverse order):
?- time((fib(50000,L),false)).
% 150,001 inferences, 0.396 CPU in 0.396 seconds (100% CPU, 379199 Lips)
false.
?- time((fib_seq(50000,L),false)).
% 150,002 inferences, 0.078 CPU in 0.078 seconds (100% CPU, 1930675 Lips)
false.
Or leave fib_seq/2 as it is and measure fib/2 with an additional goal reverse/2 (then R in the fib/2 solution corresponds to L in the fib_seq/2 solution):
?- time((fib(50000,L),reverse(L,R),false)).
% 200,004 inferences, 0.409 CPU in 0.409 seconds (100% CPU, 488961 Lips)
false.
?- time((fib_seq(50000,L),false)).
% 200,005 inferences, 0.088 CPU in 0.088 seconds (100% CPU, 2267872 Lips)
false.
On a side note, I would urge you to compare your predicate fibonacci/2 with the posted solutions when trying to get bigger lists, say N > 30.
If you're happy to reverse the order of the results for the sequence then this works:
fib(0, [0]).
fib(1, [1,0]).
fib(N, [R,X,Y|Zs]) :-
N > 1,
N1 is N - 1,
fib(N1, [X,Y|Zs]),
R is X + Y.
Then ?- fib(15,Z). gives me [610, 377, 233, 144, 89, 55, 34, 21, 13, 8, 5, 3, 2, 1, 1, 0].
It would be easy to throw in a reverse/3 predicate:
reverse([],Z,Z).
reverse([H|T],Z,A) :- reverse(T,Z,[H|A]).
Just for fun using scanl. and some standard dcgs.
:-use_module(library(clpfd)).
my_plus(X,Y,Z):-
Z#>=0,
Z#=<1000, % Max size optional
Z#=X+Y.
list([]) --> [].
list([L|Ls]) --> [L], list(Ls).
concatenation([]) --> [].
concatenation([List|Lists]) -->
list(List),
concatenation(Lists).
fib(Len,List1):-
X0=1,
length(List1,Len),
length(End,2),
MiddleLen #= Len - 3,
length(Middle,MiddleLen),
phrase(concatenation([[X0],Middle,End]), List1),
phrase(concatenation([[X0],Middle]), List2),
phrase(concatenation([Middle,End]), List3),
scanl(my_plus,List2,X0,List3).
If you want to collect a list of the first N elements of the Fibonacci series you can use the rule below. Just remember to initialize the first 2 predicates.
fib(0, [1]).
fib(1, [1, 1]).
fib(N, L) :-
N > 1,
N1 is N - 1,
N2 is N - 2,
fib(N1, F1),
last(F1, L1),
fib(N2, F2),
last(F2, L2),
L_new is L1 + L2,
append(F1, [L_new], L).
Here's an outline of my SWI-Prolog program:
:- use_module(library(clpfd)).
consec1(L) :-
L=[L1,L2,L3,L4,L5,L6,L7,L8,L9],
L ins 1..9,
...,
abs(L5-L4)#=1,
all_different(L),
labeling([],L)
abs(L5-L4)#=1 makes L5 and L4 next to each other. If I wanted to make three numbers next to each other e.g. L3, L4 and L5, how could I use reified constraints to do this?
E.g. L3=4,L5=5,L4=6 or L4=7,L5=8,L3=9
This implements consecutive in the sense you gave in the comments. For a list of N values, we need space enough to make all the values fit in between, and all values need to be different.
consecutive([]). % debatable case
consecutive(Xs) :-
Xs = [_|_],
length(Xs, N),
all_different(Xs),
max_of(Max, Xs),
min_of(Min, Xs),
Max-Min #= N-1.
max_of(Max, [Max]).
max_of(Max0, [E|Es]) :-
Max0 #= max(E,Max1),
max_of(Max1, Es).
min_of(Min, [Min]).
min_of(Min0, [E|Es]) :-
Min0 #= min(E, Min1),
min_of(Min1, Es).
TL;DR: too long for a comment: play-time with specialized sicstus-prolog clpfd constraints
This answer follows up this previous answer; recent versions of SICStus Prolog offer specialized clpfd constraints maximum/2 and minimum/2 as alternatives to min_of/2 and max_of/2.
Using the following code for benchmarking1,2 ...
:- use_module(library(clpfd)).
:- use_module(library(between)).
bench_(How, N, Ub) :-
\+ \+ ( length(Xs, N),
domain(Xs, 1, Ub),
all_different(Xs),
Max-Min #= N-1,
( How = 0
; How = min_of , max_of( Max, Xs), min_of( Min, Xs)
; How = minimum, maximum(Max, Xs), minimum(Min, Xs)
),
labeling([enum], Xs) ).
... we run the following tests:
To estimate worst-case overhead of min/max constraint:
?- member(How, [0,v1,v2]), call_time(bench_(How,10,10), T_ms).
How = 0 , T_ms = 5910
; How = v1, T_ms = 19560
; How = v2, T_ms = 7190.
To measure the runtime costs of propagating min/max constraints in more typical cases:
?- between(6, 8, N), NN #= N+N, call_time(bench_(v1,N,NN),T_ms).
N = 6, NN = 12, T_ms = 50
; N = 7, NN = 14, T_ms = 300
; N = 8, NN = 16, T_ms = 2790.
?- between(6, 8, N), NN #= N+N, call_time(bench_(v2,N,NN),T_ms).
N = 6, NN = 12, T_ms = 20
; N = 7, NN = 14, T_ms = 100
; N = 8, NN = 16, T_ms = 830.
In both "use cases", the specialized constraints give impressive speedup.
Footnote 1: Using SICStus Prolog version 4.3.2 (64-bit).
Footnote 2: Answer sequences were post-processed to improve appearance.
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.
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.