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).
i'm implement stochastic search in prolog.
code is
queens_rand([],Qs,Qs) :- !.
queens_rand(UnplacedQs,SafeQs,Qs) :-
random_sort(UnplacedQs, UnplacedQs1),
select(UnplacedQs,UnplacedQs1,Q),
not_attack(SafeQs,Q,1),
queens_rand(UnplacedQs1,[Q|SafeQs],Qs),
!.
queen_solve_rand(N) :-
alloc(1,N,Ns),
queens_rand(Ns,[], Q),
write(Q), nl.
random_sort([],_) :- !.
random_sort(_,[]) :- !.
random_sort(Xs, Ys) :-
length(Ys, L),
rnd_select(Xs,L, Ys),
write('Ys : '),write(Ys),nl.
remove_at(X,[X|Xs],1,Xs).
remove_at(X,[Y|Xs],K,[Y|Ys]) :- K > 1,
K1 is K - 1, remove_at(X,Xs,K1,Ys).
rnd_select(_,0,[]).
rnd_select(Xs,N,[X|Zs]) :- N > 0,
length(Xs,L),
I is random(L) + 1,
remove_at(X,Xs,I,Ys),
N1 is N - 1,
rnd_select(Ys,N1,Zs).
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).
but it returns false. i can't understand prolog well, but i have to implement it. and i cant find where is wrong.
Yyou should remove this rule : random_sort(_,[]) :- !.. It means that whatever is the first arg, the result is [].
I'm writing a prolog program that will check if two math expressions are actually the same. For example, if my math expression goal is: (a + b) + c then any of the following expressions are considered the same:
(a+b)+c
a+(b+c)
(b+a)+c
(c+a)+b
a+(c+b)
c+(a+b)
and other combinations
Certainly, I don't expect to check the combination of possible answers because the expression can be more complex than that.
Currently, this is my approach:
For example, if I want to check if a + b *c is the same with another expression such as c*b+a, then I store both expression recursively as binary expressions, and I should create a rule such as ValueOf that will give me the "value" of the first expression and the second expression. Then I just check if the "value" of both expression are the same, then I can say that both expression are the same. Problem is, because the content of the expression is not number, but identifier, I cannot use the prolog "is" keyword to get the value.
Any suggestion?
many thanks
% represent a + b * c
binExprID(binEx1).
hasLeftArg(binEx1, a).
hasRightArg(binEx1, binEx2).
hasOperator(binEx1, +).
binExprID(binEx2).
hasLeftArg(binEx2, b).
hasRightArg(binEx2, c).
hasOperator(binEx2, *).
% represent c * b + a
binExprID(binEx3).
hasLeftArg(binEx3, c).
hasRightArg(binEx3, b).
hasOperator(binEx3, *).
binExprID(binEx4).
hasLeftArg(binEx4, binEx3).
hasRightArg(binEx4, a).
hasOperator(binEx4, +).
goal:- valueOf(binEx1, V),
valueOf(binEx4, V).
Math expressions can be very complex, I presume you are referring to arithmetic instead. The normal form (I hope my wording is appropriate) is 'sum of monomials'.
Anyway, it's not an easy task to solve generally, and there is an ambiguity in your request: 2 expressions can be syntactically different (i.e. their syntax tree differ) but still have the same value. Obviously this is due to operations that leave unchanged the value, like adding/subtracting 0.
From your description, I presume that you are interested in 'evaluated' identity. Then you could normalize both expressions, before comparing for equality.
To evaluate syntactical identity, I would remove all parenthesis, 'distributing' factors over addends. The expression become a list of multiplicative terms. Essentially, we get a list of list, that can be sorted without changing the 'value'.
After the expression has been flattened, all multiplicative constants must be accumulated.
a simplified example:
a+(b+c)*5 will be [[1,a],[b,5],[c,5]] while a+5*(c+b) will be [[1,a],[5,c],[5,b]]
edit after some improvement, here is a very essential normalization procedure:
:- [library(apply)].
arith_equivalence(E1, E2) :-
normalize(E1, N),
normalize(E2, N).
normalize(E, N) :-
distribute(E, D),
sortex(D, N).
distribute(A, [[1, A]]) :- atom(A).
distribute(N, [[1, N]]) :- number(N).
distribute(X * Y, L) :-
distribute(X, Xn),
distribute(Y, Yn),
% distribute over factors
findall(Mono, (member(Xm, Xn), member(Ym, Yn), append(Xm, Ym, Mono)), L).
distribute(X + Y, L) :-
distribute(X, Xn),
distribute(Y, Yn),
append(Xn, Yn, L).
sortex(L, R) :-
maplist(msort, L, T),
maplist(accum, T, A),
sumeqfac(A, Z),
exclude(zero, Z, S),
msort(S, R).
accum(T2, [Total|Symbols]) :-
include(number, T2, Numbers),
foldl(mul, Numbers, 1, Total),
exclude(number, T2, Symbols).
sumeqfac([[N|F]|Fs], S) :-
select([M|F], Fs, Rs),
X is N+M,
!, sumeqfac([[X|F]|Rs], S).
sumeqfac([F|Fs], [F|Rs]) :-
sumeqfac(Fs, Rs).
sumeqfac([], []).
zero([0|_]).
mul(X, Y, Z) :- Z is X * Y.
Some test:
?- arith_equivalence(a+(b+c), (a+c)+b).
true .
?- arith_equivalence(a+b*c+0*77, c*b+a*1).
true .
?- arith_equivalence(a+a+a, a*3).
true .
I've used some SWI-Prolog builtin, like include/3, exclude/3, foldl/5, and msort/2 to avoid losing duplicates.
These are basic list manipulation builtins, easily implemented if your system doesn't have them.
edit
foldl/4 as defined in SWI-Prolog apply.pl:
:- meta_predicate
foldl(3, +, +, -).
foldl(Goal, List, V0, V) :-
foldl_(List, Goal, V0, V).
foldl_([], _, V, V).
foldl_([H|T], Goal, V0, V) :-
call(Goal, H, V0, V1),
foldl_(T, Goal, V1, V).
handling division
Division introduces some complexity, but this should be expected. After all, it introduces a full class of numbers: rationals.
Here are the modified predicates, but I think that the code will need much more debug. So I allegate also the 'unit test' of what this micro rewrite system can solve. Also note that I didn't introduce the negation by myself. I hope you can work out any required modification.
/* File: arith_equivalence.pl
Author: Carlo,,,
Created: Oct 3 2012
Purpose: answer to http://stackoverflow.com/q/12665359/874024
How to check if two math expressions are the same?
I warned that generalizing could be a though task :) See the edit.
*/
:- module(arith_equivalence,
[arith_equivalence/2,
normalize/2,
distribute/2,
sortex/2
]).
:- [library(apply)].
arith_equivalence(E1, E2) :-
normalize(E1, N),
normalize(E2, N), !.
normalize(E, N) :-
distribute(E, D),
sortex(D, N).
distribute(A, [[1, A]]) :- atom(A).
distribute(N, [[N]]) :- number(N).
distribute(X * Y, L) :-
distribute(X, Xn),
distribute(Y, Yn),
% distribute over factors
findall(Mono, (member(Xm, Xn), member(Ym, Yn), append(Xm, Ym, Mono)), L).
distribute(X / Y, L) :-
normalize(X, Xn),
normalize(Y, Yn),
divide(Xn, Yn, L).
distribute(X + Y, L) :-
distribute(X, Xn),
distribute(Y, Yn),
append(Xn, Yn, L).
sortex(L, R) :-
maplist(dsort, L, T),
maplist(accum, T, A),
sumeqfac(A, Z),
exclude(zero, Z, S),
msort(S, R).
dsort(L, S) :- is_list(L) -> msort(L, S) ; L = S.
divide([], _, []).
divide([N|Nr], D, [R|Rs]) :-
( N = [Nn|Ns],
D = [[Dn|Ds]]
-> Q is Nn/Dn, % denominator is monomial
remove_common(Ns, Ds, Ar, Br),
( Br = []
-> R = [Q|Ar]
; R = [Q|Ar]/[1|Br]
)
; R = [N/D] % no simplification available
),
divide(Nr, D, Rs).
remove_common(As, [], As, []) :- !.
remove_common([], Bs, [], Bs).
remove_common([A|As], Bs, Ar, Br) :-
select(A, Bs, Bt),
!, remove_common(As, Bt, Ar, Br).
remove_common([A|As], Bs, [A|Ar], Br) :-
remove_common(As, Bs, Ar, Br).
accum(T, [Total|Symbols]) :-
partition(number, T, Numbers, Symbols),
foldl(mul, Numbers, 1, Total), !.
accum(T, T).
sumeqfac([[N|F]|Fs], S) :-
select([M|F], Fs, Rs),
X is N+M,
!, sumeqfac([[X|F]|Rs], S).
sumeqfac([F|Fs], [F|Rs]) :-
sumeqfac(Fs, Rs).
sumeqfac([], []).
zero([0|_]).
mul(X, Y, Z) :- Z is X * Y.
:- begin_tests(arith_equivalence).
test(1) :-
arith_equivalence(a+(b+c), (a+c)+b).
test(2) :-
arith_equivalence(a+b*c+0*77, c*b+a*1).
test(3) :-
arith_equivalence(a+a+a, a*3).
test(4) :-
arith_equivalence((1+1)/x, 2/x).
test(5) :-
arith_equivalence(1/x+1, (1+x)/x).
test(6) :-
arith_equivalence((x+a)/(x*x), 1/x + a/(x*x)).
:- end_tests(arith_equivalence).
running the unit test:
?- run_tests(arith_equivalence).
% PL-Unit: arith_equivalence ...... done
% All 6 tests passed
true.
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.
Given an nxn letter matrix and a list of words, the program should find all the appearances of the words in the matrix and their location.
They could appear up-down, right-left and diagonally (over all 8 directions). A word can appear any number of times (including zero) and they can overlap (like the words bad, and adult) and even be a subset of one another (like the words bad and ad).
EDIT Here's a complete code (finds words in diagonals too). One drawback: words from the main diagonals are found twice.
% word(X) iff X is a word
word("foo").
word("bar").
word("baz").
% prefix(?A, +B) iff A is a prefix of B
prefix([], _).
prefix([A|B], [A|C]) :- prefix(B, C).
% sublist(?A, +B) iff A is a sublist of B
sublist(A, B) :- prefix(A, B).
sublist(A, [_|B]) :- sublist(A, B).
% reversed(?A, +B) iff A is reversed B
reversed(A, B) :- reversed(B, [], A).
reversed([A|B], C, D) :- reversed(B, [A|C], D).
reversed([], A, A).
% rowsreversed(?A, +B) iff matrix A is matrix B with reversed rows
rowsreversed([A|B], [C|D]) :- reversed(A, C), rowsreversed(B, D).
rowsreversed([], []).
% transposed(+A, ?B) iff matrix B is transposed matrix A
transposed(A, B) :- transposed(A, [], B).
transposed(M, X, X) :- empty(M), !.
transposed(M, A, X) :- columns(M, Hs, Ts), transposed(Ts, [Hs|A], X).
% empty(+A) iff A is empty list or a list of empty lists
empty([[]|A]) :- empty(A).
empty([]).
% columns(+M, ?Hs, ?Ts) iff Hs is the first column
% of matrix M and Ts is the rest of matrix M
columns([[Rh|Rt]|Rs], [Rh|Hs], [Rt|Ts]) :- columns(Rs, Hs, Ts).
columns([[]], [], []).
columns([], [], []).
% inmatrix(+M, ?W) iff word W is in the matrix M
inmatrix(M, W) :- inrows(M, W).
inmatrix(M, W) :- incolumns(M, W).
inmatrix(M, W) :- inleftdiagonals(M, W).
inmatrix(M, W) :- inrightdiagonals(M, W).
% inrows(+M, ?W) iff W or reversed W is in a row of M
inrows([R|_], W) :- word(W), sublist(W, R).
inrows([R|_], W) :- word(W), reversed(V, W), sublist(V, R).
inrows([_|Rs], W) :- inrows(Rs, W).
% incolumns(+M, ?W) iff W or reversed W is in a column of M
incolumns(M, W) :- transposed(M, N), inrows(N, W).
% inleftdiagonals(+M, ?W) iff W or reversed W is in a left diagonal of M
inleftdiagonals(M, W) :- inupperleftdiagonals(M, W).
inleftdiagonals(M, W) :- transposed(M, N), inupperleftdiagonals(N, W).
% inupperleftdiagonals(+M, ?W) iff W or reversed W is in an upper left diagonal of M
inupperleftdiagonals(M, W) :- upperdiags(M, N), inrows(N, W).
% upperdiags(+M, ?X) iff X is a list of upper diagonals of matrix M
upperdiags(M, X) :- upperdiags(M, [], Y), reversed(Z, Y), transposed(Z, X).
upperdiags([R|Rs], A, X) :- columns(Rs, _, T), upperdiags(T, [R|A], X).
upperdiags([], X, X).
% inrightdiagonals(+M, ?W) iff W or reversed W is in a right diagonal of M
inrightdiagonals(M, W) :- rowsreversed(N, M), inleftdiagonals(N, W).
Here's a partial solution for horizontal and vertical straight and reverse lookup:
count_hits(Word, Matrix, Result):-
atom_chars(Word, Chars),
reverse(Chars, C2),
transpose_matrix(Matrix, M2),
findall(1, find_chars_in_matrix(Chars,Matrix), A),
findall(1, find_chars_in_matrix(Chars,M2), B),
findall(1, find_chars_in_matrix(C2,Matrix), C),
findall(1, find_chars_in_matrix(C2,M2), D),
length(A, X1),
length(B, X2),
length(C, X3),
length(D, X4),
Result is X1 + X2 + X3 + X4.
transpose_matrix([],[]).
transpose_matrix([[ULCorner|Header]|Body], [[ULCorner|NewHeader]|NewBody]) :-
collect_heads_and_tails(Body, NewHeader, Kernel),
collect_heads_and_tails(NewBody, Header, X2),
transpose_matrix(Kernel, X2).
collect_heads_and_tails([], [], []).
collect_heads_and_tails([[H|T]|TT], [H|X], [T|Y]):-collect_heads_and_tails(TT, X, Y).
find_chars_in_matrix(Chars, [H|_]):-
sublist(Chars, H).
find_chars_in_matrix(Chars, [_|T]):-
find_chars_in_matrix(Chars, T).
sublist(L, [_|T]) :- sublist(L, T).
sublist(A, B) :- prefix(A, B).
prefix([H|T], [H|T2]) :- prefix(T, T2).
prefix([], _).
% test data
matrix([[e,t,r,e],
[r,r,t,r],
[t,r,t,t],
[e,e,t,e]]).
go :- matrix(M), count_hits(etre, M, X), write(X).
:-go.
Two weaknesses: (a) palindromic words are found twice, and one-letter words are found four times - mathematically justifiable, but probably unwanted from a common-sense perspective. (b) diagonal matches aren't found at all, for that you need more involved recursion with at least one additional counting argument.
Full disclosure: transpose_matrix/2 was adapted from the beautiful answer to this question. It's amazing, the wealth of code that stackoverflow has accumulated in just two years...