8-puzzle has a solution in prolog using manhattan distance - prolog

The 8-puzzle will be represented by a 3x3 list of lists positions where the empty box will be represented by the value 9, as shown below: [[9,1,3],[5,2,6],[4,7,8]]
Possibility Solution: Only half of the initial positions of the 8-puzzle are solvable. There is a formula that allows to know from the beginning if you can solve the puzzle.To determine whether an 8-puzzle is solvable, for each square containing a value N is calculated how many numbers less than N there after the current cell. For example, to the initial status:
1 no numbers less then = 0
Empty (9) - has to subsequently 3,5,2,6,4,7,8 = 7
3 have = 1 to 2
5 has subsequently to 2,4 = 2
2 no number under it happen = 0
6 is subsequently 4 = 1
4 no numbers less then = 0
7 no minor numbers after = 0
8 no numbers less then = 0
After that, we calculate the Manhattan distance between the position of the empty and
position (3.3). For the above example, the empty box is in the position (1.2), so
Manhattan distance that is:
d = abs (3-1) + abs (3-2) = 3
Finally, add up all the calculated values​​. If the result is even, implies that the
puzzle is solvable, but it is odd not be resolved.
0 +7 +1 +2 +0 +1 +0 +0 +0 +3 = 14
The solution is designed to create a knowledge base with all possible states of a number on the board and we'll see how many numbers less than N there after the current position.
Here's my code:
%***********************Have Solution*********************************
posA(9,8). posA(8,7). posA(7,6). posA(6,5). posA(5,4). posA(4,3). posA(3,2). posA(2,1). posA(1,0).
posB(9,7). posB(8,7). posB(8,6). posB(7,6). posB(7,5). posB(7,4).
posB(6,5). posB(6,4). posB(6,3). posB(6,2). posB(5,4). posB(5,3). posB(5,2). posB(5,1). posB(5,0).
posB(4,3). posB(4,2). posB(3,2). posB(3,1). posB(2,1). posB(2,0). posB(1,0).
posC(9,6). posC(8,6). posC(8,5). posC(7,6). posC(7,5). posC(7,4). posC(6,5). posC(6,4). posC(6,3).
posC(5,4). posC(5,3). posC(5,2). posC(4,3). posC(4,2). posC(4,1). posC(4,0).
posC(3,2). posC(3,1). posC(3,0). posC(2,1). posC(1,0).
posD(9,5). posD(8,5). posD(8,4). posD(7,5). posD(7,4). posD(7,3). posD(6,5). posD(6,4). posD(6,3).
posD(6,2). posD(5,4). posD(5,3). posD(5,2). posD(5,1). posD(4,3). posD(4,2). posD(4,1). posD(5,0).
posD(3,2). posD(3,1). posD(3,0). posD(2,1). posD(1,0).
posE(9,4). posE(8,4). posE(8,3). posE(7,4). posE(7,3). posE(7,2). posE(6,4). posE(6,3). posE(6,2). posE(6,1).
posE(5,4). posE(5,3). posE(5,2). posE(5,1). posE(5,0). posE(4,3). posE(4,2). posE(4,1). posE(4,0).
posE(3,2). posE(3,1). posE(3,0). posE(2,1). posE(2,0). posE(1,0).
posF(9,3). posF(8,3). posF(8,2). posF(7,1). posF(7,2). posF(7,3). posF(6,0). posF(6,1). posF(6,2).
posF(6,3). posF(5,0). posF(5,1). posF(5,2). posF(5,3). posF(4,0). posF(4,1). posF(4,2). posF(4,3).
posF(2,0). posF(2,1). posF(3,0). posF(3,1). posF(3,2). posF(1,0).
posG(9,2). posG(8,0). posG(8,1). posG(8,2). posG(7,0). posG(7,1). posG(7,2).
posG(6,0). posG(6,1). posG(6,2). posG(5,0). posG(5,1). posG(5,2). posG(4,0). posG(4,1). posG(4,2).
posG(3,0). posG(3,1). posG(3,2). posG(2,0). posG(2,1). posG(1,0).
posH(9,1). posH(8,0). posH(8,1). posH(7,0). posH(7,1). posH(6,0). posH(6,1). posH(5,0). posH(5,1).
posH(4,0). posH(4,1). posH(3,0). posH(3,1). posH(2,0). posH(1,1). posH(1,0).
posI(9,0). posI(8,0). posI(7,0). posI(6,0). posI(5,0). posI(4,0). posI(3,0). posI(2,0). posI(1,0).
haveSolution([[A,B,C],[D,E,F],[G,H,I]]):- distManhattan([A,B,C,D,E,F,G,H,I], Z),
posA(A,Pa), posB(B,Pb), posC(C,Pc),
posD(D,Pd), posE(E,Pe), posF(F,Pf),
posG(G,Pg), posH(H,Ph), posI(I,Pi),
P is Pa+Pb+Pc+Pd+Pe+Pf+Pg+Ph+Pg+Pi+Z, 0 is P mod 2,
write('The 8-puzzle have solution').
%%*************************Manhattan distance***********************
distManhattan([A,B,C,D,E,F,G,H,I], Dist):- A=9, Dist is abs(3-1)+abs(3-1), !;
B=9, Dist is abs(3-1)+abs(3-2), !;
C=9, Dist is abs(3-1)+abs(3-3), !;
D=9, Dist is abs(3-2)+abs(3-1), !;
E=9, Dist is abs(3-2)+abs(3-2), !;
F=9, Dist is abs(3-2)+abs(3-3), !;
G=9, Dist is abs(3-3)+abs(3-1), !;
H=9, Dist is abs(3-3)+abs(3-2), !;
I=9, Dist is abs(3-3)+abs(3-3).
The problem is that I am making a mistake because there are situations where I can have more than one alternative, eg>:
| 1 | 9 | 3 |
| 5 | 2 | 6 |
| 4 | 7 | 8 |
posA(1,0)+posB(9,7)+posC(3,1)+posD(5,2)+posE(2,0)+posF(6,1)+posG(4,0)+posH(7,0)+posI(8,0).
The right solution for posC(C,Pc) is posC(3,1), that is 1; but there are other ramifications that sometimes cause incorrect outputs ... what am I doing wrong in my code and how I can change it?

