my problem is:
While learning Prolog i wanted to make a NxN Sudoku solver.
This solver will get the input like
[[1,2,3,4],[3,4,1,2],[2,3,4,1],[4,1,2,3]]
Where some of them might be variables. The solver has to solve that Sudoku.
The problem is way smaller:
firstElementsOf([],_).
firstElementsOf([[X|_]|Rest2],Y) :-
firstElementsOf(Rest2,Y2),
append([X],[Y2],NotFlat),
flatten(NotFlat,Y).
This should be the beginning of checking, if every column has distinct numbers. The Y from firstElementsOf should contain only the first elements of the given rows. In the Example:
[1,3,2,4]
Sadly, thanks to append, it always adds another empty space to the Y list.
It gives:
[1,3,2,4,_1320]
Question1: Is there a way to get rid of that _1320?
Question2: Is this even right? Will there be a way to get the 2nd and 3rd elements of the Input with that?
For question 1: I suppose the error is in
firstElementsOf([],_).
I think should be
firstElementsOf([],[]).
Off topic: are you sure that you can't simply write the other clause as follows?
firstElementsOf([[X|_]|Rest2],[X|Y]) :-
firstElementsOf(Rest2,Y).
For question 2: I propose a more general predicate: the following getPosList/3 with support of getPosElem/3
getPosElem([H | _], 1, H).
getPosElem([_ | T], Pos, H) :-
Pos > 1,
Pm1 is Pos - 1,
getPosElem(T, Pm1, H).
getPosList([], _, []).
getPosList([H | T], Pos, [E | L]) :-
getPosElem(H, Pos, E),
getPosList(T, Pos, L).
It extract a list of all elements in position Pos, so
getPosList([[1,2,3,4],[3,4,1,2],[2,3,4,1],[4,1,2,3]], 1, L),
it's equivalent to firstElementOf([[1,2,3,4],[3,4,1,2],[2,3,4,1],[4,1,2,3]], L) and extract [1, 3, 2, 4],
getPosList([[1,2,3,4],[3,4,1,2],[2,3,4,1],[4,1,2,3]], 2, L),
extract [2, 4, 3, 1],
getPosList([[1,2,3,4],[3,4,1,2],[2,3,4,1],[4,1,2,3]], 3, L),
extract [3, 1, 4, 2],
getPosList([[1,2,3,4],[3,4,1,2],[2,3,4,1],[4,1,2,3]], 4, L),
extract [4, 2, 1, 3] and
getPosList([[1,2,3,4],[3,4,1,2],[2,3,4,1],[4,1,2,3]], 5, L),
or a number greather than 5, return false
Related
I want to exclude multiple rotations/mirrors of a list in my solutions of the predicate. I'll give an example of what I understand are rotations/mirrors of a list:
[1,2,3,4,5]
[2,3,4,5,1]
[3,4,5,1,2]
[5,4,3,2,1]
I have to find a predicate that delivers unique sequence of numbers from 1 to N, according to some constraints. I already figured out how to compute the right sequence but I can't find out how to exclude all the rotations and mirrors of 1 list. Is there an easy way to do this?
Edit:
Full predicate. clock_round(N,Sum,Yf) finds a sequence of the numbers 1 to N in such a way that no triplet of adjacent numbers has a sum higher than Sum.
clock_round(N,Sum,Yf) :-
generate(1,N,Xs),
permutation(Xs,Ys),
nth0(0,Ys,Elem1),
nth0(1,Ys,Elem2),
append(Ys,[Elem1,Elem2],Ym),
safe(Ym,Sum),
remove_duplicates(Ym,Yf).
remove_duplicates([],[]).
remove_duplicates([H | T], List) :-
member(H, T),
remove_duplicates( T, List).
remove_duplicates([H | T], [H|T1]) :-
\+member(H, T),
remove_duplicates( T, T1).
% generate/3 generates list [1..N]
generate(N,N,[N]).
generate(M,N,[M|List]) :-
M < N, M1 is M + 1,
generate(M1,N,List).
% permutation/2
permutation([],[]).
permutation(List,[Elem|Perm]) :-
select(Elem,List,Rest),
permutation(Rest,Perm).
safe([],_).
safe(List,Sum) :-
( length(List,3),
nth0(0,List,Elem1),
nth0(1,List,Elem2),
nth0(2,List,Elem3),
Elem1 + Elem2 + Elem3 =< Sum
; [_|RestList] = List, % first to avoid redundant retries
nth0(0,List,Elem1),
nth0(1,List,Elem2),
nth0(2,List,Elem3),
Elem1 + Elem2 + Elem3 =< Sum,
safe(RestList,Sum)
).
So what you want is to identify certain symmetries. At first glance you would have to compare all possible solutions with such. That is, in addition of paying the cost of generating all possible solutions you will then compare them to each other which will cost you a further square of the solutions.
On the other hand, think of it: You are searching for certain permutations of the numbers 1..n, and thus you could fix one number to a certain position. Let's fix 1 to the first position, that is not a big harm, as you can generate the remaining n-1 solutions by rotation.
And then mirroring. What happens, if one mirrors (or reverses) a sequence? Another sequence which is a solution is produced. The open question now, how can we exclude certain solutions and be sure that they will show up upon mirroring? Like: the number after 1 is larger than the number before 1.
At the end, rethink what we did: First all solutions were generated and only thereafter some were removed. What a waste! Why not avoid to produce useless solutions first?
And even further at the end, all of this can be expressed much more efficiently with library(clpfd).
:- use_module(library(clpfd)).
clock_round_(N,Sum,Xs) :-
N #=< Sum, Sum #=< 3*N -2-1,
length(Xs, N),
Xs = [D,E|_],
D = 1, append(_,[L],Xs), E #> L, % symmetry breaking
Xs ins 1..N,
all_different(Xs),
append(Xs,[D,E],Ys),
allsums(Ys, Sum).
allsums([], _).
allsums([_], _).
allsums([_,_], _).
allsums([A,B,C|Xs], S) :-
A+B+C #=< S,
allsums([B,C|Xs], S).
?- clock_round_(N, Sum, Xs), labeling([], [Sum|Xs]).
N = 3, Sum = 6, Xs = [1,3,2]
; N = 4, Sum = 9, Xs = [1,3,4,2]
; N = 4, Sum = 9, Xs = [1,4,2,3]
; N = 4, Sum = 9, Xs = [1,4,3,2]
; N = 5, Sum = 10, Xs = [1,5,2,3,4]
; ... .
Here is a possibility do do that :
is_rotation(L1, L2) :-
append(H1, H2, L1),
append(H2, H1, L2).
is_mirror(L1, L2) :-
reverse(L1,L2).
my_filter([H|Tail], [H|Out]):-
exclude(is_rotation(H), Tail, Out_1),
exclude(is_mirror(H), Out_1, Out).
For example
?- L = [[1,2,3,4,5],[2,3,4,5,1],[3,4,5,1,2],[5,4,3,2,1], [1,3,2,4,5]],my_filter(L, Out).
L = [[1, 2, 3, 4, 5], [2, 3, 4, 5, 1], [3, 4, 5, 1, 2], [5, 4, 3, 2, 1], [1, 3, 2, 4|...]],
Out = [[1, 2, 3, 4, 5], [1, 3, 2, 4, 5]].
% appends an element to the beginning of a list.
append_element(X, T, [X|T]).
% append a list to another list to create a combined list,
% by breaking the first list apart, and using append_element.
append_list([], L, L).
append_list([H|T], L, NewList) :-
append_element(H, L, NL),
append_list(T, NL, NL).
When I try to run append_list,
?- append_list([1,2], [3, 4, 5], NL).
I get back false. Instead of
NL = [2, 1, 3, 4, 5].
Why?
I am trying to run code on this page: https://swish.swi-prolog.org/example/clpfd_queens.pl in swipl on a Linux terminal.
:- use_module(library(clpfd)).
n_queens(N, Qs) :-
length(Qs, N),
Qs ins 1..N,
safe_queens(Qs).
safe_queens([]).
safe_queens([Q|Qs]) :-
safe_queens(Qs, Q, 1),
safe_queens(Qs).
safe_queens([], _, _).
safe_queens([Q|Qs], Q0, D0) :-
Q0 #\= Q,
abs(Q0 - Q) #\= D0,
D1 #= D0 + 1,
safe_queens(Qs, Q0, D1).
Following command works:
?- n_queens(4, Qs), labeling([ff], Qs).
But not just n_queens(4, Qs):
?- n_queens(4, Qs).
Qs = [_G1470, _G1473, _G1476, _G1479],
_G1470 in 1..4,
abs(_G1470-_G1479)#\=3,
_G1470#\=_G1479,
abs(_G1470-_G1476)#\=2,
_G1470#\=_G1476,
abs(_G1470-_G1473)#\=1,
_G1470#\=_G1473,
_G1479 in 1..4,
abs(_G1476-_G1479)#\=1,
_G1476#\=_G1479,
abs(_G1473-_G1479)#\=2,
_G1473#\=_G1479,
_G1476 in 1..4,
abs(_G1473-_G1476)#\=1,
_G1473#\=_G1476,
_G1473 in 1..4.
Why is labeling part needed here? Can one get proper output without labeling part?
For larger numbers, one gets only initial part of the solution:
?- n_queens(20, Qs), labeling([ff], Qs).
Qs = [1, 3, 5, 14, 17, 4, 16, 7, 12|...] ;
Qs = [1, 3, 5, 18, 16, 4, 10, 7, 14|...] ;
...
How can one get full list output for larger numbers? Also, how can one get all numbers together, without having to press spacebar for each solution? Thanks for your help.
n_queens/2 does not solves the N-queens problem for N queens: it constructs the constraint programming problem: it constructs N variables (the columns of the queens), and adds constraints between these queens: for instance that two queens can not be placed on the same row, nor on the same diagonal. We see this if we rewrite the problem output to more convenient output:
A in 1..4,
abs(A-D)#\=3,
A#\=D,
abs(A-C)#\=2,
A#\=C,
abs(A-B)#\=1,
A#\=B,
D in 1..4,
abs(C-D)#\=1,
C#\=D,
abs(B-D)#\=2,
B#\=D,
C in 1..4,
abs(B-C)#\=1,
B#\=C,
B in 1..4.
So we see four queens (A, B, C and D). Each of the queens should be in the domain 1..4, furthermore we see non equal constraints like A #\= D to prevent the first queen A sharing a column with the last queen D. We finally see constraints like abs(A-C) #\= 2 to prevent the first queen A and the third queen C to differ two columns (diagnal attack).
Next labeling/2 will actually solve the problem: it performs relaxation (reducing the domains) as well as branching (picking a value or a subrange of values for variables) and backtracking in case the constraints fail. It will continue until it finds a solution, and we can use Prolog's backtracking mechanism to let labeling/2 come up with more solutions.
labeling thus is given a list of variables and aims to label them: assign them a value out of the range such that all constraints are satisfied.
Therefore the problem construction part is usually very fast compared to the actually solving part: it is easy to generate O(N) variables and O(N2) constraints, but it can take an exponential amount of time O(DN) to come up with a solution satisfying all constraints.
Also, how can one get all numbers together, without having to press spacebar for each solution?
You can use the meta-predicate findall/3 for that:
all_n_queens(N,LL) :-
findall(L,(n_queens(N,L), labeling([ff], L)),LL).
Which generates:
?- all_n_queens(5,LL).
LL = [[1, 3, 5, 2, 4], [1, 4, 2, 5, 3], [2, 4, 1, 3, 5], [2, 5, 3, 1, 4], [3, 1, 4, 2|...], [3, 5, 2|...], [4, 1|...], [4|...], [...|...]|...].
How can one get full list output for larger numbers?
You can set the answer_write_options flag:
?- set_prolog_flag(answer_write_options,[max_depth(0)]).
true.
?- all_n_queens(5,LL).
LL = [[1,3,5,2,4],[1,4,2,5,3],[2,4,1,3,5],[2,5,3,1,4],[3,1,4,2,5],[3,5,2,4,1],[4,1,3,5,2],[4,2,5,3,1],[5,2,4,1,3],[5,3,1,4,2]].
I recently started learning Prolog and I got a task to write a predicate list(N, L) that generates lists L such that:
L has length 2N,
every number between 1 and N occurs exactly twice in L,
between each pair of the same element there is an even number of other elements,
the first occurrences of each number are in increasing order.
The author states that there are N! such lists.
For example, for N = 3 all solutions are:
?- list(3, L).
L = [1, 1, 2, 2, 3, 3] ;
L = [1, 1, 2, 3, 3, 2] ;
L = [1, 2, 2, 1, 3, 3] ;
L = [1, 2, 2, 3, 3, 1] ;
L = [1, 2, 3, 3, 2, 1] ;
L = [1, 2, 3, 1, 2, 3] ;
false.
My current solution looks like:
even_distance(H, [H | _]) :-
!.
even_distance(V, [_, _ | T]) :-
even_distance(V, T).
list(N, [], _, Length, _, _) :-
Length =:= 2*N,
!.
list(N, [New | L], Max, Length, Used, Duplicates) :-
select(New, Duplicates, NewDuplicates),
even_distance(New, Used),
NewLength is Length + 1,
list(N, L, Max, NewLength, [New | Used], NewDuplicates).
list(N, [New | L], Max, Length, Used, Duplicates) :-
Max < N,
New is Max + 1,
NewLength is Length + 1,
list(N, L, New, NewLength, [New | Used], [New | Duplicates]).
list(N, L) :-
list(N, L, 0, 0, [], []).
It does two things:
if current maximum is less than N, add that number to the list, put it on the list of duplicates, and update the max;
select some duplicate, check if there is an even number of elements between it and the number already on the list (ie. that number is on odd position), then add it to the list and remove it from duplicates.
It works, but it's slow and doesn't look really nice.
The author of this exercise shows that for N < 12, his solution generates a single list with average of ~11 inferences (using time/1 and dividing the result by N!). With my solution it grows to ~60.
I have two questions:
How to improve this algorithm?
Can this problem be generalized to some other known one? I know about similar problems based on the multiset [1, 1, 2, 2, ..., n, n] (eg. Langford pairing), but couldn't find something like this.
I'm asking because the original problem is about enumerating intersections in a self-intersecting closed curve. You draw such curve, pick a point and direction and follow the curve, enumerating each intersection when met for the first time and repeating the number on the second meeting: example (with the answer [1, 2, 3, 4, 5, 3, 6, 7, 8, 1, 9, 5, 4, 6, 7, 9, 2, 8]).
The author states that every such curve satisfies the predicate list, but not every list corresponds to a curve.
I had to resort to arithmetic to satisfy the requirement about pairs of integers separated by even count of elements. Would be nice to be able to solve without arithmetic at all...
list(N,L) :- numlist(1,N,H), list_(H,L), even_(L).
list_([D|Ds],[D|Rs]) :-
list_(Ds,Ts),
select(D,Rs,Ts).
list_([],[]).
even_(L) :-
forall(nth0(P,L,X), (nth0(Q,L,X), abs(P-Q) mod 2 =:= 1)).
select/3 is used in 'insert mode'.
edit to avoid arithmetic, we could use this more verbose schema
even_(L) :-
maplist(even_(L),L).
even_(L,E) :-
append(_,[E|R],L),
even_p(E,R).
even_p(E,[E|_]).
even_p(E,[_,_|R]) :- even_p(E,R).
edit
Here is a snippet based on assignment in a prebuilt list of empty 'slots'. Based on my test, it's faster than your solution - about 2 times.
list(N,L) :-
N2 is N*2,
length(L,N2),
numlist(1,N,Ns),
pairs(Ns,L).
pairs([N|Ns],L) :- first(N,L,R),even_offset(N,R),pairs(Ns,L).
pairs([],_).
first(N,[N|R],R) :- !.
first(N,[_|R],S) :- first(N,R,S).
even_offset(N,[N|_]).
even_offset(N,[_,_|R]) :- even_offset(N,R).
My first attempt, filtering with even_/1 after every insertion, was much slower. I was initially focused on pushing the filter immediately after the select/3, and performance was indeed almost good as the last snippet, but alas, it loses a solution out of 6...
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...