Prolog:Tiling program - prolog

I am a newbye in Prolog, so basically the error may be obvious for others.
My last question was about an algorithm about tiling.
Problem
Suppose we have a square with side length S, and N copies of rectangular tile with length X and width Y. The program must show all the ways in which these copies can be arranged in a grid so that no two copies can touch each other.
By showing, I mean that it must show the set of coordinates of upper left corners of every copy in a grid.
Coordinates start from 1, not 0.
Algorithm
Find all (x, y) where 0 > x > S, 0 < y < S such that
(x - 1, y) not in A, (x + 1, y) not in A, (x + 2, y) not in A..., (x + X + 1, Y) not in A...
(same for y's)
I wrote the following code (ntiles rule is used to compute).
% TX/TY - tile dimensions
% GridSize - length of grid side
% N - number of copies
% P - container for result
% Cor - upper left corners
% Rest - cells where it is not allowed to place corner
rest(TX/TY, X/Y, Rest) :-
(
X - 1 > 0,
append([NewX/Y], [], Rest),
NewX is X - 1
)
; (
X + L =< GridSize,
X + L =< X + TX,
append([NewX/Y], [], Rest),
NewX is X + L
)
; (
Y - 1 > 0,
append([X/NewY], [], Rest),
NewY is Y - 1
)
; (
Y + L =< GridSize,
Y + L =< Y + TY,
append([X/NewY], [], Rest),
NewY is X + L
).
corners(TX/TY, GridSize, Cor, Rest) :-
not(member(X/Y, Rest)),
X =< GridSize, Y =< GridSize,
X > 0, Y > 0,
rest(TX/TY, X/Y, Rest),
append([X/Y], [], Cor).
ntilesHelper(TX/TY, GridSize, 0, P, Cor, Rest) :- append(Cor, [], P).
ntilesHelper(TX/TY, GridSize, N, P, Cor, Rest) :-
corners(TX/TY, GridSize, Cor, Rest),
ntilesHelper(TX/TY, GridSize, X, P, Cor, Rest),
X is N - 1, append(Cor, [], P).
ntiles(TX/TY, GridSize, N, P) :-
ntilesHelper(TX/TY, GridSize, N, P, [], []).
It shows
=</2: Arguments are not sufficiently instantiated.
I can't find an error (I know that one of the "=<" operators is complaining). A bit of help will be appreciated.

the error arise because of
not(member(X/Y, Rest)),
not Goal (usually written \+ Goal) undoes any binding established while proving Goal. Then X (and Y as well) cannot be tested.
In this case you can provide X (and Y) using between(1, GridSize, X), to be placed before not(member(...)).

Related

Rewrite the definition in order to avoid the recursive call

Given the following PROLOG predicate definition f(integer, integer), with the flow model (i,
o):
f(0, -1) :- !.
f(I,Y):-
J is I-1,
f(J,V),
V > 0,
!,
K is J,
Y is K+V.
f(I,Y):-
J is I-1,
f(J,V),
Y is V+I.
Rewrite the definition in order to avoid the recursive call f(J,V) in both clauses. Do NOT redefine
the predicate. Justify your answer
With inspiration from question:
ffast(0, -1) :- !.
ffast(1, 0) :- !.
ffast(2, 2) :- !.
ffast(X, Y) :-
X0 is X - 1,
ffast(X0, Y0),
Y is Y0 + X0.
... and then to:
ffast2(0, Y) :- !, Y = -1.
ffast2(1, Y) :- !, Y = 0.
ffast2(X, Y) :- Y is ((X * (X - 1)) / 2) + 1.
(Guarding against Y being an input, as per best-practices.)

How to backtrack over a NxN board in Prolog?

I currently have to make some sort of Wumpus World implementation in SWI Prolog and give all possible paths over a board of size NxN, I have done several prolog tutorials but I can't figure how to solve this particular task in Prolog. I'm trying to get all possible paths for my agent to the gold and nothing else. It has to start from the initial position (X0, Y0).
I attach the code that I've managed to write so far. I have tried to do a simple DFS which sort of works but I struggle with the variable "parsing" to complete the code.
:- dynamic getAllPathsRec/2, agent/2, visited/2, visited/2.
gold(5,5).
worldSize(10).
agent(1,1).
getAllPaths :-
getAllPathsRec(1,1).
getAllPathsRec(X,Y) :-
format(X), format(Y), format('~n'),
gold(X1,Y1),
\+visited(X,Y),
assert(visited(X,Y)),
(X = X1, Y = Y1) -> print('Found GOLD');
move(_,X,Y).
move(right, X, Y) :-
X1 is X + 1,
X1 > 0 , X1 < 11,
getAllPathsRec(X1,Y).
move(left, X, Y) :-
X1 is X - 1,
X1 > 0 , X1 < 11,
getAllPathsRec(X1,Y).
move(up, X, Y) :-
Y1 is Y + 1,
Y1 > 0 , Y1 < 11,
getAllPathsRec(X,Y1).
move(down, X, Y) :-
Y1 is Y - 1,
Y1 > 0 , Y1 < 11,
getAllPathsRec(X,Y1).
I expect to find the gold in any possible way, ideally printing each path the algorithm has taken. Thank you in advance.
EDIT:
I've noticed that this solution has some efficiency problems for boards of enough size. It's being discussed here. I'll update the answer when we come up with a result.
Take care with assert/1 predicate, as it adds the fact to the knowledge base permanently and it's not undone while trying other combinations, so you won't be able to visit the same cell twice.
Instead of that, I approached it with an extra parameter V (that stands for visited), in which you can append the element treated in each exploration step. Also I stored the chosen directions in every step into a list L to print it when the target is found.
The or operator ; allows to not keep exploring the same path once the target is found and goes back to keep trying other combinations.
Notes:
If you face any use case where you can use assert/1, take care, because it's deprecated.
The _ variable it's not necessary in the move function as you can simply add 4 different "implementations" and just append the four directions.
As an advice use the facts or knowledge (a.k.a. World Size, Target position and Player position) as variables and don't hard code it. It'll be easier to debug and try different parameters.
Here you have the working code and some output example:
:- dynamic
getAllPathsRec/2,
agent/2,
visited/2.
gold(3, 3).
worldSize(5).
agent(1, 1).
getAllPaths :-
agent(X, Y),
getAllPathsRec(X, Y, [], []).
getAllPathsRec(X, Y, V, L) :-
hashPos(X, Y, H), \+member(H, V), append(V, [H], VP),
((gold(X, Y), print(L)) ; move(X, Y, VP, L)).
% Hash H from h(X, Y)
hashPos(X, Y, H) :- H is (X*100 + Y).
% Left
move(X, Y, V, L) :-
XP is X - 1, XP > 0,
append(L, [l], LP),
getAllPathsRec(XP, Y, V, LP).
% Right
move(X, Y, V, L) :-
XP is X + 1, worldSize(MS), XP =< MS,
append(L, [r], LP),
getAllPathsRec(XP, Y, V, LP).
% Up
move(X, Y, V, L) :-
YP is Y + 1, worldSize(MS), YP =< MS,
append(L, [u], LP),
getAllPathsRec(X, YP, V, LP).
% Down
move(X, Y, V, L) :-
YP is Y - 1, YP > 0,
append(L, [d], LP),
getAllPathsRec(X, YP, V, LP).
?- getAllPaths.
[r,r,r,r,u,l,l,l,l,u,r,r]
true ;
[r,r,r,r,u,l,l,l,l,u,r,u,l,u,r,r,r,r,d,l,l,d]
true ;
[r,r,r,r,u,l,l,l,l,u,r,u,l,u,r,r,r,r,d,l,d,l]
true ;
[r,r,r,r,u,l,l,l,l,u,r,u,l,u,r,r,r,r,d,d,l,l]
true ;
[r,r,r,r,u,l,l,l,l,u,r,u,l,u,r,r,r,r,d,d,l,u,l,d]
true ;
[r,r,r,r,u,l,l,l,l,u,r,u,l,u,r,r,r,d,l,d]
true ;
[r,r,r,r,u,l,l,l,l,u,r,u,l,u,r,r,r,d,r,d,l,l]
true ;
[r,r,r,r,u,l,l,l,l,u,r,u,l,u,r,r,r,d,d,l]
...

Using Prolog to compute the GCD of a polynomial

The title kind of says it all. I'm looking to compute the GCD of two polynomials. Is there any way this can be done in Prolog? If so, what's a good starting point? Specifically, I'm having trouble with how to implement polynomial division using Prolog.
Edit to include example input and output:
Example input:
?- GCD(x^2 + 7x + 6, x2 − 5x − 6, X).
Example output:
X = x + 1.
Solution
On the off chance that someone else needs to do this, here's my final solution:
tail([_|Tail], Tail).
head([Head | _], Head).
norm(Old, N, New) :-
length(Tail, N),
append(New, Tail, Old).
norm(Old, N, []) :-
length(Old, L),
N > L.
mult_GCD(List, GCD) :- length(List, L),
L > 2, tail(List, Tail),
mult_GCD(Tail, GCD).
mult_GCD([H | T], GCD) :-
length(T, L),
L == 1, head(T, N),
gcd(H, N, GCD).
lead(List, List) :-
length(List, L),
L == 1.
lead([0 | Tail], Out) :-
!, lead(Tail, Out).
lead([Head | Tail], [Head | Tail]) :- Head =\= 0.
poly_deg([], 0).
poly_deg(F, D) :-
lead(F, O),
length(O, N),
D is N - 1.
poly_red([0], [0]).
poly_red(Poly, Out) :-
mult_GCD(Poly, GCD),
scal_div(Poly, GCD, Out).
poly_sub(Poly,[],Poly) :- Poly = [_|_].
poly_sub([],Poly,Poly).
poly_sub([P1_head|P1_rest], [P2_head|P2_rest], [PSub_head|PSub_rest]) :-
PSub_head is P1_head-P2_head,
poly_sub(P1_rest, P2_rest, PSub_rest).
scal_prod([],_Sc,[]).
scal_prod([Poly_head|Poly_rest], Sc, [Prod_head|Prod_rest]) :-
Prod_head is Poly_head*Sc,
scal_prod(Poly_rest, Sc, Prod_rest).
scal_div([],_,[]).
scal_div([Poly_head|Poly_rest], Sc, [Prod_head|Prod_rest]) :-
Prod_head is Poly_head / Sc,
scal_div(Poly_rest, Sc, Prod_rest).
poly_div(Num, Den, OutBuild, Out) :-
poly_deg(Num, X),
poly_deg(Den, Y),
X < Y,
Out = OutBuild.
poly_div(INum, IDen, OutBuild, Out) :-
lead(INum, [NumHead | NumTail]), lead(IDen, [DenHead | DenTail]),
Q is NumHead / DenHead,
append(OutBuild, [Q], Out1),
append([DenHead], DenTail, DenNorm), append([NumHead], NumTail, Num),
scal_prod(DenNorm, Q, DenXQ),
poly_sub(Num, DenXQ, N),
poly_div(N, IDen, Out1, Out).
poly_mod(Num, Den, Out) :-
poly_deg(Num, X), poly_deg(Den, Y),
X < Y,
lead(Num, Out1),
poly_red(Out1, Out2),
lead(Out2, Out).
poly_mod(INum, IDen, Out) :-
lead(INum, [NumHead | NumTail]), lead(IDen, [DenHead | DenTail]),
Q is NumHead / DenHead,
append([DenHead], DenTail, DenNorm), append([NumHead], NumTail, Num),
scal_prod(DenNorm, Q, DenXQ),
poly_sub(Num, DenXQ, N),
poly_mod(N, IDen, Out).
poly_gcd(X, Y, X):- poly_deg(Y, O), O == 0, !.
poly_gcd(Y, X, X):- poly_deg(Y, O), O == 0, !.
poly_gcd(X, Y, D):- poly_deg(X, Xd), poly_deg(Y, Yd), Xd > Yd, !, poly_mod(X, Y, Z), poly_gcd(Y, Z, D).
poly_gcd(X, Y, D):- poly_mod(Y, X, Z), poly_gcd(X, Z, D).
gcd(X, Y, Z) :-
X < 0, X > Y, !,
X1 is X - Y,
gcd(-X, Y, Z).
gcd(X, Y, Z) :-
Y < 0, Y >= X, !,
Y1 is Y - X,
gcd(X, -Y, Z).
gcd(X, 0, X).
gcd(0, Y, Y).
gcd(X, Y, Z) :-
X > Y, Y > 0,
X1 is X - Y,
gcd(Y, X1, Z).
gcd(X, Y, Z) :-
X =< Y, X > 0,
Y1 is Y - X,
gcd(X, Y1, Z).
gcd(X, Y, Z) :-
X > Y, Y < 0,
X1 is X + Y,
gcd(Y, X1, Z).
gcd(X, Y, Z) :-
X =< Y, X < 0,
Y1 is Y + X,
gcd(X, Y1, Z).
This answer is meant as a push in the right direction.
First, forget for a moment that you need to parse an expression like x^2 + 7x + 6; this isn't even a proper term in Prolog yet. If you tried to write it on the top level, you will get an error:
?- Expr = x^2 + 7x + 6.
ERROR: Syntax error: Operator expected
ERROR: Expr = x^2 +
ERROR: ** here **
ERROR: 7x + 6 .
Prolog doesn't know how to deal with the 7x you have there. Parsing the expression is a question of its own, and maybe it is easier if you assumed you have already parsed it and gotten a representation that looks for example like this:
[6, 7, 1]
Similarly, x^2 − 5x − 6 becomes:
[-6, -5, 1]
and to represent 0 you would use the empty list:
[]
Now, take a look at the algorithm at the Wikipedia page. It uses deg for the degree and lc for the leading coefficient. With the list representation above, you can define those as:
The degree is one less then the length of the list holding the coefficients.
poly_deg(F, D) :-
length(F, N),
D is N - 1.
The leading coefficient is the last element of the list.
poly_lc(F, C) :-
last(F, C).
You also need to be able to do simple arithmetic with polynomials. Using the definitions on the Wikipedia page, we see that for example adding [] and [1] should give you [1], multiplying [-2, 2] with [1, -3, 1] should give you [-2, 8, -8, 2]. A precursory search gave me this question here on Stackoverflow. Using the predicates defined there:
?- poly_prod([-2,2], [1, -3, 1], P).
P = [-2.0, 8.0, -8.0, 2] .
?- poly_sum([], [1], S).
S = [1].
From here on, it should be possible for you to try and implement polynomial division as outlined in the Wiki article I linked above. If you get into more trouble, you should edit your question or ask a new one.

Generate multiple answers and put in list without using findall/3

the below code works perfectly but i want to get the multiple answers in a list without using the findall/3 function.
bet(N, M, K) :- N =< M, K = N.
bet(N, M, K) :- N < M, N1 is N+1, bet(N1, M, K).
pred([X, Y, S, P], N) :-
N1 is N - 1,
bet(2, N1, X),
X1 is X + 1,
N2 is N - X,
bet(X1, N2, Y),
S is X + Y,
P is X * Y.
s1(Q, N) :-
findall(X, pred(X, N), Q).
Had some help getting the above code work coz i'm new to Prolog.
Also, what the program is supposed to do is this:
X and Y are two integers with 1 < X < Y and X + Y ≤ 100. The goal
s1(Q,100) will bind Q with a list of quadruples [X, Y, S, P], where S
= X + Y and P = X * Y.
One way to do this is to break your pred/2 down to a recursive. auxiliary predicate that handles one case of X and Y on each recursive call. The following may not be optimized, but you can see in the logical tests how it achieves this:
pred(Q, N) :-
pred(Q, 2, 3, N). % Start with values X=2, Y=3
pred([], X, _, N) :- % Case in which X has reached max, so we're done
X >= N.
pred(Q, X, Y, N) :- % Case in which X is in range, but Y is at max, so next X, restart Y
X < N,
Y >= N - X,
X1 is X + 1,
Y1 is X1 + 1,
pred(Q, X1, Y1, N).
pred([[X, Y, S, P]|Qs], X, Y, N) :- % Case in which X and Y are within range
X < N,
Y < N - X,
S is X + Y,
P is X * Y,
Y1 is Y + 1,
pred(Qs, X, Y1, N). % Recurse using next Y

knight's tour efficient solution

I have build a code in prolog to find a series of legal moves in which the knight lands on each square of the chessboard(8x8) exactly once.
I have used a logic like below:
There 8 types of knight moves:
right 1 down 2
left 1 down 2
right 2 down 1
left 2 down 1
right 1 up 2
left 1 up 2
right 2 up 1
left 2 up 1
right 1 down 2 moves:
move(X,Y) :-
C_X is X mod 8,
R_X is X // 8,
C_Y is C_X + 1, % 1 right
C_Y < 8,
R_Y is R_X + 2, % 2 down
R_Y < 8,
Y is R_Y * 8 + C_Y,
Y >= 0,
X >= 0,
X < 64,
Y < 64.
And this is repeated for all 8 types of moves
The problem is that my code is not efficient, it takes too much steps to find the right path.
Does anyone know an efficient way of solving this problem?
To be able to solve 8x8 Knight's tour puzzle in a feasible amount of time Warnsdorff's rule is probably a must.
I've created a program in B-Prolog which solves the puzzle quite fast. If you need the program to be in some other Prolog - it's not too hard to translate it or just use some ideas from it.
knight_moves(X, Y, NewX, NewY) :-
( NewX is X - 1, NewY is Y - 2
; NewX is X - 1, NewY is Y + 2
; NewX is X + 1, NewY is Y - 2
; NewX is X + 1, NewY is Y + 2
; NewX is X - 2, NewY is Y - 1
; NewX is X - 2, NewY is Y + 1
; NewX is X + 2, NewY is Y - 1
; NewX is X + 2, NewY is Y + 1 ).
possible_knight_moves(R, C, X, Y, Visits, NewX, NewY) :-
knight_moves(X, Y, NewX, NewY),
NewX > 0, NewX =< R,
NewY > 0, NewY =< C,
\+ (NewX, NewY) in Visits.
possible_moves_count(R, C, X, Y, Visits, Count) :-
findall(_, possible_knight_moves(R, C, X, Y, Visits, _NewX, _NewY), Moves),
length(Moves, Count).
:- table warnsdorff(+,+,+,+,+,-,-,min).
warnsdorff(R, C, X, Y, Visits, NewX, NewY, Score) :-
possible_knight_moves(R, C, X, Y, Visits, NewX, NewY),
possible_moves_count(R, C, NewX, NewY, [(NewX, NewY) | Visits], Score).
knight(R, C, X, Y, Visits, Path) :-
length(Visits, L),
L =:= R * C - 1,
NewVisits = [(X, Y) | Visits],
reverse(NewVisits, Path).
knight(R, C, X, Y, Visits, Path) :-
length(Visits, L),
L < R * C - 1,
warnsdorff(R, C, X, Y, Visits, NewX, NewY, _Score),
NewVisits = [(X, Y) | Visits],
knight(R, C, NewX, NewY, NewVisits, Path).
| ?- time(knight(8, 8, 1, 1, [], Path)).
CPU time 0.0 seconds.
Path = [(1,1),(2,3),(1,5),(2,7),(4,8),(6,7),(8,8),(7,6),(6,8),(8,7),(7,5),(8,3),(7,1),(5,2),(3,1),(1,2),(2,4),(1,6),(2,8),(3,6),(1,7),(3,8),(5,7),(7,8),(8,6),(7,4),(8,2),(6,1),(7,3),(8,1),(6,2),(4,1),(2,2),(1,4),(2,6),(1,8),(3,7),(5,8),(7,7),(8,5),(6,6),(4,7),(3,5),(5,6),(6,4),(4,3),(5,5),(6,3),(5,1),(7,2),(8,4),(6,5),(4,4),(3,2),(5,3),(4,5),(3,3),(2,1),(1,3),(2,5),(4,6),(3,4),(4,2),(5,4)]
yes
Here is an answer set programming (ASP) solution. It can be used to find a first solution to a 24x24 in acceptable time and can be easily adapted to the 8x8 case. It uses Warnsdorff's rule as well, but is a little faster than a backward chaining solution:
Backward Chaining:
?- time(knight_tour((1,1), X)).
% Up 878 ms, GC 32 ms, Thread Cpu 859 ms (Current 10/30/18 20:55:28)
X = [(1,1),(3,2),(5,1),(7,2),(9,1),(11,2),(13,1),(15,2),(17,1), ...
Forward Chaining (With ASP Choice):
?- time(knight_tour((1,1), X)).
% Up 411 ms, GC 0 ms, Thread Cpu 406 ms (Current 10/28/18 20:45:05)
X = [(1,1),(3,2),(5,1),(7,2),(9,1),(11,2),(13,1),(15,2),(17,1), ...
The forward chaining code is faster, since it uses the forward store to check to see whether a move was already done or not. This is faster than using a member predicate for this check. The answer set programming code reads:
:- use_module(library(basic/lists)).
:- use_module(library(minimal/asp)).
knight_tour(Start, Solution) :-
post(go(Start, 1)),
findall(X, go(X,_), Solution).
choose(S) <= posted(go(X,N)), N \== 576,
findall(W-Y, (move(X, Y), weight(Y, X, W)), L),
keysort(L, R),
M is N+1,
strip_and_go(R, M, S).
strip_and_go([_-Y|L], M, [go(Y, M)|R]) :-
strip_and_go(L, M, R).
strip_and_go([], _, []).
weight(X, Z, N) :-
findall(Y, (move(X, Y), Z \== Y), L),
length(L, N).
move(X, Y) :-
knight_move(X, Y),
verify(Y),
\+ clause(go(Y, _), true).
The code uses the new module "asp" from Jekejeke Prolog. The full code with predicates knight_move/2 and verify/1 is on gist here. There one finds the backward chaining code as well so that one can compare the code side by side.

Resources