This answer looks at the problem from a different point of view:
Single board configurations are represented using the compound structure board/9.
Configurations that are equal up to sliding a single piece are connected by relation m/2.
So let's define m/2!
m(board(' ',B,C,D,E,F,G,H,I), board(D, B ,C,' ',E,F,G,H,I)).
m(board(' ',B,C,D,E,F,G,H,I), board(B,' ',C, D ,E,F,G,H,I)).
m(board(A,' ',C,D,E,F,G,H,I), board(' ',A, C , D, E ,F,G,H,I)).
m(board(A,' ',C,D,E,F,G,H,I), board( A ,C,' ', D, E ,F,G,H,I)).
m(board(A,' ',C,D,E,F,G,H,I), board( A ,E, C , D,' ',F,G,H,I)).
m(board(A,B,' ',D,E,F,G,H,I), board(A,' ',B,D,E, F ,G,H,I)).
m(board(A,B,' ',D,E,F,G,H,I), board(A, B ,F,D,E,' ',G,H,I)).
m(board(A,B,C,' ',E,F,G,H,I), board(' ',B,C,A, E ,F, G ,H,I)).
m(board(A,B,C,' ',E,F,G,H,I), board( A ,B,C,E,' ',F, G ,H,I)).
m(board(A,B,C,' ',E,F,G,H,I), board( A ,B,C,G, E ,F,' ',H,I)).
m(board(A,B,C,D,' ',F,G,H,I), board(A, B ,C,' ',D, F ,G, H ,I)).
m(board(A,B,C,D,' ',F,G,H,I), board(A,' ',C, D ,B, F ,G, H ,I)).
m(board(A,B,C,D,' ',F,G,H,I), board(A, B ,C, D ,F,' ',G, H ,I)).
m(board(A,B,C,D,' ',F,G,H,I), board(A, B ,C, D ,H, F ,G,' ',I)).
m(board(A,B,C,D,E,' ',G,H,I), board(A,B,' ',D, E ,C,G,H, I )).
m(board(A,B,C,D,E,' ',G,H,I), board(A,B, C ,D,' ',E,G,H, I )).
m(board(A,B,C,D,E,' ',G,H,I), board(A,B, C ,D, E ,I,G,H,' ')).
m(board(A,B,C,D,E,F,' ',H,I), board(A,B,C,' ',E,F,D, H ,I)).
m(board(A,B,C,D,E,F,' ',H,I), board(A,B,C, D ,E,F,H,' ',I)).
m(board(A,B,C,D,E,F,G,' ',I), board(A,B,C,D,' ',F, G ,E, I )).
m(board(A,B,C,D,E,F,G,' ',I), board(A,B,C,D, E ,F,' ',G, I )).
m(board(A,B,C,D,E,F,G,' ',I), board(A,B,C,D, E ,F, G,I,' ')).
m(board(A,B,C,D,E,F,G,H,' '), board(A,B,C,D,E,' ',G, H ,F)).
m(board(A,B,C,D,E,F,G,H,' '), board(A,B,C,D,E, F ,G,' ',H)).
Almost done!
To connect the steps, we use the meta-predicate path/4 together
with length/2 for performing iterative deepening.
The following problem instances are from #CapelliC's answer:
?- length(Path,N), path(m,Path,/* from */ board(1,' ',3,5,2,6,4,7, 8 ),
/* to */ board(1, 2 ,3,4,5,6,7,8,' ')).
N = 6, Path = [board(1,' ',3,5,2,6,4,7,8), board(1,2,3,5,' ',6,4,7,8),
board(1,2,3,' ',5,6,4,7,8), board(1,2,3,4,5,6,' ',7,8),
board(1,2,3,4,5,6,7,' ',8), board(1,2,3,4,5,6,7,8,' ')] ? ;
N = 12, Path = [board(1,' ',3,5,2,6,4,7,8), board(1,2,3,5,' ',6,4,7,8),
board(1,2,3,5,7,6,4,' ',8), board(1,2,3,5,7,6,' ',4,8),
board(1,2,3,' ',7,6,5,4,8), board(1,2,3,7,' ',6,5,4,8),
board(1,2,3,7,4,6,5,' ',8), board(1,2,3,7,4,6,' ',5,8),
board(1,2,3,' ',4,6,7,5,8), board(1,2,3,4,' ',6,7,5,8),
board(1,2,3,4,5,6,7,' ',8), board(1,2,3,4,5,6,7,8,' ')] ? ;
...
?- length(Path,N), path(m,Path,/* from */ board(8,7,4,6,' ',5,3,2, 1 ),
/* to */ board(1,2,3,4, 5 ,6,7,8,' ')).
N = 27, Path = [board(8,7,4,6,' ',5,3,2,1), board(8,7,4,6,5,' ',3,2,1),
board(8,7,4,6,5,1,3,2,' '), board(8,7,4,6,5,1,3,' ',2),
board(8,7,4,6,5,1,' ',3,2), board(8,7,4,' ',5,1,6,3,2),
board(' ',7,4,8,5,1,6,3,2), board(7,' ',4,8,5,1,6,3,2),
board(7,4,' ',8,5,1,6,3,2), board(7,4,1,8,5,' ',6,3,2),
board(7,4,1,8,5,2,6,3,' '), board(7,4,1,8,5,2,6,' ',3),
board(7,4,1,8,5,2,' ',6,3), board(7,4,1,' ',5,2,8,6,3),
board(' ',4,1,7,5,2,8,6,3), board(4,' ',1,7,5,2,8,6,3),
board(4,1,' ',7,5,2,8,6,3), board(4,1,2,7,5,' ',8,6,3),
board(4,1,2,7,5,3,8,6,' '), board(4,1,2,7,5,3,8,' ',6),
board(4,1,2,7,5,3,' ',8,6), board(4,1,2,' ',5,3,7,8,6),
board(' ',1,2,4,5,3,7,8,6), board(1,' ',2,4,5,3,7,8,6),
board(1,2,' ',4,5,3,7,8,6), board(1,2,3,4,5,' ',7,8,6),
board(1,2,3,4,5,6,7,8,' ')] ? ;
N = 29, Path = [...] ? ;
...

