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.
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).
I am writing a program to find all of the squares that a Knight can move to in a game of chess.
For example: validKnightMove(X1/Y1, X2/Y2). where each argument is a co-ordinate pair.
What I've done:
Written the predicate.
Made it deterministic using cuts.
Unit-tested it with PL-Unit.
The predicate works, but I cannot query it in a desirable way from the Prolog shell.
What I'd like to do:
I would like to make a query that will find all of the valid squares I can move to from a given location. For example, ?- validKnightMove(4/4, X/Y), then the shell would search for X and Y values which satisfy the predicate.
However, when I make the query, it simply returns false., despite having valid solutions.
Here is some output from the shell to demonstrate the issue:
1 ?- validKnightMove(4/4, 6/3).
true.
2 ?- validKnightMove(4/4, X/Y).
false.
Here is my code:
This code is admittedly verbose, but should be easy to read.
validKnightMove(X1/Y1, X2/Y2) :- % Right 1, Down 2
onBoard(X2/Y2),
X2 =:= X1 + 1,
Y2 =:= Y1 + 2,
!.
validKnightMove(X1/Y1, X2/Y2) :- % Right 2, Down 1
onBoard(X2/Y2),
X2 =:= X1 + 2,
Y2 =:= Y1 + 1,
!.
validKnightMove(X1/Y1, X2/Y2) :- % Left 2, Down 1
onBoard(X2/Y2),
X2 =:= X1 - 2,
Y2 =:= Y1 + 1,
!.
validKnightMove(X1/Y1, X2/Y2) :- % Left 1, Down 2
onBoard(X2/Y2),
X2 =:= X1 - 1,
Y2 =:= Y1 + 2,
!.
validKnightMove(X1/Y1, X2/Y2) :- % Right 1, Up 2
onBoard(X2/Y2),
X2 =:= X1 + 1,
Y2 =:= Y1 - 2,
!.
validKnightMove(X1/Y1, X2/Y2) :- % Right 2, Up 1
onBoard(X2/Y2),
X2 =:= X1 + 2,
Y2 =:= Y1 - 1,
!.
validKnightMove(X1/Y1, X2/Y2) :- % Left 2, Up 1
onBoard(X2/Y2),
X2 =:= X1 - 2,
Y2 =:= Y1 - 1,
!.
validKnightMove(X1/Y1, X2/Y2) :- % Left 1, Up 2
onBoard(X2/Y2),
X2 =:= X1 - 1,
Y2 =:= Y1 - 2,
!.
onBoard(X/Y) :-
between(1, 8, X),
between(1, 8, Y),
!.
My question is: Why can't prolog find all the solutions for a deterministic predicate?
Note: My prolog version is SWI-Prolog (Multi-threaded, 32 bits, Version 6.2.2)
I am trying to compile a SWI-Prolog program but keep getting test is always true, var (sum) error on line 7. I cant figure out what this means. Can someone please help? This is a program I am hoping will eventually solve Latin squares. Thank you.
:- use_module(library(clpfd)).
magic_counter(Count) :-
findall(a, magic_1(_Soln), As),
length(As, Count).
magic_1(Soln) :-
Row1 = [W1, W2, W3],
Row2 = [X1, X2, X3],
Row3 = [Y1, Y2, Y3],
Row1 ins 1..3,
Row2 ins 1..3,
Row3 ins 1..3,
Sum #= 6,
all_different(Row1),
all_different(Row2),
all_different(Row3),
all_different([W1,X1,Y1]),
all_different([W2,X2,Y2]),
all_different([W3,X3,Y3]),
W1 + W2 + W3 #= Sum,
X1 + X2 + X3 #= Sum,
Y1 + Y2 + Y3 #= Sum,
W1 + X1 + Y1 #= Sum,
W2 + X2 + Y2 #= Sum,
W3 + X3 + Y3 #= Sum,
append(Row1,Row2,Row12),
append(Row12,Row3,Soln),
labeling([], Soln).
It's a warning, not an error.
I posted some time again a request on SWI-Prolog mailing list for this problem, since some existing code begun to raise this warning after a refinement to messages. Here is the answer from Jan.
I think you can ignore the warning, or disable it, but this seems not advisable.
If a row consists of three integers between 1 and 3, and these integers must be distinct, then the sum of such a row must be 6 (by definition). Stating that the sum of such a row equals 6 is therefore an idle constraint. The same reasoning applies to the 'columns' for which you assert similar disjointness constraints.
Edit: Even though the above reasoning is correct, this is not the origin of the warning. Carlo is right on this, it simply depends on the way in which the constraint library rewrites the constraints.
test1:-
L = [X],
L ins 1..2,
Y #= 2,
X #= Y.
test2:-
L = [X],
L ins 1..2,
X #= 2.
test1/0 gives the warning, test2/0 does not. Still, I find it difficult to see why the warning is given in the first place, i.e. what the rational behind it is. For example, here is the expansion of test1/0 (notice my comments):
:- use_module(library(clpfd)).
test1:-
A=[D],
A ins 1..2,
(
integer(B)
->
(
var(2)
->
2 is B
;
true
->
B=:=2
;
C is B,
clpfd:clpfd_equal(C, 2)
)
;
true
->
(
var(B) % This does not throw a warning.
->
B is 2
;
C is 2,
clpfd:clpfd_equal(B, C)
)
;
clpfd:clpfd_equal(B, 2)
),
(
integer(D)
->
(
var(B) % This throws a "Test is always true" warning.
->
B is D
;
integer(B)
->
D=:=B
;
E is D,
clpfd:clpfd_equal(E, B)
)
;
integer(B)
->
(
var(D)
->
D is B
;
E is B,
clpfd:clpfd_equal(D, E)
)
;
clpfd:clpfd_equal(D, B)
).
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.