I am trying to solve a puzzle in Prolog that involves taking a square of numbers (a list of a list of numbers) and returning the list of the greatest combination of numbers starting at the top and going down, row by row. Each move must be either down, down to the right, or down to the left.
I've been trying to do this for a while now, does anyone have a place I could begin?
For example, on the board
[[0, 2, 1, 0],
[0, 1, 1, 0],
[0,10,20,30]]
the best move would be [1, 2, 3] for 33 points.
So here is how you could do it. I know it's kinda wordy, that probably is because I'm not really fluent in Prolog either...
% Lookup a value in a list by it's index.
% this should be built into prolog?
at(0, [H|_], H).
at(N, [_|T], X) :-
N > 0,
N1 is N - 1,
at(N1, T, X).
% like Haskell's maximumBy; takes a predicate, a
% list and an initial maximum value, finds the
% maximum value in a list
maxby(_, [], M, M).
maxby(P, [H|T], M0, M) :-
call(P, H, M0, M1),
maxby(P, T, M1, M).
% which of two paths has the bigger score?
maxval(path(C, I), path(C1, _), path(C, I)) :- C >= C1.
maxval(path(C0, _), path(C, I), path(C, I)) :- C0 < C.
% generate N empty paths as a starting value for
% our search
initpaths(N, Ps) :-
findall(path(0, []),
between(0, N, _),
Ps).
% given the known best paths to all indexes in the previous
% line and and index I in the current line, select the best
% path leading to I.
select(Ps, I, N, P) :-
I0 is I-1,
I1 is I+1,
select(Ps, I0, N, path(-1, []), P0),
select(Ps, I, N, P0, P1),
select(Ps, I1, N, P1, P).
% given the known best paths to the previous line (Ps),
% an index I and a preliminary choice P0, select the path
% leading to the index I (in the previous line) if I is within
% the range 0..N and its score is greater than the preliminary
% choice. Stay with the latter otherwise.
select(_, I, _, P0, P0) :- I < 0.
select(_, I, N, P0, P0) :- I > N.
select(Ps, I, _, P0, P) :-
at(I, Ps, P1),
maxby(maxval, [P0], P1, P).
% given the known best paths to the previous line (P1),
% and a Row, which is the current line, extend P1 to a
% new list of paths P indicating the best paths to the
% current line.
update(P1, P, Row, N) :-
findall(path(C, [X|Is]),
( between(0, N, X)
, select(P1, X, N, path(C0, Is))
, at(X, Row, C1)
, C is C0 + C1),
P).
% solve the puzzle by starting with a list of empty paths
% and updating it as long as there are still more rows in
% the square.
solve(Rows, Score, Path) :-
Rows = [R|_],
length(R, N0),
N is N0 - 1,
initpaths(N, IP),
solve(N, Rows, IP, Score, Path).
solve(_, [], P, Score, Path) :-
maxby(maxval, P, path(-1, []), path(Score, Is0)),
reverse(Is0, Path).
solve(N, [R|Rows], P0, Score, Path) :-
update(P0, P1, R, N),
solve(N, Rows, P1, Score, Path).
Shall we try it out? Here are your examples:
?- solve([[0,2,1,0], [0,1,1,0], [0,10,20,30]], Score, Path).
Score = 33,
Path = [1, 2, 3] ;
false.
?- solve([[0,1,1], [0,2,1], [10,0,0]], Score, Path).
Score = 13,
Path = [1, 1, 0] ;
false.
My prolog is a bit shaky. In fact all I remember about prolog is that it's declarative.
Here is some haskell code to find the value of the max path. Finding the trace should be an easy next step, but a bit more complicated to code up I imagine. I suppose a very elegant solution for the trace would be using monads.
maxValue :: [ [ Int ] ] -> Int
maxValue p = maximum $ maxValueHelper p
maxValueHelper :: [ [ Int ] ] -> [ Int ]
maxValueHelper [ row ] = row
maxValueHelper ( row : restOfRows ) = combine row ( maxValueHelper restOfRows )
combine :: [ Int ] -> [ Int ]-> [ Int ]
combine [ x ] [ y ] = [ x + y ]
combine ( x1 : x2 : lx ) ( y1 : y2 : ly ) =
let ( z2 : lz ) = combine ( x2 : lx ) ( y2 : ly )
in
( max ( x1 + y1 ) ( x1 + y2 ) : max ( x2 + y1 ) z2 : lz )
main :: IO()
main = print $ maxValue [[0,2,1,0], [0,1,1,0], [0,10,20,30]]
?- best_path_score([[0, 2, 1, 0],[0, 1, 1, 0],[0,10,20,30]], P, S).
P = [1, 2, 3],
S = 33.
with this definition
best_path_score(Rs, BestPath, BestScore) :-
aggregate_all(max(Score, Path), a_path(Rs, Path, Score), max(BestScore, BestPath)).
a_path([R|Rs], [P|Ps], Score) :-
nth0(P, R, S0),
a_path(Rs, P, Ps, S),
Score is S0 + S.
a_path([], _, [], 0).
a_path([R|Rs], P, [Q|Qs], T) :-
( Q is P - 1 ; Q is P ; Q is P + 1 ),
nth0(Q, R, S0),
a_path(Rs, Q, Qs, S),
T is S0 + S.
Related
I have this code to generate a list of the Fibonacci sequence in reverse order.
fib2(0, [0]).
fib2(1, [1,0]).
fib2(N, [R,X,Y|Zs]) :-
N > 1,
N1 is N - 1,
fib2(N1, [X,Y|Zs]),
R is X + Y.
I only need the first element though. The problem is that this code also gives out a false. after the list, so all my attempts at getting the first element have failed. Is there any way I can get that first element in the list, or any other way of calculating the Nth Fibonacci number with accumulators.
Thanks in advance.
I got this logarithmic steps O(log n) solution, and even tail recursive.
Just for fun, it can also compute the n-th Lucas number:
<pre id="in">
fib(N, X) :-
powmat(N, [[0,1],[1,1]], [[1,0],[0,1]],
[[_,X],[_,_]]).
luc(N, Z) :-
powmat(N, [[0,1],[1,1]], [[1,0],[0,1]],
[[X,Y],[_,_]]), Z is 2*X+Y.
powmat(0, _, R, R) :- !.
powmat(N, A, R, S) :- N rem 2 =\= 0, !,
mulmat(A, R, H), M is N//2, mulmat(A, A, B), powmat(M, B, H, S).
powmat(N, A, R, S) :-
M is N//2, mulmat(A, A, B), powmat(M, B, R, S).
mulmat([[A11,A12],[A21,A22]],
[[B11,B12],[B21,B22]],
[[C11,C12],[C21,C22]]) :-
C11 is A11*B11+A12*B21,
C12 is A11*B12+A12*B22,
C21 is A21*B11+A22*B21,
C22 is A21*B12+A22*B22.
?- fib(100,X).
?- luc(100,X).
</pre>
<script src="http://www.dogelog.ch/lib/exchange.js"></script>
You can compare with:
https://www.wolframalpha.com/input/?i=Fibonacci[100]
https://www.wolframalpha.com/input/?i=LucasN[100]
Edit 28.06.2021:
Here is a very quick explanation why the matrix algorithm works.
We only need to show that one step of Fibonacci is linear. Namely
that this recurrence relation leads to linear matrix:
F_{n+2} = F_{n}+F_{n+1}
To see the matrix, we have to assume that the matrix M, transforms a vector b=[Fn,Fn+1] into a vector b'=[F_{n+1}, F_{n+2}]:
b' = M*b
What could this matrix be? Just solve it:
|F_{n+1}| |0*F_{n}+1*F_{n+1}| |0 1| |F_{n} |
| | = | | = | | * | |
|F_{n+2}| |1*F_{n}+1*F_{n+1}| |1 1| |F_{n+1}|
It gives out a "false" because Prolog is unsure whether there are more solutions after the first one it provides:
?- fib2(4,L).
L = [3,2,1,1,0] ; % maybe more solutions?
false. % no
This is not a problem: You can tell Prolog that there are indeed no more solutions after the first one (or that you are not interested in seeing them):
?- once(fib2(4,L)).
or
?- fib2(4,L),!.
or you can cut in each of the first clauses, telling Prolog that if the head matches, there is no point trying another clause. This gets rid of the stray "possible solution":
fib2(0, [0]) :- !.
fib2(1, [1,0]) :- !.
fib2(N, [R,X,Y|Zs]) :-
N > 1,
N1 is N - 1,
fib2(N1, [X,Y|Zs]),
R is X + Y.
What may be a problem is that the given algorithm stores all the fib(i) and performs an addition after the recursive call, which means that Prolog cannot optimize the recursive call into a loop.
For the "accumulator-based" (bottom-up) way of computing fib(N):
% -------------------------------------------------------------
% Proceed bottom-up, without using any cache, or rather a cache
% consisting of two additional arguments.
%
% ?- fib_bottomup_direct(10,F).
% F = 55.
% ------------------------------------------------------------
fib_bottomup_direct(N,F) :-
N>0,
!,
const(fib0,FA),
const(fib1,FB),
up(1,N,FA,FB,F).
fib_bottomup_direct(0,F0) :-
const(fib0,F0).
% Carve the constants fib(0) and fib(1) out of the code.
const(fib0,0).
const(fib1,1).
% Tail recursive call moving "bottom up" towards N.
%
% X: the "current point of progress"
% N: the N we want to reach
% FA: the value of fib(X-1)
% FB: the value of fib(X)
% F: The variable that will receive the final result, fib(N)
up(X,N,FA,FB,F) :-
X<N, % not there yet, compute fib(X+1)
!,
FC is FA + FB,
Xn is X + 1,
up(Xn,N,FB,FC,F).
up(N,N,_,F,F).
Then:
?- fib_bottomup_direct(11,X).
X = 89.
Several more algorithms here; a README here.
This solution uses a tick less baggage, that is carried around.
The formulas are found at the end of the wiki fibmat section:
<pre id="in">
fib(N, X) :-
powvec(N, (1,0), (0,1), (X,_)).
luc(N, Z) :-
powvec(N, (1,0), (0,1), (X,Y)), Z is X+2*Y.
powvec(0, _, R, R) :- !.
powvec(N, A, R, S) :- N rem 2 =\= 0, !,
mulvec(A, R, H), M is N//2, mulvec(A, A, B), powvec(M, B, H, S).
powvec(N, A, R, S) :-
M is N//2, mulvec(A, A, B), powvec(M, B, R, S).
mulvec((A1,A2), (B1,B2), (C1,C2)) :-
C1 is A1*(B1+B2)+A2*B1,
C2 is A1*B1+A2*B2.
?- fib(100,X).
?- luc(100,X).
</pre>
<script src="http://www.dogelog.ch/lib/exchange.js"></script>
fib2(120,X), X=[H|_], !. answers your question, binding H to the head of that reversed list, so, the 120th Fibonacci number.
Just insert the head-taking goal X=[H|_] into the query. Of course if you're really not interested in the list, you can fuse the two goals into one
fib2(120,[H|_]), !.
Your code does ~ 2N steps, which is still O(N) like an accumulator version would, so, not a big deal, it's fine as it is. The real difference is the O(N) space your version takes, v. the O(1) of the accumulator's.
But if you look closely at your code,
fib2(0, [0]).
fib2(1, [1,0]).
fib2(N, [R,X,Y|Zs]) :-
N > 1,
N1 is N - 1,
fib2(N1, [X,Y|Zs]),
R is X + Y.
you realize that it creates the N-long list of uninstantiated variables on the way down to the deepest level of recursion, then calculates them while populating the list with the calculated values on the way back up -- but only ever referring to the last two Fibonacci numbers, i.e. the first two values in that list. So you might as well make it explicit, and end up with .... an accumulator-based version, yourself!
fib3(0, 0, 0).
fib3(1, 1, 0).
fib3(N, R, X) :-
N > 1,
N1 is N - 1,
fib3(N1, X, Y),
R is X + Y.
except that it's still not tail-recursive. The way to achieve that is usually with additional argument(s) and you can see such a code in another answer here, by David Tonhofer. But hopefully you now see the clear path between it and this last one right here.
Just for fun, an even faster version of Fibonacci (even without using tail recursion) is presented below:
% -----------------------------------------------------------------------
% FAST FIBONACCI
% -----------------------------------------------------------------------
ffib(N, F) :-
ff(N, [_, F]).
ff(1, [0, 1]) :- !.
ff(N, R) :-
M is N // 2,
ff(M, [A, B]),
F1 is A^2 + B^2,
F2 is 2*A*B + B^2,
( N mod 2 =:= 0
-> R = [F1, F2]
; F3 is F1 + F2,
R = [F2, F3] ).
% -----------------------------------------------------------------------
% MOSTOWSKI COLLAPSE VERSION
% -----------------------------------------------------------------------
fib(N, X) :-
powvec(N, (1,0), (0,1), (X,_)).
powvec(0, _, R, R) :- !.
powvec(N, A, R, S) :-
N rem 2 =\= 0, !,
mulvec(A, R, H),
M is N // 2,
mulvec(A, A, B),
powvec(M, B, H, S).
powvec(N, A, R, S) :-
M is N // 2,
mulvec(A, A, B),
powvec(M, B, R, S).
mulvec((A1,A2), (B1,B2), (C1,C2)) :-
C1 is A1*(B1 + B2) + A2*B1,
C2 is A1*B1 + A2*B2.
% -----------------------------------------------------------------------
% COMPARISON
% -----------------------------------------------------------------------
comparison :-
format('n fib ffib speed~n'),
forall( between(21, 29, E),
( N is 2^E,
cputime(fib( N, F1), T1),
cputime(ffib(N, F2), T2),
F1 = F2, % confirm that both versions compute same answer!
catch(R is T1/T2, _, R = 1),
format('2^~w~|~t~2f~6+~|~t~2f~6+~|~t~2f~6+~n', [E, T1, T2, R]))).
cputime(Goal, Time) :-
T0 is cputime,
call(Goal),
Time is cputime - T0.
The time complexity of both versions (mine and #MostowskiCollapse's) is O(lg n), ignoring multiplication cost.
Some simple empirical results (time in seconds) obtained with SWI-Prolog, version 8.2.4:
?- comparison.
n fib ffib speed
2^21 0.05 0.02 3.00
2^22 0.09 0.05 2.00
2^23 0.22 0.09 2.33
2^24 0.47 0.20 2.31
2^25 1.14 0.45 2.52
2^26 2.63 1.02 2.58
2^27 5.89 2.34 2.51
2^28 12.78 5.28 2.42
2^29 28.97 12.25 2.36
true.
This one uses the Golden Ratio formula:
<pre id="in">
fib(N, S) :-
powrad(N,(1,1),(1,0),(_,X)),
powrad(N,(1,-1),(1,0),(_,Y)),
S is (X-Y)//2^N.
luc(N, S) :-
powrad(N,(1,1),(1,0),(X,_)),
powrad(N,(1,-1),(1,0),(Y,_)),
S is (X+Y)//2^N.
powrad(0, _, R, R) :- !.
powrad(N, A, R, S) :- N rem 2 =\= 0, !,
mulrad(A, R, H), M is N//2, mulrad(A, A, B), powrad(M, B, H, S).
powrad(N, A, R, S) :-
M is N//2, mulrad(A, A, B), powrad(M, B, R, S).
mulrad((A,B),(C,D),(E,F)) :-
E is A*C+B*D*5,
F is A*D+B*C.
?- fib(100,X).
?- luc(100,X).
</pre>
<script src="http://www.dogelog.ch/lib/exchange.js"></script>
The Donald Knuth based Fibonacci-by-matrix multiplication approach, as provided by
Mostowski Collapse, but more explicit.
Algorithms can be found in the a module file plus a unit tests file on github:
The principle is based on a matrix identity provided by Donald Knuth (in Donald E. Knuth. The Art of Computer Programming. Volume 1. Fundamental
Algorithms, p.80 of the second edition)
For n >= 1 we have (for n=0, the identity matrix appears on the right-hand side, but it is unclear what fib(-1) is):
n
[ fib(n+1) fib(n) ] [ 1 1 ]
[ ] = [ ]
[ fib(n) fib(n-1) ] [ 1 0 ]
But if we work with constants fib(0) and fib(1) without assuming their value to be 0 and 1 respectively (we might be working with a special Fibonacci sequence), then we must stipulate that for n >= 1:
n-1
[ fib(n+1) fib(n) ] [ fib(2) fib(1) ] [ 1 1 ]
[ ] = [ ] * [ ]
[ fib(n) fib(n-1) ] [ fib(1) fib(0) ] [ 1 0 ]
We will separately compute the the "power matrix" on the right and explicitly multiply with the "fibonacci starter matrix", thus:
const(fib0,0).
const(fib1,1).
fib_matrixmult(N,F) :-
N>=1,
!,
Pow is N-1,
const(fib0,Fib0),
const(fib1,Fib1),
Fib2 is Fib0+Fib1,
matrixpow(
Pow,
[[1,1],[1,0]],
PowMx),
matrixmult(
[[Fib2,Fib1],[Fib1,Fib0]],
PowMx,
[[_,F],[F,_]]).
fib_matrixmult(0,Fib0) :-
const(fib0,Fib0).
matrixpow(Pow, Mx, Result) :-
matrixpow_2(Pow, Mx, [[1,0],[0,1]], Result).
matrixpow_2(Pow, Mx, Accum, Result) :-
Pow > 0,
Pow mod 2 =:= 1,
!,
matrixmult(Mx, Accum, NewAccum),
Powm is Pow-1,
matrixpow_2(Powm, Mx, NewAccum, Result).
matrixpow_2(Pow, Mx, Accum, Result) :-
Pow > 0,
Pow mod 2 =:= 0,
!,
HalfPow is Pow div 2,
matrixmult(Mx, Mx, MxSq),
matrixpow_2(HalfPow, MxSq, Accum, Result).
matrixpow_2(0, _, Accum, Accum).
matrixmult([[A11,A12],[A21,A22]],
[[B11,B12],[B21,B22]],
[[C11,C12],[C21,C22]]) :-
C11 is A11*B11+A12*B21,
C12 is A11*B12+A12*B22,
C21 is A21*B11+A22*B21,
C22 is A21*B12+A22*B22.
If your starter matrix is sure to be [[1,1],[1,0]] you can collapse the two operations matrixpow/3 followed by matrixmult/3 in the main predicate into a single call to matrixpow/3.
The above algorithm computes "too much" because two of the values in the matrix of Fibonacci numbers can be deduced from the other two. We can get rid of that redundancy. Mostowski Collapse presented a compact algorithm to do just that. Hereunder expanded for comprehensibility:
The idea is to get rid of redundant operations in matrixmult/3, by using the fact that all our matrices are symmetric and actually hold
Fibonacci numbers
[ fib(n+1) fib(n) ]
[ ]
[ fib(n) fib(n-1) ]
So, if we multiply matrices A and B to yield C, we always have something of this form (even in the starter case where B is the
identity matrix):
[ A1+A2 A1 ] [ B1+B2 B1 ] [ C1+C2 C1 ]
[ ] * [ ] = [ ]
[ A1 A2 ] [ B1 B2 ] [ C1 C2 ]
We can just retain the second columns of each matrix w/o loss of
information. The operation between these vectors is not some
standard operation like multiplication, let's mark it with ⨝:
[ A1 ] [ B1 ] [ C1 ]
[ ] ⨝ [ ] = [ ]
[ A2 ] [ B2 ] [ C2 ]
where:
C1 = B1*(A1+A2) + B2*A1 or A1*(B1+B2) + A2*B1
C2 = A1*B1 + A2*B2
fib_matrixmult_streamlined(N,F) :-
N>=1,
!,
Pow is N-1,
const(fib0,Fib0),
const(fib1,Fib1),
matrixpow_streamlined(
Pow,
v(1,0),
PowVec),
matrixmult_streamlined(
v(Fib1,Fib0),
PowVec,
v(F,_)).
fib_matrixmult_streamlined(0,Fib0) :-
const(fib0,Fib0).
matrixpow_streamlined(Pow, Vec, Result) :-
matrixpow_streamlined_2(Pow, Vec, v(0,1), Result).
matrixpow_streamlined_2(Pow, Vec, Accum, Result) :-
Pow > 0,
Pow mod 2 =:= 1,
!,
matrixmult_streamlined(Vec, Accum, NewAccum),
Powm is Pow-1,
matrixpow_streamlined_2(Powm, Vec, NewAccum, Result).
matrixpow_streamlined_2(Pow, Vec, Accum, Result) :-
Pow > 0,
Pow mod 2 =:= 0,
!,
HalfPow is Pow div 2,
matrixmult_streamlined(Vec, Vec, VecVec),
matrixpow_streamlined_2(HalfPow, VecVec, Accum, Result).
matrixpow_streamlined_2(0, _, Accum, Accum).
matrixmult_streamlined(v(A1,A2),v(B1,B2),v(C1,C2)) :-
C1 is A1*(B1+B2) + A2*B1,
C2 is A1*B1 + A2*B2.
Hi does anyone know other implementation to compute X at power N in Prolog beside this one:
predicates
power(real, integer, real)
clauses
power(_,0,1).
power(X,N,R):-
N<0,
N1 = -N,
X1 = 1/X,
power(X1,N1,R).
power(X,N,R):-
N1=N-1,
power(X,N1,R1),
R=R1*X.
In any case, I would treat the negative exponent with a predicate, as already given in the problem post, which is:
power(Base, N, P) :-
N < 0,
N1 is -N,
power(Base, N1, P1),
P is 1/P1.
So the following assume non-negative exponents.
This algorithm multiples the base N times:
power1(Base, N, P) :-
N > 0,
N1 is N - 1,
power1(Base, N1, P1),
P is P1 * Base.
power1(Base, N, P) :-
N < 0,
N1 is N + 1,
power1(Base, N1, P1),
P is P1 / Base.
power1( _Base, 0, 1 ).
This algorithm multiples the base N times using tail recursion:
power1t(Base, N, P) :-
N >= 0,
power1t(Base, N, 1, P).
power1t(Base, N, A, P) :-
N > 0,
A1 is A * Base,
N1 is N - 1,
power1t(Base, N1, A1, P).
power1t(_, 0, P, P).
This version uses the "power of 2" method, minimizing the multiplications:
power2(_, 0, 1).
power2(Base, N, P) :-
N > 0,
N1 is N div 2,
power2(Base, N1, P1),
( 0 is N /\ 1
-> P is P1 * P1
; P is P1 * P1 * Base
).
This version uses a "power of 2" method, minimizing multiplications, but is tail recursive. It's a little different than the one Boris linked:
power2t(Base, N, P) :-
N >= 0,
power2t(Base, N, Base, 1, P).
power2t(Base, N, B, A, P) :-
N > 0,
( 1 is N /\ 1
-> A1 is B * A
; A1 = A
),
N1 is N div 2,
B1 is B * B,
power2t(Base, N1, B1, A1, P).
power2t(_, 0, _, P, P).
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).
So I am relatively new to Prolog, and while this problem is easy in many other languages I am having a lot of trouble with it. I want to generate a List of factors for a number N. I have already built a predicate that tells me if a number is a factor:
% A divides B
% A is a factor of B
divides(A,B) :- A =\= 0, (B mod A) =:= 0.
% special case where 1 // 2 would be 0
factors(1,[1]) :- !.
% general case
factors(N,L):- N > 0, factor_list(1, N, L).
factor_list(S,E,L) :- S =< E // 2, f_list(S,E,L).
f_list(S,E,[]) :- S > E // 2, !.
f_list(S,E,[S|T]) :- divides(S,E), !, S1 is S+1, f_list(S1, E, T).
f_list(S,E,L) :- S1 is S+1, f_list(S1,E,L).
Any help would be appreciated.
EDIT
I pretty much changed my entire solution, but for some reason predicates like factors(9, [1]) return true, when I only want factors(9, [1,3]) to return true. Any thoughts?
Here's why factors(9,[1]) is true: the timing of attempted instantiations (that is to say, unifications) is off:
f_list(S,E,[]) :- S > E // 2, !.
f_list(S,E,[S|T]) :- divides(S,E), !, S1 is S+1, f_list(S1, E, T).
f_list(S,E,L) :- S1 is S+1, f_list(S1,E,L).
%% flist(1,9,[1]) -> (2nd clause) divides(1,9), S1 is 2, f_list(2,9,[]).
%% flist(2,9,[]) -> (3rd clause) S1 is 3, f_list(3,9,[]).
%% ...
%% flist(5,9,[]) -> (1st clause) 5 > 9 // 2, !.
because you pre-specify [1], when it reaches 3 the tail is [] and the match with the 2nd clause is prevented by this, though it would succeed due to divides/2.
The solution is to move the unifications out of clauses' head into the body, and make them only at the appropriate time, not sooner:
f_list(S,E,L) :- S > E // 2, !, L=[].
f_list(S,E,L) :- divides(S,E), !, L=[S|T], S1 is S+1, f_list(S1, E, T).
f_list(S,E,L) :- S1 is S+1, f_list(S1,E,L).
The above usually is written with the if-else construct:
f_list(S,E,L) :-
( S > E // 2 -> L=[]
; divides(S,E) -> L=[S|T], S1 is S+1, f_list(S1, E, T)
; S1 is S+1, f_list(S1, E, L)
).
Also you can simplify the main predicate as
%% is not defined for N =< 0
factors(N,L):-
( N =:= 1 -> L=[1]
; N >= 2 -> f_list(1,N,L)
).
Personally, I use a somewhat simpler looking solution:
factors(1,[1]):- true, !.
factors(X,[Factor1|T]):- X > 0,
between(2,X,Factor1),
NewX is X // Factor1, (X mod Factor1) =:= 0,
factors(NewX,T), !.
This one only accepts an ordered list of the factors.
Here is a simple enumeration based procedure.
factors(M, [1 | L]):- factors(M, 2, L).
factors(M, X, L):-
residue(M, X, M1),
((M==M1, L=L1); (M1 < M, L=[X|L1])),
((M1=1, L1=[]); (M1 > X, X1 is X+1, factors(M1, X1, L1))).
residue(M, X, M1):-
((M < X, M1=M);
(M >=X, MX is M mod X,
(MX=0, MM is M/X, residue(MM, X, M1);
MX > 0, M1=M))).
I'm trying to generate all possible 'ways' from one element in matrix to another, Main conditional says that Element in matrix can be connected with other only if elements share at least one corner so in that matrix
[[1,2,3]
[5,4,6]
[8,9,7]]
1 can be only conected with 2,4,5 but 4 is conected with all elements. Is it possible to represent that list as graph without using attract? Or maybe I can find out any easier way to do it
Thanks for all answers.
Ok i set forth :-)
Now with predicates I generated all 'edges' but i cannot use them anywhere, I could not figure out, how to add to accumulator(list) infomrations of each cell with such pattern ([row:R1,column:C1,value:V1], [row:R2,column:C2,value:V2]).
Here's a (long, but simple) solution to consider.
Firstly, it helps to have an auxiliary predicate to retrieve an element from the Row,Col position in a matrix as a list of lists, such as:
get_matrix_entry_nth0(RowInd, ColInd, Matrix, Entry) :-
nth0(RowInd, Matrix, Row),
nth0(ColInd, Row, Entry).
Secondly, it can also help to use this predicate to define the entries relative to ones indexed by Row and Col in terms of directions, such as:
up_left_entry(R-C, Matrix, E) :-
PrevR is R - 1,
PrevC is C - 1,
get_matrix_entry_nth0(PrevR, PrevC, Matrix, E).
up_entry(R-C, Matrix, E) :-
PrevR is R - 1,
get_matrix_entry_nth0(PrevR, C, Matrix, E).
up_right_entry(R-C, Matrix, E) :-
PrevR is R - 1,
NextC is C + 1,
get_matrix_entry_nth0(PrevR, NextC, Matrix, E).
right_entry(R-C, Matrix, E) :-
NextC is C + 1,
get_matrix_entry_nth0(R, NextC, Matrix, E).
down_right_entry(R-C, Matrix, E) :-
NextR is R + 1,
NextC is C + 1,
get_matrix_entry_nth0(NextR, NextC, Matrix, E).
down_entry(R-C, Matrix, E) :-
NextR is R + 1,
get_matrix_entry_nth0(NextR, C, Matrix, E).
down_left_entry(R-C, Matrix, E) :-
NextR is R + 1,
PrevC is C - 1,
get_matrix_entry_nth0(NextR, PrevC, Matrix, E).
left_entry(R-C, Matrix, E) :-
PrevC is C - 1,
get_matrix_entry_nth0(R, PrevC, Matrix, E).
With these auxiliary predicates in place, the solution is fairly straightforward:
matrix_path([R|Rs], P) :-
% determine rows, cols
length([R|Rs], Rows),
length(R, Cols),
% defer to matrix_path/4 to compute all paths starting with 0,0
matrix_path(0-0, Rows-Cols, [R|Rs], P).
matrix_path/2 is the entry-point to the program. This single-clause predicate pre-determines the number of rows and columns in the given matrix, and defers processing to matrix_path/4 which starts computation from the 0,0 (top-left) element.
matrix_path(R-C, Rows-Cols, Matrix, P) :-
C >= Cols, !,
% end of column, proceed to next row
NextRow is R + 1,
NextRow < Rows,
matrix_path(NextRow-0, Rows-Cols, Matrix, P).
The first clause of matrix_path/4 checks if the number of columns has been exceeded; if so, a cut (!) is used to exclude the clauses below, and re-starts the computation in the next row and resets the column index to 0.
matrix_path(R-C, _, Matrix, adj(S, T)) :-
% get this entry
get_matrix_entry_nth0(R, C, Matrix, S),
% get each adjacent entry
( up_left_entry(R-C, Matrix, T)
; up_entry(R-C, Matrix, T)
; up_right_entry(R-C, Matrix, T)
; right_entry(R-C, Matrix, T)
; down_right_entry(R-C, Matrix, T)
; down_entry(R-C, Matrix, T)
; down_left_entry(R-C, Matrix, T)
; left_entry(R-C, Matrix, T)
).
The second clause of matrix_path/4 simply tries to retrieve all possible 'paths' from the given entry. Some may fail (such as looking up in the top row), but Prolog will backtrack to find all solutions that work.
matrix_path(R-C, Rows-Cols, Matrix, P) :-
% get the entry for the next column in this row
NextC is C + 1,
matrix_path(R-NextC, Rows-Cols, Matrix, P).
The last clause of matrix_path/4 simply shifts processing relative to the item in the next column in the same row.
Running a simple example:
?- matrix_path([[1,2],[3,4]], P).
P = adj(1, 2) ;
P = adj(1, 4) ;
P = adj(1, 3) ;
P = adj(2, 4) ;
P = adj(2, 3) ;
P = adj(2, 1) ;
P = adj(3, 1) ;
P = adj(3, 2) ;
P = adj(3, 4) ;
P = adj(4, 1) ;
P = adj(4, 2) ;
P = adj(4, 3) ;
false.
Note that if you want all adjacent pairs immediately without backtracking, wrap the call in a findall/2, like this:
?- findall(P, matrix_path([[1,2],[3,4]], P), Ps).
Ps = [adj(1, 2), adj(1, 4), adj(1, 3), adj(2, 4), adj(2, 3), adj(2, 1), adj(3, 1), adj(3, 2), adj(..., ...)|...].
Enumeration of a finite set can be done easily using Prolog backtracking:
adjacent_pos((R,C), (Ra,Ca)) :-
(R > 1, Ra is R-1 ; Ra is R ; Ra is R+1),
(C > 1, Ca is C-1 ; Ca is C ; Ca is C+1),
once(Ra \= R ; Ca \= C).
Using paired nth1/3 we can access a cell:
cell(Mat, (R,C), Cell) :-
nth1(R, Mat, Row),
nth1(C, Row, Cell).
So, in a matrix NxM of distinct elements:
adjacent(Mat, Elem, Adj) :-
cell(Mat, Pe, Elem),
adjacent_pos(Pe, Pa),
cell(Mat, Pa, Adj).
simple test:
test :-
M = [[1,2,3],
[5,4,6],
[8,9,7]],
findall(A, adjacent(M,1,A), L1), writeln(L1),
findall(A, adjacent(M,4,A), L4), writeln(L4).
yields:
?- test.
[2,5,4]
[1,2,3,5,6,8,9,7]
true.
Note that the test R > 1 and C > 1 could be avoided, demanding to nth1/3 failure the 'out of band' test. The same is true for the upper limit, omitted indeed, with the added benefit that we are not limited to a predefined matrix size.