Here is a solver, not an answer to the original question. Joel76 already addressed the problem in comments, and thus he will get the deserved reputation when he will answer.
But the 8-puzzle was interesting to solve, and pose some efficiency problem. Here is my best effort, where I used library(nb_set) in attempt to achieve reasonable efficiency on full solutions enumeration.
Note: nb_set is required to keep track of visited also on failed paths. The alternative is a :- dynamic visited/1. but that turned out to be too much slow.
/* File: 8-puzzle.pl
Author: Carlo,,,
Created: Feb 4 2013
Purpose: solve 8-puzzle
*/
:- module(eight_puzzle,
[eight_puzzle/3
]).
:- use_module(library(nb_set)).
% test cases from Stack Overflow thread with Joel76
test0(R) :- eight_puzzle([1,2,3,4,5,6,7,8,0], [1,0,3, 5,2,6, 4,7,8], R).
test1(R) :- eight_puzzle([1,2,3,4,5,6,7,8,0], [8,7,4, 6,0,5, 3,2,1], R).
%% eight_puzzle(+Target, +Start, -Moves) is ndet
%
% public interface to solver
%
eight_puzzle(Target, Start, Moves) :-
empty_nb_set(E),
eight_p(E, Target, Start, Moves).
%% -- private here --
eight_p(_, Target, Target, []) :-
!.
eight_p(S, Target, Current, [Move|Ms]) :-
add_to_seen(S, Current),
setof(Dist-M-Update,
( get_move(Current, P, M),
apply_move(Current, P, M, Update),
distance(Target, Update, Dist)
), Moves),
member(_-Move-U, Moves),
eight_p(S, Target, U, Ms).
%% get_move(+Board, +P, -Q) is semidet
%
% based only on coords, get next empty cell
%
get_move(Board, P, Q) :-
nth0(P, Board, 0),
coord(P, R, C),
( R < 2, Q is P + 3
; R > 0, Q is P - 3
; C < 2, Q is P + 1
; C > 0, Q is P - 1
).
%% apply_move(+Current, +P, +M, -Update)
%
% swap elements at position P and M
%
apply_move(Current, P, M, Update) :-
assertion(nth0(P, Current, 0)), % constrain to this application usage
( P > M -> (F,S) = (M,P) ; (F,S) = (P,M) ),
nth0(S, Current, Sv, A),
nth0(F, A, Fv, B),
nth0(F, C, Sv, B),
nth0(S, Update, Fv, C).
%% coord(+P, -R, -C)
%
% from linear index to row, col
% size fixed to 3*3
%
coord(P, R, C) :-
R is P // 3,
C is P mod 3.
%% distance(+Current, +Target, -Dist)
%
% compute Manatthan distance between equals values
%
distance(Current, Target, Dist) :-
aggregate_all(sum(D),
( nth0(P, Current, N), coord(P, Rp, Cp),
nth0(Q, Target, N), coord(Q, Rq, Cq),
D is abs(Rp - Rq) + abs(Cp - Cq)
), Dist).
%% add_to_seen(+S, +Current)
%
% fail if already in, else store
%
add_to_seen(S, [A,B,C,D,E,F,G,H,I]) :-
Sig is
A*100000000+
B*10000000+
C*1000000+
D*100000+
E*10000+
F*1000+
G*100+
H*10+
I,
add_nb_set(Sig, S, true)
Test case that Joel76 posed to show the bug in my first effort:
?- time(eight_puzzle:test1(R)).
% 25,791 inferences, 0,012 CPU in 0,012 seconds (100% CPU, 2137659 Lips)
R = [5, 8, 7, 6, 3, 0, 1, 2, 5|...] ;
% 108,017 inferences, 0,055 CPU in 0,055 seconds (100% CPU, 1967037 Lips)
R = [5, 8, 7, 6, 3, 0, 1, 2, 5|...] ;
% 187,817,057 inferences, 93,761 CPU in 93,867 seconds (100% CPU, 2003139 Lips)
false.

