PROLOG predicate answers true or false, but not the desired value - prolog

I am new to Prolog, and got stuck trying to make an auxiliary function that takes elements from a list, 2 at a time, and makes a vector.
For example:
L=[0,0,0,0,0,0,0,0], v_form([2,3,1,1],L).
L = [0,1,3,0,0,0,0,0] .
It should be like that, but im getting this:
?- L=[0,0,0,0,0,0,0,0], v_form([2,3,1,1],L).
L = [0, 0, 0, 0, 0, 0, 0, 0] .
My code is:
replace([_|T], 0, X, [X|T]).
replace([H|T], I, X, [H|R]):- I > 0, I1 is I-1, replace(T, I1, X, R).
v_form([],R).
v_form([X,Y|Z],R) :- replace(R,X,Y,K), v_form(Z,K).
I found this "A is not being Unified with anything in the body of your rules. The way Prolog works is via unification of terms. You cannot "return" A as in procedural languages as such", so im guessing R in my predicate is not being unified, but if thats the case, i dont understand why i get the desired value, when i change
v_form([],R).
for
v_form([],R).:- write(R).
i get:
?- L=[0,0,0,0,0,0,0,0], v_form([2,3,1,1],L).
[0,1,3,0,0,0,0,0]
L = [0, 0, 0, 0, 0, 0, 0, 0]
So, if its true that im not unifying R, why wrtie(R) dont throw an error/exception/prints []/ tell me its not unified, or something among those lines, but instead write the R i want the predicate to return.

You are 'returning' K instead of R, and must add another output parameter, because in Prolog you cannot 'reassign' a variable. That's the meaning of the statement you cite.
Try
v_form([],R,R).
v_form([X,Y|Z],I,R) :- replace(I,X,Y,K), v_form(Z,K,R).
?- L=[0,0,0,0,0,0,0,0], v_form([2,3,1,1],L,R).
L = [0, 0, 0, 0, 0, 0, 0, 0],
R = [0, 1, 3, 0, 0, 0, 0, 0] .

Related

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.

Prolog - merge digits to number

I want to merge list of digits to number.
[1,2,3] -> 123
My predicate:
merge([X], X).
merge([H|T], X) :-
merge(T, X1),
X is X1 + H * 10.
But now I get:
[1,2,3] -> 33
Another way to do it would be to multiply what you've handled so far by ten, but you need an accumulator value.
merge(Digits, Result) :- merge(Digits, 0, Result).
merge([X|Xs], Prefix, Result) :-
Prefix1 is Prefix * 10 + X,
merge(Xs, Prefix1, Result).
merge([], Result, Result).
The math is off. You're rule says you have to multiply H by 10. But really H needs to be multiplied by a power of 10 equivalent to its position in the list. That would be * 100 for the 1, and * 10 for the 2. What you get now is: 10*1 + 10*2 + 3 which is 33. The problem is that your recursive clause doesn't know what numeric "place" the digit is in.
If you structure the code differently, and use an accumulator, you can simplify the problem. Also, by using CLP(FD) and applying some constraints on the digits, you can have a more general solution.
:- use_module(library(clpfd)).
digits_number(Digits, X) :-
digits_number(Digits, 0, X).
digits_number([], S, S).
digits_number([D|Ds], S, X) :-
D in 0..9,
S1 #= S*10 + D,
digits_number(Ds, S1, X).
?- digits_number([1,2,3], X).
X = 123
?- digits_number(L, 123).
L = [1, 2, 3] ;
L = [0, 1, 2, 3] ;
L = [0, 0, 1, 2, 3] ;
L = [0, 0, 0, 1, 2, 3] ;
L = [0, 0, 0, 0, 1, 2, 3]
...
?-

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:

Constrain two lists to begin with N consecutive elements in total using CLP(FD)

I am trying to constrain two lists to begin with N consecutive elements (E) in total using CLP(FD). Here's an example: let L1 and L2 be two lists of size 6, the elements belong to the domain [0, 1], E = 1, and N = 3, then the predicate constraint(+L1, +L2, +N) would provide the following possible solutions:
L1 = [1, 1, 1, 0, _, _], L2 = [0, _, _, _, _, _];
L1 = [1, 1, 0, _, _, _], L2 = [1, 0, _, _, _, _];
L1 = [1, 0, _, _, _, _], L2 = [1, 1, 0, _, _, _];
L1 = [0, _, _, _, _, _], L2 = [1, 1, 1, 0, _, _].
For lists of size 3, the following would be acceptable:
L1 = [1, 1, 1], L2 = [0, _, _];
L1 = [1, 1, 0], L2 = [1, 0, _];
L1 = [1, 0, _], L2 = [1, 1, 0];
L1 = [0, _, _], L2 = [1, 1, 1].
I eventually want to generalize this to an arbitrary number of lists and domain, but this is the smallest equivalent problem I could think of.
Here's my (failed) attempt so far:
:- use_module(library(clpfd)).
constseq([], _, 0).
constseq([L|_], A, 0) :- L #\= A.
constseq([A|Ls], A, N) :- N1 #= N - 1, constseq(Ls, A, N1).
constraint(L1, L2, N) :-
SL1 + SL2 #= N,
constseq(L1, 1, SL1),
constseq(L2, 1, SL2).
main(L1, L2) :-
length(L1, 6),
length(L2, 6),
constraint(L1, L2, 3).
Although it works, note that I'm generating the solutions through backtracking, and not taking advantage of CLP(FD) to do the dirty job. I'm trying to figure out how to accomplish this, and I'm already looking at predicates like chain/2, and monsters like automaton/3, but something in me tells that there must be a simpler solution to this...
Inspired on SICStus example of exactly/3, here's my latest attempt:
constseq_(_, [], _, 0).
constseq_(X, [Y|L], F, N) :-
X #= Y #/\ F #<=> B,
N #= M+B,
constseq_(X, L, B, M).
constseq(L, E, N) :-
constseq_(E, L, 1, N).
I'd write it as follows (using ECLiPSe with library(ic)):
:- lib(ic).
:- lib(ic_global).
constraint(Xs, Ys, N) :-
Xs #:: 0..1,
Ys #:: 0..1,
sum(Xs) + sum(Ys) #= N,
ordered(>=, Xs),
ordered(>=, Ys).
which gives the desired solutions:
?- length(Xs,6), length(Ys,6), constraint(Xs,Ys,3), labeling(Xs), labeling(Ys).
Xs = [0, 0, 0, 0, 0, 0]
Ys = [1, 1, 1, 0, 0, 0]
Yes (0.00s cpu, solution 1, maybe more) ? ;
Xs = [1, 0, 0, 0, 0, 0]
Ys = [1, 1, 0, 0, 0, 0]
Yes (0.00s cpu, solution 2, maybe more) ? ;
Xs = [1, 1, 0, 0, 0, 0]
Ys = [1, 0, 0, 0, 0, 0]
Yes (0.00s cpu, solution 3, maybe more) ? ;
Xs = [1, 1, 1, 0, 0, 0]
Ys = [0, 0, 0, 0, 0, 0]
Yes (0.00s cpu, solution 4)

Defining 5x5 matrix

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

Resources