Defining 5x5 matrix - prolog

the problem is ; we have a function take 3 argument,
like; func ( [[0, 0, 0, 1, 0], [0, 1, 1, 1, 0], [0, 0, 1, 0, 0],
[0, 0, 1, 0, 0], [0, 0, 0, 1, 0]], (1, 1), X ) the first one is nested list, which is
show 5x5 matrix and 1s means it is full, 0 means empty and,
the second parameter (1,1) our starting point 1st row 1st column,
the 3rd parameter X is ; variable that we will unify with
the points that are accessible from the starting point which is (1,1)
so if asked;
?- func ( [ [0,0,0,1] [0,0,1,0] [0,0,1,1] [0,0,1,0] ], (1,1), X).
X = (1, 1);
X = (1, 2);
X = (1, 3);
X = (2, 2);
X = (3, 2);
X = (4, 1);
X = (4, 2);
false.
when we start from (1,1) we can move up, down, left and right;
since no left and up movement while on (1,1) look right if empty, write it, look down empty write down, go the (1,2) again, move right or left or up or down, and so on.
here the reason why we didn't write the outputs, (2,4) (4,4)
if for example point (2,3) is full and (2,4) is empty
we look that can we go point (2,4) one by one, I mean,
if left , up and down of them is full, we can't go point (2,4) using this point, since they are full.

My solution: get the textbook, sit at the computer, and figure it out for yourself! Simply labelling something as homework doesn't excuse not doing it yourself.

lastly I done it, here is the code;
%returns the nth element from the list
nth([F|_],1,F).
nth([_|R],N,M) :- N > 1, N1 is N-1, nth(R,N1,M).
%returns true if cell is empty: gets the cell value at (StartRow,StartColumn) and returns whether the value is 0
isempty(Maze,StartRow,StartColumn) :- nth(Maze,StartRow,Line),nth(Line,StartColumn,Y), Y == 0.
%returns the head of the list
head([Elem|_],Elem).
%find accessible returns empty list if not in maze size (1 to N for row and column)
findaccessible(Maze, (StartRow,StartColumn), [], _) :- head(Maze,L),length(L,N), (StartColumn > N ; StartRow > N ; StartColumn < 1 ; StartRow < 1).
%find all empty cells and retain them in X. L retains the current found cells in order to avoid returning to visited positions.
findaccessible(Maze, (StartRow,StartColumn), X, L) :-
%if cell is empty, retain position and add it to the list
isempty(Maze,StartRow,StartColumn) -> (union(L,[(StartRow,StartColumn)],L1),X1 = [(StartRow,StartColumn)],
%check right column and if element not visited, find all accessible cells from that point and unify the lists
SR is StartRow, SC is StartColumn+1,(member((SR,SC),L) -> union(X1,[],X2) ; (findaccessible(Maze, (SR,SC), Tmp1, L1), union(X1,Tmp1,X2))),
%check down row and if element not visited, find all accessible cells from that point and unify the lists
SR2 is StartRow+1,SC2 is StartColumn, (member((SR2,SC2),L) -> union(X2,[],X3) ; (findaccessible(Maze, (SR2,SC2), Tmp2, L1), union(X2,Tmp2,X3))),
%check left column and if element not visited, find all accessible cells from that point and unify the lists
SR3 is StartRow, SC3 is StartColumn-1, (member((SR3,SC3),L) -> union(X3,[],X4) ; (findaccessible(Maze, (SR3,SC3), Tmp3, L1), union(X3,Tmp3,X4))),
%check up row and if element not visited, find all accessible cells from that point and unify the lists
SR4 is StartRow-1, SC4 is StartColumn, (member((SR4,SC4),L) -> union(X4,[],X) ; (findaccessible(Maze, (SR4,SC4), Tmp4, L1), union(X4,Tmp4,X)))) ; X = [].
%lists each result
%if no more results return false
results(_,[]) :- fail.
%return the result or return the rest of the results
results(X,[Head|Rest]) :- X = Head ; results(X,Rest).
%accessible predicate that finds all empty accessible cells and then list each of them
accessible(Maze, (StartRow,StartColumn), X) :- findaccessible(Maze, (StartRow,StartColumn), Lst, []), !, results(X,Lst).
%sample test run
%accessible([[0, 0, 0, 1, 0], [0, 1, 1, 1, 0], [0, 0, 1, 0, 0], [0, 0, 1, 0, 0], [0, 0, 0, 1, 0]], (1, 1), X).

Related

Get diagonal from matrix