Related

Tabling in Prolog, when are values stored?

So let's say I have this code that uses a table to take 'note' of previous solutions or answers.
first_rule:-
doSomething,
recursive_call(A,B,C). %where A and B are lists of character codes
:- table recursive_call(_,_,min).
recursive_call([],B,C):- doSomething.
recursive_call(A,[],C):- doSomething.
My question is, are the values being 'stored' or 'cached' into the table each time recursive_call is called?
Note (just to add more context to this code in case it might help): This is actually a snippet code of edit distance algorithm implementation in Prolog. So the purpose of :- table recursive_call(_,_,min) is to add the solutions or answers into the table while keeping the minimum value.
I think the following program helps to understand when a table is updated.
% This predicate shows updates that are triggered by the query.
show_updates :-
abolish_all_tables,
nl,
cost(a, e, _),
show_table(cost/3).
% This predicate shows the current state of a table.
show_table(Name/Arity) :-
writeln('-- table --'),
functor(Term, Name, Arity),
forall( ( get_calls(Term, Trie, Return),
get_returns(Trie, Return) ),
writeln(Term)),
writeln('-----------\n').
% This predicate is called each time a new solution cost must be
% compared with a previous one. It selects the minimum cost and informs
% whether the table should be updated or not.
mincost(Old, New, Min) :-
Min is min(Old, New),
show_table(cost/3),
compare(R, New, Old),
format('new_cost(~w) ~w previous_cost(~w) => ', [New, R, Old]),
( New < Old -> format('update with ~w\n\n', [New])
; format('don\'t update\n\n', []) ).
% B
% ^ | \
% / | \
% 3 4 6
% / | \
% / v v
% A --8--> C --1--> E
% \ ^ ^
% \ | /
% 7 5 9
% \ | /
% v | /
% D
:- table cost(_, _, lattice(mincost/3)).
link(a, b, 3).
link(a, c, 8).
link(a, d, 7).
link(b, c, 4).
link(b, e, 6).
link(c, e, 1).
link(d, c, 5).
link(d, e, 9).
cost(U, W, C) :- link(U, W, C).
cost(U, W, C) :- link(U, V, Cuv), cost(V, W, Cvw), C is Cuv + Cvw.
Execution result:
?- show_updates.
-- table --
cost(c,e,1)
cost(b,e,6)
-----------
new_cost(5) < previous_cost(6) => update with 5
-- table --
cost(c,e,1)
cost(a,e,8)
cost(b,e,5)
-----------
new_cost(9) > previous_cost(8) => don't update
-- table --
cost(d,e,9)
cost(c,e,1)
cost(a,e,8)
cost(b,e,5)
-----------
new_cost(6) < previous_cost(9) => update with 6
-- table --
cost(d,e,6)
cost(c,e,1)
cost(a,e,8)
cost(b,e,5)
-----------
new_cost(13) > previous_cost(8) => don't update
-- table --
cost(d,e,6)
cost(c,e,1)
cost(a,e,8)
cost(b,e,5)
-----------
true.
Maybe this example will help (it uses a "lattice" rather than "min", but they're similar; and if you're doing edit distance, you might want to keep a list of the edits anyway):
https://www.swi-prolog.org/pldoc/man?section=tabling-mode-directed
"In this execution model one or more arguments are not added to the table. Instead, we remember a single aggregated value for these arguments."

