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).
An example will explain better what I'm trying to do.
For example, I have this prolog list:
L=[(d,15),(e,16),(g,23),(e,14),(h,23),(d,19)]
And I want to generate this list:
L'=[(d,15),(g,23),(e,14),(h,23)]
This is, from all occurrences of element (X,_), leave the one with the smallest Y.
Not really elegant but... what about the following code?
getFirst((X, _), X).
isMinor(_, []).
isMinor((X1, Y1), [(X2, _) | T]) :-
X1 \= X2,
isMinor((X1, Y1), T).
isMinor((X, Y1), [(X, Y2) | T]) :-
Y1 =< Y2,
isMinor((X, Y1), T).
purgeList(_, [], []).
purgeList(X1, [(X2, Y2) | Tin], [(X2, Y2) | Tout]) :-
X1 \= X2,
purgeList(X1, Tin, Tout).
purgeList(X, [(X, _) | Tin], Tout) :-
purgeList(X, Tin, Tout).
filterList([], []).
filterList([H1 | Tin1], [H1 | Tout]) :-
isMinor(H1, Tin1),
getFirst(H1, X),
purgeList(X, Tin1, Tin2),
filterList(Tin2, Tout).
filterList([H1 | Tin], Tout) :-
\+ isMinor(H1, Tin),
filterList(Tin, Tout).
From
filterList([(d,15),(e,16),(g,23),(e,14),(h,23),(d,19)], L)
I obtain (L is unified with)
[(d,15),(g,23),(e,14),(h,23)]
You could also write:
select_elements(L,Lout):-
sort(L,L1),
reverse(L1,L2),
remove(L2,L3),
output_list(L,L3,Lout).
remove([],[]).
remove([H],[H]).
remove([(X,Y1),(X,Y2)|T],[(X,Y1)|T1]):-remove([(X,Y2)|T],T1).
remove([(X1,Y1),(X2,Y2)|T],[(X1,Y1)|T1]):-
dif(X1,X2),\+member((X2,_),T),
remove([(X2,Y2)|T],T1).
remove([(X1,Y1),(X2,_)|T],[(X1,Y1)|T1]):-
dif(X1,X2),member((X2,_),T),
remove(T,T1).
output_list([],_,[]).
output_list([H|T],L,[H|T1]):-member(H,L),output_list(T,L,T1).
output_list([H|T],L,T1):- \+member(H,L),output_list(T,L,T1).
Example:
?- select_elements([(d,15),(e,16),(g,23),(e,14),(h,23),(d,19)],L).
L = [ (d, 15), (g, 23), (e, 14), (h, 23)] ;
false.
You can try
test((V, N), Y, Z) :-
( member((V,N1), Y)
-> ( N < N1
-> select((V,N1), Y, (V,N), Z)
; Z = Y)
; append(Y, [(V,N)], Z)).
my_select(In, Out) :-
foldl(test, In, [], Out).
For example
?- my_select([(d,15),(e,16),(g,23),(e,14),(h,23),(d,19)], Out).
Out = [(d,15),(e,14),(g,23),(h,23)] ;
false.
Let's say I have Prolog facts such as:
fact1(x, [y1, y2, y3, y4]).
fact2(z1, [s, t, u, **y3**).
fact2(z2, [o, p, **y1**, q, r]).
fact2(z3, [**y1**, m, **y3**, n]).
fact2(z4, [j, k, **y4**, l]).
fact2(z5, [**y2**, d, e, f, g, h, i]).
fact2(z6, [a, b, c, **y4**]).
And, I want a query such that I get all the 'z' who are related to x.
Thus, this query should output z1, z2, z3, z4, z5, z6 because they all contain an element y1, y2, y3, and/or y4 because they are related to x in the first Prolog fact.
The following code outputs all of z's relation's of fact2:
fact2(_,X).
And the following code outputs x's relation of fact1:
fact1(x,X).
Thus, I figured that I would need to get the intersection of the two sets with the following code, but it doesn't work.
xyz(X):-
intersection(fact2(_,X),fact2(x,X),X).
This doesn't work, can someone lead me in the right direction?
With the query, what I need to get is: z1, z2, z3, z4, z5, z6 because they all contain either y1, y2, y3, and/or y4 due to the fact that those are all related to x int he first fact.
If you need clarification, please let me know. Thank you.
this snippet
xyz(L):-
fact1(x, L1),
setof(K, L2^I^(fact2(K, L2), intersection(L1,L2,I), I \= []), L).
yields
?- xyz(L).
L = [z1, z2, z3, z4, z5, z6].
You must instantiate each term on fact2 and fact1 in a different variable, otherwise you are forcing the instances to match identically. Also, lose the asterics on the facts "fact2", and close the clasp in the first fact "fact2", after the element y3.
If you wanna keep the asterics, then enclose them between single quotation mark.
fact1(x, [y1, y2, y3, y4]).
fact2(z1, [s, t, u, '**y3**']).
fact2(z2, [o, p, y1, q, r]).
fact2(z3, [y1, m, y3, n]).
fact2(z4, [j, k, y4, l]).
fact2(z5, [y2, d, e, f, g, h, i]).
fact2(z6, [a, b, c, y4]).
xyz(Z):- fact2(Z,X),fact1(_,Y), intersection(X,Y,I), I\=[].
Then try asking:
?- xyz(X)
or this if you want all the answers in a single list L:
?- setof(Z, xyz(Z), L).
I am a very green when it comes to prolog, but essentially what I am trying to do is implement recursion to parse a grammar rule. What I have seems to be correct logically but obviously not because I am not getting the expected outcome.
Here is the rule I want to parse:
S -> X Y Z
X -> a X | a
Y -> b Y | b
Z -> c Y | c
Here is the prolog code:
match(X, [X|T], T).
xs(X0, X):- match(a, X0, X).
xs(X0, X):- xs(X0, X).
ys(X0, X):- match(b, X0, X).
ys(X0, X):- ys(X0, X).
zs(X0, X):- match(c, X0, X).
zs(X0, X):- zs(X0, X).
s(X0, X):- xs(X0, X1), ys(X1, X2), zs(X2, X).
Any help in understanding what I am doing wrong would be greatly appreciated.
Cheers.
maybe the grammar translation must be completed, like in
xs(X0, X):- match(a, X0, X).
xs(X0, X):- match(a, X0, X1), xs(X1, X).
...
I would suggest to take a look at the translation that a DCG has to offer:
s --> x,y,z.
x --> [a], x | [a].
y --> [b], y | [b].
z --> [c], y | [c].
consulted and listed results in
z(A, C) :-
( A=[c|B],
y(B, C)
; A=[c|C]
).
y(A, C) :-
( A=[b|B],
y(B, C)
; A=[b|C]
).
x(A, C) :-
( A=[a|B],
x(B, C)
; A=[a|C]
).
s(A, D) :-
x(A, B),
y(B, C),
z(C, D).
In each XS YS ZS method when calling recursively need to call match again.