I want to get the left and right diagonals of a matrix containing the element with the given column and row indexes.
For example:
rightDiagonal([[1,2,3],[4,5,6],[7,8,9]], 1, 0, Diagonal).
Diagonal = [2,4]
leftDiagonal([[1,2,3],[4,5,6],[7,8,9]], 1, 0, Diagonal).
Diagonal = [4,8]
Thank you.
This is my try:
left_diagonal_left(Board, 0, Column_Index, List, New_List) :-
get_value_from_matrix(Board, Row_Index, Column_Index, Value),
append(List, Value, New_List).
left_diagonal_left(Board, Row_Index, 0, List, New_List) :-
get_value_from_matrix(Board, Row_Index, Column_Index, Value),
append(List, Value, New_List).
left_diagonal_left(Board, Row_Index, Column_Index, List, New_List) :-
get_value_from_matrix(Board, Row_Index, Column_Index, Value),
append(List, Value, New_List),
R = Row_Index - 1,
C = Column_Index - 1,
left_diagonal_left(Board, R, C, New_List, Newer_List).
left_diagonal_right(Board, 6, Column_Index, List, New_List).
left_diagonal_right(Board, Row_Index, 6, List, New_List).
left_diagonal_right(Board, Row_Index, Column_Index, List, New_List) :-
get_value_from_matrix(Board, Row_Index, Column_Index, Value),
append(List, Value, New_List),
R = Row_Index + 1,
C = Column_Index + 1,
left_diagonal_right(Board, R, C, New_List, Newer_List).
left_diagonal(Board, Row_Index, Column_Index, List, Newer_List) :-
left_diagonal_left(Board, Row_Index, Column_Index, List, New_List),
R = Row_Index + 1,
C = Column_Index + 1,
left_diagonal_right(Board, R, C, New_List, Newer_List).
The problem is that the append() fails.
We can make a generic predicate that can walk in both directions (to the left, and to the right).
We basically here need two parameters: the index of the first column, and and the "direction" in which we walk, this is -1 for "right", and 1 for "left".
We can thus implement a predicate diagonal/4 that will generate such diagional.
Basically there are three cases we need to take into account:
the matrix has "no rows", in that case the diagonal is an empty list;
the matrix has at least one row, but the index is too low/high, in that case the diagonal is an empty list as well; and
the matrix has at least one row, and the index is not out of range, in that case we add the element of the first row for the given column, and recursively call the predicate where we shift the column one to the right, or one to the left.
So we can implement this with:
diagonal([], _, _, []).
diagonal([Row|Rest], Col, DCol, Result) :-
( nth0(Col, Row, El)
-> (Result = [El | R2],
Col2 is Col + DCol,
diagonal(Rest, Col2, DCol, R2))
; Result = []).
So now we can obtain diagonals with:
?- diagonal([[4,5,6],[7,8,9]], 1, -1, Diagonal).
Diagonal = [5, 7].
?- diagonal([[1,2,3],[4,5,6],[7,8,9]], 1, -1, Diagonal).
Diagonal = [2, 4].
?- diagonal([[4,5,6],[7,8,9]], 0, 1, Diagonal).
Diagonal = [4, 8].
Of course the above is not yet complete: since in the question, one enters two coordinates. In case we take the right coordinate however, for a coordinate pair (X, Y), this is equivalent to (X+Y, 0). The same for left diagonals: the diagonal containing (X, Y) is the same as the one containing (0, Y-X). Note however that it is possible that X+Y, or Y-X are out of range, so we can first "normalize" the coordinate, but in case the coordinate is "too high", or "too low", we thus will need a to drop a certain number of rows, and each time updating the number until we reach a value that is in range.
So we can implement a predicate that first makes some iterations until it finds a valid index, and then passes control to the diagonal/4 predicate, for example prediagonal/4:
prediagonal([], _, _, []).
prediagonal([Row|Rest], Col, DCol, Result) :-
Col2 is Col + DCol,
( nth0(Col, Row, El)
-> (Result = [El | R2],
diagonal(Rest, Col2, DCol, R2))
; prediagonal(Rest, Col2, DCol, Result)).
So now we can write our left_diagonal/4 and right_diagonal in terms of prediagonal/4:
left_diagonal(M, R, C, Diagonal) :-
Delta is C-R,
prediagonal(M, Delta, 1, Diagonal).
right_diagonal(M, R, C, Diagonal) :-
Delta is R+C,
prediagonal(M, Delta, -1, Diagonal).
this then gives us:
?- right_diagonal([[1,2,3],[4,5,6],[7,8,9]], 1, 0, Diagonal).
Diagonal = [2, 4].
?- left_diagonal([[1,2,3],[4,5,6],[7,8,9]], 1, 0, Diagonal).
Diagonal = [4, 8].
The above is not the most elegant solution. It might be better to "merge" diagonal/4 and prediagonal/4 in one predicate. I leave this as an exercise.