How can I get this simple Prolog predicate to "return" the right way?

So I am learning Prolog. I need to write a predicate that finds the min/max value of an integer list. For example, the query minmaxArray([4,-1,5,4,1,2,3,-2],X,Y) would return X = -2 Y = 5. Here is what I have so far:
%min/max element of a 1 item list is that item.
minmaxArray([X], X, X).
%when there is only 2 items, put the smaller element in A and the
%larger element in B
minmaxArray([X,Y], A, B) :- mymin(X,Y,Min),
A is Min, mymax(X,Y,Max), B is Max.
%when there is more than two items make a recursive call to find the min/max
%of the rest of the list.
minmaxArray([X,Y|T], A, B) :- minmaxArray([Y|T], M, K),
mymin(X,M,Temp), A is Temp, mymax(X,K,Temp2), B is Temp2.
Assume mymin and mymax predicates work properly. They return the min and max of 2 numbers.
The issue here is that for example when I query minmaxArray([4,-1,5],X,Y) it returns X = -1 Y = 5 and then again X = -1 Y = 5. I know this must be because it hits the 2nd condition on the recursive call. I only want it to return X = -1 Y = 5 one time. I tried replacing condition 3 with this:
minmaxArray([X,Y,_|T], A, B) :- minmaxArray([Y,_|T], M, K),
mymin(X,M,Temp), A is Temp, mymax(X,K,Temp2), B is Temp2.
but that crashes the program. What can I do to fix this?
Note: I know that I may not be using the terminology correctly by saying returning and saying predicate when it should be rule, etc so I apologize in advance.
Seems that your code could be simpler. This predicate does all what's needed, and attempt to show how to use some standard construct (if/then/else)
minmaxArray([X], X, X).
minmaxArray([X|R], Min, Max) :-
minmaxArray(R, Tmin, Tmax),
( X < Tmin -> Min = X ; Min = Tmin ), % or mymin(X,Tmin,Min)
( X > Tmax -> Max = X ; Max = Tmax ).
You have provided 2 ways of solving the case where there are 2 items: one explicitly for 2 items, and your general case, which then employs the 1 element case.
Solution: remove the unneeded 2-element case.
Or, tail-recursive:
minmax([X|Xs],Min,Max) :- % we can only find the min/max of a non-empty list.
minmax(Xs,(X,X),Min,Max) % invoke the helper with the min/max accumulators seeded with the first item
.
minmax([],(Min,Max),Min,Max). % when the source list is exhausted, we're done: unify the accumulators with the result
minmax([X|Xs],(M,N),Min,Max) :- % when the source list is non-empty
min(X,M,M1) , % - get a new min value for the accumulator
max(X,N,N1) , % - get a new max value for the accumulator
minmax(Xs,(M1,N1),Min,Max) % - recurse down on the tail.
.
min(X,Y,X) :- X =< Y . % X is the min if it's less than or equal to Y.
min(X,Y,Y) :- X > Y . % Y is the min if it's greater than X.
max(X,Y,X) :- X >= Y . % X is the max if it's greater than or equal to Y.
max(X,Y,Y) :- X < Y . % Y is the max if it's greater than X.

