Efficient Fibonacci in Prolog - prolog

I am trying to implement a Fibonacci predicate that can be efficiently used with CLP.
:- module(fibonacci, [fibonacci/2]).
fibonacci(N, F) :-
( var(N) ; integer(N) ),
( var(F) ; integer(F) ),
( var(F) ->
( integer(N) ->
fib_1(N, F), !
; fib_3(0, N, F)
)
; ( integer(N) ->
fib_1(N, F0), F0 = F, !
; fib_2(0, F, N0), N0 = N, !
)
).
fib_3(I, J, F) :-
( I = J, fib_1(I, F) ) ;
( I1 is I + 1, fib_3(I1, J, F) ).
fib_2(I, F, J) :-
fib_1(I, F0),
( F = F0 ->
J = I, !
; ( F0 > F -> !, fail
; I1 is I + 1,
fib_2(I1, F, J)
)
).
fib_1(0, 0).
fib_1(1, 1).
fib_1(2, 1).
fib_1(N, F) :-
var(F),
N > 2,
( N mod 2 =:= 0 ->
N0 is div(N, 2),
N1 is N0 + 1,
fib_1(N0, F0),
fib_1(N1, F1),
F is F0 * (2 * F1 - F0)
; N0 is div(N + 1, 2),
N1 is N0 - 1,
fib_1(N0, F0),
fib_1(N1, F1),
F is F0 * F0 + F1 * F1
).
This is not the prettiest code, but it does what I want it to do.
?- fibonacci(A, 10).
false.
?- fibonacci(A, 13).
A = 7.
?- fibonacci(12, A).
A = 144.
?- fibonacci(12, 144).
true.
?- fibonacci(12, 145).
false.
?- fibonacci(A, B).
A = B, B = 0 ;
A = B, B = 1 ;
A = 2,
B = 1 ;
A = 3,
B = 2 ;
A = 4,
B = 3 ;
A = B, B = 5 .
What's the magic potion that is missing for this query to work:
fibonacci(_, B), B #< 1000
Is it rectifiable at all, or is CLP a completely different beast altogether, and every predicate that is CLP-compatible needs to understand more than just integers and vars?

You should avoid using ! within an algorithm that uses clp(FD) as they don't mix well. Also if-then-else may backfire too. I'd also keep an eye on using var/1 within an algorithm that uses clp.
Here goes a solution that uses clp(FD) and accumulators to avoid double recursion:
fibonacci(0, 0).
fibonacci(1, 1).
fibonacci(N, F):-
N #> 1,
zcompare(C, 2, N),
fibonacci(C, 2, N, 0, 1, F).
fibonacci(=, N, N, F1, F2, F):-
F #= F1+F2.
fibonacci(<, N0, N, F1, F2, F):-
N1 #= N0+1,
F3 #= F1+F2,
F #> F3,
zcompare(C, N1, N),
fibonacci(C, N1, N, F2, F3, F).
Also for the test you should issue the constraint over the expected number before calling fibonacci/2. So instead of fibonacci(_, B), B #< 1000. use B #< 1000, fibonacci(_, B).
sample runs:
?- fibonacci(10, F).
F = 55.
?- B #< 1000, fibonacci(_, B).
B = 0 ;
B = 1 ;
B = 1 ;
B = 2 ;
B = 3 ;
B = 5 ;
B = 8 ;
B = 13 ;
B = 21 ;
B = 34 ;
B = 55 ;
B = 89 ;
B = 144 ;
B = 233 ;
B = 377 ;
B = 610 ;
B = 987 ;
false.

Related

Finding the minimum value out of all the outcomes of a predicate

I have the following predicates:
slow(a , 10 , b).
slow(b , 17 , c).
slow(c , 12 , d).
slow(d , 19 , e).
slow(e , 13 , f).
fast(a , 20 , c).
fast(b , 20 , d).
fast(d , 20 , f).
line(X,T,Y) :- slow(X,T,Y).
line(X,T,Y) :- fast(X,T,Y).
journey(X,N,Z) :-
line(X,L,Y),
journey(Y,M,Z),
N is L+M.
journey(X,0,X) :-
!.
I now need to create a new predicate of 2arity to find the minimum value of N defined in the journey predicate.
I've so far defined the new predicate as:
minimum(X,Y) :-
journey(X,N,Y),
write(N).
I've tried to use findall/3 and bagof/3 to make a list and find the minimum atom of that list, but I am not sure how to use them.
I'm not sure how else to go about it, so any advice would be greatly appreciated.
Thanks
(First, remove the !)
?- journey(A,N,B), false.
false. % your definition always terminates, good
?- journey(A,N,B), \+ ( journey(A,M,B), M < N ).
A = a, N = 49, B = e
; A = a, N = 50, B = f
; A = a, N = 30, B = d
; A = a, N = 10, B = b
; A = b, N = 17, B = c
; A = c, N = 31, B = e
; ... .
?- setof(N,journey(A,N,B),[N|_]).
N = 0, A = B
; N = 10, A = a, B = b
; N = 20, A = a, B = c
; N = 30, A = a, B = d
; N = 49, A = a, B = e
; N = 50, A = a, B = f
; N = 17, A = b, B = c
; ... .
?- setof(N,journey(A,N,B),[N|_]), journey(A,N,B).
... . % same as above but in general safer

