Related
Currently working on an exercise where, given some predicate, the syntactic complexity has to be calculated. The syntactic complexity of some predicate is calculated as follows:
If the predicate is atomic or a function, its complexity is 2.
If the predicate is a variable, its complexity is 1.
For example, the syntactic complexity of loyalty(father(bob, Y), X) is worked out as follows:
loyalty = 2 (function)
father = 2 (function)
bob = 2 (atom)
Y = 1 (variable)
X = 1 (variable)
Total = 8
The approach taken was calculating such complexity if the predicate was in the form of a nested list, i.e. loyalty(father(bob, Y), X) = [loyalty, father, bob, Y, X], as follows:
complexity([], 0).
complexity([H|L], C) :- atomic(H), complexity(L, C1), C is C1+2.
complexity([H|L], C) :- var(H), complexity(L, C1), C is C1+1.
The remaining issue is converting the predicate to a flat list, as shown above. The ..= is useful, but its output is not complete, that is:
loyalty(father(bob, Y), X) ..= ["loyalty", "father(bob, Y)", "X"]
Any help would be appreciated.
You must apply =.. recursively as follows:
% term_to_list(+Term, -List)
term_to_list(Term, [Term]) :- var(Term), !.
term_to_list(Term, [Term]) :- atomic(Term), !.
term_to_list(Term, List) :-
compound(Term),
Term =.. Components,
maplist(term_to_list, Components, ListOfLists),
flatten(ListOfLists, List).
Example:
?- term_to_list(loyalty(father(bob, Y), X), L).
L = [loyalty, father, bob, Y, X].
Alternatively, you can define complexity/2 as follows:
% complexity(+Term, -Complexity)
complexity(Term, 1) :- var(Term), !.
complexity(Term, 2) :- atomic(Term), !.
complexity(Term, Complexity) :-
compound(Term),
Term =.. Components,
maplist(complexity, Components, Complexities),
sum_list(Complexities, Complexity).
Example:
?- complexity(loyalty(father(bob, Y), X), L).
L = 8.
Remark SWI-Prolog defines maplist/3 and sum_list/2 as follows:
maplist(Goal, List1, List2) :-
maplist_(List1, List2, Goal).
maplist_([], [], _).
maplist_([Elem1|Tail1], [Elem2|Tail2], Goal) :-
call(Goal, Elem1, Elem2),
maplist_(Tail1, Tail2, Goal).
sum_list(Xs, Sum) :-
sum_list(Xs, 0, Sum).
sum_list([], Sum, Sum).
sum_list([X|Xs], Sum0, Sum) :-
Sum1 is Sum0 + X,
sum_list(Xs, Sum1, Sum).
my_list([this,is,a,dog,.,what,is,your,name,?,i,simply,adore,you,!]).
count(_, [], 0) :- !.
count(X, [X|Q], N) :- !, count(X, Q, N1), N is N1+1.
count(X, [_|Q], N) :- count(X, Q, N).
number_of_sentence(N) :- my_list(L),count(.,L,N).
number_of_sentence(N) :- my_list(L),count(?,L,N).
number_of_sentence(N) :- my_list(L),count(!,L,N).
in the above code there are three types of sentences in the list(my_list) 1 affirmative, 1 question and 1 exclamatory and when i do this
?- number_of_sentence(N).
N = 1 ;
N = 1 ;
N = 1.
now how can i add the values in N and show "total = 3"
can any one help me please......
if your Prolog has library(aggregate) you can do
?- aggregate(sum(C), (my_list(L), (count(.,L,C);count(?,L,C);count(!,L,C))), N).
but mbratch' suggestion seems better. Another method, without count/3:
?- aggregate(count, E^(my_list(L), member(E, L), memberchk(E, [.,?,!])), N).
L = [this, is, a, dog, '.', what, is, your, name|...],
N = 3.
I am trying to write a program in Prolog to find a Latin Square of size N.
I have this right now:
delete(X, [X|T], T).
delete(X, [H|T], [H|S]) :-
delete(X, T, S).
permutation([], []).
permutation([H|T], R) :-
permutation(T, X),
delete(H, R, X).
latinSqaure([_]).
latinSquare([A,B|T], N) :-
permutation(A,B),
isSafe(A,B),
latinSquare([B|T]).
isSafe([], []).
isSafe([H1|T1], [H2|T2]) :-
H1 =\= H2,
isSafe(T1, T2).
using SWI-Prolog library:
:- module(latin_square, [latin_square/2]).
:- use_module(library(clpfd), [transpose/2]).
latin_square(N, S) :-
numlist(1, N, Row),
length(Rows, N),
maplist(copy_term(Row), Rows),
maplist(permutation, Rows, S),
transpose(S, T),
maplist(valid, T).
valid([X|T]) :-
memberchk(X, T), !, fail.
valid([_|T]) :- valid(T).
valid([_]).
test:
?- aggregate(count,S^latin_square(4,S),C).
C = 576.
edit your code, once corrected removing typos, it's a verifier, not a generator, but (as noted by ssBarBee in a deleted comment), it's flawed by missing test on not adjacent rows.
Here the corrected code
delete(X, [X|T], T).
delete(X, [H|T], [H|S]) :-
delete(X, T, S).
permutation([], []).
permutation([H|T], R):-
permutation(T, X),
delete(H, R, X).
latinSquare([_]).
latinSquare([A,B|T]) :-
permutation(A,B),
isSafe(A,B),
latinSquare([B|T]).
isSafe([], []).
isSafe([H1|T1], [H2|T2]) :-
H1 =\= H2,
isSafe(T1, T2).
and some test
?- latinSquare([[1,2,3],[2,3,1],[3,2,1]]).
false.
?- latinSquare([[1,2,3],[2,3,1],[3,1,2]]).
true .
?- latinSquare([[1,2,3],[2,3,1],[1,2,3]]).
true .
note the last test it's wrong, should give false instead.
Like #CapelliC, I recommend using CLP(FD) constraints for this, which are available in all serious Prolog systems.
In fact, consider using constraints more pervasively, to benefit from constraint propagation.
For example:
:- use_module(library(clpfd)).
latin_square(N, Rows, Vs) :-
length(Rows, N),
maplist(same_length(Rows), Rows),
maplist(all_distinct, Rows),
transpose(Rows, Cols),
maplist(all_distinct, Cols),
append(Rows, Vs),
Vs ins 1..N.
Example, counting all solutions for N = 4:
?- findall(., (latin_square(4,_,Vs),labeling([ff],Vs)), Ls), length(Ls, L).
L = 576,
Ls = [...].
The CLP(FD) version is much faster than the other version.
Notice that it is good practice to separate the core relation from the actual search with labeling/2. This lets you quickly see that the core relation terminates also for larger N:
?- latin_square(20, _, _), false.
false.
Thus, we directly see that this terminates, hence this plus any subsequent search with labeling/2 is guaranteed to find all solutions.
I have better solution, #CapelliC code takes very long time for squares with N length higher than 5.
:- use_module(library(clpfd)).
make_square(0,_,[]) :- !.
make_square(I,N,[Row|Rest]) :-
length(Row,N),
I1 is I - 1,
make_square(I1,N,Rest).
all_different_in_row([]) :- !.
all_different_in_row([Row|Rest]) :-
all_different(Row),
all_different_in_row(Rest).
all_different_in_column(Square) :-
transpose(Square,TSquare),
all_different_in_row(TSquare).
all_different_in_column1([[]|_]) :- !.
all_different_in_column1(Square) :-
maplist(column,Square,Column,Rest),
all_different(Column),
all_different_in_column1(Rest).
latin_square(N,Square) :-
make_square(N,N,Square),
append(Square,AllVars),
AllVars ins 1..N,
all_different_in_row(Square),
all_different_in_column(Square),
labeling([ff],AllVars).
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)).
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.