Create a list from zero down to a negative number

I want to make a program in which the user will give a negative number and it will return a list starting from zero till that number. Here is a desired output example
create(-5,L).
L = [0,-1,-2,-3,-4,-5]
could you help me in any way, please?
I would break it up into two auxiliary predicates. The auxiliary predicate is helpful for building the list in the direction you desire.
create(N, L) :-
N < 0,
create_neg(N, 0, L).
create(N, L) :-
N >= 0,
create_pos(N, 0, L).
create_neg(N, N, [N]).
create_neg(N, A, [A|T]) :-
A > N,
A1 is A - 1,
create_neg(N, A1, T).
create_pos(N, N, [N]).
create_pos(N, A, [A|T]) :-
A < N,
A1 is A + 1,
create_pos(N, A1, T).
This will put them in the right order as well:
| ?- create(-5, L).
L = [0,-1,-2,-3,-4,-5] ? a
no
| ?- create(5, L).
L = [0,1,2,3,4,5] ? a
no
| ?-
What you're after is not really a program, just an 'idiomatic' pattern:
?- findall(X, (between(0,5,T), X is -T), L).
L = [0, -1, -2, -3, -4, -5].
Note the parenthesis around the Goal. It's a compound one...
Another way:
?- numlist(-5,0,T), reverse(T,L).
...
Since you provided your code (which as mentioned in comments would be better to appear in your question), one problem I think is that with X>0 and X<0 clauses-cases you will have infinite recursion, maybe it would be better to use abs/1:
create(0,[0]).
create(X,[X|T]):- Y is abs(X), Y > 0,
(X>0 -> N is X-1 ; N is X+1),
create(N,T).
Though still one problem:
?- create(-5,L).
L = [-5, -4, -3, -2, -1, 0] ;
false.
?- create(5,L).
L = [5, 4, 3, 2, 1, 0] ;
false.
The list is built reversed so you could reverse it at the end like:
create_list(N,L):- create(N,L1), reverse(L1, L).
And now:
?- create_list(5,L).
L = [0, 1, 2, 3, 4, 5] ;
false.
?- create_list(-5,L).
L = [0, -1, -2, -3, -4, -5] ;
false.

Testing solutions for Bert Bos puzzle

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:

Solving the Numberlink puzzle with prolog