How to debug non-termination

I'm trying to implement n_factors/2 predicate that works in all directions.
:- use_module(library(clpz)).
n_factors(N, Fs) :-
integer(N),
N > 1,
primes(Ps),
n_factors0(N, Fs, Ps),
!.
n_factors(N, Fs) :-
var(N),
primes(Ps),
N #> 1,
above(2, N),
n_factors0(N, Fs, Ps).
above(I, I).
above(I, N) :- I1 is I + 1, above(I1, N).
n_factors0(N, [F|Fs], [P|Ps]) :-
N #> 1,
F #=< N,
P #=< N,
( P * P #> N ->
F = N, Fs = []
; ( N #= N1 * P ->
F #= P, n_factors0(N1, Fs, [P|Ps])
; F #> P, n_factors0(N, [F|Fs], Ps)
)
).
When I am issuing the following query I get:
?- C #> 6, C #< 12, n_factors(A, [B,C]).
C = 7, A = 14, B = 2
; C = 7, A = 21, B = 3
; C = 11, A = 22, B = 2
; C = 11, A = 33, B = 3
; C = 7, A = 35, B = 5
; C = 7, A = 49, B = 7
; C = 11, A = 55, B = 5
; C = 11, A = 77, B = 7
; C = 11, A = 121, B = 11
;
before the program moves on to exploring the realm of rather large numbers. So the question I've go is the following: knowing for certain that the mathematical problem is constraint enough to terminate, how do I find the missing constraint in my program? What I am doing right now is staring at the screen before trying to add "invariant" conditions here and there and see if they help.
primes(Ps) is a "frozen" infinite list with all prime numbers. I don't think the implementation thereof is important for this question but just in case
primes(Ps) :-
Ps = [2,3|T],
primes0(5, Ps, Ps, T),
!.
primes0(C, [D|Ds], Ps, T) :-
( D * D > C ->
T = [C|T1], C1 is C + 2, freeze(T1, primes0(C1, Ps, Ps, T1))
; ( C mod D =:= 0 ->
C1 is C + 2, primes0(C1, Ps, Ps, T)
; primes0(C, Ds, Ps, T)
)
).

How can labeling/2 generate solutions starting from the midpoint of a domain?

