I have made two programs in Prolog for the nqueens puzzle using hill climbing and beam search algorithms.
Unfortunately I do not have the experience to check whether the programs are correct and I am in dead end.
I would appreciate if someone could help me out on that.
Unfortunately the program in hill climbing is incorrect. :(
The program in beam search is:
queens(N, Qs) :-
range(1, N, Ns),
queens(Ns, [], Qs).
range(N, N, [N]) :- !.
range(M, N, [M|Ns]) :-
M < N,
M1 is M+1,
range(M1, N, Ns).
queens([], Qs, Qs).
queens(UnplacedQs, SafeQs, Qs) :-
select(UnplacedQs, UnplacedQs1,Q),
not_attack(SafeQs, Q),
queens(UnplacedQs1, [Q|SafeQs], Qs).
not_attack(Xs, X) :-
not_attack(Xs, X, 1).
not_attack([], _, _) :- !.
not_attack([Y|Ys], X, N) :-
X =\= Y+N,
X =\= Y-N,
N1 is N+1,
not_attack(Ys, X, N1).
select([X|Xs], Xs, X).
select([Y|Ys], [Y|Zs], X) :- select(Ys, Zs, X).
I would like to mention this problem is a typical constraint satisfaction problem and can be efficiency solved using the CSP module of SWI-Prolog. Here is the full algorithm:
:- use_module(library(clpfd)).
queens(N, L) :-
N #> 0,
length(L, N),
L ins 1..N,
all_different(L),
applyConstraintOnDescDiag(L),
applyConstraintOnAscDiag(L),
label(L).
applyConstraintOnDescDiag([]) :- !.
applyConstraintOnDescDiag([H|T]) :-
insertConstraintOnDescDiag(H, T, 1),
applyConstraintOnDescDiag(T).
insertConstraintOnDescDiag(_, [], _) :- !.
insertConstraintOnDescDiag(X, [H|T], N) :-
H #\= X + N,
M is N + 1,
insertConstraintOnDescDiag(X, T, M).
applyConstraintOnAscDiag([]) :- !.
applyConstraintOnAscDiag([H|T]) :-
insertConstraintOnAscDiag(H, T, 1),
applyConstraintOnAscDiag(T).
insertConstraintOnAscDiag(_, [], _) :- !.
insertConstraintOnAscDiag(X, [H|T], N) :-
H #\= X - N,
M is N + 1,
insertConstraintOnAscDiag(X, T, M).
N is the number of queens or the size of the board (), and , where , being the position of the queen on the line .
Let's details each part of the algorithm above to understand what happens.
:- use_module(library(clpfd)).
It indicates to SWI-Prolog to load the module containing the predicates for constraint satisfaction problems.
queens(N, L) :-
N #> 0,
length(L, N),
L ins 1..N,
all_different(L),
applyConstraintOnDescDiag(L),
applyConstraintOnAscDiag(L),
label(L).
The queens predicate is the entry point of the algorithm and checks if the terms are properly formatted (number range, length of the list). It checks if the queens are on different lines as well.
applyConstraintOnDescDiag([]) :- !.
applyConstraintOnDescDiag([H|T]) :-
insertConstraintOnDescDiag(H, T, 1),
applyConstraintOnDescDiag(T).
insertConstraintOnDescDiag(_, [], _) :- !.
insertConstraintOnDescDiag(X, [H|T], N) :-
H #\= X + N,
M is N + 1,
insertConstraintOnDescDiag(X, T, M).
It checks if there is a queen on the descendant diagonal of the current queen that is iterated.
applyConstraintOnAscDiag([]) :- !.
applyConstraintOnAscDiag([H|T]) :-
insertConstraintOnAscDiag(H, T, 1),
applyConstraintOnAscDiag(T).
insertConstraintOnAscDiag(_, [], _) :- !.
insertConstraintOnAscDiag(X, [H|T], N) :-
H #\= X - N,
M is N + 1,
insertConstraintOnAscDiag(X, T, M).
Same as previous, but it checks if there is a queen on the ascendant diagonal.
Finally, the results can be found by calling the predicate queens/2, such as:
?- findall(X, queens(4, X), L).
L = [[2, 4, 1, 3], [3, 1, 4, 2]]
If I read your code correctly, the algorithm you're trying to implement is a simple depth-first search rather than beam search. That's ok, because it should be (I don't see how beam search will be effective for this problem and it can be hard to program).
I'm not going to debug this code for you, but I will give you a suggestion: build the chess board bottom-up with
queens(0, []).
queens(N, [Q|Qs]) :-
M is N-1,
queens(M, Qs),
between(1, N, Q),
safe(Q, Qs).
where safe(Q,Qs) is true iff none of Qs attack Q. safe/2 is then the conjunction of a simple memberchk/2 check (see SWI-Prolog manual) and your not_attack/2 predicate, which on first sight seems to be correct.
A quick check on Google has found a few candidates for you to compare with your code and find what to change.
My favoured solution for sheer clarity would be the second of the ones linked to above:
% This program finds a solution to the 8 queens problem. That is, the problem of placing 8
% queens on an 8x8 chessboard so that no two queens attack each other. The prototype
% board is passed in as a list with the rows instantiated from 1 to 8, and a corresponding
% variable for each column. The Prolog program instantiates those column variables as it
% finds the solution.
% Programmed by Ron Danielson, from an idea by Ivan Bratko.
% 2/17/00
queens([]). % when place queen in empty list, solution found
queens([ Row/Col | Rest]) :- % otherwise, for each row
queens(Rest), % place a queen in each higher numbered row
member(Col, [1,2,3,4,5,6,7,8]), % pick one of the possible column positions
safe( Row/Col, Rest). % and see if that is a safe position
% if not, fail back and try another column, until
% the columns are all tried, when fail back to
% previous row
safe(Anything, []). % the empty board is always safe
safe(Row/Col, [Row1/Col1 | Rest]) :- % see if attack the queen in next row down
Col =\= Col1, % same column?
Col1 - Col =\= Row1 - Row, % check diagonal
Col1 - Col =\= Row - Row1,
safe(Row/Col, Rest). % no attack on next row, try the rest of board
member(X, [X | Tail]). % member will pick successive column values
member(X, [Head | Tail]) :-
member(X, Tail).
board([1/C1, 2/C2, 3/C3, 4/C4, 5/C5, 6/C6, 7/C7, 8/C8]). % prototype board
The final link, however, solves it in three different ways so you can compare against three known solutions.
Related
Given a list of regs regs (1,2,3, ...) what I want the code to do is to copy the position X to X + 1, I put some examples below. I have the following code in prolog:
exe(EA, copy(X), ES):-
EA =.. [reg|TH],
LL1 is X+1,
length(TH,LL),
LL2 is LL+X+1,
length(L1,LL1),
length(L2,LL2),
append(L1,LI1,TH),[EX|L2]=LT1,
flatten(reg[L1,EX,L2], LR),
ES=.. LR.
what i want to show me as a result is:
?- exe(reg(1,2,3,4), copy(2), ES).
result:
?- ES=reg(1,2,2,4)
?- exe(reg(4,6,2,9), copy(1), ES).
result:
?-ES=reg(4,4,2,9).
?- exe(reg(1,2), copy(2), ES).
result:
false
I think the code is wrong
Try to split up your goal into multiple aspects, like: getting the element at position X (nth_element), then try to implement a predicate overwriting a particular value. Below is code that works as you expect. It basically traverses lists in the Prolog-"standard" way.
% Get the nth element of a list, indices starting at 1
nth_element([X|_], 1, X) :- !.
nth_element([_|Xs], N, R) :-
M is N - 1,
nth_element(Xs, M, R).
% Overwrites the N-th position in a list by a new element
% Indices starting with 1
% overwrite(List, N, Element, New_List) :-
% overwrite([], _, _, []) :- !.
overwrite([_|Xs], 1, Y, [Y|Xs]) :- !.
overwrite([X|Xs], N, Y, [X|Ys]) :-
M is N - 1,
overwrite(Xs, M, Y, Ys).
exe(EA, copy(X), Es):-
EA =.. [reg|TH],
nth_element(TH, X, Element),
Y is X + 1,
overwrite(TH, Y, Element, New),
Es =.. [reg|New].
I need to fill a list with N characters at the end of it in Prolog.
Without libraries or maplist,findall commands.
I tried this code which was creating recursively more lists with "e" characters at the end but I needed one list.
append_e(_,0,[]).
append_e(List,E_size_loop,[ListTemp|List0]):-
E_size_loop>0,
N2 is E_size_loop-1,
append(List,[e],ListTemp),
append_e(ListTemp,N2,List0).
and this one was erasing my previous list and replacing it with my desired number of e characters
append_e(_,0,[]).
append_e(List,E_size_loop,ListTemp):-
E_size_loop>0,
N2 is E_size_loop-1,
append_e(List,N2,ListO),
append(ListO,[e],ListTemp)
append_e(Xs, N, Ys) :-
length(Es, N),
maplist(=(e), Es),
append(Xs, Es, Ys).
length and maplist can be combined into one definition:
append_e(Xs, N, Ys) :-
n_es(N, Es),
append(Xs, Es, Ys).
n_es(N, Es) :-
length(Es, N),
maplist(=(e), Es).
which in turn might be defined manually for the case that N is instantiated
n_es(N0, [e|Es]) :-
N0 > 0,
N1 is N0-1,
n_es(N1, Es).
n_es(0, []).
You need to copy the input list until you reach its end and then add the N copies of the given character:
fill_list([], Character, N, List) :-
fill_with_character(Character, N, List).
fill_list([Head| Tail0], Character, N, [Head| Tail]) :-
fill_list(Tail0, Character, N, Tail).
The fill_with_character/3 predicate can simply do a countdown while copying the character:
fill_with_character(_, 0, []) :- !.
fill_with_character(Character, N, [Character| Tail]) :-
N > 0,
M is N - 1,
fill_with_character(Character, M, Tail).
The cut in the first clause is a green cut that avoids a spurious choice point.
Sample call:
| ?- fill_list([a,b,c], d, 2, L).
L = [a,b,c,d,d]
yes
I have 2 lists with random number of elemets. Eg A=[1,2,4,5] and B=[1,2,3]. Result should be 2.
Code that I tried:
domains
Numbers1 = integer*
Numbers2 = integer*
int_list=integer*
predicates
nondeterm prinadl(integer, int_list)
clauses
//here going the code that read number that I've entered, and according to entered numer,programm should do something
answer(T):- T=5,
P = 0,
write ("Enter the 1st list"), readterm (int_list, L),
write ("Enter the 2nd list"), readterm (int_list, L2),
L2 = [H|V], prinadl(H, L), P1 = P + 1,
write(L2, P1, V).
prinadl (X, L):- L=[X|_], !.
prinadl (X, L):- L=[_|T], prinadl (X, T).
I'm totally new with prolog. Can you please say me where I'm wrong? All I need is to get number of matches printed to the console.
Thanks in advance.
This answer is based on two things: first, guesswork. second, if_/3 by #false.
Let's define
the meta-predicate count_left_while2/4.
count_left_while2(P_2,Xs,Ys,N)
counts
the number N of corresponding list items in Xs and Ys fulfilling P_2. Proceeding from left to right, count_left_while2 stops at the first two items not satisfying P_2. It also stops when one list is empty, but the other one is not.
:- use_module(library(clpfd)).
:- meta_predicate count_left_while2(2,?,?,?).
count_left_while2(P_2,Xs,Ys,N) :-
N #>= 0,
list_list_countleft_while(Xs,Ys,N,P_2).
nil_or_cons([]).
nil_or_cons([_|_]).
:- meta_predicate list_list_countleft_while(?,?,?,2).
list_list_countleft_while([],Xs,0,_) :-
nil_or_cons(Xs).
list_list_countleft_while([X|Xs],Ys,N,P_2) :-
list_list_prev_countleft_while(Ys,Xs,X,N,P_2).
:- meta_predicate list_list_prev_countleft_while(?,?,?,?,2).
list_list_prev_countleft_while([],_,_,0,_).
list_list_prev_countleft_while([Y|Ys],Xs,X,N,P_2) :-
if_(call(P_2,X,Y),
( N0 #>= 0, N #= N0+1, list_list_countleft_while(Xs,Ys,N0,P_2) ),
N = 0).
Let's use it in combination with reified term equality predicate (=)/3, like this:
:- count_left_while2(=,[1,2,4,5],[1,2,3],N).
N = 2.
I need to write a program that constructs a minimal dominating vector for a set of N-Dimensional vectors. A dominating vector for a set S of vectors is defined as a vector whose ith component is greater than or equal to the ith component of every vector in S, with i ranging over all dimensions of the vectors. The dimension N must be taken as input from the user.
Prolog doesn't have vectors. You can use lists, or structs of arity N.
In second case of course N must be less than the max arity allowed (SWI-Prolog has unlimited length...)
If you use lists, this code should do. I assume N is implicit from list length.
'minimal dominating vector'([V|Vs], Min) :-
'minimal dominating vector'(Vs, V, Min).
'minimal dominating vector'([], M, M).
'minimal dominating vector'([V|Vs], MinSoFar, Min) :-
maplist(min, V, MinSoFar, Updated),
'minimal dominating vector'(Vs, Updated, Min).
min(X, Y, M) :- X < Y -> M = X ; M = Y.
test:
?- 'minimal dominating vector'(["abc","aab","uaa"],M),format('~s',[M]).
aaa
M = [97, 97, 97].
If your Prolog doesn't have maplist/4 (I can't remember this detail of P#) then replace maplist(min, V, MinSoFar, Updated), with minvect(V, MinSoFar, Updated),, and add this definition
minvect([], [], []).
minvect([N|Ns], [M|Ms], [R|Rs]) :- min(N,M,R), !, minvect(Ns,Ms,Rs).
note, OT when I tried P# some year ago, I found it very slow, and memory ungry. If you have big arrays, then you're better to use LINQ
Serial Implementation:
fnt(M,N) :-
fnt2(M,N,0,[]).
fnt2(_,N,N,Ds) :-
reverse(Ds,R),
write(R).
fnt2(M,N,K,Ds) :-
column(M,K,Col),
max_list(Col,H),
K2 is K+1,
fnt2(M,N,K2,[H|Ds]).
row(M, N, Row) :-
nth(N, M, Row).
column(M, N, Col) :-
transpose(M, MT),
row(MT, N, Col).
symmetrical(M) :-
transpose(M, M).
transpose([[]|_], []) :- !.
transpose([[I|Is]|Rs], [Col|MT]) :-
first_column([[I|Is]|Rs], Col, [Is|NRs]),
transpose([Is|NRs], MT).
first_column([], [], []).
first_column([[]|_], [], []).
first_column([[I|Is]|Rs], [I|Col], [Is|Rest]) :-
first_column(Rs, Col, Rest).
nth(0,[X|_],X).
nth(N,[_|T],R):- M is N-1,nth(M,T,R).
max_list([H], H).
max_list([H|T], M2) :-
max_list(T, M),
M2 is max(H, M).
Parallel Implementation (Minor Tweaks)
fnt(M,N) :-
fnt2(M,N,0,[]).
fnt2(_,N,N,Ds) :-
reverse(Ds,R),
write(R).
fnt2(M,N,K,Ds) :-
column(M,K,Col),
max_list(Col,H),
K2 is K+1,
fork(fnt2(M,N,K2,[H|Ds])).
row(M, N, Row) :-
nth(N, M, Row).
column(M, N, Col) :-
transpose(M, MT),
row(MT, N, Col).
symmetrical(M) :-
transpose(M, M).
transpose([[]|_], []) :- !.
transpose([[I|Is]|Rs], [Col|MT]) :-
first_column([[I|Is]|Rs], Col, [Is|NRs]),
transpose([Is|NRs], MT).
first_column([], [], []).
first_column([[]|_], [], []).
first_column([[I|Is]|Rs], [I|Col], [Is|Rest]) :-
first_column(Rs, Col, Rest).
nth(0,[X|_],X).
nth(N,[_|T],R):- M is N-1,nth(M,T,R).
max_list([H], H).
max_list([H|T], M2) :-
max_list(T, M),
M2 is max(H, M).
reverse(A,R) :- reverse(A,[],R).
reverse([X|Y],Z,W) :- reverse(Y,[X|Z],W).
reverse([],X,X).
Test:
time(fnt([[1,2,3,56],[14,5,6,43],[7,8,9,22]],4)).
My database consists out of predicates like these:
road(1,2,geel).
road(2,3,blauw).
road(1,3,geel).
where the first 2 numbers are points. I have to check wether every point has a even number of roads. I managed to do it with the following code, but somehow I think there's a better way of doing this.
% Count(Element, List, Occurences) => Counts the amount of occurences of Element in the given List
count(_, [], 0).
count(X, [X | T], N) :-
!, count(X, T, N1),
N is N1 + 1.
count(X, [_ | T], N) :-
count(X, T, N).
checkRoad :-
findall(Point,(weg(Point,_,_) ; weg(_,Point,_)),List),
list_to_set(List,K),
foreach( (member(P,K), count(P, List,N)), N mod 2 =:= 0 ).
I think this approach would have better performance:
checkRoad:-
findall(Point,(road(Point,_,_) ; road(_,Point,_)),List), % renamed wge/3 with road/3
msort(List, SList),
checkEven(none, SList).
checkEven(_, []).
checkEven(Item, [Item|SList]):-
!,
checkOdd(Item, SList).
checkEven(_, [Item|SList]):-
checkOdd(Item, SList).
checkOdd(Item, [Item|SList]):-
checkEven(Item, SList).
If you first sort all the points then you can just traverse this sorted list once to test whether every point appears in an even number of roads.