Square placing in Prolog

I have a nxn area. And I want to list all of the positions of possible kxk m squares (k < n) which don't touch each other in that area. I want to list the coordinates of the upper-leftmost squares of those kxk squares. Can you give me some hint about implementing this with Prolog? I'm very new to this language. I just read a small tutorial but now I don't know what to do.
They are also touching if their corners touch.
The input and output should be like this :(k : size of small square,n : size of big square, m: number of small squares)
>func(k,n,m,O).
>func(1,3,2,O).
O =[1-1,1-3];
O =[1-1,2-3];
O =[1-1,3-1];
O =[1-1,3-2];
O =[1-1,3-3];
O =[1-2,3-1];
O =[1-2,3-2];
O =[1-2,3-3];
O =[1-3,2-1];
O =[1-3,3-1];
O =[1-3,3-2];
O =[1-3,3-3];
O =[2-1,2-3];
O =[2-1,3-3];
O =[2-3,3-1];
O =[3-1,3-3];
No.
I post a solution showing a possible Prolog coding, in style generate and test. There is some slot where you'll place appropriate arithmetic, just to complete your assignment.
%% placing
place_squares(Big, Small, Squares) :-
place_not_overlapping(Big, Small, [], Squares).
place_not_overlapping(Big, Small, SoFar, Squares) :-
available_position(Big, Small, Position),
\+ overlapping(Small, Position, SoFar),
place_not_overlapping(Big, Small, [Position|SoFar], Squares).
place_not_overlapping(_Big, _Small, Squares, Sorted) :-
sort(Squares, Sorted).
overlapping(Size, R*C, Squares) :-
member(X*Y, Squares),
... % write conditions here
available_position(Big, Small, Row*Col) :-
Range is Big - Small + 1,
between(1, Range, Row),
between(1, Range, Col).
after placing, it's easy to display
%% drawing
draw_squares(Big, Small, Squares) :-
forall(between(1, Big, Row),
(forall(between(1, Big, Col),
draw_point(Row*Col, Small, Squares)),
nl
)).
draw_point(Point, Small, Squares) :-
( nth1(I, Squares, Square),
contained(Point, Square, Small)
) -> write(I) ; write('-').
contained(R*C, A*B, Size) :-
... % place arithmetic here
the result with requested dimensions, and drawing
?- place_squares(5,2,Q),draw_squares(5,2,Q).
1122-
1122-
3344-
3344-
-----
Q = [1*1, 1*3, 3*1, 3*3] ;
1122-
1122-
33-44
33-44
-----
Q = [1*1, 1*3, 3*1, 3*4] ;
1122-
1122-
33---
3344-
--44-
Q = [1*1, 1*3, 3*1, 4*3] .
...
the place_squares/3 output is sorted, to ease displaying, and could as well be used to get rid of symmetry, and get a count of all solutions:
9 ?- setof(Q, place_squares(5,2,Q), L), length(L, N).
L = [[], [1*1], [1*1, 1*3], [1*1, 1*3, 3*1], [1*1, 1*3, 3*1, ... * ...], [1*1, 1*3, ... * ...|...], [1*1, ... * ...|...], [... * ...|...], [...|...]|...],
N = 314.
You can note that this accepts boards with 'spare' space. You could filter out such incomplete solutions, to complete your task.

Prolog - get the factors for a given number doesn't stop?

