Deletion of Attribute Variables in Prolog - prolog

I am working on a project involving graphs, and I have a list of attribute variables, each representing a node in the graph. Each node has several attributes, such as adjacent nodes, distance to start node, etc. I want to remove a single node from the list, but when I use delete, I get the following error:
ERROR: uhook/3: Undefined procedure: adjs:attr_unify_hook/2
For example, I get this error if I include delete(OldVertices, Node, NewVertices) in my program.
I also get the exact same error if I am storing my vertices in a binary heap, and try to delete a vertex from the heap using delete_from_heap.
I was able to successfully use delete and delete_from_heap on the node if I first delete all of its attributes, but this causes problems for my program because I want to use the attributes later on; I just don't want the node to be contained in the list or binary heap.
Is this a bug, or am I handling attribute variables incorrectly?
EDIT:
Thanks! That works for lists. Now I am trying to do something similar for deleting attribute variables from binary heaps. I have a rule
delheap(Heap, Key, NewHeap) :-
delete_from_heap(Heap, A1, A0, NewHeap),
get_attr(Key, dist, A1),
A0 == Key.
However when I am testing I get the following results:
?- TLO = [3-A, 4-B], put_attr(A, dist, 3), put_attr(B, dist, 4), list_to_heap(TLO, H), delheap(H, A, Hq).
Correct to: "dijkstra_av:delheap(H,A,Hq)"? yes
TLO = [3-A, 4-B], H = heap(t(A, 3, [t(B, 4, [])]), 2), Hq = heap(t(B, 4, []), 1), put_attr(A, dist, 3), put_attr(B, dist, 4).
Which works fine, but when I try with B :
?- TLO = [3-A, 4-B], put_attr(A, dist, 3), put_attr(B, dist, 4), list_to_heap(TLO, H), delheap(H, B, Hq).
Correct to: "dijkstra_av:delheap(H,A,Hq)"? yes
TLO = [3-A, 4-B], false.
EDIT 2:
I was able to get it working by calling delete_from_heap with the priority and not the key, however, this does cause problems if two items has the same priority and it picks the wrong one. In my application this problem does not often arise, but it does seem like generally there should be a better way of using attribute variables with existing rules.

You are accidentally unifying a variable that has attributes attached with another term. Unifications that involve attributed variables trigger attr_unify_hook/2 in the corresponding modules, and you do not define such hooks, since you only use attributes as a quick way to access data and probably have no interest in any unifications among these variables.
To remove a variable from a list, use for example (==)/2:
list0_var_list(Ls0, V, Ls) :-
select(V0, Ls0, Ls),
V0 == V.
Sample query:
?- list0_var_list([A,B,C,D], B, Ls).
Ls = [A, C, D] ;
false.
Note that this still leaves a choicepoint. You can use once/1 to commit to the first and only solution, since you already know that each node in the list is unique:
?- once(list0_var_list([A,B,C,D], B, Ls)).
Ls = [A, C, D].
Using such a predicate instead of delete/3 lets you safely detect equality of variables and remove a given one from a list, without triggering any unification hooks.
Notice also that delete/3 is deprecated (see the documentation), and consider the following case:
?- delete([A,B,C], A, Cs).
Cs = [].
This shows that you cannot safely use delete/3 when variables are involved.

