AI PROGRAMMING WITH PROLOG PART 2
ARTIFICIAL INTELLIGENCE PROGRAMMING WITH PROLOG
WORKSHOP I
PART 2 (Examples 81-140)
LEARNING prolog
BY EXAMPLE
I have recompiled over 200 prolog examples with test. Since this is a self-learning program, I recommend that you review the materials provided in the AI Programming resources page. Since I recommend using gnu prolog, you can also visit their User's Guide and their website.
http://www.gprolog.org/manual/gprolog.html
http://www.gprolog.org/
To download the pdf guide, click here.
The easiest way to obtain an executable from a Prolog source file example1.pl is to use:
% gplc example1.pl
This will produce a native executable called example1 which can be executed from the prolog command line interface, as follows:
% example1
You can enhance the options you have, by studying the user's guide literature.
EXAMPLE 81
% Find all 3 by 3 magic squares.
% Shows the use of a list of variables to keep track of whether
% they have been assumed to have values or not yet.
:-op(100, xfx, not_in). % a new infix operator. xfx defines associativity
_ not_in [].
D not_in [X | Rest]:- var(X),! , %added to reduce trail
D not_in Rest.
D not_in [X | Rest]:- nonvar(X), D\==X,!, %added to reduce trail
D not_in Rest.
% d(D) is for digit
d(1). d(2). d(3). d(4). d(5). d(6). d(7). d(8). d(9).
% nd(X, D) gets a new and different digit each time, But quickly.
% D is a list of the variables representing digits in problem
nd(Digit,DigitList):- nonvar(Digit),!.
% cut added to reduce trail
nd(Digit,DigitList):-
var(Digit),!, d(X1), X1 not_in DigitList, Digit=X1.
% a row has 3 different digits that add up to 15
row(X,Y,Z, DigitList):-nd(X,DigitList),
nd(Y,DigitList),
nd(Z,DigitList),
X+Y+Z=:=15.
col(X,Y,Z):- X+Y+Z=:=15.
diag(X,Y,Z):- X+Y+Z=:=15.
printrow(A,B,C):-write(A),write(B),write(C),nl.
out(A,B,C,D,E,F,G,H,I):-nl,
printrow(A,B,C),
printrow(D,E,F),
printrow(G,H,I).
go:-go(More).
go(More):-More=more,
DigitList=[A,B,C,D,5,F,G,H,I],
row(A,B,C,DigitList),
row(D,5,F,DigitList),
row(G,H,I,DigitList),
col(A,D,G),col(B,E,H),col(C,F,I),
diag(A,E,I), diag(G,E,C),
out(A,B,C,D,E,F,G,H,I).
EXAMPLE 82
% Find all 3 by 3 magic squares.
% Shows the use of a list of variables to keep track of whether
% they have been assumed to have values or not yet.
:-op(100, xfx, not_in). % a new infix operator. xfx defines associativity
_ not_in [].
D not_in [X | Rest]:- var(X),! , %added to reduce trail
D not_in Rest.
D not_in [X | Rest]:- nonvar(X), D\==X,!, %added to reduce trail
D not_in Rest.
% d(D) is for digit
d(1). d(2). d(3). d(4). d(5). d(6). d(7). d(8). d(9).
% nd(X, D) gets a new and different digit each time, But quickly.
% D is a list of the variables representing digits in problem
nd(Digit,DigitList):- nonvar(Digit),!.
% cut added to reduce trail
nd(Digit,DigitList):-
var(Digit),!, d(X1), X1 not_in DigitList, Digit=X1.
% a row has 3 different digits that add up to 15
row(X,Y,Z, DigitList):-nd(X,DigitList),
nd(Y,DigitList),
nd(Z,DigitList),
X+Y+Z=:=15.
col(X,Y,Z):- X+Y+Z=:=15.
diag(X,Y,Z):- X+Y+Z=:=15.
printrow(A,B,C):-write(A),write(B),write(C),nl.
out(A,B,C,D,E,F,G,H,I):-nl,
printrow(A,B,C),
printrow(D,E,F),
printrow(G,H,I).
go:-go(More).
go(More):-More=more,
DigitList=[A,B,C,D,5,F,G,H,I],
row(A,B,C,DigitList),
row(D,5,F,DigitList),
row(G,H,I,DigitList),
col(A,D,G),col(B,E,H),col(C,F,I),
diag(A,E,I), diag(G,E,C),
out(A,B,C,D,E,F,G,H,I).
EXAMPLE 83
% Find all 3 by 3 magic squares. 10 times faster!
% d(D) is for digit
d(1). d(2). d(3). d(4). d(5). d(6). d(7). d(8). d(9).
% a row has 3 different digits that add up to 15
row(X,Y,Z):-d(X),d(Y), X=\=Y, Z is 15 - X - Y, d(Z), d(Z),X=\=Z, Y=\=Z.
% was row(X,Y,Z):-d(X),d(Y), X=\=Y, d(Z),X=\=Z, Y=\=Z, X+Y+Z=:=15.
col(X,Y,Z):-X=\=Y, Y=\=Z, X=\=Z, X+Y+Z=:=15.
diag(X,Y,Z):-X=\=Y, Y=\=Z, X=\=Z, X+Y+Z=:=15.
% make sure that there are no other duplicate digits
offdiag(X,Y,Z):-X=\=Y, Y=\=Z, X=\=Z.
printrow(A,B,C):-write(A),write(B),write(C),nl.
out(A,B,C,D,E,F,G,H,I):-nl,
printrow(A,B,C),
printrow(D,E,F),
printrow(G,H,I).
go:-go(More).
go(More):-More=more,
row(A,B,C),
row(D,E,F),
G is 15-A-D, H is 15-B-E,
row(G,H,I),
col(A,D,G),col(B,E,H),col(C,F,I),
diag(A,E,I), diag(G,E,C),
offdiag(A,H,F), offdiag(C,D,H),offdiag(G,B,F),offdiag(I,D,B),
out(A,B,C,D,E,F,G,H,I).
EXAMPLE 84
% Find all 3 by 3 magic squares. 10 times faster!
% digit(D) is for digit
digit(1). digit(2). digit(3). digit(4). digit(5). digit(6). digit(7).
digit(8). digit(9).
% digits can only be used once. Select extracts one digit from Unused list
d(D,OldUnUsed,NewUnUsed):-select(OldUnUsed,D,NewUnUsed).
% a row has 3 digits that add up to 15
row(X,Y,Z,OldUnused, NewUnused):-d(X,OldUnused, U),d(Y,U,U2),
Z is 15 - X - Y, d(Z,U2,NewUnused).
% was row(X,Y,Z):-d(X),d(Y), X=\=Y, d(Z),X=\=Z, Y=\=Z, X+Y+Z=:=15.
col(X,Y,Z):- X+Y+Z=:=15.
diag(X,Y,Z):- X+Y+Z=:=15.
printrow(A,B,C):-write(A),write(B),write(C),nl.
out(A,B,C,D,E,F,G,H,I):-nl,
printrow(A,B,C),
printrow(D,E,F),
printrow(G,H,I).
go:-go(More).
go(More):-More=more,
UnUsed=[1,2,3,4,5,6,7,8,9],
row(A,B,C,UnUsed,UnUsed2),
row(D,E,F,UnUsed2,UnUsed3),
G is 15-A-D, H is 15-B-E,
row(G,H,I,UnUsed2,UnUsed4),
col(A,D,G),col(B,E,H),col(C,F,I),
diag(A,E,I), diag(G,E,C),
out(A,B,C,D,E,F,G,H,I).
EXAMPLE 85
% Find all 3 by 3 magic squares. 10 times faster!
% digit(D) is for digit
digit(1). digit(2). digit(3). digit(4). digit(5). digit(6). digit(7).
digit(8). digit(9).
% digits can only be used once. Select extracts one digit from Unused list
d(D,OldUnUsed,NewUnUsed):-select(OldUnUsed,D,NewUnUsed).
% a row has 3 digits that add up to 15
row(X,Y,Z,OldUnused, NewUnused):-d(X,OldUnused, U),d(Y,U,U2),
Z is 15 - X - Y, d(Z,U2,NewUnused).
% was row(X,Y,Z):-d(X),d(Y), X=\=Y, d(Z),X=\=Z, Y=\=Z, X+Y+Z=:=15.
col(X,Y,Z):- X+Y+Z=:=15.
diag(X,Y,Z):- X+Y+Z=:=15.
printrow(A,B,C):-write(A),write(B),write(C),nl.
out(A,B,C,D,E,F,G,H,I):-nl,
printrow(A,B,C),
printrow(D,E,F),
printrow(G,H,I).
go:-go(More).
go(More):-More=more,
UnUsed=[1,2,3,4,5,6,7,8,9],
row(A,B,C,UnUsed,UnUsed2),
row(D,E,F,UnUsed2,UnUsed3),
G is 15-A-D, H is 15-B-E,
row(G,H,I,UnUsed2,UnUsed4),
col(A,D,G),col(B,E,H),col(C,F,I),
diag(A,E,I), diag(G,E,C),
out(A,B,C,D,E,F,G,H,I).
EXAMPLE 86
% In Elementary Pascal Ledgard & Singer have Sherlock Holmes program
% the Analytical Engine to confirm the identity of the murderer of
% a well known art dealer at the Metropolitan Club in London.
% The murderer can be deduced from the following apparently trivial
% clues.
murderer(X):-hair(X, brown). % the murderer had brown hair
attire(mr_holman, ring). % mr_holman had a ring
attire(mr_pope, watch). % mr_pope had a watch.
attire(mr_woodley, pincenez):-attire(sir_raymond, tattered_cuffs). % If sir_raymond had tattered cuffs then mr_woodley had the pincenez spectacles
attire(sir_raymond, pincenez):-attire(mr_woodley, tattered_cuffs). % and vice versa
attire(X, tattered_cuffs):-room(X, 16). % A person has tattered cuffs if they were in room 16.
hair(X, black):-room(X, 14). % A person has black hair if they were in room 14.
hair(X, grey):-room(X, 12).
hair(X, brown):-attire(X, pincenez).
hair(X, red):-attire(X, tattered_cuffs).
room(mr_holman, 12). % mr_holman was in room 12
room(sir_raymond, 10).
room(mr_woodley, 16).
room(X, 14):-attire(X, watch).
:- nl, nl, write('The game is afoot....'), nl, nl.
EXAMPLE 87
% In Elementary Pascal Ledgard & Singer have Sherlock Holmes program
% the Analytical Engine to confirm the identity of the murderer of
% a well known art dealer at the Metropolitan Club in London.
% The murderer can be deduced from the following apparently trivial
% clues.
:-op(50, xfx, wore).
:-op(50, xfx, has).
:-op(50, xfx, was_in).
:-op(40, xf, hair).
mr_holman wore a_ring.
mr_pope wore a_watch.
mr_woodley wore pincenez:-sir_raymond wore tattered_cuffs.
sir_raymond wore pincenez:-mr_woodley wore tattered_cuffs.
X wore tattered_cuffs:-X was_in room_16.
X has black hair:-X was_in room_14.
X has brown hair:-X wore pincenez.
X has grey hair:-X was_in room_12.
X has red hair:-X wore tattered_cuffs.
murderer(X):-X has brown hair.
mr_holman was_in room_12.
sir_raymond was_in room_10.
mr_woodley was_in room_16.
X was_in room_14:-X wore a_watch.
:- write('The game is afoot....'), nl.
EXAMPLE 88
% permutations: one list is a reordering of the items in the other list
% perm(-List1, +List2)
perm([],[]).
perm(X,[Y|Z]):-select(X,Y,R),perm(R,Z).
sudoku(Board):-Board=[R1,R2,R3,R4],
Board=[[X11,X12,X13,X14],[X21,X22,X23,X24],[X31,X32,X33,X34],[X41,X42,X43,X44]],
D=[1,2,3,4], %the digits
X11=1, X22=2,X33=3,X44=4,
perm(R1,D), perm(R2,D), perm(R3,D),perm(R4,D),
perm([X11,X21,X31,X41],D), %Columns
perm([X12,X22,X32,X42],D),
perm([X13,X23,X33,X43],D),
perm([X14,X24,X34,X44],D),
perm([X11,X12,X21,X22],D), %Boxes
perm([X13,X14,X23,X24],D),
perm([X31,X32,X41,X42],D),
perm([X33,X34,X43,X44],D),
write_ln(R1),
write_ln(R2),
write_ln(R3),
write_ln(R4).
EXAMPLE 89
% Harry Potter and the seven potions
puzzle(Potions):-
% seven potions in a row
Potions=[P1,P2,P3,P4,P5,P6,P7],
% one forward, one backward, 2 wines, and 3 poisons in some order
permutation(Potions, [forward,back,wine,wine,poison,poison,poison]),
% Look at the drawing for the biggest and smallest
Dwarf=P3, Giant=P2,
% First clue -- Each wine bottle has poison on the left
P1\==wine,
(P2\==wine; P1=poison),
(P3\==wine; P2=poison),
(P4\==wine; P3=poison),
(P5\==wine; P4=poison),
(P6\==wine; P5=poison),
(P7\==wine; P6=poison),
% Second clue -- the ends are different
P1\==P7,
% and neither end moves you forward
P1\==forward, P7\==forward,
% Third clue -- The largest and smallest are not poison
Dwarf\==poison, Giant\==poison,
% Fourth clue -- second left and second on the right are the same
P2==P6.
solve(S):-setof(P,puzzle(P),S).
writeSet(S):-member(T,S), write(T),nl,fail.
go:-solve(S), writeSet(S).
:-write('puzzle/1, solve/1, writeSet/1, go/0 loaded. Type go. to see solution').
EXAMPLE 90
% month(Number, LongName).
month(1, january).
month(2, february).
month(3, march).
EXAMPLE 91
set_year:-write('Input the year ending with a period: '), read(Year),
abolish(year, 1), assert(year(Year)).
EXAMPLE 92
% month(Name, Days, Next) when Name has Days days and is followed by Next.
month(jan, 31, feb).
month(feb, 29, mar):-leapyear,!.
month(feb, 28, mar).
month(mar, 31, apr). month(apr, 30, may).
month(may, 31, jun). month(jun, 30, jul). month(jul, 31, aug).
month(aug, 31, sep). month(sep, 30, oct). month(oct, 31, nov).
month(nov, 30, dec). month(dec, 31, jan).
% month(X,_,_) will list months in order
% month(X,D,_) will give the days for month X
% month(X,_,N) will give the next month after X
% --------------or---------------
% month_days(Name, Days) and when Name has Days days.
% month_next(Name, Next) and when Name is followed by Next.
month_days(feb, 29):-leapyear,!.
month_days(feb, 28).
month_days(M, 31):-member(M, [jan, mar, may, jul, aug, oct, dec]).
month_days(M, 30):-member(M, [apr,jun,sep,nov ]).
month_next(jan, feb). month_next(feb, mar).
month_next(mar, apr). month_next(apr, may).
month_next(may, jun). month_next(jun, jul). month_next(jul, aug).
month_next(aug, sep). month_next(sep, oct). month_next(oct, nov).
month_next(nov, dec). month_next(dec, jan).
% month_next(X,_) will list months in order
% month_days(X,D) will give the days for month X
% month_next(X,N) will give the next month after X
EXAMPLE 81
% Find all 3 by 3 magic squares.
% Shows the use of a list of variables to keep track of whether
% they have been assumed to have values or not yet.
:-op(100, xfx, not_in). % a new infix operator. xfx defines associativity
_ not_in [].
D not_in [X | Rest]:- var(X),! , %added to reduce trail
D not_in Rest.
D not_in [X | Rest]:- nonvar(X), D\==X,!, %added to reduce trail
D not_in Rest.
% d(D) is for digit
d(1). d(2). d(3). d(4). d(5). d(6). d(7). d(8). d(9).
% nd(X, D) gets a new and different digit each time, But quickly.
% D is a list of the variables representing digits in problem
nd(Digit,DigitList):- nonvar(Digit),!.
% cut added to reduce trail
nd(Digit,DigitList):-
var(Digit),!, d(X1), X1 not_in DigitList, Digit=X1.
% a row has 3 different digits that add up to 15
row(X,Y,Z, DigitList):-nd(X,DigitList),
nd(Y,DigitList),
nd(Z,DigitList),
X+Y+Z=:=15.
col(X,Y,Z):- X+Y+Z=:=15.
diag(X,Y,Z):- X+Y+Z=:=15.
printrow(A,B,C):-write(A),write(B),write(C),nl.
out(A,B,C,D,E,F,G,H,I):-nl,
printrow(A,B,C),
printrow(D,E,F),
printrow(G,H,I).
go:-go(More).
go(More):-More=more,
DigitList=[A,B,C,D,5,F,G,H,I],
row(A,B,C,DigitList),
row(D,5,F,DigitList),
row(G,H,I,DigitList),
col(A,D,G),col(B,E,H),col(C,F,I),
diag(A,E,I), diag(G,E,C),
out(A,B,C,D,E,F,G,H,I).
EXAMPLE 82
% Find all 3 by 3 magic squares.
% Shows the use of a list of variables to keep track of whether
% they have been assumed to have values or not yet.
:-op(100, xfx, not_in). % a new infix operator. xfx defines associativity
_ not_in [].
D not_in [X | Rest]:- var(X),! , %added to reduce trail
D not_in Rest.
D not_in [X | Rest]:- nonvar(X), D\==X,!, %added to reduce trail
D not_in Rest.
% d(D) is for digit
d(1). d(2). d(3). d(4). d(5). d(6). d(7). d(8). d(9).
% nd(X, D) gets a new and different digit each time, But quickly.
% D is a list of the variables representing digits in problem
nd(Digit,DigitList):- nonvar(Digit),!.
% cut added to reduce trail
nd(Digit,DigitList):-
var(Digit),!, d(X1), X1 not_in DigitList, Digit=X1.
% a row has 3 different digits that add up to 15
row(X,Y,Z, DigitList):-nd(X,DigitList),
nd(Y,DigitList),
nd(Z,DigitList),
X+Y+Z=:=15.
col(X,Y,Z):- X+Y+Z=:=15.
diag(X,Y,Z):- X+Y+Z=:=15.
printrow(A,B,C):-write(A),write(B),write(C),nl.
out(A,B,C,D,E,F,G,H,I):-nl,
printrow(A,B,C),
printrow(D,E,F),
printrow(G,H,I).
go:-go(More).
go(More):-More=more,
DigitList=[A,B,C,D,5,F,G,H,I],
row(A,B,C,DigitList),
row(D,5,F,DigitList),
row(G,H,I,DigitList),
col(A,D,G),col(B,E,H),col(C,F,I),
diag(A,E,I), diag(G,E,C),
out(A,B,C,D,E,F,G,H,I).
EXAMPLE 83
% Find all 3 by 3 magic squares. 10 times faster!
% d(D) is for digit
d(1). d(2). d(3). d(4). d(5). d(6). d(7). d(8). d(9).
% a row has 3 different digits that add up to 15
row(X,Y,Z):-d(X),d(Y), X=\=Y, Z is 15 - X - Y, d(Z), d(Z),X=\=Z, Y=\=Z.
% was row(X,Y,Z):-d(X),d(Y), X=\=Y, d(Z),X=\=Z, Y=\=Z, X+Y+Z=:=15.
col(X,Y,Z):-X=\=Y, Y=\=Z, X=\=Z, X+Y+Z=:=15.
diag(X,Y,Z):-X=\=Y, Y=\=Z, X=\=Z, X+Y+Z=:=15.
% make sure that there are no other duplicate digits
offdiag(X,Y,Z):-X=\=Y, Y=\=Z, X=\=Z.
printrow(A,B,C):-write(A),write(B),write(C),nl.
out(A,B,C,D,E,F,G,H,I):-nl,
printrow(A,B,C),
printrow(D,E,F),
printrow(G,H,I).
go:-go(More).
go(More):-More=more,
row(A,B,C),
row(D,E,F),
G is 15-A-D, H is 15-B-E,
row(G,H,I),
col(A,D,G),col(B,E,H),col(C,F,I),
diag(A,E,I), diag(G,E,C),
offdiag(A,H,F), offdiag(C,D,H),offdiag(G,B,F),offdiag(I,D,B),
out(A,B,C,D,E,F,G,H,I).
EXAMPLE 84
% Find all 3 by 3 magic squares. 10 times faster!
% digit(D) is for digit
digit(1). digit(2). digit(3). digit(4). digit(5). digit(6). digit(7).
digit(8). digit(9).
% digits can only be used once. Select extracts one digit from Unused list
d(D,OldUnUsed,NewUnUsed):-select(OldUnUsed,D,NewUnUsed).
% a row has 3 digits that add up to 15
row(X,Y,Z,OldUnused, NewUnused):-d(X,OldUnused, U),d(Y,U,U2),
Z is 15 - X - Y, d(Z,U2,NewUnused).
% was row(X,Y,Z):-d(X),d(Y), X=\=Y, d(Z),X=\=Z, Y=\=Z, X+Y+Z=:=15.
col(X,Y,Z):- X+Y+Z=:=15.
diag(X,Y,Z):- X+Y+Z=:=15.
printrow(A,B,C):-write(A),write(B),write(C),nl.
out(A,B,C,D,E,F,G,H,I):-nl,
printrow(A,B,C),
printrow(D,E,F),
printrow(G,H,I).
go:-go(More).
go(More):-More=more,
UnUsed=[1,2,3,4,5,6,7,8,9],
row(A,B,C,UnUsed,UnUsed2),
row(D,E,F,UnUsed2,UnUsed3),
G is 15-A-D, H is 15-B-E,
row(G,H,I,UnUsed2,UnUsed4),
col(A,D,G),col(B,E,H),col(C,F,I),
diag(A,E,I), diag(G,E,C),
out(A,B,C,D,E,F,G,H,I).
EXAMPLE 85
% Find all 3 by 3 magic squares. 10 times faster!
% digit(D) is for digit
digit(1). digit(2). digit(3). digit(4). digit(5). digit(6). digit(7).
digit(8). digit(9).
% digits can only be used once. Select extracts one digit from Unused list
d(D,OldUnUsed,NewUnUsed):-select(OldUnUsed,D,NewUnUsed).
% a row has 3 digits that add up to 15
row(X,Y,Z,OldUnused, NewUnused):-d(X,OldUnused, U),d(Y,U,U2),
Z is 15 - X - Y, d(Z,U2,NewUnused).
% was row(X,Y,Z):-d(X),d(Y), X=\=Y, d(Z),X=\=Z, Y=\=Z, X+Y+Z=:=15.
col(X,Y,Z):- X+Y+Z=:=15.
diag(X,Y,Z):- X+Y+Z=:=15.
printrow(A,B,C):-write(A),write(B),write(C),nl.
out(A,B,C,D,E,F,G,H,I):-nl,
printrow(A,B,C),
printrow(D,E,F),
printrow(G,H,I).
go:-go(More).
go(More):-More=more,
UnUsed=[1,2,3,4,5,6,7,8,9],
row(A,B,C,UnUsed,UnUsed2),
row(D,E,F,UnUsed2,UnUsed3),
G is 15-A-D, H is 15-B-E,
row(G,H,I,UnUsed2,UnUsed4),
col(A,D,G),col(B,E,H),col(C,F,I),
diag(A,E,I), diag(G,E,C),
out(A,B,C,D,E,F,G,H,I).
EXAMPLE 86
% In Elementary Pascal Ledgard & Singer have Sherlock Holmes program
% the Analytical Engine to confirm the identity of the murderer of
% a well known art dealer at the Metropolitan Club in London.
% The murderer can be deduced from the following apparently trivial
% clues.
murderer(X):-hair(X, brown). % the murderer had brown hair
attire(mr_holman, ring). % mr_holman had a ring
attire(mr_pope, watch). % mr_pope had a watch.
attire(mr_woodley, pincenez):-attire(sir_raymond, tattered_cuffs). % If sir_raymond had tattered cuffs then mr_woodley had the pincenez spectacles
attire(sir_raymond, pincenez):-attire(mr_woodley, tattered_cuffs). % and vice versa
attire(X, tattered_cuffs):-room(X, 16). % A person has tattered cuffs if they were in room 16.
hair(X, black):-room(X, 14). % A person has black hair if they were in room 14.
hair(X, grey):-room(X, 12).
hair(X, brown):-attire(X, pincenez).
hair(X, red):-attire(X, tattered_cuffs).
room(mr_holman, 12). % mr_holman was in room 12
room(sir_raymond, 10).
room(mr_woodley, 16).
room(X, 14):-attire(X, watch).
:- nl, nl, write('The game is afoot....'), nl, nl.
EXAMPLE 87
% In Elementary Pascal Ledgard & Singer have Sherlock Holmes program
% the Analytical Engine to confirm the identity of the murderer of
% a well known art dealer at the Metropolitan Club in London.
% The murderer can be deduced from the following apparently trivial
% clues.
:-op(50, xfx, wore).
:-op(50, xfx, has).
:-op(50, xfx, was_in).
:-op(40, xf, hair).
mr_holman wore a_ring.
mr_pope wore a_watch.
mr_woodley wore pincenez:-sir_raymond wore tattered_cuffs.
sir_raymond wore pincenez:-mr_woodley wore tattered_cuffs.
X wore tattered_cuffs:-X was_in room_16.
X has black hair:-X was_in room_14.
X has brown hair:-X wore pincenez.
X has grey hair:-X was_in room_12.
X has red hair:-X wore tattered_cuffs.
murderer(X):-X has brown hair.
mr_holman was_in room_12.
sir_raymond was_in room_10.
mr_woodley was_in room_16.
X was_in room_14:-X wore a_watch.
:- write('The game is afoot....'), nl.
EXAMPLE 88
% permutations: one list is a reordering of the items in the other list
% perm(-List1, +List2)
perm([],[]).
perm(X,[Y|Z]):-select(X,Y,R),perm(R,Z).
sudoku(Board):-Board=[R1,R2,R3,R4],
Board=[[X11,X12,X13,X14],[X21,X22,X23,X24],[X31,X32,X33,X34],[X41,X42,X43,X44]],
D=[1,2,3,4], %the digits
X11=1, X22=2,X33=3,X44=4,
perm(R1,D), perm(R2,D), perm(R3,D),perm(R4,D),
perm([X11,X21,X31,X41],D), %Columns
perm([X12,X22,X32,X42],D),
perm([X13,X23,X33,X43],D),
perm([X14,X24,X34,X44],D),
perm([X11,X12,X21,X22],D), %Boxes
perm([X13,X14,X23,X24],D),
perm([X31,X32,X41,X42],D),
perm([X33,X34,X43,X44],D),
write_ln(R1),
write_ln(R2),
write_ln(R3),
write_ln(R4).
EXAMPLE 89
% Harry Potter and the seven potions
puzzle(Potions):-
% seven potions in a row
Potions=[P1,P2,P3,P4,P5,P6,P7],
% one forward, one backward, 2 wines, and 3 poisons in some order
permutation(Potions, [forward,back,wine,wine,poison,poison,poison]),
% Look at the drawing for the biggest and smallest
Dwarf=P3, Giant=P2,
% First clue -- Each wine bottle has poison on the left
P1\==wine,
(P2\==wine; P1=poison),
(P3\==wine; P2=poison),
(P4\==wine; P3=poison),
(P5\==wine; P4=poison),
(P6\==wine; P5=poison),
(P7\==wine; P6=poison),
% Second clue -- the ends are different
P1\==P7,
% and neither end moves you forward
P1\==forward, P7\==forward,
% Third clue -- The largest and smallest are not poison
Dwarf\==poison, Giant\==poison,
% Fourth clue -- second left and second on the right are the same
P2==P6.
solve(S):-setof(P,puzzle(P),S).
writeSet(S):-member(T,S), write(T),nl,fail.
go:-solve(S), writeSet(S).
:-write('puzzle/1, solve/1, writeSet/1, go/0 loaded. Type go. to see solution').
EXAMPLE 90
% month(Number, LongName).
month(1, january).
month(2, february).
month(3, march).
EXAMPLE 91
set_year:-write('Input the year ending with a period: '), read(Year),
abolish(year, 1), assert(year(Year)).
EXAMPLE 92
% month(Name, Days, Next) when Name has Days days and is followed by Next.
month(jan, 31, feb).
month(feb, 29, mar):-leapyear,!.
month(feb, 28, mar).
month(mar, 31, apr). month(apr, 30, may).
month(may, 31, jun). month(jun, 30, jul). month(jul, 31, aug).
month(aug, 31, sep). month(sep, 30, oct). month(oct, 31, nov).
month(nov, 30, dec). month(dec, 31, jan).
% month(X,_,_) will list months in order
% month(X,D,_) will give the days for month X
% month(X,_,N) will give the next month after X
% --------------or---------------
% month_days(Name, Days) and when Name has Days days.
% month_next(Name, Next) and when Name is followed by Next.
month_days(feb, 29):-leapyear,!.
month_days(feb, 28).
month_days(M, 31):-member(M, [jan, mar, may, jul, aug, oct, dec]).
month_days(M, 30):-member(M, [apr,jun,sep,nov ]).
month_next(jan, feb). month_next(feb, mar).
month_next(mar, apr). month_next(apr, may).
month_next(may, jun). month_next(jun, jul). month_next(jul, aug).
month_next(aug, sep). month_next(sep, oct). month_next(oct, nov).
month_next(nov, dec). month_next(dec, jan).
% month_next(X,_) will list months in order
% month_days(X,D) will give the days for month X
% month_next(X,N) will give the next month after X
EXAMPLE 95
% Examples of the effect of forcing a predicate to backtrack by failure.
poem(N) :-
open(A, N),
!,
closer(B, N),
append(A,B,AB),
append(AB,'.', C),
write(C), nl.
closer(C, 0) :-
!,
fail.
closer(C, N) :-
N > 0,
contin(C).
closer(C, N) :-
N > 0,
contin(C1),
N1 is N - 1,
closer(C2, N1),
append(C1, C2, C).
contin(' is a rose').
open('A rose', _).
:- write('Predicate poem(N). loaded'), nl.
EXAMPLE 96
% pretty print a prolog structure
pp(P):-pp([],P).
pp(L,P):-atomic(P),indented_print(L,P).
pp(L,P):-var(P),indented_print(L,P).
pp(L,[H|T]):-indented_print(L,'['), pp([' |'|L],H),ppa([' |'|L],T),indented_print(L,']').
pp(L,P):-P=..[F|Arg], pp(L,F), ppa([' |'|L], Arg).
ppa(L,[H|T]):-pp(L,H),ppa(L,T).
ppa(L,[]):-true.
indented_print([H|T], P):-write(H), indented_print(T, P).
indented_print([],P):-write('-'), write(P), nl.
EXAMPLE 97
% Quicksort in Prolog.
% filter(List, Pivot, Lower, Higher) divides List up into items Lower & Higher than Pivot
filter( [], _, [], []).
filter( [X|Y], P, [X|L], H ):- X =< P, filter(Y, P, L, H).
filter( [X|Y], P, L, [X|H] ):- X > P, filter(Y, P, L, H).
% Here is the sort
qsort([], []):-!.
qsort([X], [X]):-!.
qsort([X|Y], SXY):- filter(Y, X, L, H), qsort(L,SL), qsort(H,SH), append(SL, [X], SLX), append(SLX, SH, SXY).
EXAMPLE 98
% Quicksort in Prolog.
% filter(List, Pivot, Lower, Higher) divides List up into items Lower & Higher than Pivot
filter( [], _, [], []).
filter( [X|Y], P, [X|L], H ):- X =< P, filter(Y, P, L, H).
filter( [X|Y], P, L, [X|H] ):- X > P, filter(Y, P, L, H).
% Here is the sort program
qsort([], []):-!.
qsort([X], [X]):-!.
qsort([X,Y], [X,Y]):-X=<Y,!.
qsort([X,Y], [Y,X]):-X>Y,!.
qsort([X|Y], SXY):- filter(Y, X, L, H), qsort(L,SL), qsort(H,SH), append(SL, [X], SLX), append(SLX, SH, SXY).
EXAMPLE 99
% Simulated memory
% Prolog variables are temporary local variables that can be lost
% during backtracking.
% The Prolog data base is global but does not assoicate a unique
% value with each variable.
% This file shows how to emulate a global random access memory.
% ram(x, v) is a clause when and only when x is a variable and v its
% current value.
:-dynamic(ram/2).
print_ram:-ram(X, VX), write('RAM['), write(X), write(']='), write(VX), nl,fail.
print_ram:- write('-------------'), nl.
initial_ram:-abolish(ram,2 ), !, assert(ram(nothing, empty)).
% Now define semantics of assignment statements used with our RAM.
% Notice these do not evaluate the value being stored.
set(X,V):- remove_old(X), assert(ram(X, V)),!.
remove_old(X):- (ram(X,Old), retract(ram(X,Old)); true),!.
% The following two definitions will work with functions.plg to
% allow variables in RAM to be used in functional expressions
:-consult('functions.plg').
function(X,V):-ram(X,V),!.
let(X,E):-EV es E, remove_old(X), assert(ram(X,EV)),!.
:-write('intial_ram, print_ram, set(X,V), let(X,Expr) loaded'),nl,nl.
EXAMPLE 100
% Fractions and rational numbers in Prolog
gcd(X,X,X):-!.
gcd(X,1, 1):-!.
gcd(1,X,1):-!.
gcd(X,0, X):-!.
gcd(0,X,X):-!.
gcd(X,Y,Z):-X>Y,!, XY is X mod Y, gcd(XY,Y,Z).
gcd(X,Y,Z):-X<Y,!, YX is Y mod X, gcd(X,YX,Z).
lcm(X,Y,LCM):-gcd(X,Y,GCD), LCM is X*Y//GCD.
reduce(A/A,1/1):-!.
reduce(A/1,A/1):-!.
reduce(1/A,1/A):-!.
reduce(A/B,C/D):-gcd(A,B,G), C is A//G, D is B//G.
propper(A/B,A/B):-A<B,!.
propper(A/A,1):-!.
propper(A/B,I+E/B):-I is A // B, E is A mod B.
val(A/B+C/D, E/F):- !, lcm(B,D,Den), N is A*(Den//B) + C*(Den//D), reduce(N/Den,E/F).
val(X+Y, E/F):- val(X, C/D), val(Y,A/B), !, val(C/D+A/B, E/F).
val(A/B-C/D, E/F):- !, lcm(B,D,Den), N is A*(Den//B) - C*(Den//D), reduce(N/Den,E/F).
val(X-Y, E/F):- val(X, C/D), val(Y,A/B), !, val(C/D-A/B, E/F).
val((A/B)*(C/D), E/F):- !, N is A*C, Den is B*D, reduce(N/Den,E/F).
val(X*Y, E/F):- val(X, C/D), val(Y,A/B), !, val((C/D)*(A/B), E/F).
val((A/B)/(C/D), E/F):- !, N is A*D, Den is B*C, reduce(N/Den,E/F).
val(X/Y, E/F):- val(X, C/D), val(Y,A/B), !, val((C/D)/(A/B), E/F).
val(-(A/B), MA/VB):- val(A/B,VA/VB), !, MA is - VA.
val(+(A/B), VA/VB):- val(A/B,VA/VB), !.
val(A/B, RA/RB):- VA is A, VB is B, !, reduce(VA/VB, RA/RB).
val(A, VA/1):-VA is A.
go:-prompt(_, 'Expression=? '), repeat, read(Term), val(Term,Val), write(Val), nl, propper(Val,PVal), write(PVal), nl.
:- write('Input "go."... end the expression with a period.'), nl.
EXAMPLE 101
% Risk Analysis for a system described in terms of and/or tree
% sample tree: 1 fails if both 2 and 3 happen, 2 happens when either, 4
% or 5 happens. When can the system fail?
and(1, 2, 3).
or(2,4,5).
go:-risk(1,P), write(P), nl, fail.
% p operates on a list of events representing the probabillty
% of ALL of them occuring. p([1,2,3]) is the probability of 1,2,and 3
% all happening at one time.
% risk(N, P) is true when event N has probabillity P
risk([],p([])):-!.
risk(A,p(PA)):-and(A,B,C),!,risk(C,p(PC)),risk(B,p(PB)),merge(PC,PB,PA).
risk(A,p(P)+p(Q)-p(R)):- or(A,B,C),!, risk(B, p(P)), risk(C, p(Q)),join(P,Q,R).
risk(A,p([A])).
merge(A,A,A):-!.
merge([],A,A):-!.
merge(A,[],A):-!.
merge([X|R],[X|S],[X|T]):-!,merge(R,S,T).
merge([X|R],[Y|S],[X|T]):-X<Y,!,merge(R,[Y|S],T).
merge([X|R],[Y|S],[Y|T]):-Y<X,!,merge([X|R],S,T).
join(A,A,A):-!.
join([],A,A):-!.
join(A,[],A):-!.
join([X|R],[X|S],[X|T]):-!,join(R,S,T).
join([X|R],[Y|S],T):-X<Y,!,join(R,[Y|S],T).
join([X|R],[Y|S],T):-Y<X,!,join([X|R],S,T).
EXAMPLE 102
% A Sample Logic Problem. [ Original logic problems, July 1990, p 5]
% Angela, David and Mae are the young stars in a talent show.
% Their ages are 5,7, and 8. One has last name Starr.
% Miss Grant is three years older than Angela.
% The child whose last name is Diamond is seven years old
%
% compile/consult this file and then run 'go.' to see the answer.
%
first(angela). first(david). first(mae).
male(david). female(angela). female(mae).
age(5). age(7). age(8).
last(diamond). last(grant). last(starr).
:-style_check(-singleton).
child(First,Last,Age):-first(First), last(Last), age(Age),
givens(First,Last,Age),
assertz(fact(First,Last,Age)).
% The above tries combinations of names and ages against
% the givens, and adds new data as a known fact
% when a child has two names and an age.
givens(First,Last,Age):-
if(male(First), Last\=grant),
if(Last=grant, female(First)),
iff(Last=diamond,Age=7),
iff(Last=grant,Age=8),
iff(First=angela,Age=5),
unknown(First, Last, Age).
% once a case has been found, assume it eliminates
% its values from other cases.
unknown(First, Last, Age):- not( fact(First,_,_) ),
not( fact(_,Last,_) ),
not( fact(_,_,Age) ).
if(P,Q):- P->Q;true.
iff(P,Q):-(P,Q); not( P ), not( Q ).
:-dynamic(fact/3). % allow new facts to be added.
go:-child(First, Last, Age), fail; listing(fact).
% The 'fail' above forces Prolog to try and find another child.
% When all the children are found prolog takes the next branch after
% the semicolon and lists the facts it has filed.
:- write('Puzzle loaded'), nl.
:- write('Input go. to start solving it...'), nl.
EXAMPLE 103
% Generic puzzle solver
% ---- Try possibillities against given facts and assert those that fit
% Each component can only occur once in a fact
solution(X):-
possibility(X),
unknown(X),
givens(X),
assertz(fact(X)).
% --- the following avoids a warning ----
:-style_check(-singleton).
% --- the following avoids an exception ----
:-dynamic(fact/1).
% normally X will be a structure with components representing different
% facets of the entities involved.
% --- two utilities: if-then-, and if-and-only-if
if(P,Q):- P->Q;true.
iff(P,Q):-(P,Q); not( P ), not( Q ).
% Test case
% A Sample Logic Problem. [ Original logic problems, July 1990, p 5]
% Angela, David and Mae are the young stars in a talent show.
% Their ages are 5,7, and 8. One has last name Starr.
% Miss Grant is three years older than Angela.
% The child whose last name is Diamond is seven years old
%
first(angela). first(david). first(mae).
male(david). female(angela). female(mae).
age(5). age(7). age(8).
last(diamond). last(grant). last(starr).
possibility(child(First,Last,Age)):-first(First), last(Last), age(Age).
givens(child(First,Last,Age)):-
if(male(First), Last\=grant),
if(Last=grant, female(First)),
iff(Last=diamond,Age=7),
iff(Last=grant,Age=8),
iff(First=angela,Age=5).
unknown(child(First,Last,Age)):- not( fact(child(First,_,_))),
not( fact(child(_,Last,_))),
not( fact(child(_,_,Age))).
go:-solution(X), fail; listing(fact).
:- write('Puzzle loaded'), nl,nl.
:- write('Input time(go). to start solving it... and see how fast it is.'), nl,nl.
EXAMPLE 104
% Generic puzzle solver
% ---- Try possibillities against given facts and assert those that fit
% Each component can only occur once in a fact
solution(X):-
clear_facts,
possibility(X),
new_attributes(X),
givens(X),
assertz(fact(X)).
clear_facts:-abolish(fact,1), assert( fact(dummy_entity) ).
% --- the following avoids an exception ----
:-dynamic(fact/1).
:-style_check(-singleton).
go:-solution(X), fail; listing(fact).
% normally X will be a structure with components representing different
% facets or attributes of the entities involved.
% --- two utilities: if-then-, and if-and-only-if
if(P,Q):- P->Q;true.
iff(P,Q):-(P,Q); not( P ), not( Q ).
:- write('Input time(go). to solving puzzle... and see how fast it is.'), nl,nl.
% Test case
% A Sample Logic Problem. [ Original logic problems, July 1990, p 5]
% Angela, David and Mae are the young stars in a talent show.
% Their ages are 5,7, and 8. One has last name Starr.
% Miss Grant is three years older than Angela.
% The child whose last name is Diamond is seven years old
%
first(angela). first(david). first(mae).
male(david). female(angela). female(mae).
age(5). age(7). age(8).
last(diamond). last(grant). last(starr).
possibility(child(First,Last,Age)):-first(First), last(Last), age(Age).
givens(child(First,Last,Age)):-
if(male(First), Last\=grant),
if(Last=grant, female(First)),
iff(Last=diamond,Age=7),
iff(Last=grant,Age=8),
iff(First=angela,Age=5).
new_attributes(child(First,Last,Age)):- not( fact(child(First,_,_)) ),
not( fact(child(_,Last,_)) ),
not( fact(child(_,_,Age)) ).
:- write('Puzzle loaded'), nl,nl.
EXAMPLE 105
% experiemnts with setof
go:-setof(X, (member(X,[1,2,3,4,0,-1,-2,-3,-4]), 4 is X*X), Root), write(Root).
id(1234, jim). id(2345, joan). id(3456, jane). id(4567, jo).
grade(1234, a). grade(2345, b). grade(3456, c). grade(4567, d).
grade_roster_by_SSN(List):- setof( student(SSN,Name,Grade), ( id(SSN,Name), grade(SSN,Grade) ), List).
grade_roster(List):- setof( student(Name,SSN,Grade), ( id(SSN,Name), grade(SSN,Grade) ), List).
print_set(List):-member(X,List),write(X),nl,fail.
one_name_grade(List):-setof(ng(Name,Grade), ( id(SSN,Name), grade(SSN,Grade) ), List).
list_name_grade(List):-setof(ng(Name,Grade), SSN^( id(SSN,Name), grade(SSN,Grade) ), List).
EXAMPLE 106
square(N,S):-S is N*N.
% s2(Number, Sum_Squares)
s2(1,1).
s2(N, _) :- N=<0, print('Silly Sum Squares'), fail.
s2(N,SN) :- N>1, square(N, SqN), N1 is N-1, s2(N1, SN1), SN is SN1+SqN.
EXAMPLE 107
% This is a prologish variation
% This illstrates how to use the data base to accumulate partial results
% and when complete print them out.
square( X, SX):- SX is X * X.
data(1). data(2). data(3). data(4). data(5).
data(6). data(7). data(8). data(9). data(10).
% The 'object' sum(S) has two 'methods': add and clear
:-dynamic(sum/1).
sum(0).
clear:-abolish(sum,1),assert(sum(0)).
add(I):-retract(sum(S)),S2 is S+I,asserta(sum(S2)).
summer:-data(I), square(I, I2), add(I2), fail.
summer:-sum(S), write('The sum of data' = S), nl, clear.
go:-data(I),square(I,S), write(square(I)=S), nl,fail.
go:-write('---------------------'), nl, summer.
EXAMPLE 108
% s1(N,SN) - given a positive non zero integer number N, SN=1+2+...+N
s1(N,SN):- N < 1, print('Error in s1'), nl, fail.
s1(N,SN):- N=:=1, SN is 1.
s1(N,SN):- N > 1, N1 is N-1, s1(N1, SN1), SN is SN1 + N.
EXAMPLE 109
% a way to find the minimum cost of car insurance
% minimum(+Company, +Cost): Cost is minimum over all insurance(Company, Cost)
:-dynamic(mini/2). % mini(C,V) asserts the minimum so far is C,S.
minimum(C,V):-insurance(C0,V0),asserta(mini(C0,V0)), !, minimumrest(C,V).
minimumrest(_,_):-insurance(C1,V1), retract(mini(C0,V0)),
( V1 < V0 , asserta(mini(C1,V1)) ;
V1 >=V0 , asserta(mini(C0,V0))
), fail.
minimumrest(C,V):-retract(mini(C,V)).
insurance('AAA', 900).
insurance('GEICO', 800).
insurance('MobCo', 1000).
:-write('example: minimum(Company,Cost).').
EXAMPLE 110
% a way to find the minimum cost of car insurance using higher level predicates bagof and min_list
% minimum(+Company, +Cost): Cost is minimum over all insurance(Company, Cost)
minimum(C,V):-bagof(V0, X^insurance(X,V0), L), min_list(L, V), insurance(C,V).
insurance('AAA', 900).
insurance('GEICO', 800).
insurance('MobCo', 1000).
:-write('example: minimum(Company,Cost).').
EXAMPLE 111
% a set of predicates developed from T. Van Le's 'TEchniques of Prolog Programming'
% Wiley 1992
% an alternative find_all
% Usually you have 'findall(Vars,SatisfyingGoal,PutInList)' but if not use:
:-dynamic(found/1).
find_all(X,G,L):-
asserta(found([])),
G,
once(retract(found(L))),
asserta(found([X; L])),
fail.
find_all(_,_,L):-retract(found(L)).
%This is simpler than Schnupp and Bernhard, but is it faster?
% This splits a list up at successive points into a head and a tail
% remove comments if not builtin!
% select(H, [H|T], T).
% select(X, [H|T], [H|T1]):-select(X,T,T1).
% A selection sort from page 40
selection_sort([],[]).
selection_sort(L,[H|T]):- least(H,L,R), selection_sort(R,T).
least(X,[X],[]).
least(X,[H; T],R):-least(Y,R,S),
( H =< Y, (X,Y)=(H,T)
; H > Y, (X,R)=(Y,[H|S])
).
EXAMPLE 112
% From a paper by G Canfora, Aniello Cimitile and Ugo de Carlini
% 'A Logic Based Approach to Reverse Engineering Tools Production'
% IEEE Trans SE18 n 2 Dec 1992, pages 1053-1063
% problem - record the structure of a complex program so that a programmer
% can ask questions about it when trying to create an improved version.
% This is for a Pascal program
% Utility rules used in other predicates
% non_member(E, X) is true if E is not in list X.
% it differs from `not member(E,X)` becuase if E is a variable the not
% predicate backtracks and leaves E uninstanciated.
meta( non_member(e,l), 'Test if e is in list l').
non_member(_,[]).
non_member(E,[A|B]):-E\==A, non_member(E,B).
uniq([],[]).
uniq([H|T],[H|T2]):-non_member(H,T), !, uniq(T,T2).
uniq([H|T], T2):-uniq(T,T2).
meta( path_concat(p1,p2,p3), 'list p3 is/becomes list p1 in front of list p2').
path_concat([X], [X|Ys], [X|Ys]).
path_concat([X|Xs], Ys, [X|Zs]):-path_concat(Xs, Ys, Zs).
% basic predicates describe a particular program
% They are (ideally) extracted from code by a another program
basic(mod,1). basic(var_dec,2). basic(mod_dec,2). basic(par_dec,3).
basic(use,2). basic(set,2). basic(cal,2). basic(bind,4).
% notice that by including a definition of these predicates
% as part of the data base, we canwrite generic DataBase operations
clear_db:-basic(Atom,Arity), abolish(Atom,Arity),fail.
clear_db:- write('Program model erased'), nl.
list_db:-basic(Atom,Arity), write(Atom/Arity), nl, fail.
list_db.
% meta definitions document the meaning of predicates
meta( mod(x) ,'x is a module.').
meta( var_dec(x,y) ,'module x has declaration of variable called y').
meta( par_dec(x,y,i) ,'module x has formal parameter y in position').
meta( mod_dec(x,y) ,'module x has a declaration of a local module y').
meta( use(x,y) ,'module x uses variable y').
meta( set(x,y) ,'module x sets the value of variable y').
meta( cal(x,y) ,'module x calls module y').
%ca not use 'call' since that indicates a call of a predicate.
meta( bind(x,y,z,i), 'Module x calls y and has z as actual parameter i').
%summary relations - questions a program may ask
meta( mod_dec_scope(m1,m2), 'Module m1 declares a module, that declares a module, ...that declares m2').
mod_dec_scope(M1,M2):-mod_dec(M1,M2).
mod_dec_scope(M1,M2):-mod_dec(M1,Mi), mod_dec_scope(Mi,M2).
meta( var_or_par_dec(m,i), 'Module m declares identifier i as a variable or parameter').
var_or_par_dec(M, VoP):-(var_dec(M,VoP); par_dec(M,(VoP,_))).
meta( visible(m1, (i,m2)), 'Identifier i declared in m2 is visible in m1').
visible(M,(VoP,M)):-mod(M), var_or_par_dec(M,VoP).
visible(M1,(VoP,M2)):-var_or_par_dec(M2,VoP),mod_dec_scope(M2,M1),
not ( var_or_par_dec(M1,VoP); mod_dec_scope(M2,Mi),mod_dec_scope(Mi,M1),
var_or_par_dec(Mi,VoP)
).
meta( active(m1, m2,[m1,p,p,p|m2]), 'Paths for m1 to cal m2').
active(M,M,[M]):-mod(M).
active(M1,M2,[M1|Path]):-cal(M1,M3),active(M3,M2,Path).
meta( actualize(m1,i,(v,m2),p), 'module m1s ith parameter is actually identifier v declared or specified in m2, by path p').
actualize(M1,VoP,(VoP,M2), Path):-
visible(M1, (VoP,M2)), var_dec(M2,VoP), active(main,M2,Path1),
active(M2, M1, Path2),
path_concat(Path1, Path2, Path).
actualize(M1,VoP,(Var,M2),Path):- visible(M1,(VoP,M3)),
par_dec(M3,(VoP,Pos)),
cal(M4,M3),
bind(M4,M3,(VoP1,Pos)), active(M3,M1,Path1),
actualize(M4,VoP1,(Var,M2),Path2),
path_concat(Path2, [M4; Path1],Path).
meta( up_in((m1,p),(v,m2)), 'm1 is a module identified by path p and v is a variable in m2 that actually provides the data for m1 thru p').
up_in((M1,Path),(Var,M2)):- use(M1,VoP), actualize(M1,VoP,(Var,M2), Path), M2\==M1.
up_in((M1,Path),(Var,M2)):- cal(M1,M3),
active(main, M1,Path),
path_concat(Path, [M1,M3], Path1),
up_in((M3, Path1), (Var,M2)),
M2\==M1.
% The next predicate needs 'set_of(V, P, V)' to work.
% meta( in_flow((m,p), v), 'Produces a set of input sets for (m,p) to module m thru pathp, from all other modules').
in_flow((M, Path), VarSet):- active(main,M,Path), set_of(VarSet, up_in((M,Path), VarSet), VarSet).
% user interfaces
declarations:-mod(M),declared(M),fail.
declarations.
declared(M):-var_dec(M,V), write(M), write(' declares variable '), write(V), nl.
declared(M):-par_dec(M,(V,_)), write(M), write(' has parameter '), write(V), nl.
declared(M):-mod_dec(M,V), write(M), write(' declares module '), write(V), nl.
calls:-mod(M),calls(M),fail.
calls.
calls(M):-cal(M,M2), write(M), write(' calls '), write(M2), nl.
usage:-mod(M),uses(M),fail.
usage.
uses(M):-use(M,V), write(M), write(' uses '), write(V), nl.
uses(M):-set(M,V), write(M), write(' sets '), write(V), nl.
list:-declarations, calls, usage.
%...
% sample data
mod(main).
var_dec(main,x). var_dec(main,y). mod_dec(main,a). mod_dec(main, d).
cal(main, a). bind(main, a, (x,1)). bind(main, a, (y,2)).
cal(main,d).
use(main,x). use(main,y).
mod(a).
var_dec(a,l). var_dec(a,m). par_dec(a, (t,1)). par_dec(a, (z,2)).
mod_dec(a,b).
mod_dec(a,c).
cal(a,b). bind(a,b,(t,1)). bind(a,b,(m,2)).
cal(a,c). bind(a,c,(m,1)). bind(a,c,(l,1)). % two different calls to c in a
mod(b). var_dec(b,u). par_dec(b, (x,1)). par_dec(b, (z,2)).
use(b,x). use(b,z). use(b,l). use(b,u).
mod(c). var_dec(c,p). par_dec(c, (q,1)).
cal(c,b). bind(c,b,(q,1)). bind(c,b,(p,1)). bind(c,b,(x,2)). bind(c,b,(t,2)).
set(c,p).
use(c,q).
mod(d).
var_dec(d,r). var_dec(d,s).
cal(d,a).
bind(d,a,(r,1)). bind(d,a,(s,1)). bind(d,a, (y,2)).
use(d,x).
EXAMPLE 113
% It is not easy to predict all possible consequences when two different
% sequences of instructions are operating on the same data in an
% unpredictable order. The predicate will shuffle lists of actions
% together into a sequence and then obey them.
:-style_check(-singleton).
% This is based on a sample GRE question 1991-1992. CS489 Fall92
shuffle([], X, X).
shuffle(X, [], X).
shuffle([X|Y], Z, [X|W]):-shuffle(Y,Z,W),Z \= [].
shuffle(Y, [X|Z], [X|W]):-shuffle(Y,Z,W),Y \= [].
obey([]):-!.
obey([X|Y]):- write(X), nl, X, print_status, obey(Y),!.
% notice the simulated memory - needed since Prolog variables are temporary.
% ram(x, v) is a clause when and only when x is a variable and v its
% current value in the simulation.
print_status:-ram(X, VX), write('RAM['), write(X), write(']='), write(VX), nl,fail.
print_status:- write('-------------'), nl.
initial_status:-abolish(ram,2), assert(ram(x,0)), assert(ram(y,0)),!.
% we now have to define how to evaluate expressions using ram values.
eval(X, V):-ram(X,V),!.
eval(+Y, VX):-eval(X,VX), !.
eval(-Y, V):-eval(X,VX), V is -VX, !.
eval(X+Y, V):-eval(X,VX), eval(Y,VY), V is VX+VY, !.
eval(X-Y, V):-eval(X,VX), eval(Y,VY), V is VX-VY, !.
eval(X*Y, V):-eval(X,VX), eval(Y,VY), V is VX*VY, !.
eval(X, V):-V is X,!.
% Now define semantics of assignment statements used with our RAM.
let(X,E):-eval(E,EV), remove_old(X), assert(ram(X,EV)),!.
remove_old(X):- (ram(X,Old), retract(ram(X,Old)); true),!.
doit:-A=[let(x,1), let(y,y+x)], B=[let(y,2),let(x,x+3)], !,
shuffle(A,B,C), initial_status, print_status, obey(C).
:-nl, print('shuffle, obey, and doit loaded'), nl.
EXAMPLE 114
%Prolog example developed by Dr. Klerer, CSUSB
append(L,L).
append:-print('Usage: append( List1, List2, List3 )').
append([],L,L).
append([X; L1],L2,[X; L3]) :- append(L1,L2,L3).
append(L1,L2,L3,L) :- append(L1,X,L), append(L2,L3,X).
append(A,B,C,D,L):-append(A,B,C,E), append(E,D,L).
%t(X) :- append(X1,X2,X3,X), f(X3).
%f([x]).
:-print('Append(List1,List2,List1and2) loaded').
EXAMPLE 115
shuffle([], X, X).
shuffle(X, [], X).
shuffle([X|Y], Z, [X|W]):-shuffle(Y,Z,W),Z \= [].
shuffle(Y, [X|Z], [X|W]):-shuffle(Y,Z,W),Y \= [].
order([]).
order([X]).
order([X,Y|Z]):-X <= Y, order([Y|Z]).
merge(X,Y,Z):-shuffle(X,Y,Z),order(Z).
:-print('shuffle, order and merge loaded').
EXAMPLE 116
% MemberP tests for membership only.
memberp(E, [E, .._]):-!.
% Once found, will not search for alternatives
memberp(E, [_, ..R]) :- memberp(E, R),!.
EXAMPLE 117
% File of predicates operating on lists
% rev(X,Y) - Y is the reverse of X
rev([],[]).
rev([H; T],L) :- rev(T,Z), append(Z,[H],L).
% append(X,Y,Z) - Z is a list starting with X and followed by Y
append([],L,L).
append([X; L1],L2,[X; L3]) :- append(L1,L2,L3).
% no_dups(X) is true if no element in X is duplicated
no_dups([]).
no_dups([E|R]):-no_dups(R), non_member(E,R).
subset([],_).
subset([E, ..S], L):- member(E,L), subset(S, L).
% non_member(E, X) is true if E is not in list X.
% it differs from `not member(E,X)` becuase if E is a variable the not
% predicate backtracks and leaves E uninstanciated.
non_member(_,[]).
non_member(E,[A|B]):-E\=A, non_member(E,B).
% For a list of numeric expressions ascending tests for ascending order
ascending([]).
ascending([R]).
ascending([E1|R]):-R=[E2|R2], E1<E2, ascending(R).
:-print('rev(L,M), append(A,B,C), no_dups(L), subset(L,M), non_member(E,L), and ascending(L) loaded.').
EXAMPLE 118
% collection of list manipulation operations - DRAFT RJB May 90
rev([],[]).
rev([H; T],L) :- rev(T,Z), append(Z,[H],L).
append([],L,L).
append([X; L1],L2,[X; L3]) :- append(L1,L2,L3).
nodups([]).
nodups([E|R]):-nodups(R), non_member(E,R).
subset([],_).
subset([E, ..S], T):- member(E,T), subset(S, T).
non_member(_,[]).
non_member(E,[A|B]):-E\=A, non_member(E,B).
ascending([]).
ascending([R]).
ascending([E1|R]):-R=[E2|R2], E1<E2, ascending(R).
sort([], []):-!. sort([A], [A]):-!.
sort([A, B], [A, B]):- A<=B,!.
sort([A, B], [B, A]):- B<A,!.
sort(A, B):- split(A, A1, A2), sort(A1, B1), sort(A2, B2), merge(B1,B2,B).
split([],[],[]):-!. split([A],[],[A]):-!.
split([A1, A2|A3], [A1|B1], [A2|B2]):-split(A3, B1, B2).
merge(A,A,A):-!. merge([],A,A):-!. merge(A,[],A):-!.
merge([A1|A],[B1|B],[A1|C]):-A1<=B1,merge(A, [B1|B],C).
merge([A1|A],[B1|B],[B1|C]):-A1>B1, merge([A1|A],B, C).
permuted(A,B):-sort(A,C),sort(B,C).
common(A,A,A):-!. common([],A,A):-!. common(A,[],A):-!.
common([A1|A],[A1|B],[A1|C]):-common(A,B,C),!.
common([A1|A],[B1|B],C):-common(A,B,C).
EXAMPLE 119
%Prolog example developed by Dr. Klerer, CSUSB
:-dynamic(once/0).
one(X) :- X=1.
two(X) :- X=2.
two(X) :- X=3.
uniq(G) :- call(G), ((once, retract(once),!, fail);
(asserta(once), fail)).
uniq(_) :- once, retract(once).
u(G) :- call(G), (once, retract(once),!, fail;
asserta(once), fail) ; once, retract(once).
one :- one(_), ((once, retract(once),!, fail);
(asserta(once), fail)).
one :- once, retract(once).
two :- two(_), ((once, retract(once),!, fail);
(asserta(once), fail)).
two :- once, retract(once).
r :- repeat, ((once, retract(once),!, fail);
(asserta(once), fail)).
r :- once, retract(once).
:- write('uniq(Goal) loaded'), nl.
EXAMPLE 120
:- op(650, xfx, <=).
X<=Y :- X=<Y.
EXAMPLE 121
% defines the syntax of a small subset of English ..!
verb(X):-op(695,xfx,X).
:-verb([equals, isa, has, owns, married, hates, loves]).
:-verb([lets, keeps, gives,gets,takes,puts,makes,does,says,sees,sends, comes, goes]).
pred(X):-op(695, xf, X).
:-pred([is_happy, is_sad, is_on, is_off]).
prep(X):-op(690,yfx, X).
:-prep([in, on, off, to, from, by, under, over,with,near,arround]).
:-prep([about, across, after, against, among, at,before,between]).
X has Y:-X keeps Y.
X equals Y:-X=Y.
:- write('Mini English loaded'), nl.
EXAMPLE 122
% for statement from T Van Le 92
for(I,I,N):-I =< N.
for(I,M,N):-M < N, M1 is M+1, for(I,M1,N).
for(I,N):-for(I,1,N).
sample('for(I,1,10), write(I), nl, fail!').
go:-for(I,1,10), write(I), nl, fail.
EXAMPLE 123
% A for statement for(Identifier, Initial, Increment, Final)
% use like this: for(i,1,2,10),i(I)|..
for(Label,F):-for(Label,1,1,F).
for(Label,I,F):-for(Label,I,1,F).
for(Label,I,S,F):- V=I,V=<F,
(Garbage=..[Label,_], Garbage,abolish(Label); true),
Count=..[Label,V], asserta(Count).
for(Label,I,S,F):-Count=..[Label,V], retract(Count,_), V+S=<F,
Next is V+S, Count2=..[Label,Next], asserta(Count2).
for(Label,I,S,F):-abolish(Label), fail.
isqrt(N,Sqrt):-for(i,N), i(I), I*I>N,!, Sqrt is I-1, abolish(i).
pyth(N):-for(i,N),i(I), I1 is I+1, for(j,I),j(J), for(k,I1,N),k(K),
K*K=:=I*I+J*J, print([I,J,K]).
sample(N):-for(i,N),i(I), for(j,I),j(J), for(k,J),k(K),print([I,J,K]).
lagrange(N):-isqrt(N,L),
I1 is N - L*L, for(i,0,1,I1),i(I),prin(I),prin(' '),
J1 is I1 - I*I, for(j,I,1,J1),j(J),prin(J),prin(' '),
K1 is J1 - J*J, for(k,J,1,K1),k(K),prin(K),prin(' '),
N=:=I*I+J*J+K*K+L*L,print,print([I,J,K,L]).
EXAMPLE 124
% for statement from T Van Le 92
for(I,I,N):-I =< N.
for(I,M,N):-M < N, M1 is M+1, for(I,M1,N).
for(I,N):-for(I,1,N).
% interesting examples of searches - pythagorean triples, 4 square make an integer and so on.
sample(N):-for(I,1,N), for(J,1,I), for(K,1,J),print([I,J,K]).
pyth(N):-for(I,N), I1 is I+1, for(J,I), for(K,I1,N),
K*K=:=I*I+J*J, print([J,I,K]).
isqrt(N,Sqrt):-for(I,1,N), I*I>N,!, Sqrt is I-1.
lagrange(N):-isqrt(N,L),
I1 is N - L*L, for(I,0,I1),
J1 is I1 - I*I, for(J,I,J1),
K1 is J1 - J*J, for(K,J,K1),
N=:=I*I+J*J+K*K+L*L,print,print([I,J,K,L]).
EXAMPLE 125
% predicate that changes the data base delta(Old, New, Where)
% must declare the predicate in Old and New as dynamic.
delta(Old,New,Where):- retract(Old), call(Where), assert(New).
delta(Old,New):-delta(Old, New, true).
EXAMPLE 126
a(S,S2) :-concat([S, 'a'], S2).
b(S,S2) :-concat([S, 'b'], S2).
c(S,S2) :-concat([S, 'c'], S2).
s:-s(S), write(S), nl.
t:-t(T), write(T), nl.
u:-u(U), write(U), nl.
s(S):-s('', S).
s(S0,S):-c(S0,S) ; a(S0,S1),s(S1,S2),b(S2,S).
t(T):-t('',T).
t(T0,T):-a(T0,T1), c(T1,T) ; a(T0,T1),t(T1,T).
u(U):-u('',U).
u(U0,U):-c(U0,U) ; a(U0,U1),b(U1,U2),b(U2,U3),u(U3,U) ; a(U0,U1),b(U1,U2),u(U2,U3),b(U3,U) ; a(U0,U1),u(U1,U2),b(U2,U3),b(U3,U) ; u(U0,U1),a(U1,U2),b(U1,U2),b(U3,U).
:- write('Input s(S), nl? , t(T)?, or u(U)? to generate strings').
:- write(' But prolog won't generate all the U strings....'), nl.
EXAMPLE 129
% An example based on p262 of Appleby 91 'Programming Lnguages'
happy(X):-watching(X, football), has(X,supplies).
has(X, supplies):-has(X,beer), has(X, pretzels).
watching(X, football):-ison(X, tv), playing(cowboys).
ison(tom, tv).
playing(cowboys).
has(tom,beer).
has(tom,pretzels).
has(dick,beer).
has(harry,pretzels).
ison(dick,tv).
ison(joan,radio).
has(joan,pretzels).
has(joan,beer).
:- write('happy(Person) is loaded'), nl.
:- write('try queries like: happy(X). has(X,beer). has(tom, X). '),nl,nl.
EXAMPLE 130
% An example based on p262 of Appleby 91 'Programming Lnguages'
% This uses a simplified english grammar.
:-consult('/u/faculty/dick/cs320/prolog/english.pl').
:-verb([watches]).
:-pred([is_happy]).
X is_happy:-X watches football, X has supplies.
X has supplies:-X has beer, X has pretzels.
X watches football:-X sees T, T isa tv, X owns T, T is_on.
T is_on:-cowboys on T.
tom owns his_tv. his_tv isa tv.
tom sees his_tv.
cowboys on his_tv.
tom has beer.
tom has pretzels.
dick has beer. dick owns two_tvs. two_tvs isa tv.
harry has pretzels.
joan has beer. joan has pretzels. joan has her_radio. her_radio is_on.
:- write('Monday night is now'), nl.
:-print('Words defined: is_happy, is_on, has, supplies, beer, pretzels, tom...').
:- write('Try: Who is_happy? and listing!'), nl.
why:-pp postfix is_happy; pp infix has; pp infix owns; pp infix isa.
why:-pp infix sees; pp postfix is_on.
EXAMPLE 131
% An example based on p262 of Appleby 91 'Programming Lnguages'
% This uses a simplified english grammar.
:-consult('/u/faculty/dick/cs320/prolog/english.pl').
:-verb([watches]).
:-pred([is_happy]).
X is_happy:-X watches football, X has supplies.
X has supplies:-X has beer, X has pretzels.
X watches football:-X sees T, T isa tv, X owns T, T is_on.
T is_on:-cowboys on T.
tom owns his(X).
his(X) isa X.
tom sees his(tv).
cowboys on his(tv).
tom has beer.
tom has pretzels.
dick has beer. dick owns two_tvs. two_tvs isa tv.
harry has pretzels.
joan has beer. joan has pretzels. joan has her(radio). her(radio) is_on.
joan owns her(X). her(X) isa X.
:- write('Monday night is now'), nl.
:-print('Words defined: is_happy, is_on, has, supplies, beer, pretzels, tom...').
:- write('Try: Who is_happy? and listing!'), nl.
why:-pp postfix is_happy; pp infix has; pp infix owns; pp infix isa.
why:-pp infix sees; pp postfix is_on.
EXAMPLE 132
% Genrating integer values. Shows problems.
int(I,I).
int(I,M):- M1 is M+1, int(I,M1).
int(I):-int(I,1).
space:-prin(' ').
sample('int(I), write(I), nl, I>=5!').
sample('int(I), int(J), prin(I),space, write(J), nl, I is 2 * J?').
sample('int(I), int(J), prin(I),space, write(J), nl, J is 2 * I?').
EXAMPLE 133
% From murphy Thu Oct 31 14:53 PST 1991
% To: dick
% Subject: complexity of prolog
% While going through some of my old files, I found a short
%prolog program you may find interesting. The Air Force was
%considering the development of a massively parallel prolog
%interpreter for the SDI program until I showed them this one.
num(a,a,a,a).
num(X1,X2,X3,b):-num(X1,X2,X3,a).
num(X1,X2,b,a):-num(X1,X2,a,b).
num(X1,b,a,a):-num(X1,a,b,b).
num(b,a,a,a):-num(a,b,b,b).
%What does it do? Ask it trace, num(b,b,b,b).
EXAMPLE 134
% Predicates for simulating logical formula
false:-!,fail.
boolean(true). boolean(false).
boolean(P,Q):-boolean(P),boolean(Q).
boolean(P,Q,R):-boolean(P,Q), boolean(R).
:-op(1000, fx, boolean).
boolean [].
boolean [P|List]:-boolean(P), boolean List.
boolean P:- boolean(P).
% definition of substitutions
:-op(600, xfx, eq).
not true eq false.
not false eq true.
not not P eq P:-nonvar(P).
% definition of implication.
:-op(600,xfx,=>).
false=>true.
false=>false.
true=>true.
P=>Q:-P eq R, R=>Q.
P=>Q:-Q eq R, P=>R.
% definition of logical equivalence
:-op(600,xfx,iff).
true iff true.
false iff false.
P iff Q:-P eq R, R iff Q.
P iff Q:-Q eq R, P iff R.
:-op(600, yfx, and).
true and true.
P and Q:-P eq R, R and Q.
P and Q:-Q eq R, P and R.
:-op(600, yfx, or).
true or false.
false or true.
true or true.
P or Q:-P eq R, R or Q.
P or Q:-Q eq R, P or R.
EXAMPLE 135
% Predicates for simulating logical formula
false:-!,fail.
% The boolean predicate
boolean(true). boolean(false).
boolean(P,Q):-boolean(P),boolean(Q).
boolean(P,Q,R):-boolean(P,Q), boolean(R).
% definition of implication.
:-op(600,xfx,=>).
false=>true.
false=>false.
true=>true.
% definition of logical equivalence
:-op(600,xfx,iff).
true iff true.
false iff false.
:-op(600, yfx, and).
true and true.
:-op(600, yfx, or).
true or false.
false or true.
true or true.
pbool(P):-P, write('true '), ! ;
write('false ').
truthtable(P):-boolean(P), write(P), nl,fail.
truthtable(P,Q):-boolean(P),pbool(P), write(Q), nl,fail.
truthtable(P,Q,R):-boolean(P),boolean(Q), pbool(P),pbool(Q), write(R), nl,fail.
truthtable(P,Q,R,S):-boolean(P),boolean(Q), pbool(P),pbool(Q),pbool(R), write(S), nl,fail.
EXAMPLE 136
% Boolean algebra
% boolean variables have two values: 1(true) and 0(false)
bool(X):-X=0;X=1.
bools([]).
bools([X|Y]):-bool(X), bools(Y).
% How to evaluate a boolean formula
eval(0, 0):-!.
eval(1, 1):-!.
eval(-1, 0):-!.
eval(-0, 1):-!.
eval(-X, V):-eval(X,XV), V is 1-XV, !.
eval(X+Y,V):-eval(X,XV), eval(Y,YV), V is XV+YV-XV*YV,!.
eval(X*Y,V):-eval(X,XV), eval(Y,YV), V is XV*YV,!.
eval(X-Y, V):-eval(X+(-Y),V),!.
eval(X=Y, V):-eval(X*Y+(-X)*(-Y),V),!.
eval(X->Y, V):-eval(Y-X,V).
test(E):-eval(E,1).
disprove([Var1|Rest], Proposition):-bools([Var1|Rest]), eval(Proposition,0).
EXAMPLE 137
day(D):-member(D,[sa,su,mo,tu,we,th,fr]).
next(sa,su).
next(su,mo).
next(mo,tu).
next(tu,we).
next(we,th).
next(th,fr).
next(fr,sa).
says(A,D, P):-lies(A,L,T), (member(D, L), not P; member(D,T), P).
lies(mwf,[mo,we,fr],[tu,th,sa,su]).
lies(tts,[tu,th,sa],[mo,we,fr,su]).
qn1(D):-day(D), next(Y,D), says(mwf, D, says(mwf,Y,true) ).
qn2(D):-day(D), next(Y,D), next(D,T),
says(mwf, D, Y=su), says(tts, D, T=sa).
qn3(D,A,B):-select([mwf,tts], A, [B]), next(Y,D),
says(A, D, says(A,Y,true)),
says(B, D, Y=mo).
EXAMPLE 138
% Knight Noraml or Spy
% Three people: A,B,C, one spy, one knight, one normal
% spies lie, knights speak the truth, normals do both
perm([],[]).
perm(X,[Y|Z]):-select(X,Y,R),perm(R,Z).
says(k,P):- P.
says(s,P):- not P.
says(n,_).
problem(People):- People=[A,B,C], perm(People, [k,n,s]),
says(A, C\=s),
says(B, A\=k),
says(C, B=k).
EXAMPLE 139
% Knight Noraml or Spy
% Three people: A,B,C, one spy, one knight, one normal
% spies lie, knights speak the truth, normals do both
perm([],[]).
perm(X,[Y|Z]):-select(X,Y,R),perm(R,Z).
says(k,P):- P.
says(s,P):- not P.
says(n,_).
problem(People):- People=[A,B,C], perm(People, [k,n,s]),
says(A, (B=n,B=n) ),
says(B, B=n),
says(C, (B=n;B\=n)).
EXAMPLE 140
% maxi(X,Y,Z) will be true when Z is the maximum of X and Y.
maxi(X,Y,Z):-(X>=Y, Z is X,!); Z is Y.
% Examples of the effect of forcing a predicate to backtrack by failure.
poem(N) :-
open(A, N),
!,
closer(B, N),
append(A,B,AB),
append(AB,'.', C),
write(C), nl.
closer(C, 0) :-
!,
fail.
closer(C, N) :-
N > 0,
contin(C).
closer(C, N) :-
N > 0,
contin(C1),
N1 is N - 1,
closer(C2, N1),
append(C1, C2, C).
contin(' is a rose').
open('A rose', _).
:- write('Predicate poem(N). loaded'), nl.
EXAMPLE 96
% pretty print a prolog structure
pp(P):-pp([],P).
pp(L,P):-atomic(P),indented_print(L,P).
pp(L,P):-var(P),indented_print(L,P).
pp(L,[H|T]):-indented_print(L,'['), pp([' |'|L],H),ppa([' |'|L],T),indented_print(L,']').
pp(L,P):-P=..[F|Arg], pp(L,F), ppa([' |'|L], Arg).
ppa(L,[H|T]):-pp(L,H),ppa(L,T).
ppa(L,[]):-true.
indented_print([H|T], P):-write(H), indented_print(T, P).
indented_print([],P):-write('-'), write(P), nl.
EXAMPLE 97
% Quicksort in Prolog.
% filter(List, Pivot, Lower, Higher) divides List up into items Lower & Higher than Pivot
filter( [], _, [], []).
filter( [X|Y], P, [X|L], H ):- X =< P, filter(Y, P, L, H).
filter( [X|Y], P, L, [X|H] ):- X > P, filter(Y, P, L, H).
% Here is the sort
qsort([], []):-!.
qsort([X], [X]):-!.
qsort([X|Y], SXY):- filter(Y, X, L, H), qsort(L,SL), qsort(H,SH), append(SL, [X], SLX), append(SLX, SH, SXY).
EXAMPLE 98
% Quicksort in Prolog.
% filter(List, Pivot, Lower, Higher) divides List up into items Lower & Higher than Pivot
filter( [], _, [], []).
filter( [X|Y], P, [X|L], H ):- X =< P, filter(Y, P, L, H).
filter( [X|Y], P, L, [X|H] ):- X > P, filter(Y, P, L, H).
% Here is the sort program
qsort([], []):-!.
qsort([X], [X]):-!.
qsort([X,Y], [X,Y]):-X=<Y,!.
qsort([X,Y], [Y,X]):-X>Y,!.
qsort([X|Y], SXY):- filter(Y, X, L, H), qsort(L,SL), qsort(H,SH), append(SL, [X], SLX), append(SLX, SH, SXY).
EXAMPLE 99
% Simulated memory
% Prolog variables are temporary local variables that can be lost
% during backtracking.
% The Prolog data base is global but does not assoicate a unique
% value with each variable.
% This file shows how to emulate a global random access memory.
% ram(x, v) is a clause when and only when x is a variable and v its
% current value.
:-dynamic(ram/2).
print_ram:-ram(X, VX), write('RAM['), write(X), write(']='), write(VX), nl,fail.
print_ram:- write('-------------'), nl.
initial_ram:-abolish(ram,2 ), !, assert(ram(nothing, empty)).
% Now define semantics of assignment statements used with our RAM.
% Notice these do not evaluate the value being stored.
set(X,V):- remove_old(X), assert(ram(X, V)),!.
remove_old(X):- (ram(X,Old), retract(ram(X,Old)); true),!.
% The following two definitions will work with functions.plg to
% allow variables in RAM to be used in functional expressions
:-consult('functions.plg').
function(X,V):-ram(X,V),!.
let(X,E):-EV es E, remove_old(X), assert(ram(X,EV)),!.
:-write('intial_ram, print_ram, set(X,V), let(X,Expr) loaded'),nl,nl.
EXAMPLE 100
% Fractions and rational numbers in Prolog
gcd(X,X,X):-!.
gcd(X,1, 1):-!.
gcd(1,X,1):-!.
gcd(X,0, X):-!.
gcd(0,X,X):-!.
gcd(X,Y,Z):-X>Y,!, XY is X mod Y, gcd(XY,Y,Z).
gcd(X,Y,Z):-X<Y,!, YX is Y mod X, gcd(X,YX,Z).
lcm(X,Y,LCM):-gcd(X,Y,GCD), LCM is X*Y//GCD.
reduce(A/A,1/1):-!.
reduce(A/1,A/1):-!.
reduce(1/A,1/A):-!.
reduce(A/B,C/D):-gcd(A,B,G), C is A//G, D is B//G.
propper(A/B,A/B):-A<B,!.
propper(A/A,1):-!.
propper(A/B,I+E/B):-I is A // B, E is A mod B.
val(A/B+C/D, E/F):- !, lcm(B,D,Den), N is A*(Den//B) + C*(Den//D), reduce(N/Den,E/F).
val(X+Y, E/F):- val(X, C/D), val(Y,A/B), !, val(C/D+A/B, E/F).
val(A/B-C/D, E/F):- !, lcm(B,D,Den), N is A*(Den//B) - C*(Den//D), reduce(N/Den,E/F).
val(X-Y, E/F):- val(X, C/D), val(Y,A/B), !, val(C/D-A/B, E/F).
val((A/B)*(C/D), E/F):- !, N is A*C, Den is B*D, reduce(N/Den,E/F).
val(X*Y, E/F):- val(X, C/D), val(Y,A/B), !, val((C/D)*(A/B), E/F).
val((A/B)/(C/D), E/F):- !, N is A*D, Den is B*C, reduce(N/Den,E/F).
val(X/Y, E/F):- val(X, C/D), val(Y,A/B), !, val((C/D)/(A/B), E/F).
val(-(A/B), MA/VB):- val(A/B,VA/VB), !, MA is - VA.
val(+(A/B), VA/VB):- val(A/B,VA/VB), !.
val(A/B, RA/RB):- VA is A, VB is B, !, reduce(VA/VB, RA/RB).
val(A, VA/1):-VA is A.
go:-prompt(_, 'Expression=? '), repeat, read(Term), val(Term,Val), write(Val), nl, propper(Val,PVal), write(PVal), nl.
:- write('Input "go."... end the expression with a period.'), nl.
EXAMPLE 101
% Risk Analysis for a system described in terms of and/or tree
% sample tree: 1 fails if both 2 and 3 happen, 2 happens when either, 4
% or 5 happens. When can the system fail?
and(1, 2, 3).
or(2,4,5).
go:-risk(1,P), write(P), nl, fail.
% p operates on a list of events representing the probabillty
% of ALL of them occuring. p([1,2,3]) is the probability of 1,2,and 3
% all happening at one time.
% risk(N, P) is true when event N has probabillity P
risk([],p([])):-!.
risk(A,p(PA)):-and(A,B,C),!,risk(C,p(PC)),risk(B,p(PB)),merge(PC,PB,PA).
risk(A,p(P)+p(Q)-p(R)):- or(A,B,C),!, risk(B, p(P)), risk(C, p(Q)),join(P,Q,R).
risk(A,p([A])).
merge(A,A,A):-!.
merge([],A,A):-!.
merge(A,[],A):-!.
merge([X|R],[X|S],[X|T]):-!,merge(R,S,T).
merge([X|R],[Y|S],[X|T]):-X<Y,!,merge(R,[Y|S],T).
merge([X|R],[Y|S],[Y|T]):-Y<X,!,merge([X|R],S,T).
join(A,A,A):-!.
join([],A,A):-!.
join(A,[],A):-!.
join([X|R],[X|S],[X|T]):-!,join(R,S,T).
join([X|R],[Y|S],T):-X<Y,!,join(R,[Y|S],T).
join([X|R],[Y|S],T):-Y<X,!,join([X|R],S,T).
EXAMPLE 102
% A Sample Logic Problem. [ Original logic problems, July 1990, p 5]
% Angela, David and Mae are the young stars in a talent show.
% Their ages are 5,7, and 8. One has last name Starr.
% Miss Grant is three years older than Angela.
% The child whose last name is Diamond is seven years old
%
% compile/consult this file and then run 'go.' to see the answer.
%
first(angela). first(david). first(mae).
male(david). female(angela). female(mae).
age(5). age(7). age(8).
last(diamond). last(grant). last(starr).
:-style_check(-singleton).
child(First,Last,Age):-first(First), last(Last), age(Age),
givens(First,Last,Age),
assertz(fact(First,Last,Age)).
% The above tries combinations of names and ages against
% the givens, and adds new data as a known fact
% when a child has two names and an age.
givens(First,Last,Age):-
if(male(First), Last\=grant),
if(Last=grant, female(First)),
iff(Last=diamond,Age=7),
iff(Last=grant,Age=8),
iff(First=angela,Age=5),
unknown(First, Last, Age).
% once a case has been found, assume it eliminates
% its values from other cases.
unknown(First, Last, Age):- not( fact(First,_,_) ),
not( fact(_,Last,_) ),
not( fact(_,_,Age) ).
if(P,Q):- P->Q;true.
iff(P,Q):-(P,Q); not( P ), not( Q ).
:-dynamic(fact/3). % allow new facts to be added.
go:-child(First, Last, Age), fail; listing(fact).
% The 'fail' above forces Prolog to try and find another child.
% When all the children are found prolog takes the next branch after
% the semicolon and lists the facts it has filed.
:- write('Puzzle loaded'), nl.
:- write('Input go. to start solving it...'), nl.
EXAMPLE 103
% Generic puzzle solver
% ---- Try possibillities against given facts and assert those that fit
% Each component can only occur once in a fact
solution(X):-
possibility(X),
unknown(X),
givens(X),
assertz(fact(X)).
% --- the following avoids a warning ----
:-style_check(-singleton).
% --- the following avoids an exception ----
:-dynamic(fact/1).
% normally X will be a structure with components representing different
% facets of the entities involved.
% --- two utilities: if-then-, and if-and-only-if
if(P,Q):- P->Q;true.
iff(P,Q):-(P,Q); not( P ), not( Q ).
% Test case
% A Sample Logic Problem. [ Original logic problems, July 1990, p 5]
% Angela, David and Mae are the young stars in a talent show.
% Their ages are 5,7, and 8. One has last name Starr.
% Miss Grant is three years older than Angela.
% The child whose last name is Diamond is seven years old
%
first(angela). first(david). first(mae).
male(david). female(angela). female(mae).
age(5). age(7). age(8).
last(diamond). last(grant). last(starr).
possibility(child(First,Last,Age)):-first(First), last(Last), age(Age).
givens(child(First,Last,Age)):-
if(male(First), Last\=grant),
if(Last=grant, female(First)),
iff(Last=diamond,Age=7),
iff(Last=grant,Age=8),
iff(First=angela,Age=5).
unknown(child(First,Last,Age)):- not( fact(child(First,_,_))),
not( fact(child(_,Last,_))),
not( fact(child(_,_,Age))).
go:-solution(X), fail; listing(fact).
:- write('Puzzle loaded'), nl,nl.
:- write('Input time(go). to start solving it... and see how fast it is.'), nl,nl.
EXAMPLE 104
% Generic puzzle solver
% ---- Try possibillities against given facts and assert those that fit
% Each component can only occur once in a fact
solution(X):-
clear_facts,
possibility(X),
new_attributes(X),
givens(X),
assertz(fact(X)).
clear_facts:-abolish(fact,1), assert( fact(dummy_entity) ).
% --- the following avoids an exception ----
:-dynamic(fact/1).
:-style_check(-singleton).
go:-solution(X), fail; listing(fact).
% normally X will be a structure with components representing different
% facets or attributes of the entities involved.
% --- two utilities: if-then-, and if-and-only-if
if(P,Q):- P->Q;true.
iff(P,Q):-(P,Q); not( P ), not( Q ).
:- write('Input time(go). to solving puzzle... and see how fast it is.'), nl,nl.
% Test case
% A Sample Logic Problem. [ Original logic problems, July 1990, p 5]
% Angela, David and Mae are the young stars in a talent show.
% Their ages are 5,7, and 8. One has last name Starr.
% Miss Grant is three years older than Angela.
% The child whose last name is Diamond is seven years old
%
first(angela). first(david). first(mae).
male(david). female(angela). female(mae).
age(5). age(7). age(8).
last(diamond). last(grant). last(starr).
possibility(child(First,Last,Age)):-first(First), last(Last), age(Age).
givens(child(First,Last,Age)):-
if(male(First), Last\=grant),
if(Last=grant, female(First)),
iff(Last=diamond,Age=7),
iff(Last=grant,Age=8),
iff(First=angela,Age=5).
new_attributes(child(First,Last,Age)):- not( fact(child(First,_,_)) ),
not( fact(child(_,Last,_)) ),
not( fact(child(_,_,Age)) ).
:- write('Puzzle loaded'), nl,nl.
EXAMPLE 105
% experiemnts with setof
go:-setof(X, (member(X,[1,2,3,4,0,-1,-2,-3,-4]), 4 is X*X), Root), write(Root).
id(1234, jim). id(2345, joan). id(3456, jane). id(4567, jo).
grade(1234, a). grade(2345, b). grade(3456, c). grade(4567, d).
grade_roster_by_SSN(List):- setof( student(SSN,Name,Grade), ( id(SSN,Name), grade(SSN,Grade) ), List).
grade_roster(List):- setof( student(Name,SSN,Grade), ( id(SSN,Name), grade(SSN,Grade) ), List).
print_set(List):-member(X,List),write(X),nl,fail.
one_name_grade(List):-setof(ng(Name,Grade), ( id(SSN,Name), grade(SSN,Grade) ), List).
list_name_grade(List):-setof(ng(Name,Grade), SSN^( id(SSN,Name), grade(SSN,Grade) ), List).
EXAMPLE 106
square(N,S):-S is N*N.
% s2(Number, Sum_Squares)
s2(1,1).
s2(N, _) :- N=<0, print('Silly Sum Squares'), fail.
s2(N,SN) :- N>1, square(N, SqN), N1 is N-1, s2(N1, SN1), SN is SN1+SqN.
EXAMPLE 107
% This is a prologish variation
% This illstrates how to use the data base to accumulate partial results
% and when complete print them out.
square( X, SX):- SX is X * X.
data(1). data(2). data(3). data(4). data(5).
data(6). data(7). data(8). data(9). data(10).
% The 'object' sum(S) has two 'methods': add and clear
:-dynamic(sum/1).
sum(0).
clear:-abolish(sum,1),assert(sum(0)).
add(I):-retract(sum(S)),S2 is S+I,asserta(sum(S2)).
summer:-data(I), square(I, I2), add(I2), fail.
summer:-sum(S), write('The sum of data' = S), nl, clear.
go:-data(I),square(I,S), write(square(I)=S), nl,fail.
go:-write('---------------------'), nl, summer.
EXAMPLE 108
% s1(N,SN) - given a positive non zero integer number N, SN=1+2+...+N
s1(N,SN):- N < 1, print('Error in s1'), nl, fail.
s1(N,SN):- N=:=1, SN is 1.
s1(N,SN):- N > 1, N1 is N-1, s1(N1, SN1), SN is SN1 + N.
EXAMPLE 109
% a way to find the minimum cost of car insurance
% minimum(+Company, +Cost): Cost is minimum over all insurance(Company, Cost)
:-dynamic(mini/2). % mini(C,V) asserts the minimum so far is C,S.
minimum(C,V):-insurance(C0,V0),asserta(mini(C0,V0)), !, minimumrest(C,V).
minimumrest(_,_):-insurance(C1,V1), retract(mini(C0,V0)),
( V1 < V0 , asserta(mini(C1,V1)) ;
V1 >=V0 , asserta(mini(C0,V0))
), fail.
minimumrest(C,V):-retract(mini(C,V)).
insurance('AAA', 900).
insurance('GEICO', 800).
insurance('MobCo', 1000).
:-write('example: minimum(Company,Cost).').
EXAMPLE 110
% a way to find the minimum cost of car insurance using higher level predicates bagof and min_list
% minimum(+Company, +Cost): Cost is minimum over all insurance(Company, Cost)
minimum(C,V):-bagof(V0, X^insurance(X,V0), L), min_list(L, V), insurance(C,V).
insurance('AAA', 900).
insurance('GEICO', 800).
insurance('MobCo', 1000).
:-write('example: minimum(Company,Cost).').
EXAMPLE 111
% a set of predicates developed from T. Van Le's 'TEchniques of Prolog Programming'
% Wiley 1992
% an alternative find_all
% Usually you have 'findall(Vars,SatisfyingGoal,PutInList)' but if not use:
:-dynamic(found/1).
find_all(X,G,L):-
asserta(found([])),
G,
once(retract(found(L))),
asserta(found([X; L])),
fail.
find_all(_,_,L):-retract(found(L)).
%This is simpler than Schnupp and Bernhard, but is it faster?
% This splits a list up at successive points into a head and a tail
% remove comments if not builtin!
% select(H, [H|T], T).
% select(X, [H|T], [H|T1]):-select(X,T,T1).
% A selection sort from page 40
selection_sort([],[]).
selection_sort(L,[H|T]):- least(H,L,R), selection_sort(R,T).
least(X,[X],[]).
least(X,[H; T],R):-least(Y,R,S),
( H =< Y, (X,Y)=(H,T)
; H > Y, (X,R)=(Y,[H|S])
).
EXAMPLE 112
% From a paper by G Canfora, Aniello Cimitile and Ugo de Carlini
% 'A Logic Based Approach to Reverse Engineering Tools Production'
% IEEE Trans SE18 n 2 Dec 1992, pages 1053-1063
% problem - record the structure of a complex program so that a programmer
% can ask questions about it when trying to create an improved version.
% This is for a Pascal program
% Utility rules used in other predicates
% non_member(E, X) is true if E is not in list X.
% it differs from `not member(E,X)` becuase if E is a variable the not
% predicate backtracks and leaves E uninstanciated.
meta( non_member(e,l), 'Test if e is in list l').
non_member(_,[]).
non_member(E,[A|B]):-E\==A, non_member(E,B).
uniq([],[]).
uniq([H|T],[H|T2]):-non_member(H,T), !, uniq(T,T2).
uniq([H|T], T2):-uniq(T,T2).
meta( path_concat(p1,p2,p3), 'list p3 is/becomes list p1 in front of list p2').
path_concat([X], [X|Ys], [X|Ys]).
path_concat([X|Xs], Ys, [X|Zs]):-path_concat(Xs, Ys, Zs).
% basic predicates describe a particular program
% They are (ideally) extracted from code by a another program
basic(mod,1). basic(var_dec,2). basic(mod_dec,2). basic(par_dec,3).
basic(use,2). basic(set,2). basic(cal,2). basic(bind,4).
% notice that by including a definition of these predicates
% as part of the data base, we canwrite generic DataBase operations
clear_db:-basic(Atom,Arity), abolish(Atom,Arity),fail.
clear_db:- write('Program model erased'), nl.
list_db:-basic(Atom,Arity), write(Atom/Arity), nl, fail.
list_db.
% meta definitions document the meaning of predicates
meta( mod(x) ,'x is a module.').
meta( var_dec(x,y) ,'module x has declaration of variable called y').
meta( par_dec(x,y,i) ,'module x has formal parameter y in position').
meta( mod_dec(x,y) ,'module x has a declaration of a local module y').
meta( use(x,y) ,'module x uses variable y').
meta( set(x,y) ,'module x sets the value of variable y').
meta( cal(x,y) ,'module x calls module y').
%ca not use 'call' since that indicates a call of a predicate.
meta( bind(x,y,z,i), 'Module x calls y and has z as actual parameter i').
%summary relations - questions a program may ask
meta( mod_dec_scope(m1,m2), 'Module m1 declares a module, that declares a module, ...that declares m2').
mod_dec_scope(M1,M2):-mod_dec(M1,M2).
mod_dec_scope(M1,M2):-mod_dec(M1,Mi), mod_dec_scope(Mi,M2).
meta( var_or_par_dec(m,i), 'Module m declares identifier i as a variable or parameter').
var_or_par_dec(M, VoP):-(var_dec(M,VoP); par_dec(M,(VoP,_))).
meta( visible(m1, (i,m2)), 'Identifier i declared in m2 is visible in m1').
visible(M,(VoP,M)):-mod(M), var_or_par_dec(M,VoP).
visible(M1,(VoP,M2)):-var_or_par_dec(M2,VoP),mod_dec_scope(M2,M1),
not ( var_or_par_dec(M1,VoP); mod_dec_scope(M2,Mi),mod_dec_scope(Mi,M1),
var_or_par_dec(Mi,VoP)
).
meta( active(m1, m2,[m1,p,p,p|m2]), 'Paths for m1 to cal m2').
active(M,M,[M]):-mod(M).
active(M1,M2,[M1|Path]):-cal(M1,M3),active(M3,M2,Path).
meta( actualize(m1,i,(v,m2),p), 'module m1s ith parameter is actually identifier v declared or specified in m2, by path p').
actualize(M1,VoP,(VoP,M2), Path):-
visible(M1, (VoP,M2)), var_dec(M2,VoP), active(main,M2,Path1),
active(M2, M1, Path2),
path_concat(Path1, Path2, Path).
actualize(M1,VoP,(Var,M2),Path):- visible(M1,(VoP,M3)),
par_dec(M3,(VoP,Pos)),
cal(M4,M3),
bind(M4,M3,(VoP1,Pos)), active(M3,M1,Path1),
actualize(M4,VoP1,(Var,M2),Path2),
path_concat(Path2, [M4; Path1],Path).
meta( up_in((m1,p),(v,m2)), 'm1 is a module identified by path p and v is a variable in m2 that actually provides the data for m1 thru p').
up_in((M1,Path),(Var,M2)):- use(M1,VoP), actualize(M1,VoP,(Var,M2), Path), M2\==M1.
up_in((M1,Path),(Var,M2)):- cal(M1,M3),
active(main, M1,Path),
path_concat(Path, [M1,M3], Path1),
up_in((M3, Path1), (Var,M2)),
M2\==M1.
% The next predicate needs 'set_of(V, P, V)' to work.
% meta( in_flow((m,p), v), 'Produces a set of input sets for (m,p) to module m thru pathp, from all other modules').
in_flow((M, Path), VarSet):- active(main,M,Path), set_of(VarSet, up_in((M,Path), VarSet), VarSet).
% user interfaces
declarations:-mod(M),declared(M),fail.
declarations.
declared(M):-var_dec(M,V), write(M), write(' declares variable '), write(V), nl.
declared(M):-par_dec(M,(V,_)), write(M), write(' has parameter '), write(V), nl.
declared(M):-mod_dec(M,V), write(M), write(' declares module '), write(V), nl.
calls:-mod(M),calls(M),fail.
calls.
calls(M):-cal(M,M2), write(M), write(' calls '), write(M2), nl.
usage:-mod(M),uses(M),fail.
usage.
uses(M):-use(M,V), write(M), write(' uses '), write(V), nl.
uses(M):-set(M,V), write(M), write(' sets '), write(V), nl.
list:-declarations, calls, usage.
%...
% sample data
mod(main).
var_dec(main,x). var_dec(main,y). mod_dec(main,a). mod_dec(main, d).
cal(main, a). bind(main, a, (x,1)). bind(main, a, (y,2)).
cal(main,d).
use(main,x). use(main,y).
mod(a).
var_dec(a,l). var_dec(a,m). par_dec(a, (t,1)). par_dec(a, (z,2)).
mod_dec(a,b).
mod_dec(a,c).
cal(a,b). bind(a,b,(t,1)). bind(a,b,(m,2)).
cal(a,c). bind(a,c,(m,1)). bind(a,c,(l,1)). % two different calls to c in a
mod(b). var_dec(b,u). par_dec(b, (x,1)). par_dec(b, (z,2)).
use(b,x). use(b,z). use(b,l). use(b,u).
mod(c). var_dec(c,p). par_dec(c, (q,1)).
cal(c,b). bind(c,b,(q,1)). bind(c,b,(p,1)). bind(c,b,(x,2)). bind(c,b,(t,2)).
set(c,p).
use(c,q).
mod(d).
var_dec(d,r). var_dec(d,s).
cal(d,a).
bind(d,a,(r,1)). bind(d,a,(s,1)). bind(d,a, (y,2)).
use(d,x).
EXAMPLE 113
% It is not easy to predict all possible consequences when two different
% sequences of instructions are operating on the same data in an
% unpredictable order. The predicate will shuffle lists of actions
% together into a sequence and then obey them.
:-style_check(-singleton).
% This is based on a sample GRE question 1991-1992. CS489 Fall92
shuffle([], X, X).
shuffle(X, [], X).
shuffle([X|Y], Z, [X|W]):-shuffle(Y,Z,W),Z \= [].
shuffle(Y, [X|Z], [X|W]):-shuffle(Y,Z,W),Y \= [].
obey([]):-!.
obey([X|Y]):- write(X), nl, X, print_status, obey(Y),!.
% notice the simulated memory - needed since Prolog variables are temporary.
% ram(x, v) is a clause when and only when x is a variable and v its
% current value in the simulation.
print_status:-ram(X, VX), write('RAM['), write(X), write(']='), write(VX), nl,fail.
print_status:- write('-------------'), nl.
initial_status:-abolish(ram,2), assert(ram(x,0)), assert(ram(y,0)),!.
% we now have to define how to evaluate expressions using ram values.
eval(X, V):-ram(X,V),!.
eval(+Y, VX):-eval(X,VX), !.
eval(-Y, V):-eval(X,VX), V is -VX, !.
eval(X+Y, V):-eval(X,VX), eval(Y,VY), V is VX+VY, !.
eval(X-Y, V):-eval(X,VX), eval(Y,VY), V is VX-VY, !.
eval(X*Y, V):-eval(X,VX), eval(Y,VY), V is VX*VY, !.
eval(X, V):-V is X,!.
% Now define semantics of assignment statements used with our RAM.
let(X,E):-eval(E,EV), remove_old(X), assert(ram(X,EV)),!.
remove_old(X):- (ram(X,Old), retract(ram(X,Old)); true),!.
doit:-A=[let(x,1), let(y,y+x)], B=[let(y,2),let(x,x+3)], !,
shuffle(A,B,C), initial_status, print_status, obey(C).
:-nl, print('shuffle, obey, and doit loaded'), nl.
EXAMPLE 114
%Prolog example developed by Dr. Klerer, CSUSB
append(L,L).
append:-print('Usage: append( List1, List2, List3 )').
append([],L,L).
append([X; L1],L2,[X; L3]) :- append(L1,L2,L3).
append(L1,L2,L3,L) :- append(L1,X,L), append(L2,L3,X).
append(A,B,C,D,L):-append(A,B,C,E), append(E,D,L).
%t(X) :- append(X1,X2,X3,X), f(X3).
%f([x]).
:-print('Append(List1,List2,List1and2) loaded').
EXAMPLE 115
shuffle([], X, X).
shuffle(X, [], X).
shuffle([X|Y], Z, [X|W]):-shuffle(Y,Z,W),Z \= [].
shuffle(Y, [X|Z], [X|W]):-shuffle(Y,Z,W),Y \= [].
order([]).
order([X]).
order([X,Y|Z]):-X <= Y, order([Y|Z]).
merge(X,Y,Z):-shuffle(X,Y,Z),order(Z).
:-print('shuffle, order and merge loaded').
EXAMPLE 116
% MemberP tests for membership only.
memberp(E, [E, .._]):-!.
% Once found, will not search for alternatives
memberp(E, [_, ..R]) :- memberp(E, R),!.
EXAMPLE 117
% File of predicates operating on lists
% rev(X,Y) - Y is the reverse of X
rev([],[]).
rev([H; T],L) :- rev(T,Z), append(Z,[H],L).
% append(X,Y,Z) - Z is a list starting with X and followed by Y
append([],L,L).
append([X; L1],L2,[X; L3]) :- append(L1,L2,L3).
% no_dups(X) is true if no element in X is duplicated
no_dups([]).
no_dups([E|R]):-no_dups(R), non_member(E,R).
subset([],_).
subset([E, ..S], L):- member(E,L), subset(S, L).
% non_member(E, X) is true if E is not in list X.
% it differs from `not member(E,X)` becuase if E is a variable the not
% predicate backtracks and leaves E uninstanciated.
non_member(_,[]).
non_member(E,[A|B]):-E\=A, non_member(E,B).
% For a list of numeric expressions ascending tests for ascending order
ascending([]).
ascending([R]).
ascending([E1|R]):-R=[E2|R2], E1<E2, ascending(R).
:-print('rev(L,M), append(A,B,C), no_dups(L), subset(L,M), non_member(E,L), and ascending(L) loaded.').
EXAMPLE 118
% collection of list manipulation operations - DRAFT RJB May 90
rev([],[]).
rev([H; T],L) :- rev(T,Z), append(Z,[H],L).
append([],L,L).
append([X; L1],L2,[X; L3]) :- append(L1,L2,L3).
nodups([]).
nodups([E|R]):-nodups(R), non_member(E,R).
subset([],_).
subset([E, ..S], T):- member(E,T), subset(S, T).
non_member(_,[]).
non_member(E,[A|B]):-E\=A, non_member(E,B).
ascending([]).
ascending([R]).
ascending([E1|R]):-R=[E2|R2], E1<E2, ascending(R).
sort([], []):-!. sort([A], [A]):-!.
sort([A, B], [A, B]):- A<=B,!.
sort([A, B], [B, A]):- B<A,!.
sort(A, B):- split(A, A1, A2), sort(A1, B1), sort(A2, B2), merge(B1,B2,B).
split([],[],[]):-!. split([A],[],[A]):-!.
split([A1, A2|A3], [A1|B1], [A2|B2]):-split(A3, B1, B2).
merge(A,A,A):-!. merge([],A,A):-!. merge(A,[],A):-!.
merge([A1|A],[B1|B],[A1|C]):-A1<=B1,merge(A, [B1|B],C).
merge([A1|A],[B1|B],[B1|C]):-A1>B1, merge([A1|A],B, C).
permuted(A,B):-sort(A,C),sort(B,C).
common(A,A,A):-!. common([],A,A):-!. common(A,[],A):-!.
common([A1|A],[A1|B],[A1|C]):-common(A,B,C),!.
common([A1|A],[B1|B],C):-common(A,B,C).
EXAMPLE 119
%Prolog example developed by Dr. Klerer, CSUSB
:-dynamic(once/0).
one(X) :- X=1.
two(X) :- X=2.
two(X) :- X=3.
uniq(G) :- call(G), ((once, retract(once),!, fail);
(asserta(once), fail)).
uniq(_) :- once, retract(once).
u(G) :- call(G), (once, retract(once),!, fail;
asserta(once), fail) ; once, retract(once).
one :- one(_), ((once, retract(once),!, fail);
(asserta(once), fail)).
one :- once, retract(once).
two :- two(_), ((once, retract(once),!, fail);
(asserta(once), fail)).
two :- once, retract(once).
r :- repeat, ((once, retract(once),!, fail);
(asserta(once), fail)).
r :- once, retract(once).
:- write('uniq(Goal) loaded'), nl.
EXAMPLE 120
:- op(650, xfx, <=).
X<=Y :- X=<Y.
EXAMPLE 121
% defines the syntax of a small subset of English ..!
verb(X):-op(695,xfx,X).
:-verb([equals, isa, has, owns, married, hates, loves]).
:-verb([lets, keeps, gives,gets,takes,puts,makes,does,says,sees,sends, comes, goes]).
pred(X):-op(695, xf, X).
:-pred([is_happy, is_sad, is_on, is_off]).
prep(X):-op(690,yfx, X).
:-prep([in, on, off, to, from, by, under, over,with,near,arround]).
:-prep([about, across, after, against, among, at,before,between]).
X has Y:-X keeps Y.
X equals Y:-X=Y.
:- write('Mini English loaded'), nl.
EXAMPLE 122
% for statement from T Van Le 92
for(I,I,N):-I =< N.
for(I,M,N):-M < N, M1 is M+1, for(I,M1,N).
for(I,N):-for(I,1,N).
sample('for(I,1,10), write(I), nl, fail!').
go:-for(I,1,10), write(I), nl, fail.
EXAMPLE 123
% A for statement for(Identifier, Initial, Increment, Final)
% use like this: for(i,1,2,10),i(I)|..
for(Label,F):-for(Label,1,1,F).
for(Label,I,F):-for(Label,I,1,F).
for(Label,I,S,F):- V=I,V=<F,
(Garbage=..[Label,_], Garbage,abolish(Label); true),
Count=..[Label,V], asserta(Count).
for(Label,I,S,F):-Count=..[Label,V], retract(Count,_), V+S=<F,
Next is V+S, Count2=..[Label,Next], asserta(Count2).
for(Label,I,S,F):-abolish(Label), fail.
isqrt(N,Sqrt):-for(i,N), i(I), I*I>N,!, Sqrt is I-1, abolish(i).
pyth(N):-for(i,N),i(I), I1 is I+1, for(j,I),j(J), for(k,I1,N),k(K),
K*K=:=I*I+J*J, print([I,J,K]).
sample(N):-for(i,N),i(I), for(j,I),j(J), for(k,J),k(K),print([I,J,K]).
lagrange(N):-isqrt(N,L),
I1 is N - L*L, for(i,0,1,I1),i(I),prin(I),prin(' '),
J1 is I1 - I*I, for(j,I,1,J1),j(J),prin(J),prin(' '),
K1 is J1 - J*J, for(k,J,1,K1),k(K),prin(K),prin(' '),
N=:=I*I+J*J+K*K+L*L,print,print([I,J,K,L]).
EXAMPLE 124
% for statement from T Van Le 92
for(I,I,N):-I =< N.
for(I,M,N):-M < N, M1 is M+1, for(I,M1,N).
for(I,N):-for(I,1,N).
% interesting examples of searches - pythagorean triples, 4 square make an integer and so on.
sample(N):-for(I,1,N), for(J,1,I), for(K,1,J),print([I,J,K]).
pyth(N):-for(I,N), I1 is I+1, for(J,I), for(K,I1,N),
K*K=:=I*I+J*J, print([J,I,K]).
isqrt(N,Sqrt):-for(I,1,N), I*I>N,!, Sqrt is I-1.
lagrange(N):-isqrt(N,L),
I1 is N - L*L, for(I,0,I1),
J1 is I1 - I*I, for(J,I,J1),
K1 is J1 - J*J, for(K,J,K1),
N=:=I*I+J*J+K*K+L*L,print,print([I,J,K,L]).
EXAMPLE 125
% predicate that changes the data base delta(Old, New, Where)
% must declare the predicate in Old and New as dynamic.
delta(Old,New,Where):- retract(Old), call(Where), assert(New).
delta(Old,New):-delta(Old, New, true).
EXAMPLE 126
a(S,S2) :-concat([S, 'a'], S2).
b(S,S2) :-concat([S, 'b'], S2).
c(S,S2) :-concat([S, 'c'], S2).
s:-s(S), write(S), nl.
t:-t(T), write(T), nl.
u:-u(U), write(U), nl.
s(S):-s('', S).
s(S0,S):-c(S0,S) ; a(S0,S1),s(S1,S2),b(S2,S).
t(T):-t('',T).
t(T0,T):-a(T0,T1), c(T1,T) ; a(T0,T1),t(T1,T).
u(U):-u('',U).
u(U0,U):-c(U0,U) ; a(U0,U1),b(U1,U2),b(U2,U3),u(U3,U) ; a(U0,U1),b(U1,U2),u(U2,U3),b(U3,U) ; a(U0,U1),u(U1,U2),b(U2,U3),b(U3,U) ; u(U0,U1),a(U1,U2),b(U1,U2),b(U3,U).
:- write('Input s(S), nl? , t(T)?, or u(U)? to generate strings').
:- write(' But prolog won't generate all the U strings....'), nl.
EXAMPLE 129
% An example based on p262 of Appleby 91 'Programming Lnguages'
happy(X):-watching(X, football), has(X,supplies).
has(X, supplies):-has(X,beer), has(X, pretzels).
watching(X, football):-ison(X, tv), playing(cowboys).
ison(tom, tv).
playing(cowboys).
has(tom,beer).
has(tom,pretzels).
has(dick,beer).
has(harry,pretzels).
ison(dick,tv).
ison(joan,radio).
has(joan,pretzels).
has(joan,beer).
:- write('happy(Person) is loaded'), nl.
:- write('try queries like: happy(X). has(X,beer). has(tom, X). '),nl,nl.
EXAMPLE 130
% An example based on p262 of Appleby 91 'Programming Lnguages'
% This uses a simplified english grammar.
:-consult('/u/faculty/dick/cs320/prolog/english.pl').
:-verb([watches]).
:-pred([is_happy]).
X is_happy:-X watches football, X has supplies.
X has supplies:-X has beer, X has pretzels.
X watches football:-X sees T, T isa tv, X owns T, T is_on.
T is_on:-cowboys on T.
tom owns his_tv. his_tv isa tv.
tom sees his_tv.
cowboys on his_tv.
tom has beer.
tom has pretzels.
dick has beer. dick owns two_tvs. two_tvs isa tv.
harry has pretzels.
joan has beer. joan has pretzels. joan has her_radio. her_radio is_on.
:- write('Monday night is now'), nl.
:-print('Words defined: is_happy, is_on, has, supplies, beer, pretzels, tom...').
:- write('Try: Who is_happy? and listing!'), nl.
why:-pp postfix is_happy; pp infix has; pp infix owns; pp infix isa.
why:-pp infix sees; pp postfix is_on.
EXAMPLE 131
% An example based on p262 of Appleby 91 'Programming Lnguages'
% This uses a simplified english grammar.
:-consult('/u/faculty/dick/cs320/prolog/english.pl').
:-verb([watches]).
:-pred([is_happy]).
X is_happy:-X watches football, X has supplies.
X has supplies:-X has beer, X has pretzels.
X watches football:-X sees T, T isa tv, X owns T, T is_on.
T is_on:-cowboys on T.
tom owns his(X).
his(X) isa X.
tom sees his(tv).
cowboys on his(tv).
tom has beer.
tom has pretzels.
dick has beer. dick owns two_tvs. two_tvs isa tv.
harry has pretzels.
joan has beer. joan has pretzels. joan has her(radio). her(radio) is_on.
joan owns her(X). her(X) isa X.
:- write('Monday night is now'), nl.
:-print('Words defined: is_happy, is_on, has, supplies, beer, pretzels, tom...').
:- write('Try: Who is_happy? and listing!'), nl.
why:-pp postfix is_happy; pp infix has; pp infix owns; pp infix isa.
why:-pp infix sees; pp postfix is_on.
EXAMPLE 132
% Genrating integer values. Shows problems.
int(I,I).
int(I,M):- M1 is M+1, int(I,M1).
int(I):-int(I,1).
space:-prin(' ').
sample('int(I), write(I), nl, I>=5!').
sample('int(I), int(J), prin(I),space, write(J), nl, I is 2 * J?').
sample('int(I), int(J), prin(I),space, write(J), nl, J is 2 * I?').
EXAMPLE 133
% From murphy Thu Oct 31 14:53 PST 1991
% To: dick
% Subject: complexity of prolog
% While going through some of my old files, I found a short
%prolog program you may find interesting. The Air Force was
%considering the development of a massively parallel prolog
%interpreter for the SDI program until I showed them this one.
num(a,a,a,a).
num(X1,X2,X3,b):-num(X1,X2,X3,a).
num(X1,X2,b,a):-num(X1,X2,a,b).
num(X1,b,a,a):-num(X1,a,b,b).
num(b,a,a,a):-num(a,b,b,b).
%What does it do? Ask it trace, num(b,b,b,b).
EXAMPLE 134
% Predicates for simulating logical formula
false:-!,fail.
boolean(true). boolean(false).
boolean(P,Q):-boolean(P),boolean(Q).
boolean(P,Q,R):-boolean(P,Q), boolean(R).
:-op(1000, fx, boolean).
boolean [].
boolean [P|List]:-boolean(P), boolean List.
boolean P:- boolean(P).
% definition of substitutions
:-op(600, xfx, eq).
not true eq false.
not false eq true.
not not P eq P:-nonvar(P).
% definition of implication.
:-op(600,xfx,=>).
false=>true.
false=>false.
true=>true.
P=>Q:-P eq R, R=>Q.
P=>Q:-Q eq R, P=>R.
% definition of logical equivalence
:-op(600,xfx,iff).
true iff true.
false iff false.
P iff Q:-P eq R, R iff Q.
P iff Q:-Q eq R, P iff R.
:-op(600, yfx, and).
true and true.
P and Q:-P eq R, R and Q.
P and Q:-Q eq R, P and R.
:-op(600, yfx, or).
true or false.
false or true.
true or true.
P or Q:-P eq R, R or Q.
P or Q:-Q eq R, P or R.
EXAMPLE 135
% Predicates for simulating logical formula
false:-!,fail.
% The boolean predicate
boolean(true). boolean(false).
boolean(P,Q):-boolean(P),boolean(Q).
boolean(P,Q,R):-boolean(P,Q), boolean(R).
% definition of implication.
:-op(600,xfx,=>).
false=>true.
false=>false.
true=>true.
% definition of logical equivalence
:-op(600,xfx,iff).
true iff true.
false iff false.
:-op(600, yfx, and).
true and true.
:-op(600, yfx, or).
true or false.
false or true.
true or true.
pbool(P):-P, write('true '), ! ;
write('false ').
truthtable(P):-boolean(P), write(P), nl,fail.
truthtable(P,Q):-boolean(P),pbool(P), write(Q), nl,fail.
truthtable(P,Q,R):-boolean(P),boolean(Q), pbool(P),pbool(Q), write(R), nl,fail.
truthtable(P,Q,R,S):-boolean(P),boolean(Q), pbool(P),pbool(Q),pbool(R), write(S), nl,fail.
EXAMPLE 136
% Boolean algebra
% boolean variables have two values: 1(true) and 0(false)
bool(X):-X=0;X=1.
bools([]).
bools([X|Y]):-bool(X), bools(Y).
% How to evaluate a boolean formula
eval(0, 0):-!.
eval(1, 1):-!.
eval(-1, 0):-!.
eval(-0, 1):-!.
eval(-X, V):-eval(X,XV), V is 1-XV, !.
eval(X+Y,V):-eval(X,XV), eval(Y,YV), V is XV+YV-XV*YV,!.
eval(X*Y,V):-eval(X,XV), eval(Y,YV), V is XV*YV,!.
eval(X-Y, V):-eval(X+(-Y),V),!.
eval(X=Y, V):-eval(X*Y+(-X)*(-Y),V),!.
eval(X->Y, V):-eval(Y-X,V).
test(E):-eval(E,1).
disprove([Var1|Rest], Proposition):-bools([Var1|Rest]), eval(Proposition,0).
EXAMPLE 137
day(D):-member(D,[sa,su,mo,tu,we,th,fr]).
next(sa,su).
next(su,mo).
next(mo,tu).
next(tu,we).
next(we,th).
next(th,fr).
next(fr,sa).
says(A,D, P):-lies(A,L,T), (member(D, L), not P; member(D,T), P).
lies(mwf,[mo,we,fr],[tu,th,sa,su]).
lies(tts,[tu,th,sa],[mo,we,fr,su]).
qn1(D):-day(D), next(Y,D), says(mwf, D, says(mwf,Y,true) ).
qn2(D):-day(D), next(Y,D), next(D,T),
says(mwf, D, Y=su), says(tts, D, T=sa).
qn3(D,A,B):-select([mwf,tts], A, [B]), next(Y,D),
says(A, D, says(A,Y,true)),
says(B, D, Y=mo).
EXAMPLE 138
% Knight Noraml or Spy
% Three people: A,B,C, one spy, one knight, one normal
% spies lie, knights speak the truth, normals do both
perm([],[]).
perm(X,[Y|Z]):-select(X,Y,R),perm(R,Z).
says(k,P):- P.
says(s,P):- not P.
says(n,_).
problem(People):- People=[A,B,C], perm(People, [k,n,s]),
says(A, C\=s),
says(B, A\=k),
says(C, B=k).
EXAMPLE 139
% Knight Noraml or Spy
% Three people: A,B,C, one spy, one knight, one normal
% spies lie, knights speak the truth, normals do both
perm([],[]).
perm(X,[Y|Z]):-select(X,Y,R),perm(R,Z).
says(k,P):- P.
says(s,P):- not P.
says(n,_).
problem(People):- People=[A,B,C], perm(People, [k,n,s]),
says(A, (B=n,B=n) ),
says(B, B=n),
says(C, (B=n;B\=n)).
EXAMPLE 140
% maxi(X,Y,Z) will be true when Z is the maximum of X and Y.
maxi(X,Y,Z):-(X>=Y, Z is X,!); Z is Y.
EXAMPLE 141
% A model of movement - state is set of facts object at place
:-op(690, xfx, at).
:-dynamic(at/2).
is_place(X):-_ at X.
is_object(X):-X at _.
% 'put' is already in reserved for char output.
place(X,At):-assert(X at At), write(X), write(' is now at '), write_ln(At),!.
take(X,From):-retract(X at From),
write(X), write(' was at '), write_ln(From),!.
move(X, To):-move(X,_,To).
move(X, From, To):-retract(X at From),
write(X), write(' was at '), write_ln(From),
assert(X at To),
write(X), write(' is now at '), write_ln(To),!.
d:-X at Y, write(X), write(' is at '), write_ln(Y), nl,
fail.
q:-halt.
Comments
Post a Comment