I need to find the factors of a given number , e.g :
?- divisors2(40,R).
R = [40,20,10,8,5,4,2,1].
The code :
% get all the numbers between 1-X
range(I,I,[I]).
range(I,K,[I|L]) :- I < K, I1 is I + 1, range(I1,K,L).
% calc the modulo of each element with the given number :
% any x%y=0 would be considered as part of the answer
divisors1([],[],_).
divisors1([H|T],S,X):-divisors1(T,W,X),Z is X mod H,Z==0,S=[H|W].
divisors1([_|T],S,X):-divisors1(T,S,X).
divisors2(X,Result) :-range(1,X,Result1),divisors1(Result1,Result,X).
But when I run divisors2(40,RR). I get infinite loop and nothing is presented to the screen.
Why ?
Regards
You are asking why you get an infinite loop for the query divisors2(40,R). I almost wanted to explain this to you using a failure-slice. Alas ...
... the answer is: No, you don't get an infinite loop! And your program also finds an answer. It's
R = [1,2,4,5,8,10,20,40]
which looks reasonable to me. They are in ascending order, and you wanted a descending list, but apart from that, that is a perfect answer. No kidding. However, I suspect that you were not patient enough to get the answer. For 36 I needed:
?- time(divisors2(36,R)).
% 10,744,901,605 inferences, 2248.800 CPU in 2252.918 seconds (100% CPU, 4778061 Lips)
R = [1,2,3,4,6,9,12,18,36]
; ... .
Quite unusual ... for a list with at most 36 meager integers Prolog needed 10 744 901 605 inferences, that is less than 234. Does this ring a bell? In any case, there are problems with your program. In fact, there are two quite independent problems. How can we find them?
Maybe we are looking at the wrong side. Just go back to the query. Our first error was how we used Prolog's toplevel. We were very impressed to get an answer. But Prolog offered us further answers! In fact:
?- time(divisors2(36,R)).
% 10,744,901,605 inferences, 2248.800 CPU in 2252.918 seconds (100% CPU, 4778061 Lips)
R = [1,2,3,4,6,9,12,18,36]
; % 10 inferences, 0.000 CPU in 0.000 seconds (82% CPU, 455892 Lips) R = [1,2,3,4,6,9,12,18]
; % 917,508 inferences, 0.192 CPU in 0.192 seconds (100% CPU, 4789425 Lips)
R = [1,2,3,4,6,9,12,36]
; ... .
This gets too tedious. Maybe a tiny example suffices?
?- divisors2(6,R).
R = [1,2,3,6]
; R = [1,2,3]
; R = [1,2,6]
; R = [1,2]
; R = [1,3,6]
; R = [1,3]
; R = [1,6]
; R = [1]
; R = [2,3,6]
; R = [2,3]
; R = [2,6]
; R = [2]
; R = [3,6]
; R = [3]
; R = [6]
; R = []
; false.
More than enough! Maybe we stick to the minimal example [] and restate it:
?- divisors2(6,[]).
true
; false.
Clearly, that's not what we expected. We wanted this to fail. How to localize the problem? There is one general debugging strategy in Prolog:
If a goal is too general, specialize the program.
We can specialize the program by adding further goals such that above query still succeeds. I will add false and some (=)/2 goals. false is particularly interesting because it wipes out an entire clause:
?- divisors2(6,[]).
range(I,I,[I]) :- I = 6.
range(I,K,[I|L]) :- K = 6,
I < K,
I1 is I + 1,
range(I1,K,L).
divisors1([],[],X) :- K=6.
divisors1([H|T],S,X):- false,
divisors1(T,W,X),
Z is X mod H,
Z=0,
S=[H|W].
divisors1([_|T],S,X):- S = [], X = 6,
divisors1(T,S,X).
divisors2(X,Result) :- X = 6, Result = [].
range(1,X,Result1),
divisors1(Result1,Result,X).
Somewhere in the remaining part something is too general! In fact the recursive rule of divisors1/3 is too general. This new modified program of yours is called a slice that is a specialization of our original program.
Several ways to fix this, the most naive way is to add the corresponding condition like so:
divisors1([],[],_).
divisors1([H|T],S,X):-
divisors1(T,W,X),
0 =:= X mod H,
S=[H|W].
divisors1([H|T],S,X):-
divisors1(T,S,X),
0 =\= X mod H.
However, the performance of the program did not improve. To see this, I will again specialize this program:
divisors1([],[],_) :- false.
divisors1([H|T],S,X):-
divisors1(T,W,X), false,
0 =:= X mod H,
S=[H|W].
divisors1([H|T],S,X):-
divisors1(T,S,X), false,
0 =\= X mod H.
Thus: No matter what is there behind the false, this program will try at least 3 * 2^N inferences for a list of length N.
By putting the recursive goals last we can avoid this.
You have a bug here
divisors1([H|T],S,X):-
divisors1(T,W,X),
Z is X mod H,
Z==0,S=[H|W]. <=== here
If Z is Zero then S = [H|W] else S = W.
If you correct your range (use a cut for the end-of-recursion clause), you will get it sort of working. You do not immediately succeed upon finding all divisors though.
A solution using your general idea, but also built-ins between/3 and bagof/3 (to make typing a bit easier):
divisors(X, Divs) :- bagof(D, divs(X,D), Divs).
divs(X,D) :- between(1,X,D), 0 is X mod D.
Please note that this solution returns the divisors in increasing order.

