Related
Suppose, we have the following game:
There is a pair of numbers (x, y), 2 players are making moves. During the move a player can increase any number by 1 or multiply it by 2.
The player, who makes a move after which (x + y) >= 77 wins.
The initial position is (8, x), find the minimal x such as the second player wins in minimal number of turns.
This problem can be easily solved analytically: both players multiply x by 2 and we get the following inequality:
8 + 2*2*x >= 77 => 4*x >= 69 => x >= (69 / 4) => x >= 17,25
x = ceil(17,25)
x = 18
Now we tried to solve it using Prolog:
:- use_module(library(clpfd)).
top(77).
% possible moves for player
next_state(X1, X2, Y1, Y2) :- Y1 #= X1 + 1,
Y2 #= X2.
next_state(X1, X2, Y1, Y2) :- Y1 #= X1,
Y2 #= X2 + 1.
next_state(X1, X2, Y1, Y2) :- Y1 #= 2*X1,
Y2 #= X2.
next_state(X1, X2, Y1, Y2) :- Y1 #= X1,
Y2 #= 2*X2.
% winning pair
win(X1, X2) :- top(X),
X1 + X2 #>= X.
% we have a sequence of states
sequence_correct([[X1, X2]]) :- win(X1, X2).
sequence_correct([[X1, X2], [Y1, Y2] | T]) :- next_state(X1, X2, Y1, Y2),
sequence_correct([[Y1, Y2] | T]).
% find X such as there is a sequence of 3 states, and there is no Y such as
% Y < X => X is minimum
min(X) :- sequence_correct([[8, X], _, _]), \+ (sequence_correct([[8, Y], _, _]), Y #< X).
But unfortunately when we try to find minimal X, it fails:
?- min(X).
false.
?- min(18). % <- this is good
true.
?- min(17).
false.
?- min(19).
false.
What is wrong?
How to fix?
You are using (\+)/1 which explains:
?- min(X).
false.
No position is negative [X0,Y0] ins 0..sup. Assuming the game doesn't start in the winning position (X0+Y0 #< 77), only the last move is winning (X+Y #>= 77).
move_(s(X,Y), s(X0,Y0), s(X,Y)) :-
[X0,Y0] ins 0..sup,
X0+Y0 #< 77,
next_state(X0, Y0, X, Y).
moves([S0|Ss]) :-
foldl(move_, Ss, S0, s(X,Y)),
X+Y #>= 77.
min(Y) :-
Y0 in 0..77,
labeling([min], [Y0]),
moves([s(8,Y0),_,_]),
!, % commit to the minimum.
Y = Y0.
The search for the minimum is done with labeling([min], [Y0]).
Improved solution for any depth:
move_(s(P,X,Y), s(P0,X0,Y0), s(P,X,Y)) :-
P #= 1-P0,
X0+Y0 #< 77,
next_state(X0, Y0, X, Y).
min(Depth, s(P0,X0,Y0), s(P,X,Y)) :-
[X0,Y0] ins 0..sup,
X0+Y0 #< 77,
length(Ss, Depth),
foldl(move_, Ss, s(P0,X0,Y0), s(P,X,Y)),
X+Y #>= 77.
min(Y) :-
length(_, Depth),
Y0 in 0..77,
labeling([min], [Y0]),
min(Depth, s(0,8,Y0), s(P,_,_)), % Start with player 0. Player 1-P wins.
P = 0,
!, % commit to the minimum.
Y = Y0.
Without clpfd:
move(A, B, A1, B1) :-
( move_num(A, A1), B1 = B
; move_num(B, B1), A1 = A
).
move_num(N, N1) :-
( N1 is N + 1
; N1 is N * 2
).
won(A, B) :-
Tot is A + B,
% Fast integer comparison
Tot #>= 77.
turns(v(A, B), []) :-
% Second player has won
won(A, B).
turns(v(A, B), [state(first(A1,B1),second(A2,B2))|T]) :-
% First player
move(A, B, A1, B1),
\+ won(A1, B1),
% Second player
move(A1, B1, A2, B2),
turns(v(A2, B2), T).
?- time(findall(v(N, Len), (between(0, 20, N), once(( length(T, Len), turns(v(8, N), T) )) ), Vs)).
% 9,201 inferences, 0.001 CPU in 0.001 seconds (99% CPU, 17290920 Lips)
Vs = [v(0,2),v(1,2),v(2,2),v(3,2),v(4,2),v(5,2),v(6,2),v(7,2),v(8,2),v(9,2),v(10,2),v(11,2),v(12,2),v(13,2),v(14,2),v(15,2),v(16,2),v(17,2),v(18,1),v(19,1),v(20,1)].
... which shows that N=18 is the first to have length 1.
Could then use e.g. https://www.swi-prolog.org/pldoc/man?predicate=aggregate_all/3
Can improve efficiency by restricting the length of the turns to be best-so-far:
under_best_length(Len) :-
nb_getval(best_turns, Best),
( integer(Best) ->
Len is Best - 1
; Len = inf
).
best_length_update(Len, N) :-
nb_getval(best_turns, Best),
once(Best == undefined ; Len < Best),
nb_setval(best_turns, Len),
% Potentially useful
nb_setval(best_n, N).
Result in swi-prolog, annotated:
?- nb_setval(best_turns, undefined), between(-80, 80, N),
under_best_length(Best),
once(( between(1, Best, Len), length(T, Len), turns(v(8, N), T) )),
best_length_update(Len, N).
% The first solution becomes best-so-far
N = -80,
Best = inf,
Len = 3,
T = [state(first(9,-80),second(10,-80)),state(first(20,-80),second(40,-80)),state(first(80,-80),second(160,-80))] ;
% Narrowing down to length 2
N = -51,
Best = Len, Len = 2,
T = [state(first(16,-51),second(32,-51)),state(first(64,-51),second(128,-51))] ;
% Length 1 is first seen with N=18
N = 18,
Best = Len, Len = 1,
T = [state(first(8,36),second(8,72))] ;
% There is no solution with a length lower than 1
false.
Here is a one-liner to show the desired 18 answer:
?- time(( nb_setval(best_turns, undefined), between(0, 78, N),
under_best_length(Best),
once(( between(1, Best, Len), length(T, Len), turns(v(8, N), T) )),
best_length_update(Len, N), false ; nb_getval(best_n, BestN) )).
% 3,789 inferences, 0.001 CPU in 0.001 seconds (99% CPU, 5688933 Lips)
BestN = 18.
So I recently started to learn Prolog and I had a question regarding making a predicate which gives u all the possible solutions (next moves) as the current spot is given. The best example is a maze. So this is my data which tells me 'w = white' and 'b = black' within a 5x5 maze:
grid([ [w, w, w, b, w],
[b ,b, w, w, w],
[w, w, w, b, w],
[w, b, b, b, b],
[w, w, w, w, w] ]).
I also implemented a predicated called white/1, which tells me if the given spot in the maze is white:
white(X/Y) :-
grid(M),
nth1(X, M, Line),
nth1(Y, Line, w).
What I now want to do is make a predicate that gives me all the possible moves within the maze. For example if I query:
?- move(5/2, NextState).
NextState = 4/2 ;
NextState = 5/1 ;
NextState = 5/3 ;
No
This is my code, but it gives false and I know it's completely wrong, but I don't know how to implement such a predicate:
move(5/5, _).
move(X/Y, NextState) :-
white(X/Y),
X1 is X + 1,
X1 =< 5,
move(X1/Y, NextState),
Y1 is Y + 1,
Y1 =< 5,
move(X/Y1, NextState),
X2 is X - 1,
X2 >= 5,
move(X2/Y, NextState),
Y2 is Y - 1,
Y2 >= 0,
move(X/Y2, NextState).
If someone could help me, I would really appreciate it! :)
EDIT:
move(X/Y, _) :-
white(X/Y).
move(X/Y, X/Y) :-
X1 is X + 1,
move(X/Y, X1/Y);
X2 is X - 1,
move(X/Y, X2/Y);
Y1 is Y + 1,
move(X/Y, X/Y1);
Y2 is Y - 1,
move(X/Y, X/Y2).
If I query it gives me:
?- move(3/3, NextState).
true ;
NextState = 3/3 ;
NextState = 3/3 ;
NextState = 3/3 ;
NextState = 3/3 ;
move(X/Y, X1/Y1, Xm/Ym) :-
X1 is X + 1, Y1 = Y, X1 =< Xm;
X1 is X - 1, Y1 = Y, X1 > 0;
X1 = X, Y1 is Y + 1, Y1 =< Ym;
X1 = X, Y1 is Y - 1, Y1 > 0.
For each line in the above predicate we have a new direction. The Xm/Ym are bounds of the maze.
| ?- move(5/2, X, 5/5).
X = 4/2 ? ;
X = 5/3 ? ;
X = 5/1
yes
You can remove Xm/Ym as an argument and just put 5 in the body. Or you can define a new predicate
move1(Current, Next) :- move(Current, Next, 5/5)
Instead of disjunctions, we can also write multiple clauses.
move(X/Y, X1/Y) :- X1 is X + 1, X1 =< 5.
move(X/Y, X1/Y) :- X1 is X - 1, X1 > 0.
move(X/Y, X/Y1) :- Y1 is Y + 1, Y1 =< 5.
move(X/Y, X/Y1) :- Y1 is Y - 1, Y1 > 0.
Both are equivalent and this is even clearer.
How can I find the result of an arithmetic expression composed of pluses and minuses without using 'is'?
For example, to find the result of 1+2+3+4-6, I do: X is 1+2+3+4-6 and I get: X = 4.
What I've tried so far:
eval(EXPR, EXPR) :-
integer(EXPR),
!.
eval(X+Y, RES) :-
eval(X, X1),
eval(Y, Y1),
plus(X1, Y1, RES).
eval(X-Y, RES) :-
eval(X, X1),
eval(Y, Y1),
Y2 = -Y1,
plus(X1, Y2, RES).
but when I try to compute an expression containing negative numbers, I get the error: `integer' expected, found `- number` (a compound).
How can I solve it?
Add plus(Y1,Y2,0) instead of Y2 = -Y1.
In the latter case, Y2 is a structure with functor - and Argument Y1, whereas in the former case, Y1 is a number.
Take Y1 = 3 for example. [Just for fun: try it with Y1 = -3]
?- Y1 = 3, Y2 = -Y1, Y2 =.. L.
Y1 = 3,
Y2 = - 3,
L = [-, 3].
?- Y1 = 3, plus(Y1,Y2,0), Y2 =.. L.
Y1 = 3,
Y2 = -3,
L = [-3].
However, Y2 is supposed to be an argument in the predicate plus/3, which does not allow structures as arguments.
Maybe you prefer this solution:
eval(X-Y, RES) :-
eval(X, X1),
eval(Y, Y1),
plus(Y1, RES, X1).
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.
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.