Related
Working on the Bert Bos Puzzle, where I need to print all possible permutations of a sequence (clicks or no clicks) that will turn the whole square red. This will be done by clicking the top row in a sequence of clicks and no clicks. Then, you go to the subsequent row and click squares there to make the first row all red. You progress through the puzzle like this until you turn the whole square red.
So a possible solution to a 4x4 square would be [click, click, no click, no click] on the first row. You dont have to follow the pattern for any of the lines below, just keep flipping until all blocks on the next line are red and continue till all squares are red.
Im trying to write a predicate that tests all possible permutations of ‘click’ and ‘no click’ for the first row of a square of size N. Right now Im trying to go about it by keeping track of the color of the top row after it has been clicked, then using that to say which squares of the second row should be clicked to make the top row all red.
The problem is I cant figure out how to keep track of the colors of the second row that are changed by clicks from the first row, and then how to keep track of clicks from the second row on and how they affect the rest of the rows. Any help would be greatly appreciated.
Here is what I have so far
state(no_click).
state(click).
flip(blue, red).
flip(red, blue).
board_permutations(0,[]):- !.
board_permutations(N, [H|T]) :-
state(H),
N1 is N - 1,
board_permutations(N1, T).
first_row_solutions([], []).
first_row_solutions([H1, H2|T], [FirstRow|SecondRow]):-
H1 = click,
flip(H1,C),
flip(H2,C),
first_row_solutions(H2, FirstRow).
first_row_solutions([H|T], [FRH1, FRH2, FRH3|FRT], [SR1, SR2, SR3|SRT]) :-
H = click,
flip(FRH1, C1),
flip(FRH2, C2),
flip(FRH3, C3),
%flip(SR1, S1), I was thinking I could keep track of the second row colors here
%flip(SR2, S2),
%flip(SR3, S3)
%FlipListRow1 = [C1, C2, C3 | T],
%FlipListRow2 = [S1, S2, S3|T],
first_row_solutions(H, FRH3).
%Possible predicate to handle row 2, 3, 4 etc --> ClickList is what clicks to do on row 3 to make row 2 red, etc
%row_n_solutions(FlipListRow2, ClickList)
generate_board(0, [], _).
generate_board(N, [H|T], ConstantN) :-
generate_row(ConstantN, H),
N =< 12, N >= 1,
N2 is N-1,
generate_board(N2, T, ConstantN).
generate_row(0, []) :- !.
generate_row(N, [H | T]) :-
N =< 12, N >= 1,
N2 is N-1,
H = blue,
generate_row(N2, T).
test(X) :- generate_board(5,X,5).
test1(X) :- solutions([no_click, click, no_click, no_click], X).
#CapelliC has already suggested one possible approach: You can carry along the matrix (using predicate arguments), and use this to always inspect the current state of any surrounding cells.
Complementing this approach, I would also like to point out a different method to approach the whole task: We can consider this puzzle as finding a suitable linear combination of vectors from the finite field GF(2). The number of clicks can be represented as an integer coefficient for each vector.
It only remains to establish a correspondence between board positions and vector indices. We can define such a relation as follows:
n_id_x_y(N, ID, X, Y) :-
ID #= Y*N + X,
N1 #= N - 1,
[X,Y] ins 0..N1.
Example:
?- n_id_x_y(4, 6, X, Y).
X = 2,
Y = 1.
Note that I specified 4 to obtain a mapping that works for 4×4 boards.
This uses CLP(FD) constraints and works in all directions, including for example:
?- n_id_x_y(4, ID, 3, 2).
ID = 11.
Based on this, we can also relate any index to its neighbours, again denoted by their unique indices:
n_id_neighbour(N, ID, NID) :-
n_id_x_y(N, ID, X, Y),
( ( NX #= X - 1, NY #= Y
; NX #= X + 1, NY #= Y
)
; ( NX #= X, NY #= Y - 1
; NX #= X, NY #= Y + 1
)
),
n_id_x_y(N, NID, NX, NY).
Clicking on any board position flips the colour of that position and its defined neighbours. We will use a Boolean vector and let 1 denote that the colour of the position that corresponds to this index is affected:
n_id_vector(N, ID, Vs) :-
V #= N*N,
V1 #= V - 1,
ID in 0..V1,
indomain(ID),
findall(NID, n_id_neighbour(N, ID, NID), Ns),
sort([ID|Ns], IDs),
length(Vs, V),
phrase(ids_vector(IDs, 0), Vs, Zeroes),
maplist(=(0), Zeroes).
ids_vector([], _) --> [].
ids_vector([ID|IDs], Pos0) -->
{ Gap #= ID - Pos0,
Pos #= ID + 1,
length(Zeroes, Gap),
maplist(=(0), Zeroes) },
Zeroes,
[1],
ids_vector(IDs, Pos).
For example, clicking on entry 0-0 affects precisely three other cells, which are indicated by 1:
?- n_id_vector(4, 0, Vs).
Vs = [1, 1, 0, 0, 1, 0, 0, 0, 0|...].
We are now ready to describe what we expect from a solution: A solution consists of a list of coefficients, one for each vector, such that the sum of the scalar products (vector times coefficient for each vector) modulo 2 is equal to (1,1,...,1). This means that the colour of each cell has changed.
n_solution(N, Cs) :-
findall(Vs, n_id_vector(N,_,Vs), Vss),
same_length(Vss, Cs),
Cs ins 0..1,
maplist(flip_cell(Cs), Vss),
label(Cs).
flip_cell(Cs, Ts) :-
scalar_product(Ts, Cs, #=, Sum),
Sum mod 2 #= 1.
Note that in this case, due to the inherent symmetry, there is no need to transpose the matrix.
The fact that we are reasoning over Boolean algebra already entails that the order in which the cells are clicked does not affect the outcome, and also that each of the vectors needs to be used at most once in any solution.
Here are solutions for a 4×4 board:
?- n_solution(4, Cs).
Cs = [0, 0, 0, 0, 1, 1, 1, 1, 1, 0, 0, 1, 1, 1, 1, 1] ;
Cs = [0, 0, 0, 1, 1, 1, 0, 0, 1, 1, 0, 0, 0, 0, 0, 1] ;
Cs = [0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0] ;
Cs = [0, 0, 1, 1, 1, 0, 1, 1, 0, 1, 0, 0, 1, 0, 1, 0] ;
etc.
Each solution indicates precisely which of the cells we must click. For example, the first solution:
Here is one of the longest solutions for this board size:
And this is one of the shortest:
You can of course also apply this approach to other board sizes, such as 7×7:
Or 12×12:
You have coins of values 5, 10, 20, 50, 100
whose weights are respectively 2g, 3g, 10g, 25g, 50g.
Your purse is weak so you cannot exceed the weight of 391g.
And you can put inside it only 3 coins having the same value.
Can you say what is the maximum value of your purse?
Query ::: change([(Five,Ten,Twenty,Fifty,Hundred),W,S])
range(I,I,[I]).
range(I,K,[I|L]) :-
I < K,
I1 is I + 1,
range(I1,K,L).
coin(X,L) :-
range(0,3,L1),
member(X,L1).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
change([(Five,Ten,Twenty,Fifty,Hundred),W,S]) :-
coin(Five,L),
coin(Ten,L),
coin(Twenty,L),
coin(Fifty,L),
coin(Hundred,L),
W1 = 50*Hundred + 25*Fifty + 10*Twenty +3*Ten+ 2*Five,
S1 = 5*Five+ 10*Ten+ 20*Twenty + 50*Fifty + 100*Hundred,
W1 < 391,
W is W1,
S is S1,
maximum(S1).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
maximum(S1) :-
S is S1,
threshold(S),
not( S1 < S).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
threshold(S1) :-
M is S1,
not( M < 451).
Use clpfd and simply run the following query:
:- use_module(library(clpfd)).
?- [Hundred,Fifty,Twenty,Ten,Five] ins 0..3,
Weight #=< 391,
Weight #= 50*Hundred + 25*Fifty + 10*Twenty + 3*Ten + 2*Five,
Value #= 100*Hundred + 50*Fifty + 20*Twenty + 10*Ten + 5*Five,
labeling([max(Value)], [Hundred,Fifty,Twenty,Ten,Five]).
Hundred = 3, Fifty = 3, Twenty = 3, Ten = 3, Five = 3, Value = 555, Weight = 270 ;
Hundred = 3, Fifty = 3, Twenty = 3, Ten = 3, Five = 2, Value = 550, Weight = 268 ;
...
'generate and test' performed by library(aggregate):
change(S) :-
aggregate(max(V), P^W^(purse(P, W, V), W < 391), S).
purse(P, W, V) :-
length(P, 5),
maplist(between(0, 3), P),
scalar(P, [2,3,10,25,50], W),
scalar(P, [5,10,20,50,100], V).
scalar(Vs, Fs, S) :-
foldl([V,F,V0,U]>>(U is V0+V*F), Vs, Fs, 0, S).
scalar/3 is a bit of overengineering, take it as a suggestion to look into scalar_product/4 if you go with library(clpfd)
Hi does anyone know other implementation to compute X at power N in Prolog beside this one:
predicates
power(real, integer, real)
clauses
power(_,0,1).
power(X,N,R):-
N<0,
N1 = -N,
X1 = 1/X,
power(X1,N1,R).
power(X,N,R):-
N1=N-1,
power(X,N1,R1),
R=R1*X.
In any case, I would treat the negative exponent with a predicate, as already given in the problem post, which is:
power(Base, N, P) :-
N < 0,
N1 is -N,
power(Base, N1, P1),
P is 1/P1.
So the following assume non-negative exponents.
This algorithm multiples the base N times:
power1(Base, N, P) :-
N > 0,
N1 is N - 1,
power1(Base, N1, P1),
P is P1 * Base.
power1(Base, N, P) :-
N < 0,
N1 is N + 1,
power1(Base, N1, P1),
P is P1 / Base.
power1( _Base, 0, 1 ).
This algorithm multiples the base N times using tail recursion:
power1t(Base, N, P) :-
N >= 0,
power1t(Base, N, 1, P).
power1t(Base, N, A, P) :-
N > 0,
A1 is A * Base,
N1 is N - 1,
power1t(Base, N1, A1, P).
power1t(_, 0, P, P).
This version uses the "power of 2" method, minimizing the multiplications:
power2(_, 0, 1).
power2(Base, N, P) :-
N > 0,
N1 is N div 2,
power2(Base, N1, P1),
( 0 is N /\ 1
-> P is P1 * P1
; P is P1 * P1 * Base
).
This version uses a "power of 2" method, minimizing multiplications, but is tail recursive. It's a little different than the one Boris linked:
power2t(Base, N, P) :-
N >= 0,
power2t(Base, N, Base, 1, P).
power2t(Base, N, B, A, P) :-
N > 0,
( 1 is N /\ 1
-> A1 is B * A
; A1 = A
),
N1 is N div 2,
B1 is B * B,
power2t(Base, N1, B1, A1, P).
power2t(_, 0, _, P, P).
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(...)).
I am trying to solve a puzzle in Prolog that involves taking a square of numbers (a list of a list of numbers) and returning the list of the greatest combination of numbers starting at the top and going down, row by row. Each move must be either down, down to the right, or down to the left.
I've been trying to do this for a while now, does anyone have a place I could begin?
For example, on the board
[[0, 2, 1, 0],
[0, 1, 1, 0],
[0,10,20,30]]
the best move would be [1, 2, 3] for 33 points.
So here is how you could do it. I know it's kinda wordy, that probably is because I'm not really fluent in Prolog either...
% Lookup a value in a list by it's index.
% this should be built into prolog?
at(0, [H|_], H).
at(N, [_|T], X) :-
N > 0,
N1 is N - 1,
at(N1, T, X).
% like Haskell's maximumBy; takes a predicate, a
% list and an initial maximum value, finds the
% maximum value in a list
maxby(_, [], M, M).
maxby(P, [H|T], M0, M) :-
call(P, H, M0, M1),
maxby(P, T, M1, M).
% which of two paths has the bigger score?
maxval(path(C, I), path(C1, _), path(C, I)) :- C >= C1.
maxval(path(C0, _), path(C, I), path(C, I)) :- C0 < C.
% generate N empty paths as a starting value for
% our search
initpaths(N, Ps) :-
findall(path(0, []),
between(0, N, _),
Ps).
% given the known best paths to all indexes in the previous
% line and and index I in the current line, select the best
% path leading to I.
select(Ps, I, N, P) :-
I0 is I-1,
I1 is I+1,
select(Ps, I0, N, path(-1, []), P0),
select(Ps, I, N, P0, P1),
select(Ps, I1, N, P1, P).
% given the known best paths to the previous line (Ps),
% an index I and a preliminary choice P0, select the path
% leading to the index I (in the previous line) if I is within
% the range 0..N and its score is greater than the preliminary
% choice. Stay with the latter otherwise.
select(_, I, _, P0, P0) :- I < 0.
select(_, I, N, P0, P0) :- I > N.
select(Ps, I, _, P0, P) :-
at(I, Ps, P1),
maxby(maxval, [P0], P1, P).
% given the known best paths to the previous line (P1),
% and a Row, which is the current line, extend P1 to a
% new list of paths P indicating the best paths to the
% current line.
update(P1, P, Row, N) :-
findall(path(C, [X|Is]),
( between(0, N, X)
, select(P1, X, N, path(C0, Is))
, at(X, Row, C1)
, C is C0 + C1),
P).
% solve the puzzle by starting with a list of empty paths
% and updating it as long as there are still more rows in
% the square.
solve(Rows, Score, Path) :-
Rows = [R|_],
length(R, N0),
N is N0 - 1,
initpaths(N, IP),
solve(N, Rows, IP, Score, Path).
solve(_, [], P, Score, Path) :-
maxby(maxval, P, path(-1, []), path(Score, Is0)),
reverse(Is0, Path).
solve(N, [R|Rows], P0, Score, Path) :-
update(P0, P1, R, N),
solve(N, Rows, P1, Score, Path).
Shall we try it out? Here are your examples:
?- solve([[0,2,1,0], [0,1,1,0], [0,10,20,30]], Score, Path).
Score = 33,
Path = [1, 2, 3] ;
false.
?- solve([[0,1,1], [0,2,1], [10,0,0]], Score, Path).
Score = 13,
Path = [1, 1, 0] ;
false.
My prolog is a bit shaky. In fact all I remember about prolog is that it's declarative.
Here is some haskell code to find the value of the max path. Finding the trace should be an easy next step, but a bit more complicated to code up I imagine. I suppose a very elegant solution for the trace would be using monads.
maxValue :: [ [ Int ] ] -> Int
maxValue p = maximum $ maxValueHelper p
maxValueHelper :: [ [ Int ] ] -> [ Int ]
maxValueHelper [ row ] = row
maxValueHelper ( row : restOfRows ) = combine row ( maxValueHelper restOfRows )
combine :: [ Int ] -> [ Int ]-> [ Int ]
combine [ x ] [ y ] = [ x + y ]
combine ( x1 : x2 : lx ) ( y1 : y2 : ly ) =
let ( z2 : lz ) = combine ( x2 : lx ) ( y2 : ly )
in
( max ( x1 + y1 ) ( x1 + y2 ) : max ( x2 + y1 ) z2 : lz )
main :: IO()
main = print $ maxValue [[0,2,1,0], [0,1,1,0], [0,10,20,30]]
?- best_path_score([[0, 2, 1, 0],[0, 1, 1, 0],[0,10,20,30]], P, S).
P = [1, 2, 3],
S = 33.
with this definition
best_path_score(Rs, BestPath, BestScore) :-
aggregate_all(max(Score, Path), a_path(Rs, Path, Score), max(BestScore, BestPath)).
a_path([R|Rs], [P|Ps], Score) :-
nth0(P, R, S0),
a_path(Rs, P, Ps, S),
Score is S0 + S.
a_path([], _, [], 0).
a_path([R|Rs], P, [Q|Qs], T) :-
( Q is P - 1 ; Q is P ; Q is P + 1 ),
nth0(Q, R, S0),
a_path(Rs, Q, Qs, S),
T is S0 + S.