my own test using attributed variables for graph representation. I remember I found difficult to adapt to the particular programming style required. HTH
/* File: dijkstra_av.pl
Author: Carlo,,,
Created: Aug 3 2012
Modified:Oct 28 2012
Purpose: learn graph programming with attribute variables
*/
:- module(dijkstra_av, [dijkstra_av/3,
dijkstra_edges/3]).
dijkstra_av(Graph, Start, Solution) :-
setof(X, Y^D^(member(d(X,Y,D), Graph) ; member(d(Y,X,D), Graph)), Xs),
length(Xs, L),
length(Vs, L),
aggregate_all(sum(D), member(d(_, _, D), Graph), Infinity),
catch((algo(Graph, Infinity, Xs, Vs, Start, Solution),
throw(sol(Solution))
), sol(Solution), true).
dijkstra_edges(Graph, Start, Edges) :-
dijkstra_av(Graph, Start, Solution),
maplist(nodes_to_edges(Graph), Solution, Edges).
nodes_to_edges(Graph, s(Node, Dist, Nodes), s(Node, Dist, Edges)) :-
join_nodes(Graph, Nodes, Edges).
join_nodes(_Graph, [_Last], []).
join_nodes(Graph, [N,M|Ns], [e(N,M,D)|Es]) :-
aggregate_all(min(X), member(d(N, M, X), Graph), D),
join_nodes(Graph, [M|Ns], Es).
algo(Graph, Infinity, Xs, Vs, Start, Solution) :-
pairs_keys_values(Ps, Xs, Vs),
maplist(init_adjs(Ps), Graph),
maplist(init_dist(Infinity), Ps),
%ord_memberchk(Start-Sv, Ps),
memberchk(Start-Sv, Ps),
put_attr(Sv, dist, 0),
time(main_loop(Vs)),
maplist(solution(Start), Vs, Solution).
solution(Start, V, s(N, D, [Start|P])) :-
get_attr(V, name, N),
get_attr(V, dist, D),
rpath(V, [], P).
rpath(V, X, P) :-
get_attr(V, name, N),
( get_attr(V, previous, Q)
-> rpath(Q, [N|X], P)
; P = X
).
init_dist(Infinity, N-V) :-
put_attr(V, name, N),
put_attr(V, dist, Infinity).
init_adjs(Ps, d(X, Y, D)) :-
%ord_memberchk(X-Xv, Ps),
%ord_memberchk(Y-Yv, Ps),
memberchk(X-Xv, Ps),
memberchk(Y-Yv, Ps),
adj_add(Xv, Yv, D),
adj_add(Yv, Xv, D).
adj_add(X, Y, D) :-
( get_attr(X, adjs, L)
-> put_attr(X, adjs, [Y-D|L])
; put_attr(X, adjs, [Y-D])
).
main_loop([]).
main_loop([Q|Qs]) :-
smallest_distance(Qs, Q, U, Qn),
put_attr(U, assigned, true),
get_attr(U, adjs, As),
update_neighbours(As, U),
main_loop(Qn).
smallest_distance([A|Qs], C, M, [T|Qn]) :-
get_attr(A, dist, Av),
get_attr(C, dist, Cv),
( Av < Cv
-> (N,T) = (A,C)
; (N,T) = (C,A)
),
!, smallest_distance(Qs, N, M, Qn).
smallest_distance([], U, U, []).
update_neighbours([V-Duv|Vs], U) :-
( get_attr(V, assigned, true)
-> true
; get_attr(U, dist, Du),
get_attr(V, dist, Dv),
Alt is Du + Duv,
( Alt < Dv
-> put_attr(V, dist, Alt),
put_attr(V, previous, U)
; true
)
),
update_neighbours(Vs, U).
update_neighbours([], _).
:- begin_tests(dijkstra_av).
small([d(a,b,2),d(a,b,1),d(b,c,1),d(c,d,1),d(a,d,3),d(a,d,2)]).
test(1) :-
nl,
small(S),
time(dijkstra_av(S, a, L)),
maplist(writeln, L).
test(2) :-
open(salesman, read, F),
readf(F, L),
close(F),
nl,
dijkstra_av(L, penzance, R),
maplist(writeln, R).
readf(F, [d(X,Y,D)|R]) :-
read(F, dist(X,Y,D)), !, readf(F, R).
readf(_, []).
test(3) :-
nl, small(S),
time(dijkstra_edges(S, a, Es)),
maplist(writeln, Es).
:- end_tests(dijkstra_av).
the presence of test unit allows for:
?- run_tests(dijkstra_av).
% PL-Unit: dijkstra_av
% 122 inferences, 0.000 CPU in 0.000 seconds (100% CPU, 1015009 Lips)
% 475 inferences, 0.002 CPU in 0.002 seconds (100% CPU, 283613 Lips)
s(a,0,[a])
s(b,1,[a,b])
s(c,2,[a,b,c])
s(d,2,[a,d])
.
ERROR: /home/carlo/prolog/dijkstra_av.pl:115:
test 2: received error: open/3: source_sink `salesman' does not exist (No such file or directory)
% 122 inferences, 0.000 CPU in 0.000 seconds (100% CPU, 2027285 Lips)
% 619 inferences, 0.001 CPU in 0.001 seconds (100% CPU, 899941 Lips)
s(a,0,[])
s(b,1,[e(a,b,1)])
s(c,2,[e(a,b,1),e(b,c,1)])
s(d,2,[e(a,d,2)])
Warning: /home/carlo/prolog/dijkstra_av.pl:127:
PL-Unit: Test 3: Test succeeded with choicepoint
done
% 1 test failed
% 2 tests passed
false.
with time passing, something has been lost... sorry

Related

How to convert a propositional formula to disjunctive normal form (DNF) in Prolog?

I'm new at Prolog, and i need to convert from the truth table the result into disjunctive normal form.
I have been able to produce the truth table as given:
?- table(p or(q and not r) or not s or r).
[p,q,r,s] | (p or (q and not r) or not s or r) ----------------------------------------------|[0,0,0,0] | 1 |[0,0,0,1] | 0 |[0,0,1,0] | 1 |[0,0,1,1] | 1 |[0,1,0,0] | 1 |[0,1,0,1] | 1 |[0,1,1,0] | 1 |[0,1,1,1] | 1 |[1,0,0,0] | 1 |[1,0,0,1] | 1 |[1,0,1,0] | 1 |[1,0,1,1] | 1 |[1,1,0,0] | 1 |[1,1,0,1] | 1 |[1,1,1,0] | 1 |[1,1,1,1] | 1 |-----------------------------------------------
if anyone can help me make from this table to the disjunctive normal form i would apreciate it.
let's implement a generic truth table evaluator, translating to Prolog evaluable formula in CDNF, then, by definition, we will disjoin each minterm:
:- op(900, fy, neg).
:- op(1000, xfy, and).
:- op(1100, xfy, or).
formula(p or (q and neg r) or neg s or r).
cnf(F, CNF) :-
setof(V, literal(F, V), Ls),
setof(La, T^(assign(Ls, La), translate(F, La, T), T), CNF).
literal((X or Y), L) :- literal(X,L) ; literal(Y,L).
literal((X and Y), L) :- literal(X,L) ; literal(Y,L).
literal(neg X, L) :- literal(X,L).
literal(L, L) :- atom(L).
assign(Ls, La) :- maplist(assign_literal, Ls, La).
assign_literal(L, L=true).
assign_literal(L, L=false).
translate((X or Y), Ls, (A;B)) :- translate(X, Ls, A), translate(Y, Ls, B).
translate((X and Y), Ls, (A,B)) :- translate(X, Ls, A), translate(Y, Ls, B).
translate(neg X, Ls, \+ A) :- translate(X, Ls, A).
translate(L, Ls, V) :- memberchk(L=V, Ls).
yields:
?- formula(F),cnf(F,CNF),maplist(writeln,CNF).
[p=false,q=false,r=false,s=false]
[p=false,q=false,r=true,s=false]
[p=false,q=false,r=true,s=true]
[p=false,q=true,r=false,s=false]
[p=false,q=true,r=false,s=true]
[p=false,q=true,r=true,s=false]
[p=false,q=true,r=true,s=true]
[p=true,q=false,r=false,s=false]
[p=true,q=false,r=false,s=true]
[p=true,q=false,r=true,s=false]
[p=true,q=false,r=true,s=true]
[p=true,q=true,r=false,s=false]
[p=true,q=true,r=false,s=true]
[p=true,q=true,r=true,s=false]
[p=true,q=true,r=true,s=true]
F = or(p, or(and(q, neg(r)), or(neg(s), r))),
CNF = [[p=false, q=false, r=false, s=false], [p=false, q=false, r=true, s=false], [p=false, q=false, r=true, s=true], [p=false, q=true, r=false, s=false], [p=false, q=true, r=false, ... = ...], [p=false, q=true, ... = ...|...], [p=false, ... = ...|...], [... = ...|...], [...|...]|...].
Sorry the output it's a bit verbose. Can be easily tailored on further spec.
I used neg/1 instead of not/1 (that's already a valid Prolog operator), just to make clear the distinction...
Edit
Here is a simplification, resulting in a syntactic generalization. Just literal/2 and translate/3 have changed, and translate/2 has been added:
literal(F, L) :- F =.. [_,X,Y], (literal(X,L) ; literal(Y,L)).
literal(F, L) :- F =.. [_,X], literal(X,L).
literal(L, L) :- atom(L).
translate(and, (,)).
translate(or, (;)).
translate(neg, (\+)).
translate(F, Ls, T) :-
F =.. [S,X,Y],
translate(S,O),
T =.. [O,A,B],
translate(X, Ls, A), translate(Y, Ls, B).
translate(F, Ls, T) :-
F =.. [S,X],
translate(S,O),
T =.. [O,A],
translate(X, Ls, A).
translate(F, Ls, T) :- memberchk(F=T, Ls).
More Edit
The code above can be made more efficient, just moving the translation out of the cycle
cnf(F, CNF) :-
setof(V, literal(F, V), Ls),
translate(F, La, T),
setof(La, (assign(Ls, La), T), CNF).
a minor modification is required in last translate/3 clause: use member/2 instead of memberchk
...
translate(F, Ls, T) :- member(F=T, Ls).
Timing: with the old version
4 ?- formula(F),time(cnf(F,CNF)).
% 1,788 inferences, 0.002 CPU in 0.002 seconds (98% CPU, 834727 Lips)
With the new one:
5 ?- formula(F),time(cnf(F,CNF)).
% 282 inferences, 0.001 CPU in 0.001 seconds (99% CPU, 315768 Lips)
about 6x better.
Old with memberchk:
6 ?- formula(F),time(cnf(F,CNF)).
% 1,083 inferences, 0.002 CPU in 0.002 seconds (98% CPU, 561426 Lips)
Well, still almost 4x better.
Edit Some more step is required to get a true Prolog formula
cdnf(F, CNDF, Prolog) :-
cdnf(F, CNDF), % well, was cnf/2, I renamed to be more precise
maplist(cj, CNDF, CJs),
reverse(CJs, [H|T]),
foldl(dj, T, H, Prolog).
dj(A, B, (A;B)).
cj(A, J) :-
maplist(tf, A, B),
reverse(B, [H|T]),
foldl(cj, T, H, J).
cj(A, B, (A,B)).
tf(S=true,S).
tf(S=false,\+S).
now, the result is more usable
?- formula(_,F), cdnf(F,_,P).
F = or(p, or(and(q, neg(r)), or(neg(s), r))),
P = (\+p, \+q, \+r, \+s;\+p, \+q, r, \+s;\+p, \+q, r, s;\+p, q, \+r, \+s;\+p, q, \+r, s;\+p, q, r, \+ ...;\+p, q, ..., ...;p, ..., ...;..., ...;...;...)

Prolog - Latin Square solution

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).

How to implement Dijkstra's algorithm in Prolog returning a list of edges?

I've been trying for a while now to implement a Dijkstra shortest path algorithm in JIProlog. There are a few implementations available online, such as here and here, but they all return the path as a list of nodes. This is problematic for my implementation, because I'm technically using a multigraph, where vertices can be connected by multiple edges. Therefore, I need an algorithm that returns a list of edges rather than a list of nodes.
I've been trying to adjust the first implementation I mentioned to track edges, but I get lost in the dijkstra_l/3 rule. Could someone help me? Thanks!
I answered some time ago to a similar question, with an implementation.
Alas, that code doesn't work with the lastes SWI-Prlog, I've debugged and found that ord_memberchk (used for efficiency) has changed behaviour. I've replaced with memberchk and now is working...
I would suggest to use the output of the algorithm with a simple post processing pass that recovers the edges from nodes, selecting the smaller value. I've implemented as it dijkstra_edges/3
/* File: dijkstra_av.pl
Author: Carlo,,,
Created: Aug 3 2012
Modified:Oct 28 2012
Purpose: learn graph programming with attribute variables
*/
:- module(dijkstra_av, [dijkstra_av/3,
dijkstra_edges/3]).
dijkstra_av(Graph, Start, Solution) :-
setof(X, Y^D^(member(d(X,Y,D), Graph) ; member(d(Y,X,D), Graph)), Xs),
length(Xs, L),
length(Vs, L),
aggregate_all(sum(D), member(d(_, _, D), Graph), Infinity),
catch((algo(Graph, Infinity, Xs, Vs, Start, Solution),
throw(sol(Solution))
), sol(Solution), true).
dijkstra_edges(Graph, Start, Edges) :-
dijkstra_av(Graph, Start, Solution),
maplist(nodes_to_edges(Graph), Solution, Edges).
nodes_to_edges(Graph, s(Node, Dist, Nodes), s(Node, Dist, Edges)) :-
join_nodes(Graph, Nodes, Edges).
join_nodes(_Graph, [_Last], []).
join_nodes(Graph, [N,M|Ns], [e(N,M,D)|Es]) :-
aggregate_all(min(X), member(d(N, M, X), Graph), D),
join_nodes(Graph, [M|Ns], Es).
algo(Graph, Infinity, Xs, Vs, Start, Solution) :-
pairs_keys_values(Ps, Xs, Vs),
maplist(init_adjs(Ps), Graph),
maplist(init_dist(Infinity), Ps),
%ord_memberchk(Start-Sv, Ps),
memberchk(Start-Sv, Ps),
put_attr(Sv, dist, 0),
time(main_loop(Vs)),
maplist(solution(Start), Vs, Solution).
solution(Start, V, s(N, D, [Start|P])) :-
get_attr(V, name, N),
get_attr(V, dist, D),
rpath(V, [], P).
rpath(V, X, P) :-
get_attr(V, name, N),
( get_attr(V, previous, Q)
-> rpath(Q, [N|X], P)
; P = X
).
init_dist(Infinity, N-V) :-
put_attr(V, name, N),
put_attr(V, dist, Infinity).
init_adjs(Ps, d(X, Y, D)) :-
%ord_memberchk(X-Xv, Ps),
%ord_memberchk(Y-Yv, Ps),
memberchk(X-Xv, Ps),
memberchk(Y-Yv, Ps),
adj_add(Xv, Yv, D),
adj_add(Yv, Xv, D).
adj_add(X, Y, D) :-
( get_attr(X, adjs, L)
-> put_attr(X, adjs, [Y-D|L])
; put_attr(X, adjs, [Y-D])
).
main_loop([]).
main_loop([Q|Qs]) :-
smallest_distance(Qs, Q, U, Qn),
put_attr(U, assigned, true),
get_attr(U, adjs, As),
update_neighbours(As, U),
main_loop(Qn).
smallest_distance([A|Qs], C, M, [T|Qn]) :-
get_attr(A, dist, Av),
get_attr(C, dist, Cv),
( Av < Cv
-> (N,T) = (A,C)
; (N,T) = (C,A)
),
!, smallest_distance(Qs, N, M, Qn).
smallest_distance([], U, U, []).
update_neighbours([V-Duv|Vs], U) :-
( get_attr(V, assigned, true)
-> true
; get_attr(U, dist, Du),
get_attr(V, dist, Dv),
Alt is Du + Duv,
( Alt < Dv
-> put_attr(V, dist, Alt),
put_attr(V, previous, U)
; true
)
),
update_neighbours(Vs, U).
update_neighbours([], _).
:- begin_tests(dijkstra_av).
small([d(a,b,2),d(a,b,1),d(b,c,1),d(c,d,1),d(a,d,3),d(a,d,2)]).
test(1) :-
nl,
small(S),
time(dijkstra_av(S, a, L)),
maplist(writeln, L).
test(2) :-
open('salesman.pl', read, F),
readf(F, L),
close(F),
nl,
dijkstra_av(L, penzance, R),
maplist(writeln, R).
readf(F, [d(X,Y,D)|R]) :-
read(F, dist(X,Y,D)), !, readf(F, R).
readf(_, []).
test(3) :-
nl, small(S),
time(dijkstra_edges(S, a, Es)),
maplist(writeln, Es).
:- end_tests(dijkstra_av).
test(3) shows the implementation, I've added some edge with higher values to verify, the output shows that these are correctly discarded:
s(a,0,[])
s(b,1,[e(a,b,1)])
s(c,2,[e(a,b,1),e(b,c,1)])
s(d,2,[e(a,d,2)])

Prolog. How to check if two math expressions are the same

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.

best structure Graph to implement Dijkstra in prolog

The question is simple.
How can I struct my Graph in SWI prolog to implement the Dijkstra's algorithm?
I have found this but it's too slow for my job.
That implementation isn't so bad:
?- time(dijkstra(penzance, Ss)).
% 3,778 inferences, 0,003 CPU in 0,003 seconds (99% CPU, 1102647 Lips)
Ss = [s(aberdeen, 682, [penzance, exeter, bristol, birmingham, manchester, carlisle, edinburgh|...]), s(aberystwyth, 352, [penzance, exeter, bristol, swansea, aberystwyth]), s(birmingham, 274, [penzance, exeter, bristol, birmingham]), s(brighton, 287, [penzance, exeter, portsmouth, brighton]), s(bristol, 188, [penzance, exeter, bristol]), s(cambridge, 339, [penzance, exeter|...]), s(cardiff, 322, [penzance|...]), s(carlisle, 474, [...|...]), s(..., ..., ...)|...].
SWI-Prolog offers attributed variables, then this answer could be relevant to you.
I hope I will post later today an implementation of dijkstra/2 using attribute variables.
edit well, I must say that first time programming with attribute variables is not too much easy.
I'm using the suggestion from the answer by #Mat I linked above, abusing of attribute variables to get constant time access to properties attached to data as required of algorithm. I've (blindly) implemented the wikipedia algorithm, here my effort:
/* File: dijkstra_av.pl
Author: Carlo,,,
Created: Aug 3 2012
Purpose: learn graph programming with attribute variables
*/
:- module(dijkstra_av, [dijkstra_av/3]).
dijkstra_av(Graph, Start, Solution) :-
setof(X, Y^D^(member(d(X,Y,D), Graph)
;member(d(Y,X,D), Graph)), Xs),
length(Xs, L),
length(Vs, L),
aggregate_all(sum(D), member(d(_, _, D), Graph), Infinity),
catch((algo(Graph, Infinity, Xs, Vs, Start, Solution),
throw(sol(Solution))
), sol(Solution), true).
algo(Graph, Infinity, Xs, Vs, Start, Solution) :-
pairs_keys_values(Ps, Xs, Vs),
maplist(init_adjs(Ps), Graph),
maplist(init_dist(Infinity), Ps),
ord_memberchk(Start-Sv, Ps),
put_attr(Sv, dist, 0),
time(main_loop(Vs)),
maplist(solution(Start), Vs, Solution).
solution(Start, V, s(N, D, [Start|P])) :-
get_attr(V, name, N),
get_attr(V, dist, D),
rpath(V, [], P).
rpath(V, X, P) :-
get_attr(V, name, N),
( get_attr(V, previous, Q)
-> rpath(Q, [N|X], P)
; P = X
).
init_dist(Infinity, N-V) :-
put_attr(V, name, N),
put_attr(V, dist, Infinity).
init_adjs(Ps, d(X, Y, D)) :-
ord_memberchk(X-Xv, Ps),
ord_memberchk(Y-Yv, Ps),
adj_add(Xv, Yv, D),
adj_add(Yv, Xv, D).
adj_add(X, Y, D) :-
( get_attr(X, adjs, L)
-> put_attr(X, adjs, [Y-D|L])
; put_attr(X, adjs, [Y-D])
).
main_loop([]).
main_loop([Q|Qs]) :-
smallest_distance(Qs, Q, U, Qn),
put_attr(U, assigned, true),
get_attr(U, adjs, As),
update_neighbours(As, U),
main_loop(Qn).
smallest_distance([A|Qs], C, M, [T|Qn]) :-
get_attr(A, dist, Av),
get_attr(C, dist, Cv),
( Av < Cv
-> (N,T) = (A,C)
; (N,T) = (C,A)
),
!, smallest_distance(Qs, N, M, Qn).
smallest_distance([], U, U, []).
update_neighbours([V-Duv|Vs], U) :-
( get_attr(V, assigned, true)
-> true
; get_attr(U, dist, Du),
get_attr(V, dist, Dv),
Alt is Du + Duv,
( Alt < Dv
-> put_attr(V, dist, Alt),
put_attr(V, previous, U)
; true
)
),
update_neighbours(Vs, U).
update_neighbours([], _).
:- begin_tests(dijkstra_av).
test(1) :-
nl,
time(dijkstra_av([d(a,b,1),d(b,c,1),d(c,d,1),d(a,d,2)], a, L)),
maplist(writeln, L).
test(2) :-
open('salesman.pl', read, F),
readf(F, L),
close(F),
nl,
dijkstra_av(L, penzance, R),
maplist(writeln, R).
readf(F, [d(X,Y,D)|R]) :-
read(F, dist(X,Y,D)), !, readf(F, R).
readf(_, []).
:- end_tests(dijkstra_av).
To be true, I prefer the code you linked in the question. There is an obvious point to optimize, smallest_distance/4 now use a dumb linear scan, using an rbtree the runtime should be better. But attributed variables must be handled with care.
time/1 apparently show an improvement
% 2,278 inferences, 0,003 CPU in 0,003 seconds (97% CPU, 747050 Lips)
s(aberdeen,682,[penzance,exeter,bristol,birmingham,manchester,carlisle,edinburgh,aberdeen])
....
but the graph is too small for any definitive assertion. Let we know if this snippet reduce the time required for your program.
File salesman.pl contains dist/3 facts, it's taken verbatim from the link in the question.

Resources