Trying to solve a game in Prolog

user_789186 0
Viewed 100

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?
clpfd prolog
2 Answers

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.
user_144143240

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.
user_176283360
Related