Prolog's DCG syntax allows for some nice tricks. DCG facts and rules
take the form
fact --> []
head --> goal1, goal2.
|
DCG fact and rules are expanded and an extra variable is carried
around the clause. The above DCG facts and rules become:
fact(A, A).
head(A, B) :-
goal1(A, C),
goal2(C, B).
|
In head/2, the variable A comes in, gets passed to goal1
which then
returns C. C is then passed to goal2 which then returns B.
B is then returned by the head.
This lets us code up some things in a nice syntactic sugar.
% dcg1.pl
students(weak) --> sort, first.
students(strong) --> sort, reverse, first.
% return the first part of the list with the
% same keys
first([Key-X,Key-Y|Tail],[Key-X|Rest]) :-
first([Key-Y|Tail],Rest).
first([Key1-X,Key2-_|_],[Key1-X]) :-
Key1 \= Key2.
demo :-
listing(students),nl,
Marks= [1-tim
,7-sue
,3-jon
,6-alice
,1-nancy
,8-kekwee
,10-sally
,7-ho
],
forall(students(What,Marks,Who),
format('~w = ~w\n',[What,Who])).
|
Which generates:
:- demo.
students(weak, A, B) :-
sort(A, C),
first(C, B).
students(strong, A, B) :-
sort(A, C),
reverse(C, D),
first(D, B).
weak = [1-nancy, 1-tim]
strong = [10-sally]
YES
|
Standard DCGs are limited. They add in the carry variables when
it is inconvenient to do so.
For example:
students(reportWeakStudents) -->
sort,
first,
length,
print,
nl.
|
expands internally to
students(reportWeakStudents, A, B) :-
sort(A, C),
first(C, D),
length(D, E),
print(E, F),
nl(F, B).
|
Which is nearly what we want. But note that print and nl
now have two arguments which will crash.
But Prolog taketh away and Prolog giveth. Goal_expansion is a
predicate that massages every sub-goal. It is called once at load
time so it incurs no runtime overheads.
Using it,
we can repair the over-zealous
expansions of standard DCGs.
% dcgfix.pl
goal_expansion(>(A, B, C,C), A > B).
goal_expansion(<(A, B, C,C), A < B).
goal_expansion(>=(A,B, C,C), A >= B).
goal_expansion(=<(A,B, C,C), A =< B).
goal_expansion(=(A, B, C,C), A = B).
goal_expansion(is(A,B, C,C), A is B).
goal_expansion(format(A,B,C,C), format(A,B)).
goal_expansion(print(A, C,C), print(A)).
goal_expansion(nl( C,C), nl).
goal_expansion(fail( C,C), fail).
|
Note the convention: the last two arguments of the first term of the repair
must be the same (see C,C). This means that the carry variables are
carried over the repair, without changing their values.
This is fine for (e.g.) nl, but incomplete
for (e.g.) print since we still can't give it an argument
to print.
In this example,
we need to somehow access the contents of the carry and pass it to
print. This is easy to do.
First, we define:
Second, we write reportWeakStudents
as follows:
students(reportWeakStudents) -->
sort,
first,
length,
val(X),
print(numberOfWeakStudents=X),
nl.
|
This will now expand to
students(reportWeakStudents, A, B) :-
sort(A, C),
first(C, D),
length(D, E),
val(F, E, B),
print(numberOfWeakStudents=F),
nl.
|
which we can run as follows:
demo :-
Marks= [1-tim
,7-sue
,3-jon
,6-alice
,1-nancy
,8-kekwee
,10-sally
,7-ho
],
students(reportWeakStudents,Marks,_).
:- demo.
|
which would print:
Records in Prolog
%rec0.pl
:- [dcgfix].
demo :-
tell('rec0.out'),
listing(p),
nl,
p(demo,_,_),
told.
% p=person(name,dob,shoeSize).
p(name, A0,A,person(A0,B,C),person(A,B,C)).
p(dob, B0,B,person(A,B0,C),person(A,B,C)).
p(shoeSize,C0,C,person(A,B,C0),person(A,B,C)).
p(demo) -->
p(name,_,tim),
p(dob,_,1960),
p(shoeSize,_,10),
p(age(A)),
print(age(A)),nl.
p(age(Age)) -->
p(dob,Dob,Dob),
{year(Year),
Age is Year-Dob}.
year(Year) :-
get_time(Time),
convert_time(Time, Year, _Month, _Day,
_Hour, _Minute, _Second, _MilliSeconds).
|
Which generates:
%rec0.out
p(demo, A, B) :-
p(name, C, tim, A, D),
p(dob, E, 1960, D, F),
p(shoeSize, G, 10, F, H),
p(age(I), H, B),
print(age(I)),
nl.
p(age(A), B, C) :-
p(dob, D, D, B, E),
year(F),
A is F-D,
C=E.
p(name, A, B, person(A, C, D), person(B, C, D)).
p(dob, A, B, person(C, A, D), person(C, B, D)).
p(shoeSize, A, B, person(C, D, A), person(C, D, B)).
age(41)
|
But too many brackets. So...
%rec1.pl
% p=person(name,dob,shoeSize).
demo :- tell('rec1.out'),
write('%rec1.out\n'),
listing(p),
nl,
p(demo,_,_),
told.
p(name, A0,A,person(A0,B,C),person(A,B,C)).
p(dob, B0,B,person(A,B0,C),person(A,B,C)).
p(shoeSize,C0,C,person(A,B,C0),person(A,B,C)).
:- dynamic context/1.
:- op(701,fx,(?)).
:- op(701,fx,(!)).
term_expansion((C=X --> Y),Z) :- print(C),nl,
retractall(context(_)),
assert(context(C)),
Head =.. [C,X],
expand_term((Head --> Y),Z),print(Z).
goal_expansion(?(W = X, Y,Z),true) :-
context(C),
Out =.. [C,W,X,X,Y,Z],
Out.
goal_expansion(?(X,Y,Z),Out) :-
context(C),
Out =.. [C,X,Y,Z].
goal_expansion(!(W=X,Y,Z), true) :-
context(C),
Out =.. [C,W,_,X,Y,Z],
Out.
p=demo -->
!name=tim,
!dob=1960,
!shoeSize=10,
?age(A),
print(age(A)),nl.
p=age(Age) -->
?dob=Dob,
{year(Year)},
Age is Year-Dob.
year(Year) :-
get_time(Time),
convert_time(Time, Year, _Month, _Day,
_Hour, _Minute, _Second, _MilliSeconds).
|
Which generates
%rec1.out
p(demo, person(A, B, C), D) :-
true,
true,
true,
p(age(E), person(tim, 1960, 10), D),
print(age(E)),
nl.
p(age(A), person(B, C, D), E) :-
true,
year(F),
A is F-C,
E=person(B, C, D).
p(name, A, B, person(A, C, D), person(B, C, D)).
p(dob, A, B, person(C, A, D), person(C, B, D)).
p(shoeSize, A, B, person(C, D, A), person(C, D, B)).
age(41)
|
This is better, but we still have to handcraft those
p/5 facts. Wouldn't it be
great to:
% rec2.pl
:- [dcgfix,recdef].
demo :- tell('rec2.out'),
write('%rec2.out\n'),
listing(p),
nl,
p(demo,_,_),
told.
p=person(name,dob,shoeSize).
p=demo -->
!name=tim,
!dob=1960,
!shoeSize=10,
?age(A),
print(age(A)),nl.
p=age(Age) -->
?dob=Dob,
{year(Year)},
Age is Year-Dob.
year(Year) :-
get_time(Time),
convert_time(Time, Year, _Month, _Day,
_Hour, _Minute, _Second, _MilliSeconds).
|
No sooner said than done:
%rec2.out
p(demo, person(A, B, C), D) :-
true,
true,
true,
p(age(E), person(tim, 1960, 10), D),
print(age(E)),
nl.
p(age(A), person(B, C, D), E) :-
true,
year(F),
E=person(B, C, D),
A is F-C.
p(name, A, B, person(A, C, D), person(B, C, D)).
p(dob, A, B, person(C, A, D), person(C, B, D)).
p(shoeSize, A, B, person(C, D, A), person(C, D, B)).
age(41)
|
And the magic is:
% recdef.pl
:- dynamic context/1.
:- op(701,fx,(?)).
:- op(701,fx,(!)).
term_expansion((C=X --> Y),Z) :-
retractall(context(_)),
assert(context(C)),
Head =.. [C,X],
expand_term((Head --> Y),Z).
goal_expansion(?(W = X, Y,Z),true) :-
context(C),
Out =.. [C,W,X,X,Y,Z],
Out.
goal_expansion(?(X,Y,Z),Out) :-
context(C),
Out =.. [C,X,Y,Z].
goal_expansion(!(W=X,Y,Z), true) :-
context(C),
Out =.. [C,W,_,X,Y,Z],
Out.
term_expansion(X=Y,Z) :-
capsules(X=Y,Z).
capsules(X = Y,Out) :-
bagof(Z,X^Y^capsule(X=Y,Z),Out).
capsule(Handle = Wme,Out) :-
functor(Wme,F,Arity),
arg(Pos,Wme,Item),
joinArgs(F,Arity,Pos,Old,New,Term1,Term2),
Out =.. [Handle,Item,Old,New,Term1,Term2].
joinArgs(F,Arity,Pos,Old,New,Term1,Term2) :-
length(L1,Arity),
Pos0 is Pos - 1,
length(Before,Pos0),
append(Before,[Old|After],L1),
append(Before,[New|After],L2),
Term1 =.. [F|L1],
Term2 =.. [F|L2].
|
So lets do a little application: find
consistent assignments to some variables.
:- [dcgfix,recdef].
demo :- tell('globals.out'), ignore(demo1), told.
demo1 :-
listing(o),
o(kb,_,Globals),
o(prints,Globals,_),
fail.
demo1.
o=globals(health,eating,weight,happiness).
o=A + B --> ?A=A1, ?B=B1, ?direct(A1,B1).
o=A - B --> ?A=A1, ?B=B1, ?inverse(A1,B1).
o=prints -->
nl,
?A=B,
format('~w\n',A=B),
fail.
o=prints --> [].
% new syntax: declare "!" as a fact.
!o=inverse(1,0).
!o=inverse(0,1).
!o=direct(1,1).
!o=direct(0,0).
o=kb -->
?eating + weight,
?weight - happiness,
?happiness + health,
?weight - happiness.
|
Which generates:
o(A+B, C, D) :-
o(A, E, E, C, F),
o(B, G, G, F, H),
o(direct(E, G), H, D).
o(A-B, C, D) :-
o(A, E, E, C, F),
o(B, G, G, F, H),
o(inverse(E, G), H, D).
o(prints, A, B) :-
nl,
o(C, D, D, A, B),
format('~w\n', C=D),
fail.
o(prints, A, A).
o(inverse(1, 0), A, A).
o(inverse(0, 1), A, A).
o(direct(1, 1), A, A).
o(direct(0, 0), A, A).
o(kb, A, B) :-
o(eating+weight, A, C),
o(weight-happiness, C, D),
o(happiness+health, D, E),
o(weight-happiness, E, B).
o(health, A, B, globals(A, C, D, E), globals(B, C, D, E)).
o(eating, A, B, globals(C, A, D, E), globals(C, B, D, E)).
o(weight, A, B, globals(C, D, A, E), globals(C, D, B, E)).
o(happiness, A, B, globals(C, D, E, A), globals(C, D, E, B)).
health=0
eating=1
weight=1
happiness=0
health=1
eating=0
weight=0
happiness=1
|
To do this, we had to change recdef a little (which
should be backward compatible with the previous
examples and no, I have not tested that.
% recdef.pl
:- dynamic context/1.
:- op(701,fx,(?)).
:- op(701,fx,(!)).
% new syntax for facts
term_expansion(!C=X,Out) :-
Out =.. [C,X,A,A].
term_expansion((C=X --> Y),Z) :-
retractall(context(_)),
assert(context(C)),
Head =.. [C,X],
expand_term((Head --> Y),Z).
goal_expansion(?(W = X, Y,Z),Out) :-
context(C),
swap(C,W,X,X,Y,Z,Out).
goal_expansion(?(X,Y,Z),Out) :-
context(C),
Out =.. [C,X,Y,Z].
goal_expansion(!(W=X,Y,Z), Out) :-
context(C),
swap(C,W,_,X,Y,Z,Out).
% handling var field names
swap(C,V,W,X,Y,Z,Out) :-
Temp =.. [C,V,W,X,Y,Z],
(var(V) % accessor name unknown
% at compile time
-> Temp=Out % so leave accessor call
% in to execute at runtime
; Temp, % otherwise, call it
Out=true % and don't leave it in
).
term_expansion(X=Y,Z) :-
capsules(X=Y,Z).
capsules(X = Y,Out) :-
bagof(Z,X^Y^capsule(X=Y,Z),Out).
capsule(Handle = Wme,Out) :-
functor(Wme,F,Arity),
arg(Pos,Wme,Item),
joinArgs(F,Arity,Pos,Old,New,Term1,Term2),
Out =.. [Handle,Item,Old,New,Term1,Term2].
joinArgs(F,Arity,Pos,Old,New,Term1,Term2) :-
length(L1,Arity),
Pos0 is Pos - 1,
length(Before,Pos0),
append(Before,[Old|After],L1),
append(Before,[New|After],L2),
Term1 =.. [F|L1],
Term2 =.. [F|L2].
|
Working memory
We'll assume that a working memory is a set of key-value pairs.
- create(Key=Value)
- add a value at some key.
- within(Key=Value)
- Test that value is known at key.
- zap(Key=Value)
- Remove a key-value pair.
- setup
- Global initializations, only needs to be called once.
- keys(N)
- Returns the number of keys in the working memory.
- what(X)
- Returns the type of the current working memory.
- zaps
- Removes all contents of current wme
A standard usage pattern would be:
do --> setup,do1, do1, do1,...
do1 --> reset, run,report.
reset --> zaps, inits.
inits --> create(a=1), create(a=2).
run --> within(x=Y), zap(x=Y).
report --> within(X=Y),print(X=Y),nl, fail.
report.
|
For a working memory held as an argument carried around:
% wmest.pl
% working memory as stack
% add an item
create(X=Y, st(N0,L), st(N,[X=Y|L])) :-
N is N0 + 1.
% test item exists
within(X=Y, st(N,L), st(N,L)) :-
member(X=Y,L).
% delete an item
zap(X=Y, st(N0,L0), st(N,L)) :-
select(X=Y,L0,L),
N is N0 - 1.
% set up the wme- need
% only be called once
setup(st(_,_), st(0,[])).
% size of wme
keys(N, st(N,L), st(N,L)).
% type of wme
what(st, st(N,L), st(N,L)).
% remove all contents of current wme
zaps(st(_,_), st(0,[])).
|
For a working memory held as global, backtrackable asserts:
% wmest.pl
% working memory as backtrackable asserts
% add an item
create(X=Y, ba(N0), ba(N)) :-
bassert(memo(X,Y)),
N is N0 + 1.
bassert(X) :- asserta(X).
bassert(X) :- retract(X),fail.
% test item exists
within(X=Y, ba(N), ba(N)) :-
memo(X,Y).
% delete an item
zap(X=Y, ba(N0), ba(N)) :-
bretract(memo(X,Y)),
N is N0 - 1.
bretract(X) :-
retract(X),
bretract1(X).
bretract1(_).
bretract1(X) :-
asserta(X),
fail.
% set up the wme- need
% only be called once
setup(ba(_), ba(0)) :-
dynamic(memo/2),
index(memo(1,0)).
% size of wme
keys(N, ba(N), ba(N)).
% type of wme
what(ba, ba(N), ba(N)).
% remove all contents of current wme
zaps(ba(_), ba(0)) :-
retractall(memo(_,_)).
|
Which means we can test them all the same way:
% assume ground index terms of the form X=Y
% setup - really does noting except for ba
% st= stack
:- [dcgfix].
demo :-
tell('wmedemo.out'),
ignore(demo1),
told.
demo1 :-
write('%wmedemo.out'),
nl,nl,
listing(wmeTest),
listing(prints),
forall(wmeTest(wmeab,_,_),true),
forall(wmeTest(wmest,_,_),true).
wmeTest(X)-->
{[X]},
setup,
what(What),
format('\n%--| ~w |--------\n',[What]),
zaps,
create(a=1),
create(b=1),
create(a=2),
within(a=L),
print(within(a=L)),
zap(a=2),
prints,
nl,
print(zapping),
nl,
zaps,
prints,!.
prints -->
keys(K), what(W),
format('\n%~w wme with ~w item(s)\n',[W,K]),
within(X),
format('~w\n',X),
fail.
prints --> [].
|
Which generates:
%wmedemo.out
wmeTest(A, B, C) :-
[A],
D=B,
setup(D, E),
what(F, E, G),
format('\n%--| ~w |--------\n', [F]),
zaps(G, H),
create(a=1, H, I),
create(b=1, I, J),
create(a=2, J, K),
within(a=L, K, M),
print(within(a=L)),
zap(a=2, M, N),
prints(N, O),
nl,
print(zapping),
nl,
zaps(O, P),
prints(P, C), !.
prints(A, B) :-
keys(C, A, D),
what(E, D, F),
format('\n%~w wme with ~w item(s)\n', [E, C]),
within(G, F, B),
format('~w\n', G),
fail.
prints(A, A).
%--| ba |--------
within(a=2)
%ba wme with 2 item(s)
b=1
a=1
zapping
%ba wme with 0 item(s)
%--| st |--------
within(a=2)
%st wme with 2 item(s)
b=1
a=1
zapping
%st wme with 0 item(s)
|
Not © Tim Menzies, 2001
Share and enjoy- information wants to be free.
But if you take anything from this site,
please credit tim@menzies.com.
|