I have an assignment that seems out of scope of my class (I say this because they barely taught us anything about prolog), I have to write a prolog program to solve the game "Flow Free" on android. In the assignment it is called Numberlink. I could solve this in C++ in a hour but because I'm not too familiar with prolog it is giving me trouble. Here's what I would like to do:
Make a list that holds a boolean to indicate whether it has been visited or used.
Recursively search all possible paths from a given starting point to
the end point using a breadth first search to find the shortest
paths.
Go from there I guess.
My attempt included searching the web on how to make a list. Of course prolog is not documented well at all anywhere so I came up blank and gave up. A friend told me to use maplist which I don't understand how I would use it to make a list including what I need.
Thanks in advance.
EDIT:
Thanks for the link, but I was looking to make a 2D list to represent the board being played on. Function would look like this:
makeList(size, list):-
Where size is an integer representing the size of one dimension in the square list ex. (7x7).
Here's an implementation of #CapelliC's solution. The code is self-explanatory. 2 blocks are connected if they are adjacent and have the same color, or adjacent to another connected block of the same color. (I used X and Y instead of row and column, it made writing the conditions at the end a little confusing.)
Solving in SWI-Prolog
https://flowfreesolutions.com/solution/?game=flow&pack=green&set=5&level=1
connected(P1, P2, M, Visited) :-
adjacent(P1, P2),
maplist(dif(P2), Visited),
color(P1, C, M),
color(P2, C, M).
connected(P1, P2, M, Visited) :-
adjacent(P1, P3),
maplist(dif(P3), Visited),
color(P1, C, M),
color(P3, C, M),
connected(P3, P2, M, [P3|Visited]).
adjacent(p(X,Y1), p(X,Y2)) :- Y2 is Y1+1.
adjacent(p(X,Y1), p(X,Y2)) :- Y2 is Y1-1.
adjacent(p(X1,Y), p(X2,Y)) :- X2 is X1+1.
adjacent(p(X1,Y), p(X2,Y)) :- X2 is X1-1.
color(p(X,Y), C, M) :-
nth1(Y, M, R),
nth1(X, R, C).
sol(M) :-
M = [[1,_,_,_,1],
[2,_,_,_,_],
[3,4,_,4,_],
[_,_,_,_,_],
[3,2,5,_,5]],
connected(p(1,1), p(5,1), M, [p(1,1)]),
connected(p(1,2), p(2,5), M, [p(1,2)]),
connected(p(1,3), p(1,5), M, [p(1,3)]),
connected(p(2,3), p(4,3), M, [p(2,3)]),
connected(p(3,5), p(5,5), M, [p(3,5)]).
Sample query:
?- sol(M).
M = [[1, 1, 1, 1, 1],
[2, 2, 2, 2, 2],
[3, 4, 4, 4, 2],
[3, 2, 2, 2, 2],
[3, 2, 5, 5, 5]].
The declarative Prolog 'modus operandi' is based on non determinism, implemented by depth first search. Let's apply to this puzzle: M is the playground, a list of lists of free cells (variables) or integers (colors)
one_step(M) :-
cell(M, X,Y, C),
integer(C), % the selected cell is a color
delta(X,Y,X1,Y1),
cell(M, X1,Y1, C). % bind adjacent to same color - must be free
cell(M, X,Y, C) :- nth1(Y,M,R), nth1(X,R,C).
% moves
delta(X,Y,X1,Y) :- X1 is X+1. % right
delta(X,Y,X1,Y) :- X1 is X-1. % left
delta(X,Y,X,Y1) :- Y1 is Y-1. % up
delta(X,Y,X,Y1) :- Y1 is Y+1. % down
what this does ? let's try on a 3x3 playground
?- M=[[_,9,_],[_,0,_],[_,_,9]],one_step(M).
M = [[_G1824, 9, 9], [_G1836, 0, _G1842], [_G1848, _G1851, 9]] ;
M = [[9, 9, _G1830], [_G1836, 0, _G1842], [_G1848, _G1851, 9]] ;
M = [[_G1824, 9, _G1830], [_G1836, 0, 0], [_G1848, _G1851, 9]] ;
M = [[_G1824, 9, _G1830], [0, 0, _G1842], [_G1848, _G1851, 9]] ;
M = [[_G1824, 9, _G1830], [_G1836, 0, _G1842], [_G1848, 0, 9]] ;
M = [[_G1824, 9, _G1830], [_G1836, 0, _G1842], [_G1848, 9, 9]] ;
M = [[_G1824, 9, _G1830], [_G1836, 0, 9], [_G1848, _G1851, 9]] ;
false.
No need to declare grid size, check index boundaries, etc... when one_step/1 succeeds it has instantiated a free cell to an adjacent same color...

Prolog BattleShips bombing game

So i'm programming a battleship game in prolog. The game has 5x5 board where ships should be located with similar logic to real game, which means they can't be side by side and touch each other at all.
So i've came across these problems.
How to make the code recognize which board Tiles(cordinates) have been already shot?
How can i programmatically recognize ships as a whole and how to use this knowledge to recognize when the ship has sank.
Currently the prompt loop will end after first hit, but goal is to end the loop when all ships are sank.
EDIT: Board contains 2 values 0 and 1, 0 is empty Tile, 1 represents that it has an ship part on it.
board([[0, 0, 0, 0, 0],
[1, 1, 0, 0, 0],
[0, 0, 0, 0, 0],
[1, 1, 1, 1, 0],
[0, 0, 0, 0, 0]]).
row_at(X, Row) :-
board(Board),
nth0(X, Board, Row).
column_at(Y, Row, Cell) :-
nth0(Y, Row, Cell).
ship_at(X, Y) :-
row_at(X, Row),
column_at(Y, Row, Cell),
Cell = 1.
hit:-
write('hit!'), nl.
miss :-
write('miss!'), nl.
target(X, Y, State) :-
(ship_at(X, Y) ->
hit, asserta(X,Y);
miss).
prompt_number(Prompt, Number) :-
write(Prompt),
write(': '),
read(Number).
:- initialization(main).
main :-
repeat,
prompt_number('enter column number', Col),
prompt_number('enter row number', Row),
target(Row, Col, State),
(ship_at(Row, Col) ->
write('you won!'), nl, halt ;
write('keep trying!'), nl, fail).

Resources