Related
I want to add in the DB a constant and a linked variable:
?- assertz(my(x, A))
So that in the future I can define A and get the only one entry. Sth like that:
?- assertz(my(x, A)), ..., A = 2.
?- my(A, B).
A = x,
B = 2.
Can this be done?
As I noted in the comments your idea of a link like a pointer is not the way to approach solving your problem.
A common solution is to walk the tree and construct a new tree as you walk the tree by replacing the leaf of the tree with a new leaf that contains the value from the input tree along with the associated value, what you are thinking should be linked.
Since you are somewhat new to Prolog I will do this with two examples. The first will just walk a tree and only return true when successfully walked. It can be used to understand how to walk a tree and run with gtrace to single step the code to understand it.
The second example will expand on the tree walk and add the type (link as you think) to the leaf item. The the old leaf for something simple like an atom a, will become a new leaf in the tree like (a,atom).
Also this was quickly written as a demonstration only. I am sure it will have problems if pressed into doing anything more than the single example.
:- module(example,
[
example/1
]).
example(walk) :-
Term = term_size(a(1,"Hello",'Atom',1+2,[a,$,T])),
walk(Term).
example(infer_type) :-
Term = term_size(a(1,"Hello",'Atom',1+2,[a,$,T])),
infer_type(Term,Is),
write(Is).
walk([]) :- !.
walk([T]) :- var(T), !.
walk(L) :- is_list(L), !, L = [H|T], walk(H), walk(T).
walk(T) :- compound(T), !, T =.. [_|Args], !, walk(Args).
walk(T) :- integer(T), !.
walk(T) :- var(T), !.
walk(T) :- atomic(T), !.
walk(T) :- T =.. [Arg|Args], !, walk(Arg), walk(Args).
infer_type([],[]) :- !.
infer_type([T],[(T,var)]) :- var(T), !.
infer_type(L,S) :- is_list(L), !, L = [H|T], infer_type(H,I), infer_type(T,Is), S = [I|Is].
infer_type(T,S) :- compound(T), !, T =.. [F|Args], !, infer_type(Args,Is), S =.. [F|Is].
infer_type(T,(T,integer)) :- integer(T), !.
infer_type(T,(T,var)) :- var(T), !.
infer_type(T,(T,atom)) :- atomic(T), !.
infer_type(T,S) :- T =.. [Arg|Args], !, infer_type(Arg,I), infer_type(Args,Is), S =.. [I|Is].
Example run
Note: I know there are warnings; it is a demo not production code.
Welcome to SWI-Prolog (threaded, 64 bits, version 8.5.3)
?- working_directory(_,'C:/Users/Groot').
true.
?- [example].
Warning: c:/users/Groot/example.pl:20:
Warning: Singleton variables: [T]
Warning: c:/users/Groot/example.pl:24:
Warning: Singleton variables: [T]
true.
?- example(walk).
true.
?- example(infer_type).
term_size(a((1,integer),(Hello,atom),(Atom,atom),(1,integer)+(2,integer),[(a,atom),(($),atom),(_25642,var)]))
true.
As an exercise I did not identify the string as a string, the change should be easy.
Let's say I have this Prolog program:
loves(vincent, mia).
loves(marcellus, mia).
jealous(A, B) :- loves(A, C), loves(B, C).
With query jealous(A,B). I'm very new to Prolog and I'd like to know how is it possible to see the exact order the program will be running and taking its ways for this query? I have tried using trace, jealous(A,B). command but it has only given me that:
Isn't there any more detailed solution for that? :/
Have you seen the Prolog Visualizer?
When you get to the page be sure to click on the icons in the upper right to learn more.
Enjoy.
Screenshot after step 10 of 49.
Screenshot for example given after all steps.
The Prolog Visualizer uses a slightly nonstandard way to enter a query by ending the query with a question mark (?), e.g.
jealous(A,B)?
If you do not post a query in the input area on the left you will receive an error, e.g.
The input for the Prolog Visualizer for your example is
loves(vincent, mia).
loves(marcellus, mia).
jealous(A, B) :- loves(A, C), loves(B, C).
jealous(A,B)?
When the Prolog Visualizer completes your example, notice the four results in green on the right
If you are using SWI-Prolog and after you understand syntactic unification, backtracking and write more advanced code you will find this of use:
Overview of the SWI Prolog Graphical Debugger
For other useful Prolog references see: Useful Prolog references
If the Prolog system has callable_property/2 and sys_rule/3, then one can code
a smart "unify" port as follows, showing most general unifiers (mgu's`):
:- op(1200, fx, ?-).
% solve(+Goal, +Assoc, +Integer, -Assoc)
solve(true, L, _, L) :- !.
solve((A, B), L, P, R) :- !, solve(A, L, P, H), solve(B, H, P, R).
solve(H, L, P, R) :- functor(H, F, A), sys_rule(F/A, J, B),
callable_property(J, sys_variable_names(N)),
number_codes(P, U), atom_codes(V, [0'_|U]), shift(N, V, W),
append(L, W, M), H = J, reverse(M, Z), triage(M, Z, I, K),
offset(P), write_term(I, [variable_names(Z)]), nl,
O is P+1, solve(B, K, O, R).
% triage(+Assoc, +Assoc, -Assoc, -Assoc)
triage([V=T|L], M, R, [V=T|S]) :- var(T), once((member(W=U, M), U==T)), W==V, !,
triage(L, M, R, S).
triage([V=T|L], M, [V=T|R], S) :-
triage(L, M, R, S).
triage([], _, [], []).
% shift(+Assoc, +Atom, -Assoc)
shift([V=T|L], N, [W=T|R]) :-
atom_concat(V, N, W),
shift(L, N, R).
shift([], _, []).
% offset(+Integer)
offset(1) :- !.
offset(N) :- write('\t'), M is N-1, offset(M).
% ?- Goal
(?- G) :-
callable_property(G, sys_variable_names(N)),
shift(N, '_0', M),
solve(G, M, 1, _).
Its not necessary to modify mgu's retrospectively, since a solution to a
Prolog query is the sequential composition of mgu's. Here is an example run:
?- ?- jealous(A,B).
[A_0 = X_1, B_0 = Y_1]
[H_1 = mia, X_1 = vincent]
[Y_1 = vincent]
A = vincent,
B = vincent ;
[Y_1 = marcellus]
A = vincent,
B = marcellus ;
Etc..
This is a preview of Jekejeke Prolog 1.5.0 the new
predicate sys_rule/3, its inspired by the new
predicate rule/2 of SWI-Prolog, but keeps the
clause/2 argument of head and body and uses a predicate
indicator.
I'm attempting to write a Prolog meta-interpreter to choose the order of goal execution, for example executing first all goals with the minimum number of parameters.
I started from the vanilla meta-interpreter:
solve2(true).
solve2(A) :- builtin(A), !, A.
solve2((A,B)) :- solve2(A), solve2(B).
solve2(A) :- clause(A,B), solve2(B).
Then i went to something like
solve2(true).
solve2(A) :- builtin(A), !, A.
solve2((A,B)) :- count(A,Args), count(B,Args2), Args<Args2, solve2(A), solve2(B).
solve2((A,B)) :- count(A,Args), count(B,Args2), Args>Args2, solve2(B), solve2(A).
solve2(A) :- clause(A,B), solve2(B).
But if the 4th line is executed then the whole block B is executed before A which is wrong.
Ex. A=a(x,y), B=(b(x,y,z), c(x)) I'd like to execute c, then a, then b. - while in this method i'd get c, b and then a.
I'm thinking about transforming the goals in a list but i'm not too sure.
Any ideas?
Here is an (untested) vanilla meta interpreter, with conjunction order changed. I would be glad if you could try with your data.
solve2(true).
solve2(A) :- builtin(A), !, A.
solve2((A,B)) :- ordering(A,B, C,D), ! /* needed */, solve2(C), solve2(D).
solve2(A) :- clause(A,B), solve2(B).
ordering(A,B, C,D) :-
minargs(A, NA),
minargs(B, NB),
( NA =< NB -> C/D=A/B ; C/D=B/A ).
minargs((A,B), N) :-
minargs(A, NA),
minargs(B, NB),
!, ( NA =< NB -> N=NA ; N=NB ).
minargs(T, N) :-
functor(T, _, N).
edit I tested with this setting:
builtin(writeln(_)).
a(1):-writeln(1).
b(1,2):-writeln(2).
c(1,2,3):-writeln(3).
test :-
solve2((c(A,B,_),a(A),b(A,B))).
and got the expected output:
?- test.
1
2
3
true .
edit I had to resort to a list representation, but then it make sense to preprocess the clauses and get the right order before, then stick to plain vanilla interpreter:
test :-
sortjoin((b(A,B),a(A),c(A,B,_)), X),
solve2(X).
sortjoin(J, R) :-
findall(C-P, (pred(J, P), functor(P,_,C)), L),
sort(L, T),
pairs_values(T, V),
join(V, R).
join([C], C).
join([H|T], (H,R)) :- join(T, R).
pred((A, _), C) :-
pred(A, C).
pred((_, B), C) :-
!, pred(B, C).
pred(C, C).
where solve2((A,B)) :- ... it's the original solve2(A),solve2(B)
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'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.