Having a list with independent variables, whose domain is 1..N, how can we use labeling/2 so it starts producing solutions starting from the middle?
The flags i tried are [bisect], [enum], [max], [min], [ff], but no matter which i picked, i can't make it work.
My code is:
:-use_module(library(clpfd)).
combos(EMPLOYEES,POSTS,LIST):-
LIMIT is POSTS-EMPLOYEES+1,
length(LIST,EMPLOYEES),
LIST ins 1..LIMIT,
sum(LIST,#=,POSTS),
labeling([bisect],LIST).
after setting a query, for example:
?-combos(2,10,LIST).
i want it to return:
L = [5,5];
L = [4,6];
L = [6,4] ...
instead of:
L = [1,9];
L = [2,8];
L = [3,7] ...
As a rule of thumb, whenever you try to extend the functionality of clpfd, try to reuse as much as possible. It seems that you want solutions first whose sum of distances to the center is as small as possible.
combos2(EMPLOYEES,POSTS,LIST):-
LIMIT is POSTS-EMPLOYEES+1,
length(LIST,EMPLOYEES),
LIST ins 1..LIMIT,
sum(LIST,#=,POSTS),
Mid is (LIMIT+1) div 2, %%
maplist(dist(Mid), LIST, DISTS), %%
sum(DISTS,#=,Totaldist), %%
labeling([],[Totaldist|LIST]).
dist(Mid, E, D) :-
D #= abs(Mid-E).
?- combos2(2,10,L).
L = [5,5]
; L = [4,6]
; L = [6,4]
; L = [3,7]
; L = [7,3]
; ... .
Here you go!
combos(2,S,L) :- b2(S,L).
combos(C,S,[A|L]) :-
C > 2,
b2(S,[A,B]),
D is C-1,
combos(D,B,L).
b2(S,L) :- B is S-1, bisector(B,L).
bisector(Y,[A,B]) :-
odd(Y),
M is div(1+Y,2),
Z is M-1,
range(D,0,Z),
bisec1(D,M,A,B).
bisector(Y,[A,B]) :-
even(Y),
M is 1+Y,
Z is Y/2-1,
range(D,0,Z),
bisec2(D,M,A,B).
bisec1(0,M,M,M).
bisec1(D,M,A,B) :- D > 0, A is M + D, A > 0, B is M - D, B > 0.
bisec1(D,M,A,B) :- D > 0, A is M - D, A > 0, B is M + D, B > 0.
bisec2(D,M,A,B) :- A is (M+2*D+1)/2, A > 0, B is (M-2*D-1)/2, B > 0.
bisec2(D,M,A,B) :- A is (M-2*D-1)/2, A > 0, B is (M+2*D+1)/2, B > 0.
even(X) :- 0 is mod(X, 2).
odd(X) :- 1 is mod(X, 2).
range(M,M,_).
range(X,M,N) :- P is M + 1, P =< N, range(X,P,N).

Calculating Cousin Relationship in Prolog

I am trying to calculate cousin relationship in the format P'th cousin Qth removed. For example, In this picture below,
Thomas and Zack are cousins twice removed.
Thomas and Nikolay are second cousins once removed
Thomas and Saul are third cousins zero'th removed
So far I have a code like this that, finds the cousins:
ancestor(X,Z):-parent(X,Z).
ancestor(X,Z):-parent(X,Y), ancestor(Y,Z).
cousins(Child1, Child2) :-
ancestor(Y1,Child1),
ancestor(Y1,Child2),
Child1 \= Child2.
My logic is as long as Child1 and Child2 shares a common ancestor they are cousins.
The issue I am having is in trying to find out whether they are first cousins, or second cousins, or third cousins etc and whether they are once removed, twice removed, or thrice removed.
Any suggestion or hints on how I could solve this problem would be greatly helpful.
Thanks!
I think I got this right.
You will need the CLP(FD) library to make this work.
Simply write :- use_module(library(clpfd)). at the beginning of your program.
cousins_nth_removed/4
The first two arguments are atoms representing the persons' names. The third argument (in [1,sup)) represents the first/second/third/... cousins relationship, while the fourth argument (in [0,sup)) represents the zeroth/once/twice/... removed relationship
cousins_nth_removed(C1, C2, 1, 0) :- % First cousins, zeroth removed
dif(C1, C2),
dif(P1, P2), % They have different parents
parent_child(P1, C1),
parent_child(P2, C2),
parent_child(GP, P1), % Their parents have the same parent GP
parent_child(GP, P2).
cousins_nth_removed(C1, C2, N, 0) :- % Nth cousins, zeroth removed
N #> 1,
dif(C1, C2),
children_removed_ancestor(C1, C2, R, R), % They are both R generations away from
dif(P1, P2), % their oldest common ancestor
parent_child(P1, C1),
parent_child(P2, C2),
M #= N - 1, % Their parents are N-1th cousins
cousins_nth_removed(P1, P2, M, 0). % zeroth removed
cousins_nth_removed(C1, C2, N, R) :- % Nth cousins, Rth removed
R #> 0,
dif(C1, C2),
children_removed_ancestor(C1, C2, R1, R2), % R is the difference of the distances
R #= abs(R2 - R1), % between each cousin and their oldest
S #= R - 1, % common ancestor
( R1 #= R2, % R = 0 -> Zeroth removed, second rule
cousins_nth_removed(C1, C2, N, 0)
; R1 #> R2, % C1 is younger than C2
parent_child(P1, C1), % -> C2 is Nth cousin R-1th removed
cousins_nth_removed(P1, C2, N, S) % with the parent of C1
; R1 #< R2, % C2 is younger than C1
parent_child(P2, C2), % -> C1 is Nth cousin R-1th removed
cousins_nth_removed(C1, P2, N, S) % with the parent of C2
).
children_removed_ancestor/4
The name isn't ideal, but this predicate is basically used to retrieve the generation gaps of two persons to their oldest common ancestor.
children_removed_ancestor(C1, C2, R1, R2) :-
child_removed_oldest_ancestor(C1, R1, A),
child_removed_oldest_ancestor(C2, R2, A).
child_removed_oldest_ancestor/3
This predicate retrieves the generation gap between a person and their oldest ancestor.
child_removed_oldest_ancestor(C, 0, C) :- % The ancestor of all
\+ parent_child(_, C). % They have no parent
child_removed_oldest_ancestor(C, N, A) :-
N #> 0,
parent_child(P, C),
M #= N - 1,
child_removed_oldest_ancestor(P, M, A).
Some queries
?- cousins_nth_removed(thomas, zack, N, R). % Your example
N = 1,
R = 2 ;
false.
?- cousins_nth_removed(thomas, nikolay, N, R). % Your example
N = 2,
R = 1 ;
false.
?- cousins_nth_removed(thomas, saul, N, R). % Your example
N = 3,
R = 0 ;
false.
?- cousins_nth_removed(thomas, C, N, R). % All cousins of thomas
C = farah,
N = 1,
R = 0 ;
C = ping,
N = 2,
R = 0 ;
C = william,
N = 3,
R = 0 ;
C = saul,
N = 3,
R = 0 ;
C = sean,
N = R, R = 1 ;
C = steven,
N = R, R = 1 ;
C = zack,
N = 1,
R = 2 ;
C = kyle,
N = 2,
R = 1 ;
C = nikolay,
N = 2,
R = 1 ;
C = wei,
N = 2,
R = 1 ;
false.
?- cousins_nth_removed(C1, C2, 3, 0). % All third cousins zeroth removed
C1 = ping,
C2 = william ;
C1 = ping,
C2 = saul ;
C1 = farah,
C2 = william ;
C1 = farah,
C2 = saul ;
C1 = ignat,
C2 = william ;
C1 = ignat,
C2 = saul ;
C1 = thomas,
C2 = william ;
C1 = thomas,
C2 = saul ;
C1 = william,
C2 = ping ;
C1 = william,
C2 = farah ;
C1 = william,
C2 = ignat ;
C1 = william,
C2 = thomas ;
C1 = saul,
C2 = ping ;
C1 = saul,
C2 = farah ;
C1 = saul,
C2 = ignat ;
C1 = saul,
C2 = thomas ;
false.
Overall program
:- use_module(library(clpfd)).
parent_child(leila,min).
parent_child(leila,seema).
parent_child(min,ali).
parent_child(min,jesse).
parent_child(min,john).
parent_child(ali,sean).
parent_child(ali,steven).
parent_child(sean,ping).
parent_child(jesse,dallas).
parent_child(jesse,mustafa).
parent_child(dallas,farah).
parent_child(mustafa,ignat).
parent_child(mustafa,thomas).
parent_child(seema,zack).
parent_child(zack,kyle).
parent_child(zack,nikolay).
parent_child(zack,wei).
parent_child(kyle,william).
parent_child(nikolay,saul).
cousins_nth_removed(C1, C2, 1, 0) :-
dif(C1, C2),
dif(P1, P2),
parent_child(P1, C1),
parent_child(P2, C2),
parent_child(GP, P1),
parent_child(GP, P2).
cousins_nth_removed(C1, C2, N, 0) :-
N #> 1,
dif(C1, C2),
children_removed_ancestor(C1, C2, R, R),
dif(P1, P2),
parent_child(P1, C1),
parent_child(P2, C2),
M #= N - 1,
cousins_nth_removed(P1, P2, M, 0).
cousins_nth_removed(C1, C2, N, R) :-
R #> 0,
dif(C1, C2),
children_removed_ancestor(C1, C2, R1, R2),
R #= abs(R2 - R1),
S #= R - 1,
( R1 #= R2,
cousins_nth_removed(C1, C2, N, 0)
; R1 #> R2,
parent_child(P1, C1),
cousins_nth_removed(P1, C2, N, S)
; R1 #< R2,
parent_child(P2, C2),
cousins_nth_removed(C1, P2, N, S)
).
children_removed_ancestor(C1, C2, R1, R2) :-
child_removed_oldest_ancestor(C1, R1, A),
child_removed_oldest_ancestor(C2, R2, A).
child_removed_oldest_ancestor(C, 0, C) :-
\+ parent_child(_, C).
child_removed_oldest_ancestor(C, N, A) :-
N #> 0,
parent_child(P, C),
M #= N - 1,
child_removed_oldest_ancestor(P, M, A).
I now hate genealogical trees.

Inverse factorial in Prolog

Can someone helping me to find a way to get the inverse factorial in Prolog...
For example inverse_factorial(6,X) ===> X = 3.
I have been working on it a lot of time.
I currently have the factorial, but i have to make it reversible. Please help me.
Prolog's predicates are relations, so once you have defined factorial, you have implicitly defined the inverse too. However, regular arithmetics is moded in Prolog, that is, the entire expression in (is)/2 or (>)/2 has to be known at runtime, and if it is not, an error occurs. Constraints overcome this shortcoming:
:- use_module(library(clpfd)).
n_factorial(0, 1).
n_factorial(N, F) :-
N #> 0, N1 #= N - 1, F #= N * F1,
n_factorial(N1, F1).
This definition now works in both directions.
?- n_factorial(N,6).
N = 3
; false.
?- n_factorial(3,F).
F = 6
; false.
Since SICStus 4.3.4 and SWI 7.1.25 also the following terminates:
?- n_factorial(N,N).
N = 1
; N = 2
; false.
See the manual for more.
For reference, here is the best implementation of a declarative factorial predicate IĀ could come up with.
Two main points are different from #false's answer:
It uses an accumulator argument, and recursive calls increment the factor we multiply the factorial with, instead of a standard recursive implementation where the base case is 0. This makes the predicate much faster when the factorial is known and the initial number is not.
It uses if_/3 and (=)/3 extensively, from module reif, to get rid of unnecessary choice points when possible. It also uses (#>)/3 and the reified (===)/6 which is a variation of (=)/3 for cases where we have two couples that can be used for the if -> then part of if_.
factorial/2
factorial(N, F) :-
factorial(N, 0, 1, F).
factorial(N, I, N0, F) :-
F #> 0,
N #>= 0,
I #>= 0,
I #=< N,
N0 #> 0,
N0 #=< F,
if_(I #> 2,
( F #> N,
if_(===(N, I, N0, F, T1),
if_(T1 = true,
N0 = F,
N = I
),
( J #= I + 1,
N1 #= N0*J,
factorial(N, J, N1, F)
)
)
),
if_(N = I,
N0 = F,
( J #= I + 1,
N1 #= N0*J,
factorial(N, J, N1, F)
)
)
).
(#>)/3
#>(X, Y, T) :-
zcompare(C, X, Y),
greater_true(C, T).
greater_true(>, true).
greater_true(<, false).
greater_true(=, false).
(===)/6
===(X1, Y1, X2, Y2, T1, T) :-
( T1 == true -> =(X1, Y1, T)
; T1 == false -> =(X2, Y2, T)
; X1 == Y1 -> T1 = true, T = true
; X1 \= Y1 -> T1 = true, T = false
; X2 == Y2 -> T1 = false, T = true
; X2 \= Y2 -> T1 = false, T = false
; T1 = true, T = true, X1 = Y1
; T1 = true, T = false, dif(X1, Y1)
).
Some queries
?- factorial(N, N).
N = 1 ;
N = 2 ;
false. % One could probably get rid of the choice point at the cost of readability
?- factorial(N, 1).
N = 0 ;
N = 1 ;
false. % Same
?- factorial(10, N).
N = 3628800. % No choice point
?- time(factorial(N, 93326215443944152681699238856266700490715968264381621468592963895217599993229915608941463976156518286253697920827223758251185210916864000000000000000000000000)).
% 79,283 inferences, 0.031 CPU in 0.027 seconds (116% CPU, 2541106 Lips)
N = 100. % No choice point
?- time(factorial(N, 93326215443944152681699238856266700490715968264381621468592963895217599993229915608941463976156518284253697920827223758251185210916864000000000000000000000000)).
% 78,907 inferences, 0.031 CPU in 0.025 seconds (125% CPU, 2529054 Lips)
false.
?- F #> 10^100, factorial(N, F).
F = 11978571669969891796072783721689098736458938142546425857555362864628009582789845319680000000000000000,
N = 70 ;
F = 850478588567862317521167644239926010288584608120796235886430763388588680378079017697280000000000000000,
N = 71 ;
F = 61234458376886086861524070385274672740778091784697328983823014963978384987221689274204160000000000000000,
N = 72 ;
...
a simple 'low tech' way: enumerate integers until
you find the sought factorial, then 'get back' the number
the factorial being built is greater than the target. Then you can fail...
Practically, you can just add 2 arguments to your existing factorial implementation, the target and the found inverse.
Just implement factorial(X, XFact) and then swap arguments
factorial(X, XFact) :- f(X, 1, 1, XFact).
f(N, N, F, F) :- !.
f(N, N0, F0, F) :- succ(N0, N1), F1 is F0 * N1, f(N, N1, F1, F).

Resources