Generalizing Fibonacci sequence with SICStus Prolog

I'm trying to find a solution for a query on a generalized Fibonacci sequence (GFS). The query is: are there any GFS that have 885 as their 12th number? The initial 2 numbers may be restricted between 1 and 10.
I already found the solution to find the Nth number in a sequence that starts at (1, 1) in which I explicitly define the initial numbers. Here is what I have for this:
fib(1, 1).
fib(2, 1).
fib(N, X) :-
N #> 1,
Nmin1 #= N - 1,
Nmin2 #= N - 2,
fib(Nmin1, Xmin1),
fib(Nmin2, Xmin2),
X #= Xmin1 + Xmin2.
For the query mentioned I thought the following would do the trick, in which I reuse the fib method without defining the initial numbers explicitly since this now needs to be done dynamically:
fib(N, X) :-
N #> 1,
Nmin1 #= N - 1,
Nmin2 #= N - 2,
fib(Nmin1, Xmin1),
fib(Nmin2, Xmin2),
X #= Xmin1 + Xmin2.
fib2 :-
X1 in 1..10,
X2 in 1..10,
fib(1, X1),
fib(2, X2),
fib(12, 885).
... but this does not seem to work.
Is it not possible this way to define the initial numbers, or am I doing something terribly wrong? I'm not asking for the solution, but any advice that could help me solve this would be greatly appreciated.
Under SWI-Prolog:
:- use_module(library(clpfd)).
fib(A,B,N,X):-
N #> 0,
N0 #= N-1,
C #= A+B,
fib(B,C,N0,X).
fib(A,B,0,A).
task(A,B):-
A in 1..10,
B in 1..10,
fib(A,B,11,885).
Define a predicate gfs(X0, X1, N, F) where X0 and X1 are the values for the base cases 0 and 1.
I'd say you're doing something terribly wrong...
When you call fib(1, X1), the variable X1 is the number that the function fib will return, in this case, it will be 1, because of the base case fib(1, 1)..
Without the base cases, fib/2 has no solution; no matter how you call it in fib2.
Note: if you use recursion, you need at least one base case.
Consider fib(N,F1,F2) so you'll be able to replace fib(Nmin1, Xmin1) and fib(Nmin2, Xmin2) with simple fib(Nmin2, Xmin2, Xmin1).
Maybe not a solution in the strict sense but I will share it never the less. Probably the only gain is to show, that this does neither need a computer nor a calculator to be solved. If you know the trick it can be done on a bearmat.
If F_n ist the n-th Term of the ordinary Fibo-sequence, starting with F_1=F_2=1, then the n-th Term of the generalized sequence will be G_n = F_{n-2}*a+F_{n-1}*b.
Define F_{-1}=1, F_0 = 0
(Indeed, by induction
G_1 = F_{-1}*a+F_0*b = 1*a+0*b=a
G_2 = F_0 * a + F_1 * b = 0*a + 1*b = b
G_{n+1} = F_{n-1}a + F_nb = (F_{n-3} + F_{n-2} )a + (F_{n-2} + F_{n-1})*b = G_n + G_{n-1}
)
Thus G_12 = F_10 * a + F_11 * b = 55a + 89b.
Now you can either search for solutions to the equation 55a + 89b = 885 with your computer
OR
do the math:
Residues mod 11 (explanation):
55a + 89b = 0 + 88b + b = b; 885 = 880 + 5 = 80*11 + 5 = 5
So b = 5 mod 11, but since 1 <= b <= 10, b really is 5. 89 * 5 = 445 and 885-445 = 440. Now, divide by 55 and get a=8.

Resources