I want to create a Prolog program that can connect conveyor belts to ovens and an output belt.
The program has the following facts:
factory(12,10).
oven((2,5),(4,5)).
oven((7,5),(7,5)).
blocked(0,9).
blocked(3,1).
blocked(5,1).
blocked(4,9).
blocked(5,9).
Where factory(X,Y) gives you the width of the factory (X) and the height (Y), oven((X,Y),(OutputX,OutputY)) gives you the x-y coordinates of the bottom leftcorner of the oven (each oven is of size 3 by 3) and their output coordinates (OutputX, OutputY), blocked(X,Y) represents a square in the factory that cannot contain an oven or a belt.
Then, given the following code pos_empty(X,Y) that returns whether a position can have a belt or not, create a term serveOven(Oven, Length, InBelts, Belts) that constructs a belt line from each starting belt in the list InBelts to the output coordinates of the Oven and that line can have a max length of Length.
The code to check if a position is empty:
pos_empty(X,Y) :-
\+(blocked(X,Y)),
\+(has_oven(X,Y)).
has_oven(X,Y) :-
oven((X1,Y1), _),
X2 is X1 + 3,
Y2 is Y1 + 3,
between(X1, X2, X),
between(Y1, Y2, Y).
The code I got is the following:
serveOven( oven(_, (OutX, OutY)), Length, InBelts, Belts) :-
findall(Belt, (member(InBelt, InBelts), make_belt(InBelt, OutX, OutY, Length, Belt)), Belts).
make_belt((X,Y), OutX, OutY, Length, [(X,Y) | Tail]) :-
pos_empty(X,Y),
(X = OutX, Y = OutY;
(X < OutX, NewX is X + 1, make_belt((NewX, Y), OutX, OutY, Length, Tail));
(X > OutX, NewX is X - 1, make_belt((NewX, Y), OutX, OutY, Length, Tail));
(Y < OutY, NewY is Y + 1, make_belt((X, NewY), OutX, OutY, Length, Tail));
(Y > OutY, NewY is Y - 1, make_belt((X, NewY), OutX, OutY, Length, Tail))),
length(Tail, Len),
Len < Length.
But this returns nothing. Can anybody help me? Thanks!
So, as said in the details:
The code I got is the following:
serveOven( oven(_, (OutX, OutY)), Length, InBelts, Belts) :-
findall(Belt, (member(InBelt, InBelts), make_belt(InBelt, OutX, OutY, Length, Belt)), Belts).
make_belt((X,Y), OutX, OutY, Length, [(X,Y) | Tail]) :-
pos_empty(X,Y),
(X = OutX, Y = OutY;
(X < OutX, NewX is X + 1, make_belt((NewX, Y), OutX, OutY, Length, Tail));
(X > OutX, NewX is X - 1, make_belt((NewX, Y), OutX, OutY, Length, Tail));
(Y < OutY, NewY is Y + 1, make_belt((X, NewY), OutX, OutY, Length, Tail));
(Y > OutY, NewY is Y - 1, make_belt((X, NewY), OutX, OutY, Length, Tail))),
length(Tail, Len),
Len < Length.
When running the query serveOven(oven((2,5),(4,5)), 20, [(11,2)], Belts). this resulted in an empty list of Belts. Which should not happen.
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.
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
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.
I'm trying to solve the 2-water jug problem in swi-prolog: Given 2 jugs of capacities 4 and 3 gallons respectively, I want to find the steps to obtain 2 gallons in jug of capacity 4 and 0 in the other.
I wrote programs for this problem in C++ using both bfs and dfs: http://kartikkukreja.wordpress.com/2013/10/11/water-jug-problem/. Now, I'm trying to solve the problem in prolog. I'm completely new to the language and my code doesn't terminate.
Here's the code I have so far:
% state(0, 0) is the initial state
% state(2, 0) is the goal state
% Jugs 1 and 2 have capacities 4 and 3 respectively
% P is a path to the goal state
% C is the list of visited states
solution(P) :-
path(0, 0, [state(0, 0)], P).
path(2, 0, [state(2, 0)|_], _).
path(0, 2, C, P) :-
not(member(state(2, 0), C)),
path(2, 0, [state(2, 0)|C], R),
P = ['Pour 2 gallons from 3-Gallon jug to 4-gallon.'|R].
path(X, Y, C, P) :-
X < 4,
not(member(state(4, Y), C)),
path(4, Y, [state(4, Y)|C], R),
P = ['Fill the 4-Gallon Jug.'|R].
path(X, Y, C, P) :-
Y < 3,
not(member(state(X, 3), C)),
path(X, 3, [state(X, 3)|C], R),
P = ['Fill the 3-Gallon Jug.'|R].
path(X, Y, C, P) :-
X > 0,
not(member(state(0, Y), C)),
path(0, Y, [state(0, Y)|C], R),
P = ['Empty the 4-Gallon jug on ground.'|R].
path(X, Y, C, P) :-
Y > 0,
not(member(state(X, 0), C)),
path(X, 0, [state(X, 0)|C], R),
P = ['Empty the 3-Gallon jug on ground.'|R].
path(X, Y, C, P) :-
X + Y >= 4,
X < 4,
Y > 0,
NEW_Y = Y - (4 - X),
not(member(state(4, NEW_Y), C)),
path(4, NEW_Y, [state(4, NEW_Y)|C], R),
P = ['Pour water from 3-Gallon jug to 4-gallon until it is full.'|R].
path(X, Y, C, P) :-
X + Y >=3,
X > 0,
Y < 3,
NEW_X = X - (3 - Y),
not(member(state(NEW_X, 3), C)),
path(NEW_X, 3, [state(NEW_X, 3)|C], R),
P = ['Pour water from 4-Gallon jug to 3-gallon until it is full.'|R].
path(X, Y, C, P) :-
X + Y =< 4,
Y > 0,
NEW_X = X + Y,
not(member(state(NEW_X, 0), C)),
path(NEW_X, 0, [state(NEW_X, 0)|C], R),
P = ['Pour all the water from 3-Gallon jug to 4-gallon.'|R].
path(X, Y, C, P) :-
X + Y =< 3,
X > 0,
NEW_Y = X + Y,
not(member(state(0, NEW_Y), C)),
path(0, NEW_Y, [state(0, NEW_Y)|C], R),
P = ['Pour all the water from 4-Gallon jug to 3-gallon.'|R].
Any help is appreciated.
The 'equal' operator in Prolog doesn't perform arithmetic, but unifies its two arguments.
Try (for instance) to replace this
NEW_Y = Y - (4 - X)
with
NEW_Y is Y - (4 - X)
OT: also Prolog, like any other language, benefits from code factoring: most path/4 rules expose the same pattern, thus the code could be more clean with an helper predicate: again, for instance
path(0, 2, C, P) :-
not(member(state(2, 0), C)),
path(2, 0, [state(2, 0)|C], R),
P = ['Pour 2 gallons from 3-Gallon jug to 4-gallon.'|R].
could be
path(0, 2, C, ['Pour 2 gallons from 3-Gallon jug to 4-gallon.'|R]) :-
upd_path(2, 0, C, R).
given
upd_path(X, Y, C, R).
not(member(state(X, Y), C)),
path(X, Y, [state(X, Y)|C], R).
edit: another OT hint: use memberchk/2 instead of member/2. It's more efficient and could make easier to trace the execution, being deterministic.
edit Also, the base case of recursion doesn't close the descriptions' list: try
path(2, 0, [state(2, 0)|_], []).
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(...)).