AI PROGRAMMING WITH PROLOG PART 1
ARTIFICIAL INTELLIGENCE PROGRAMMING WITH PROLOG
WORKSHOP I
PART 1 (Examples 1-80)
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.
PROLOG EXAMPLE 1
has(jack,apples).
has(ann,plums).
has(dan,money).
fruit(apples).
fruit(plums).
?- [lesson1]. /* loads the file */
yes
?- listing(fruit). /* lists the clauses */
fruit(apples).
fruit(plums).
?- listing(has).
has(jack,apples).
has(ann,plums).
has(dan,money).
?- has(jack,X). /* what has Jack? */
X = apples
?- has(jack,_). /* does Jack have something? */
yes
?- has(X,apples),has(Y,plums). /* who has apples and who has plums? */
X = jack
Y = ann
?- has(X,apples),has(X,plums). /* does someone have apples and plums? */
no
?- has(dan,X),fruit(X). /* has Dan fruits? */
no
?- has(X,Y),not fruit(Y). /* does someone have something else? */
X = dan
Y = money
PROLOG EXAMPLE 2
+ plus - minus
* multiplication ^ power
/ division // integer division
sqrt square root mod N mod M is the remainder N/M
?- X is 5+4, Y is 5-4.
X = 9
Y = 1
?- X is 5*4, Y is 2^3.
X = 20
Y = 8
?- X is 234556^100.
Error 0:Arithmetic Overflow
?- X is 5/3, Y=5//3.
X=1.66666667
Y=1
?- X is sqrt(3),Y is 3^0.5.
X = 1.73205080756888
Y = 1.73205080756888
?- X is 8 mod 3.
X = 2
?- Y is 10^3 * (1+1) + 3.
Y = 2003
?- halt. Exit from Prolog
EXAMPLE 3
?- my_write([a,b,c]).
a
b
c
yes
Solution1.
my_write([]).
my_write([X|R]):- write(X),nl,my_write(R).
Solution2.
my_write(L):- member(X,L),write(X),nl,fail.
Remember how member/2 works?
member(X,[X|_]).
member(X,[_|T]):- member(X,T).
EXAMPLE 4
vowel(X):- member(X,[a,e,i,o,u]).
nr_vowel([],0).
nr_vowel([X|T],N):- vowel(X),nr_vowel(T,N1),N is N1+1,!.
nr_vowel([X|T],N):- nr_vowel(T,N).
?- nr_vowel([],X).
X = 0
?- nr_vowel([a,r,e,d,i],X).
X = 3
?- nr_vowel([m,r],X).
X = 0
?- nr_vowel([s,e,e,d],X).
X = 2
EXAMPLE 5
abs(X,X):- X >= 0, !.
abs(X,Y):- Y is -X.
?- abs(0,R).
R = 0
?- abs(-9,R).
R = 9
?- abs(-9,9).
yes
?- abs(-9,8).
no
?- abs(I,8).
I = 8
EXAMPLE 6
inc(X,Y):- Y is X+1.
mapcar(F,[],[]).
mapcar(F,[H|T],[R|RT]):- F(H,R),mapcar(F,T,RT)
?- inc(12,R).
R=13
?- mapcar(inc,[1,2,3],R).
R=[2,3,4]
EXAMPLE 7
remove_duplicates([],[]):- !.
remove_duplicates([H|T],R):- member(H,T),remove_duplicates(T,R),!.
remove_duplicates([H|T],[R|Rest]):- remove_duplicates(T,Rest).
REMOVES DUPLICATES from a list.
?- remove_duplicates([a,b,a,b,b,c],I).
I=[a,b,c].
?- remove_duplicates([a,b],I).
I=[a,b].
EXAMPLE 8
union([],X,X):-!.
union([X|R],Y,Z):- member(X,Y),union(R,Y,Z),!.
union([X|R],Y,[X|Z]):- union(R,Y,Z).
intersect([],X,[]):- !.
intersect([X|R],Y,[X|T]):- member(X,Y),intersect(R,Y,T),!.
intersect([X|R],Y,L):- intersect(R,Y,L).
Basic operations with sets
Union of two sets.
?- union([a,b,c],[d,e,f],[a,b,c,d,e,f]).
yes
?- union([a,b,c],[d]).
no
?- union([a,b,c],[c,d,e],R).
R = [a,b,c,d,e]
Intersection of two sets.
?- intersect([],[a,b,c],[]).
yes
?- intersect([a,b,c],[c,d],[c]).
yes
?- intersect([a,b,c],[b,c,d],R).
R=[b,c]
EXAMPLE 9
my_reverse([],[]).
my_reverse([H|T],L):- my_reverse(T,R),append(R,[H],L).
my_reverse/2 written with the technique of the collector variable
my_reverse(L1,R):- rev(L1,[],R).
rev([],L,L).
rev([H|T],L,M):- rev(T,[H|L],M).
R E V E R S E a list
reverse/2 is Win-Prolog predicate
?- my_reverse([m,e,l,a,n,i,e],R).
R = [e,i,n,a,l,e,m]
?- my_reverse([a,[b,1],c],R).
R = [c,[b,1],a]
EXAMPLE 10
ack(0,M,R):- R is M+1,!.
ack(N,0,R):- R1 is N-1,ack(R1,1,R).
ack(N,m,R):- N1 is N-1,M1 is M-1,ack(N,M1,R1),ack(N1,R1,R).
Ackermann
Some values for Ackermann's function:
n m ACK(n m)
-------------------------------------------------------
1 1 3
1 2 4
2 1 5
2 2 7
2 3 9
3 2 29
3 3 61
3 4 stack overflow
EXAMPLE 11
subst(N,O,[],[]):- !.
subst(N,O,[O|T],[N|R]):- subst(N,O,T,R),!.
subst(N,O,[X|T],[X|R]):- subst(N,O,T,R).
Substitution of an element with another in a list (superficial level)
?- subst(new,old,[old,a,old,b,c,old]],R).
R = [new,a,new,b,c,new]
?- subst(n,o,[a,b,c,d]],R).
R = [a,b,c,d]
?- subst(x,y,[y,y,c,[d,y],e],R).
R = [x,x,c,[d,y],e]
EXAMPLE 12
start:- write('Write a word='),read(X),nl,
name(X,L),permut(L,R),
name(Cuv,R),write(Cuv),tab(5),fail.
add(X,L,[X|L]).
add(X,[L|H],[L|R]):- add(X,H,R).
permut([],[]).
permut([L|H],R):- permut(H,R1),add(L,R1,R).
Anagram
Anagram - a word or phrase spelled by rearranging the letters of another word or phrase.
?- start.
Write a word= max.
max amx axm mxa xma xam no
?- add(a,[b,c,d],X).
X = [a,b,c,d]
X = [b,a,c,d]
X = [b,c,a,d]
X = [b,c,d,a]
?- permut([a,b,c],X).
X= [a,b,c]
X= [b,a,c]
X= [b,c,a]
X= [a,c,b]
X= [c,a,b]
X= [c,b,a]
EXAMPLE 13
start:- write('Text is in file= '),read(F),
write('What letter do you want to count='),read(Let),
see(F),process(Let,0),seen.
process(Let,N):- get0(Char), process1(Char,Let,N).
/* The end of the file is -1 */
process1(-1,Let,N):- write('This letter occurs '),write(N), write(' times.'),!.
process1(Char,Let,K):- name(Let,[Char]),K1 is K+1,process(Let,K1).
process1(Char,Let,K):- process(Let,K).
/* Another solution (without recursion!).
Be careful the counter must be put back to 0 at the end! I did not do this!*/
counter(0).
start:- write('Text is in file= '),read(F),
write('What letter do you want to count= '),get0(MyChar),
see(F),process(MyChar),seen,
counter(Final),
write('This letter occurs '),write(Final),write(' times'),nl.
process(MyChar):- repeat,get0(I),(dothis(I,MyChar) ;true), I = -1.
dothis(I,MyChar):- I=MyChar,counter(K), R is K + 1,
retractall(counter(_)), assert(counter(R)).
Counts a letter in a text
Let's see how many times is a in the file called mary.txtcontaining:
Mary has a little lamb
Little lamb
?- start.
Text is in file= 'mary.txt'.
What letter do you want to count= a.
This letter occurs 5 times.
EXAMPLE 14
start:- write('List of words is: '),read(X),
write('Prefix is: '),read(Y),
sellist(Y,X,R),
write('The words: '),write(R),
write('have the prefix '),write(Y),nl.
sellist(P,[],[]).
sellist(P,[W1|RestW],[W1|R]):- prefix(P,W1),sellist(P,RestW,R).
sellist(P,[W1|RestW],R):- sellist(P,RestW,R).
prefix(X,Y):- name(Y,Ylist),name(X,Xlist),append(Xlist,_,Ylist).
PREFIX
Verifies if X is prefix of a given word.
Selects from a list of words, those words which have prefix X.
?- start.
List of words is: [man,sky,manhattan,automobile,school,march,river].
Prefix is: ma.
The words: [man,manhattan,march] have the prefix ma
yes
EXAMPLE 15
The number of permutations of a list with n elements is n!
Algorithm:
We take each element by turn and add it in front of each element.
add(X,L,[X|L]).
add(X,[L|H],[L|R]):- add(X,H,R).
permut([],[]).
permut([L|H],R):- permut(H,R1),add(L,R1,R).
permutations(L,R):- findall(P,permut(L,P),R).
PERMUTATIONS
?- permutations([1,2],R).
R = [[1,2],[2,1]]
?- add(a,[b,c,d],X).
X = [a,b,c,d]
X = [b,a,c,d]
X = [b,c,a,d]
X = [b,c,d,a]
?- permut([a,b,c],X).
X = [a,b,c]
X = [b,a,c]
X = [b,c,a]
X = [a,c,b]
X = [c,a,b]
X = [c,b,a]
The number of permutations of a list with n elements is n!
Algorithm:
We take each element by turn and add it in front of each element.
add(X,L,[X|L]).
add(X,[L|H],[L|R]):- add(X,H,R).
permut([],[]).
permut([L|H],R):- permut(H,R1),add(L,R1,R).
permutations(L,R):- findall(P,permut(L,P),R).
EXAMPLE 16
in_mind([l,o,v,e]).
start:- write('Guess first letter'),read(X),
in_mind([X|T]),write('OK. '),guess(T).
guess([]):- write('Congratulations! The word is '),in_mind(W),write(W),!.
guess(L):- repeat,write('Next letter'),read(X),
((L=[X|T1],write('OK. '),guess(T1));
(write('Fail. Try again!'),guess(L))).
in_mind([l,o,v,e]).
start:- write('Guess first letter'),read(X),
in_mind([X|T]),write('OK. '),guess(T).
guess([]):- write('Congratulations! The word is '),in_mind(W),write(W),!.
guess(L):- repeat,write('Next letter'),read(X),
((L=[X|T1],write('OK. '),guess(T1));
(write('Fail. Try again!'),guess(L))).
Guess the word
The program has "in mind" a word (love) and you have to guess this word: letter by letter.
Unless you don't guess the first letter the program does not ask for the next letter.
If you guess a letter the program says: OK. And asks for the next one.
?- start.
Guess first letter|: m.
no
?- start.
Guess first letter|: l.
OK. Next letter|: a.
Fail. Try again! Next letter|: o.
OK. Next letter|: v.
OK. Next letter|: e.
OK. Congratulations! The word is [l,o,v,e]yes
EXAMPLE 17
area:- write('Radius '),read(R),
write('Area is '),A is 3.14*R*R,write(A),nl,
write('Circumference is '),C is 2*3.14*R,write(C),nl.
?- start.
Radius= |: 1.
Circumference is 6.28
Area is 3.14
start:- radius(R),
circ(R,C),write('Circumference is '),write(C),nl,
area(R,A),write('Area is '),write(A).
radius(R):- write('Radius= '),read(R).
circ(R,C):- C is 2*3.14*R.
area(R,A):- A is 3.14*R*R.
Circle: area and circumference
?- area.
Radius |: 1.
Area is 3.14
Circumference is 6.28
yes
EXAMPLE 18
parent(abraham,ismael).
parent(abraham,isaac).
parent(isaac,esau).
parent(isaac,iacob).
grandfather(B,N):- parent(B,P),parent(P,N).
brother(F1,F2):- parent(P,F1),parent(P,F2),not F1=F2.
descendent(X,Y):- parent(X,Y).
descendent(X,Y):- parent(X,Z),descendent(Z,Y).
?- parent(abraham,X). /* The children of Abraham */
X = ismael
Y = isaac
yes
?- parent(abraham,_). /* Did Abraham have children? */
yes
?- parent(Father,esau). /* The father of Esau? */
Father = isaac
?- parent(F,S). /* All the pairs father-son from the data base */
F = abraham
S = ismael
...
?- parent(abraham,X),parent(X,Grandson). /* Is Abraham grandfather? */
X = isaac
Grandson = esau
X = isaac
Grandson = iacob
no
?- grandfather(abraham,iacob).
yes
?- grandfather(abraham,Grandson).
Grandson = esau
Grandson = iacob
no
EXAMPLE 19
put_prefix(P,C,R):- name(P,Pcode),name(C,Ccode),
append(Pcode,Ccode,Rcode),
name(R,Rcode).
put_suffix(S,C,R):- name(S,Scode),name(C,Ccode),
append(Ccode,Scode,Rcode),
name(R,Rcode).
Adds a prefix/suffix to a given word
?- put_prefix(un,deliver,R).
R = undeliver
?- put_suffix(able,deliver,R).
R = deliverable
?- name(melanie,Ascii_code). /* name/2 is a system predicate*/
Ascii_code=[109,101,108,97,110,105,101]
?- name(X,[109,101,108,97,110,105,101]).
X = melanie
EXAMPLE 20
start:- write('input a= '),read(A),
write('input b= '),read(B),
write('input c= '),read(C),
A >= 0,B >= 0,C >= 0, /* must be positive */
A < B+C,B < C+A,C < A+B,
write('These numbers are the edges of a triangle.').
Verifies if 3 numbers can be the edges of a triangle
?- start.
input a= 3.
input b= 4.
input c= 5.
These numbers are the edges of a triangle.
yes
EXAMPLE 21
Maximum number
Win-Prolog maximum works like this:
?- R is max(3,4).
R = 4
See below our versions. Which one do you prefer?
max(X,Y,X):- X >= Y.
max(X,Y,Y):- Y > X.
?- max(5,3,R).
R = 5
no
maxx(X,Y,X):- X >= Y.
maxx(X,Y,Y).
?- maxx(3,5,R).
R = 5
no
?- maxx(5,3,R).
R = 5
R = 3
maxxx(X,Y,X):- X >= Y,!.
maxxx(X,Y,Y).
?- maxxx(5,3,R).
R = 5
no
EXAMPLE 22
append/3 - concatenates two lists
Win PROLOG predicate
?- append([a,b],[c],R).
R=[a,b,c]
?- append(_,[e,s],[f,o,x,e,s]).
yes
?- append(X,[e,s],[f,o,x,e,s]).
X=[f,o,x]
?-append(X,Y,[a,b,c]).
X=[]
Y=[a,b,c]
X=[a]
Y=[b,c]
X=[a,b]
Y=[c]
X=[a,b,c]
Y=[]
no
append([],L,L).
append([H|T],L,[H|R]):- append(T,L,R).
Example. last3/2 finds the last 3 elements of the list.
?-last3([c,o,l,l,e,g,e],R).
R=[e,g,e]
last3(L,[A1,A2,A3]):- append(_,[A1,A2,A3],L).
or
last3(L,[A1,A2,A3]):- append(_,X,L), length(X,3).
EXAMPLE 23
Multiply vectors
Example:
?- prodv([1,2,4],[3,2,3],R).
R = [3,4,12]
prodv([X],[Y],[R]):- R is X*Y.
prodv([H|T],[H1|T1],[R|R1]):- prodv(T,T1,R1),R is H*H1.
EXAMPLE 24
PALINDROME
Verify if a word is a palindrome.
Palindrome - a word or phrase that reads the same backward as forward.
See how many there are: Palindrome List
Examples (in English): deified, racecar
Examples (in Romanian): cojoc, sas, capac, rar
?- reverse([a,b,c,d],X).
X = [d,c,b,a]
?- reverse([g,u,e,s,s],X).
X = [s,s,u,e,g]
?- palindrome([r,a,c,e,c,a,r]).
yes
?- palindrome([l,o,v,e]).
no
palindrome(L):- reverse(L,L).
my_reverse([],[]).
my_reverse([H|T],R):- my_reverse(T,T1),append(T1,[H],R).
EXAMPLE 25
MAPCAR
mapcar/3: applies a function of one argument to each element of a list
?- mapcar(inc,[2,3],L).
L = [3,4]
?- mapcar(square,[2,3],L).
L = [4,9]
inc(N,R):- R is N + 1.
square(N,R):- R is N * N.
mapcar(F,[],[]).
mapcar(F,[H|T],[R|RT]):- R is F(H),mapcar(F,T,RT).
mapcar1/4 for two lists
?- mapcar1(plus,[1,3],[4,6],R).
R = [5,9].
?- add_vectors([1,3],[4,6],R).
R = [5,9].
plus(X,Y,Z):- Z is X+Y.
add_vectors(V1,V2,R):- mapcar1(plus,V1,V2,R).
mapcar1(F,[],[],[]).
mapcar1(F,[H1|T1],[H2|T2],[H3|T3]):- H3 is F(H1,H2),mapcar1(F,T1,T2,T3).
EXAMPLE 26
The second order equation: Ax2 + Bx + C
?- start.
Input the coefficients:
A= 1.
B= -3.
C= 2.
Solutions are x1= 2 x2= 1
Do you want to continue(Y/N)?= N.
start:- reads(A,B,C),solve(A,B,C),!,continue.
reads(A,B,C):- write('Input the coefficients:'),nl,
write('A='),read(A),write('B='),read(B),write('C='),read(C).
delta(A,B,C,R):- D is (B*B-4*A*C),D >= 0,R is sqrt(D).
solve(A,B,C):- A=\=0,delta(A,B,C,R),
X1 is (-B+R)/(2*A), X2 is (-B-R)/(2*A),
write('Solutions are '),
write('x1= '),write(X1),write(' x2='),write(X2),nl.
solve(A,B,C):- A=0,X is (-C/B),
write('Equation is order I. Solution is: '),write(X),nl.
solve(A,B,C):- delta(A,B,C,R),R=0,X is (-B/(2*A)),
write('Has one solution: '),write(X),nl.
solve(A,B,C):- write('No solutions.'),nl.
continue:- write('Do you want to continue(y/n)?='),
read(X),(X=y;X=ya;X=yes),start.
EXAMPLE 27
The second order equation: Ax2 + Bx + C
?- start.
Input the coefficients:
A= 1.
B= -3.
C= 2.
Solutions are x1= 2 x2= 1
Do you want to continue(Y/N)?= N.
start:- reads(A,B,C),solve(A,B,C),!,continue.
reads(A,B,C):- write('Input the coefficients:'),nl,
write('A='),read(A),write('B='),read(B),write('C='),read(C).
delta(A,B,C,R):- D is (B*B-4*A*C),D >= 0,R is sqrt(D).
solve(A,B,C):- A=\=0,delta(A,B,C,R),
X1 is (-B+R)/(2*A), X2 is (-B-R)/(2*A),
write('Solutions are '),
write('x1= '),write(X1),write(' x2='),write(X2),nl.
solve(A,B,C):- A=0,X is (-C/B),
write('Equation is order I. Solution is: '),write(X),nl.
solve(A,B,C):- delta(A,B,C,R),R=0,X is (-B/(2*A)),
write('Has one solution: '),write(X),nl.
solve(A,B,C):- write('No solutions.'),nl.
continue:- write('Do you want to continue(y/n)?='),
read(X),(X=y;X=ya;X=yes),start.
EXAMPLE 28
Selects the integers from a list
Selects the integers from a list
?- integer(a).
no
?integer(4.23).
no
?- select([1,a,3,b],R).
R=[1,3]
?- select([1,[a,2],3,4],R).
R=[1,3,4]
select([],[]).
select([H|T],[H|R]):- integer(H),select(T,R),!.
select([H|T],R):- select(T,R).
EXAMPLE 29
SORT with insertion
?-sortin([9,3,2 6,1,13],R,<).
R = [1,2,3,6,9,13]
?-sortin([9,3,2,6,1,13],R,>).
R = [13,9,6,3,2,1]
inser(A,[],[A],P).
inser(A,[H|L],R,P):- P(A,H),append([A,H],L,R),!.
inser(A,[H|L],[H|R],P):- inser(A,L,R,P).
sortin([],[],P).
sortin([H|L],Re,P):- sortin(L,R,P),inser(H,R,Re,P).
EXAMPLE 30
Combinations
comb(N,L,Result). Combinations of N elements from the list L.
?- comb(2,[a,b,c],I).
I = [a,b]
I = [a,c]
I = [b,c]
comb(N,L,X):- length(X,N),mem1(X,L).
rest(A,List,Rest). Returns the Rest of the list after the first occurrence of A.
?- rest(a,[a,b,c,d],R).
R = [b,c,d]
?- rest(a,[b,c,a,d],I).
R = [d]
?- rest(a,[b,c,d],R).
R = []
rest(X,[],[]):- !.
rest(X,[X|T],T):- !.
rest(X,[_|T],R):- rest(X,T,R).
mem1(Lr,L). Fills Lr with elements from L without repetitions
?- mem1([X,Y],[a,b,c]),write([X,Y]),fail.
[a,b][a,c][b,a][b,c][c,a][c,b]no
mem1([],Y).
mem1([H|T],Y):- member(H,Y),rest(H,Y,New),mem1(T,New).
EXAMPLE 31
GRAPHS - represented with arcs
arc(a,b). arc(b,c).
arc(a,c). arc(a,d).
arc(b,e). arc(e,f).
arc(b,f). arc(f,g).
?- arc(X,Y). /* gives all the arcs (X,Y) */
X = a
Y = b
X = b
Y = c
...
?- arc(a,X). /* arcs from node a got to node X */
X = b
X = c
X = d
?- node_out(a,R). /* the list of nodes adjacent to a */
R = [b,c,d]
node_out(Nod,R):- findall(X,arc(Nod,X),R).
?- node_in(c,R)./* the list of nodes from node c */
R = [b,a]
node_in(Nod,R):- findall(X,arc(X,Nod),R).
?- node_graf(R). /* the list with all the nodes */
R = [a,b,c,d,e,f,g]
node_graf(R):- findall(X,(arc(X,_);arc(_,X)),L),sort(L,R).
EXAMPLE 32
Add two numbers
?- start.
X= |: 1.
Y= |: 2.
Sum is 3
yes
start:- sum,nl.
sum:- write('X= '),read(X),
write('Y= '),read(Y),
S is X+Y,
write('Sum is '),write(S).
EXAMPLE 33
The LAST element of a list
Examples:
?- last([a],R)
R=a
?-last([a,b,1,c],X).
X=c
?-last([a,b,[c,[d]]],X).
X=[c,[d]]
Solution 1.
last([X],X).
last([H|T],R):- last(T,R).
Solution 2.
last(L,R):- append(_,[R],L).
append/2 is a Win-Prolog predicate:
append([],Y,Y).
append([H|T],Y,[H|R]):- append (T,Y,R).
EXAMPLE 34
Prefix, suffix, infix
?- prefix(ant,antiquity).
yes
?- prefix(ant,another).
no
?- suffix(rior,superior).
yes
?- infix(pp,happiness).
yes
prefix(P,C):- name(P,Pcod),name(C,Ccod),
append(Pcod,_,Ccod).
suffix(S,C):- name(S,Scod),name(C,Ccod),
append(X,Scod,Ccod),not X=[].
infix(I,C):- name(I,Icod),name(C,Ccod),
append(C1,C2,Ccod),append(Icod,_,C2).
EXAMPLE 35
Even number of elements in a list
Verifies if a list has 2 elements.
?- two([a,b]).
yes
two([_,_]).
Verifies if a list has an even number of elements.
?-even([a,b,c,d]).
yes
even([_,_]).
even([_,_|T]):- even(T).
EXAMPLE 36
Length of a list
The predicate is also built in Win-Prolog:
length(List,Nr).
?- my_length([a,b,[c,d],e],R).
R = 4
?- my_length([[],[]],R).
R = 2
?- my_length([[[]]],R).
R = 1
my_length([],0).
my_length([_|T],R):- my_length(T,R1),R is R1+1.
EXAMPLE 37
If a list is a set
A list represents a set if no element repeats.
So set/1 verifies if each element occurs only once in a list.
?- set([a,b,c,c,d]).
no
?- set([a,b,c]).
yes
?- set([a,[b,a],c]).
yes
?- set([]).
yes
set([]).
set([X|T]):- not(member(X,T)),set(T).
EXAMPLE 38
Subset of all sets from a list
SUBSET verifies if a set is a subset of another set.
?- subset([a,b],[a,c,d,b]).
yes
?-include([],[a,b]).
yes
subset([],L).
subset([X|T],L):- member(X,L),subset(T,L).
We verify if a set is included in all the sets of a list.
?- all_subset([a,b],[[1,a],[c,b]).
no
?- all_subset([a,c,b],[[a,b,c,d],[m,a,b,c]])
yes
subset([],L).
subset([H|T],L):- member(H,L),subset(T,L).
all_subset(X,[Y]):- subset(X,Y).
all_subset(X,[H|T]):- subset(X,H), all_subset(X,T).
EXAMPLE 39
Power. NK where K is a natural number
Example:
?- power(2,3,R).
R = 8
?- power(2,0,R).
R = 1
power(N,0,1):- !.
power(N,K,R):- K1 is K-1,power(N,K1,R1),R is R1*N.
EXAMPLE 40
F A C T O R I A L
Factorial of n is n!= 1 * 2* 3 * 4 *... * n
?- fact(4,R).
R = 24
fact(0,1).
fact(N,R):- fact(N1,R1),N is N1+1,R is R1*N.
Written with collector variable.
?- fact(4,R).
R = 24
fact(N,F):- fact1(N,1,F).
fact1(0,F,F).
fact1(N,X,F):- N is M+1, Y is X*N, fact1(M,Y,F).
EXAMPLE 41
FILES
procesch = process a file character by character
Example. In the text file called mary there is a poem:
Mary had a little lamb..
?- start.
File name= mary.
m
a
r
y
h
a
...
yes
start:- write('File name= '),read(F),see(F),procesch,seen.
procesch:- get0(C),proces1(C).
proces1(-1):- !.
proces1(C):- name(L,[C]),work(L),procesch.
/* write each letter on a new line */
work(L):- write(L),nl.
EXAMPLE 42
Deletes all the occurences of an element in a list (superficial level)
?- delete(a,[a,c,[a,b],a,f],R).
R=[c,[a,b],f]
delete(X,[],[]).
delete(X,[X|T],R):- delete(X,T,R),!.
delete(X,[Y|T],[Y|R]):- delete(X,T,R).
Deletes all the elements from another list
?- delete2([1,2,3],[1,4,2,5,3,7],R).
R=[4,5,7]
delete2([],L1,L1).
delete2([H|T],L1,L3):-delete2(H,L1,R2),delete2(T,R2,L3).
EXAMPLE 43
INSERT
Put an element in front of each element of a given list.
?- inser(a,1,[2,1,3,4],R).
R = [2,a,1,3,4]
?- append(X,Y,[a,b]).
X = []
Y = [a,b]
X = [a,b]
Y = []
X = [a]
Y = [b]
Solution 1:
inser(X,A,[],[]).
inser(X,A,[A|T],[X,A|T]):-!.
inser(X,A,[H|T],[H|R]):-inser(X,A,T,R).
Solution 2:
inser(X,A,L,R):- append(P1,[A|P2],L),append(P1,[X,A|P2],R).
append([],L,L).
append([H|T],L,[H|R]):- append(T,L,R).
EXAMPLE 44
Selects from a list n elements (from beginning/end)
The last element of a list
?- last([1,2,3,4],R).
R = 4
last(L,R):- append(X,[R],L).
The last 2 elements of a list
?- last2([1,2,3,4],R).
R = [3,4]
last2(L,[A,B]):- append(X,[A,B],L).
The last n elements of a list L.
?-lastn([1,2,3,4],2,T).
T = [3,4]
lastn(L,N,Y):- append(X,Y,L),length(Y,N).
The first n elements of a list.
?- firstn([1,2,3,4,5],3,W).
W = [1,2,3]
firstn(L,N,X):- append(X,Y,L),length(X,N).
EXAMPLE 45
PERMUTATIONS with delete
Deletes an element from a list, first occurrence
?- delete(a,[a,c,[a,b],f],R).
R=[c,[a,b],f]
?- delete(X,[a,b,c],R).
X = a
R = [b,c]
X = b
R = [b,c]
X = c
R = [a,b]
delete(X,[X|T],T).
delete(X,[Y|T],[Y|R]):- delete(X,T,R).
Deletes all elements from a list found in a given list
?- delete_list([1,2,3],[1,4,2,5,3,7],R).
R = [4,5,7].
?- delete_list(X,[a,b],R).
X = []
R = [a,b]
X = [a]
R = [b]
X = [a,b]
R = []
X = [b]
R = [a]
X = [b,a]
R = []
delete_list([],L1,L1).
delete_list([H|T],L1,L3):- delete(H,L1,L2),delete_list(T,L2,L3).
Permutation of a list
?- permut([a,b,c],L).
L = [[a,b,c],[a,c,b],b,a,c],[b,c,a],[c,a,b],[c,b,a]]
permut(L,R):- findall(X,delete_list(X,L,[]),R).
EXAMPLE 46
Path in a graph
arc(a,b). arc(b,c).
arc(a,c). arc(a,d).
arc(b,e). arc(e,f).
arc(b,f). arc(f,g).
?- path(a,b). /* is there any path from a to b? */
yes
?- path(c,g). /* is there any path from c to g? */
no
path(X,Y):- arc(X,Y).
path(X,Y):- arc(X,Z),path(Z,Y).
?- pathall(a,g,R). /* all the paths from node a to node g */
R = [a,b,b,e,e,f,f,g]
R = [a,b,b,f,f,g]
no
pathall(X,X,[]).
pathall(X,Y,[X,Z|L]):- arc(X,Z),pathall(Z,Y,L).
EXAMPLE 47
Double a number
Example:
/* Loads the file ex1.pl: */
?- [ex1].
yes
?- double.
Please input a number= 3.
Double is 6
You write this code in a text file called ex1.pl.
nl - means new line
/* Those are comments in Prolog.
Always write something about your predicate.
*/
double:- write('Please input a number= '),
read(X),nl,
write('Double is '), Y is 2*X,
write(Y),nl.
EXAMPLE 48
Arithmetic mean
?- start.
X= 4.
Y= 6.
R is 5
yes
start:- write('X= '),read(X),
write('Y= '),read(Y),
R is (X+Y)/2,
write('R is '),write(R),nl.
EXAMPLE 49
MEMBER
The predicate member/2 verifies if an element is in a list.
It is found in Win-Prolog.
?- member(b,[a,v,b,c]).
yes
?- member(a,[b,c,g]).
no
?- member(X,[a,b,c]).
X = a ;
X = b ;
X = c ;
no
| ?- member(X,[a,b,c]),write(X),nl,fail.
a
b
c
no
member(X,[X|_]).
member(X,[_|T]):- member(X,T).
EXAMPLE 50
MEMBER
The predicate member/2 verifies if an element is in a list.
It is found in Win-Prolog.
?- member(b,[a,v,b,c]).
yes
?- member(a,[b,c,g]).
no
?- member(X,[a,b,c]).
X = a ;
X = b ;
X = c ;
no
| ?- member(X,[a,b,c]),write(X),nl,fail.
a
b
c
no
member(X,[X|_]).
member(X,[_|T]):- member(X,T).
EXAMPLE 51
Product of two sets
Example:
?- product([a,b],[1,2,3],R).
R = [[a,1],[a,2],[a,3],[b,1],[b,2],[b,3]]
?- put(a,[1,2,3],I).
I = [[a,1],[a,2],[a,3]]
product([],_,[]).
product([H1|T1],L2,R):- put(H1,L2,R1),product(T1,L2,R2),append(R1,R2,R).
put(X,[],[]).
put(X,[H|T],[[X,H]|R]):- put(X,T,R).
Another version with member/2.
?- mmproduct([a,b],[1,2,3],R).
R = [[a,1],[a,2],[a,3],[b,1],[b,2],[b,3]]
mmproduct(M,N,R):- findall([X,Y],(member(X,M),member(Y,N)),R).
EXAMPLE 52
Euclid's algorithm
Euclid's algorithm
finding
the greatest common divider (gcd)
and
the least common multiple (lcm) of two integers.
?- gcd(6,15,X).
X = 3
?- lcm(6,7,Y).
Y = 42
?- lcm(16,14,R).
R = 112
gcd(X,0,X).
gcd(X,Y,D):- R is X mod Y, gcd(Y,R,D).
lcm(X,Y,M):- gcd(X,Y,D),M is (X*Y)/D.
EXAMPLE 53
FIBONACCI
The Fibonacci sequence f(1), f(2), f(3),.. is:
1, 1, 2, 5, 8, 13, 21, 34, 55......
As you see the definition is easy to grasp:
f(1) = f(2)= 1
f(n) = f(n-2) + f(n-1), if n >= 3
Example:
?- fib(6,R).
R = 13
fib(1,1).
fib(2,1).
fib(N,R):- N >= 3,N1 is N-1,N2 is N-2,
fib(N1,R1),fib(N2,R2),R is R1+R2.
EXAMPLE 54
The nth element of a list
?- nth(0,[a,b,c],R).
R = a
?- nth(2,[a,b,c,d],R).
R = c
nth(0,[X|_],X).
nth(N,[_|T],R):- M is N-1,nth(M,T,R).
EXAMPLE 55
Counts the occurrences of an element in a list
Occurrences on the superficial level
?- count(a,[a,b,c,[a,c],a],R).
R = 2
We can also generate a list with N identical elements
?- count(a,X,10).
X = [a,a,a,a,a,a,a,a,a,a]
count(_,[],0).
count(A,[A|L],N):- !,count(A,L,N1),N is N1+1.
count(A,[_|L],N):- count(A,L,N).
Occurrences of an atom in a list on all levels
?- countt(a,[[[a],[c]],[c,a]],R).
R = 2
?- countt(a,[[[a],[b]],[c,a]],2).
yes
?- countt(X,[a,b,c,[a,b,c,[a]]],3).
X = a
countt(_,[],0).
countt(A,[A|L],N):- !,countt(A,L,N1),N is N1+1.
countt(A,[B|L],N):- atom(B),countt(A,L,N),!.
countt(A,[B|L],N):- countt(A,B,N1),countt(A,L,N2),N is N1+N2.
EXAMPLE 56
Circular Lists
Example:
?- circular([a,b,c,d],R).
[a,b,c,d]
[b,c,d,a]
[c,d,a,b]
[d,a,b,c]
circular(L,R):- circ(L,L,R).
circ(_,[],_).
circ([H|T],[_|Rest],R):- append(T,[H],R),write(R),nl,circ(R,Rest,R1).
Take the list [a,b,c,d] and put the first element at the end.
Do the same with the resulting list R (R=[b,c,d,a])
When do we know how to stop?
We introduce another variable which we initiliaze by [a,b,c,d].
Each time we obtain a new list we take one element from it.
We stop when this list is [].
EXAMPLE 57
remove_sign(X,Y):- X>=0, Y is X; X<0, Y is -X.
both_signs(X,Y) :- Y is X; Y is -X.
absolution(X,Y) :- both_signs(X,Y), Y >= 0.
EXAMPLE 58
% Generate a random story from productions of form Nonterminal=>Expression
:-op(600, xfy, =>).
story([]).
story(A * B):- story(A), story(B).
story(A + B):-makelist(A + B, L),
length(L, M),
P is random( M)+1,!,
nth1(P, L, X),
story(X).
story(A):- A => B, !, story(B).
story(A):-atomic(A), write(A), nl.
makelist(A + B, [A|C]):-makelist(B,C).
makelist(A, [A]).
go:-story(start), write('-------------the end--------------'), nl.
:- write('Enter go. to be told stories.'), nl.
start=>'Earth'*(catestrophe + science + attack + collision).
catestrophe=>(('burns up' + 'freezes' + 'falls into the sun')
*'and'
*possible_megadeath
).
collision=>('is struck by a giant'
*('comet' + 'asteroid' + 'cloud')
*('but is saved.' + 'and is destroyed.' + saved
)
).
possible_megadeath=>('everybody dies.' + ('some people'+ 'everybody' + 'almost everbody')*('dies.'+rescued+saved)).
rescued=>('is rescued by'*sizes*extraterestrial*beings).
saved=>('but is saved by'*('earth'+extraterestrial)* 'scientists.'* 'The'*science).
science=>('scientists'*('invent' + 'discover')*sizes*beings*whichetc).
attack=>('is attacked by'*sizes*extraterestrial*beings*whichetc).
sizes=>('tiny' + 'giant' + 'enormous').
extraterestrial=>('Martian' + 'Lunar' + 'ExtraGalactic').
beings=>('bugs' + 'reptiles' + 'blobs' + 'superbeings').
whichetc=>
('who'
*(wantwomen +
('are friendly'
*('.' +
('and'*(denoument + happyending)
)
) + (
('are friendly'*'but misunderstood' +
'misunderstand us' +
'understand us all too well' +
hungry
)
*butetc
) +
(hungry * ('and eat us.'+denoument)
)
)
)
).
hungry=> 'look upon us as a source of nourishment'.
wantwomen=>'want our women, and take a few and leave'.
butetc=>('and are' + 'and are not')*'radioactive'*'and'*try_to_kill.
killers=>(killer + killer*'and'*killer ).
killer=>('a crowd of peasants'
+ 'the Army'
+ 'the Navy'
+ 'the Air Force'
+ 'the Marines'
+ 'the Coast Guard'
+ 'the Atom Bomb'
).
try_to_kill=>(('can be killed by'*killers*'.') +
('can not be killed by'*killers*soetc)).
soetc=>('but they die from catching a cold.' +
'so they kill us.' +
'so they put us under a benign dictatorship.' +
'so they eat us.' +
('so scientists invent a weapon'
*('which turns them into disgusting lumps' +
'which kills them' +
'which fails,'*soetc)
) +
('But'*denoument)
).
denoument=>(('a cute little kid convinces them people are OK.' *ending) +
('a priest talks to them of God,'*ending) +
('they fall in love with this beautiful girl'
*(ending + happyending)
)
).
ending=>('and they die.' +
'and they leave.' +
'and they turn into disgusting lumps.'
).
happyending=>'and they get married and live happily forever after'.
grammar:-Nonterminal=>Expansion, write(Nonterminal),
write(' ---> '), nl, write(' '), write(Expansion), nl, nl,
fail.
:- write('Enter grammar. to list the rules generating the stories.'), nl.
EXAMPLE 59
% The Famous Barber's paradox
% In a certain village, there is a barber who shaves
% those residents who do not shave themselves,
% and all residents who don't shave themselves
% are shaved by the barber.
:-op(600, xfx, shaves).
resident(X):-(X=jim ; X=john ; X=barber).
shaving(X):-
barber shaves X ; X shaves X.
barber shaves X:-!,resident(X), X\=barber, print(X), write(' can be shaved by the barber'), nl.
X shaves X:-!, resident(X), X\=barber, print(X), write(' can shave himself'), nl.
X shaves Y:-print(X), write(' shaves '), print(Y), write('............NOT!'), nl, fail.
go:-resident(X),shaving(X),fail.
paradox:-trace, resident(Who), Who shaves barber.
EXAMPLE 60
% An experiment - Prolog is good at searching, how about a binary search?
:-style_check(-singleton).
% Binary search....
% Given: a monotonic increasing function f on a
% finite set of integers lo..hi,
% and a value y in f(lo)..f(hi)
% Goal: Find an x in lo..hi such that f(x)<=y<f(x+1).
%
% Operations: Arithmetic on lo..hi
% Note. in Prolog we think of f as a relation f(x,y) defined like
% the following example.
f(X,Y):- Y is X*X.
bsearch(X,Lo,Hi,Y):-Hi=:=Lo+1, X is Lo.
bsearch(X,Lo,Hi,Y):-Hi < Lo+1, fail.
bsearch(X,Lo,Hi,Y):-Hi>= Lo+1, Mid is (Lo+Hi)//2,
f(Mid, Val),
( Val=<Y, bsearch(X,Mid,Hi,Y)
; Val>Y, bsearch(X,Lo,Mid,Y)
).
go:-bsearch(X,1,100,49), nl,nl,print(X),nl.
EXAMPLE 61
% Problem: to generate all possible pairs of natural numbers in turn
% The typical nested for loop structure
% int(I)...., int(J).....,fail
% generates I=1 and all the J's, without getting to I=2.
% Cantor is a famous developer of set theory who specialized in infinities
% 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).
int(1).
int(I):-int(J), I=J+1.
cantor(I,J):- int(N), N1 is N-1,for(I,1,N1), J is N-I.
go(Fraction):-cantor(I,J), Fraction= I/J .
:-print('test with go(Fraction). '),nl.
EXAMPLE 62
:-style_check(-singleton).
% 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.
% This is based on a sample GRE question 1991-1992. CS489 Fall92
% cobegin x:=1; y:=y+x; and y:=2; x:=x+3; end cobegin.
% Solving this problem involves defining the semantics and
% and syntax of assignments, sequences, and cobegin.
go:-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),print_status,
nl,nl,fail.
go.
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), store(X,EV).
store(X,EV):-remove_old(X), assert(ram(X,EV)),!.
remove_old(X):- (ram(X,Old), retract(ram(X,Old)); true),!.
:-print('shuffle, obey and go loaded').
EXAMPLE 63
% Scholten's coffee can problem
% In Scholten's house there are white and black coffee beans:
bean(white). bean(black).
% There is a can of mixed beans
can([]).
can([Bean|Can]):- can(Can), bean(Bean).
% In the morning, when bored he repeatedly does the following
% He takes out two beans X and Y from the can.
% If this is not possible he stops.
% If they are the same he puts a black beean back in the can.
% If they are different he puts a white bean back in the can.
move([X,X|M], [black|M]).
move([X,Y|M], [white|M]):-X\=Y.
% What can be predicted about this game.
moves(X,X).
moves(X,Y):-move(X,Z), moves(Z,Y).
game(Final_can):-can(Initial_can), moves(Initial_can,Final_can), write(initial_can(Initial_can)), nl.
:-print('game, moves, move, can and bean loaded!'),nl,nl.
EXAMPLE 64
% Elementary Data
%First some convenient Abreviations/overloadings
% op(900, fx, not).
element:-write('element(Name, Symbol, Atomic_Number,Radioactive, Class, Normal_state, Melting_point, Boiling_point)').
element(Name):-element(Name, _,_,_,_,_,_,_).
element(Name, Symbol):-element(Name, Symbol,_,_,_,_,_,_).
element(Name, Symbol, Number):-element(Name, Symbol,Number,_,_,_,_,_).
% element(Name, Symbol, Atomic_Number, Radioactive, Class, Normal_state, Melting_point, Boiling_point)
element(actinium, 'Ac', 89, radioactive, metal, solid, 1050, 3200).
element(aluminum, 'Al', 13, not_radioactive, metal, solid, 660, 2467).
element(americum, 'Am', 95, radioactive, metal, solid, 994, 2607).
element(antinomy, 'Sb', 51, not_radioactive, metal, solid, 631, 1750).
element(argon, 'Ar', 18, not_radioactive, noble,gas, -189, -186).
element(arsenic, 'As', 33, not_radioactive, nonmetal, solid, 817, 613).
element(astatine, 'At', 85, radioactive, halogen, solid, 302, 337).
element(barium, 'Ba', 56, not_radioactive, alkali_earth, solid, 725, 1640).
element(berylium, 'Be', 4, not_radioactive, alkaline_earth, solid, 1278, 2970).
element(bismuth, 'Bi', 83, not_radioactive, metal, solid, 271, 1560).
element(boron, 'B', 5, not_radioactive, nonmetal, solid, 2079, 2550).
element(cadmium, 'Cd', 48, not_radioactive, metal, solid, 321, 765).
element(bromine, 'Br', 35, not_radioactive, halogen, liquid, -7, 59).
element(calcium, 'Ca', 20, not_radioactive, alkali_earth,solid, 839, 1484).
element(carbon, 'C', 6, not_radioactive, nonmetal, solid, 3550, 4827).
element(cerium, 'Ce', 58, not_radioactive, rare_earth, solid, 798, 3246).
element(cesium, 'Cs', 55, not_radioactive, metal, solid, 28,669).
element(chlorine, 'Cl', 17, not_radioactive, halogen,gas, -101, -35).
element(chromium, 'Cr', 24, not_radioactive,metal, solid,1857, 2672).
element(cobalt, 'Co', 27, not_radioactive,metal, solid, 1495, 2870).
element(copper, 'Cu', 29, not_radioactive, metal, solid, 1083, 2567).
element(dysprosium, 'Dy', 99, not_radioactive, rare_earth, solid, 1412, 2567).
element(erbium, 'Re', 68, not_radioactive,rare_earth,solid, 1529, 2868).
element(europium, 'Eu', 63, not_radioactive,rare_earth, solid, 822, 1597).
element(flourine, 'F', 9, not_radioactive,halogen,gas, -220, -188).
element(francium, 'Fr', 87, radioctive, metal,solid, 27, 677).
element(gadolinium, 'Gd', 87,not_radioactive, rare_earth, solid, 1313, 3273).
element(gallium, 'Ga', 31,not_radioactive, metal, solid,30, 2403).
element(germanium, 'Ge', 32,not_radioactive, metal, solid, 937, 2830).
element(gold, 'Au', 79, not_radioactive, metal,solid, 1064, 2808).
element(hafnium, 'Hf', 72, not_radioactive, metal, solid, 2227, 4602).
element(helium, 'He', 2, not_radioactive, noble,gas, -272, -269).
element(holmium, 'Ho', 67,not_radioactive, rare_earth,solid, 1470, 2720).
element(hydrogen, 'H', 1, not_radioactive, non_metal, gas, -259, -252).
element(indium, 'In', 49, not_radioactive, metal, solid, 157, 2080).
element(iodine, 'I', 53, not_radioactive, halogen, solid, 113, 184).
element(iridium, 'Ir', 77, not_radioactive, metal, solid, 157, 2080).
element(iron, 'Fe', 26, not_radioactive, metal, solid, 1535, 2750).
element(krypton, 'Kr', 36, not_radioactive, noble,gas, -157, -152).
element(lanthanum, 'La', 57, not_radioactive, rare_earth, solid, 918, 3464).
element(lead, 'Pb', 82, not_radioactive, metal, solid, 327, 1740).
element(lithium, 'Li', 3, not_radioactive, metal, solid, 180, 1342).
element(lutetium, 'Lu', 71, nonradioactive, rare_earth, solid, 1633, 3402).
element(magnesium, 'Mg', 12, not_radioactive, alkali_earth, solid, 649, 1090).
element(manganese, 'Mn', 25, not_radioactive, metal, solid, 1244, 1962).
element(mercury, 'Hg', 80, not_radioactive, metal, liquid, -39, 356).
element(molybdenum, 'Mo', 42, not_radioactive, metal, solid, 2617, 4612).
element(neodynium, 'Nd', 60, not_radioactive, rare_earth,solid, 1021, 3074).
element(neon, 'Ne', 10, not_radioactive, noble, gas, -249, -246).
element(neptunium, 'Np', 93, radioactive, metal, solid, 640, 3902).
element(nickel, 'Ni', 28, not_radioactive, metal, solid, 1453, 2732).
element(niobium, 'Nb', 41, not_radioactive, metal, solid, 2468, 4742).
element(nitrogen, 'N', 7,not_radioactive, nonmetal , gas, -210, -196).
element(osmium, 'Os', 76, not_radioactive, metal, solid, 3045, 5027).
element(oxygen, 'O', 8, not_radioactive, nonmetal, gas, -218, -183).
element(palladium, 'Pd', 46, not_radioactive, metal, solid, 1554, 3140).
element(phosphorus, 'P', 15, not_radioactive, nonmetal, solid, 44, 280).
element(platinum, 'Pt', 78, not_radioactive, metal, solid, 1772, 3827).
element(plutonium, 'Pu', 94, radioactive, metal, solid, 641, 3232).
element(polonium, 'Po', 84, radioactive, metal, solid, 254, 962).
element(potasium, 'K', 19, not_radioactive, alkali, solid, 63, 760).
element(praesydium, 'Pr', 59, not_radioactive, rare_earth, solid, 3520, 3212).
element(promethium, 'Pm', 61, radioactive,rare_earth, solid, 1042, 3000).
element(radium, 'Ra', 88, radioactive, alkali_earth, solid, 700, 1140).
element(radon, 'Rn', 86, radioactive,noble,gas, -71, -62).
element(rhenium, 'Re', 75, not_radioactive, metal, solid, 3180, 5627).
element(rhodium, 'Rh', 45, not_radioactive, metal, solid, 1966, 3272).
element(rubidium, 'Rb', 37, not_radioactive, metal, solid, 39, 686).
element(ruthenium, 'Ru', 44, not_radioactive, metal, solid, 2310, 3900).
element(samarium, 'Sm', 62, not_radioactive, rare_earth, solid, 1074, 1794).
element(scandium, 'Sc', 21, not_radioactive, metal, solid, 1541, 2831).
element(selenium, 'Se', 34, not_radioactive, non_metal, solid, 217, 685).
element(silicon , 'Si', 14, not_radioactive, non_metal, solid, 1410, 2355).
element(silver, 'Ag', 47, not_radioactive, metal, solid, 962, 2212).
element(sodium, 'Na', 11, not_radioactive, alkali, solid, 98, 883).
element(strontium, 'Sr', 38, not_radioactive, alkali_earth, solid, 769, 1384).
element(sulfur, 'S', 16, not_radioactive, nonmetal, solid, 113, 445).
element(tantalum, 'Ta', 73, not_radioactive, metal, solid, 2996, 5425).
element(technetium, 'Tc', 43, radioactive, metal, solid, 2172, 4877).
element(telurium, 'Te', 52, not_radioactive, metal, solid, 449, 990).
element(terbium, 'Tb', 65, not_radioactive, rare_earth, solid, 1356, 3230).
element(thalium, 'Tl', 81, not_radioactive, metal, solid, 303, 1457).
element(thorium, 'Th', 90, radioactive, metal, solid, 1750, 4790).
element(thulium, 'Tm', 69, not_radioactive, rare_earth, solid, 1545, 1950).
element(tin, 'Sn', 50, not_radioactive, metal, solid, 232, 2270).
element(titanium, 'Ti', 22, not_radioactive, metal, solid, 1660, 3267).
element(tungsten, 'W', 74, not_radioactive, metal, solid, 3410, 5660).
element(uranium, 'U', 92, radioactive, metal, solid, 1132, 3818).
element(vanadium, 'V', 23, not_radioactive, metal, solid, 1890, 3380).
element(xenon, 'Xe', 54, not_radioactive, noble, gas, -112, -107).
element(ytterbium, 'Yb', 70, not_radioactive, rare_earth, solid, 819, 1196).
element(ytrium, 'Y', 39, not_radioactive, rare_earth, solid, 1552, 3338).
element(zink, 'Zn', 30, not_radioactive, metal, solid, 420, 907).
element(zirconium, 'Zr', 40, not_radioactive, metal, solid, 1852, 4377).
metalic(metal).
metalic(alkali).
metalic(alkali_earth).
nonmetalic(rare_earth).
nonmetalic(non_metal).
nonmetalic(halogen).
non_metalic(noble).
% ingroup( AN, Gp) is true if element with atomic number is AN is in period Gp
ingroup(AN, 'O'):-member(AN, [2, 10, 18, 36, 54, 86]).
ingroup(AN,'IA'):-member(AN, [1,3,11,19,37,55,87]).
ingroup(AN, 'IIA'):-member(AN, [4, 12, 20, 38, 56, 88]).
ingroup(AN, 'IIIB'):- (AN>56, AN<72);(AN>88,AN<103);AN=21;AN=39.
ingroup(AN, 'IVB'):-member(AN, [22,40,72,104]).
ingroup(AN, 'VB'):-member(AN, [23,41,73,105]).
ingroup(AN, 'VIB'):-AN=24;AN=42;AN=74.
ingroup(AN, 'VIIB'):-AN=25;AN=43;AN=75.
ingroup(AN, 'VIIB'):-AN=26;AN=44;AN=76.
ingroup(AN, 'VIII'):-AN=27;AN=45;AN=77.
ingroup(AN, 'VIII'):-AN=28;AN=46;AN=78.
ingroup(AN, 'IB'):-AN=29;AN=47; AN=79.
ingroup(AN, 'IIB'):-AN=30; AN=48; AN=80.
ingroup(AN, 'IIIA'):-member(AN, [5,13,31,49,81]).
ingroup(AN, 'IVA'):-member(AN, [6,14,32,50,82]).
ingroup(AN, 'VA'):-member(AN,[7,15,33,51,83]).
ingroup(AN, 'VIA'):-member(AN, [8,16,34,52,84]).
ingroup(AN, 'VIIA'):-member(AN, [9,17,35,53,85]).
% isgroup(G) is true if G is a group in the periodic table.
isgroup( 'O').
isgroup( 'IA').
isgroup( 'IB').
isgroup( 'IIA').
isgroup( 'IIB').
isgroup( 'IIIA').
isgroup( 'IIIB').
isgroup( 'IVA').
isgroup( 'IVB').
isgroup( 'VA').
isgroup( 'VB').
isgroup( 'VIA').
isgroup( 'VIB').
isgroup( 'VIIA').
isgroup( 'VIIB').
isgroup( 'VIII').
% group(AN) - prints group name of element with Atomic Number AN.
group(AN):-ingroup(AN, Group), write(group=Group), nl.
% inperiod( AN, PN) is true if element with atomic number is AN is in period PN
inperiod(AN,1):-AN=1;AN=2.
inperiod(AN,2):-inrange(AN, 3, 10).
inperiod(AN,3):-inrange(AN, 11, 18).
inperiod(AN,4):-inrange(AN, 19, 36).
inperiod(AN,5):-inrange(AN, 37, 54).
inperiod(AN,6):-inrange(AN, 55, 86).
inperiod(AN,7):-inrange(AN, 87, 109).
% period(AN) - print period of element AN
period(AN):-inperiod(AN,Period), write(period = Period), nl.
% because I mistype =< as <=
inrange(AN, Lo, Hi):- AN>=Lo, AN=<Hi.
print_element(Name):-element(Name, Symbol, Atomic_Number, Rad, Class,Normally,Melts_at, Boils_at),
write(symbol=Symbol), nl,
write(atomic_number=Atomic_Number), nl,
write(Rad), nl, write(Class), nl,
write(normally=Normally), nl,
write(melts_at=Melts_at), nl,
write(boils_at=Boils_at), nl,
inperiod(Atomic_Number, Period), ingroup(Atomic_Number, Group),
write(period = Period), nl, write(group=Group).
print_periodic_table:-isgroup(G), nl, write(G), nl, write(': '),
element(_,Symb,An),
ingroup(An,G),
write(Symb), write(' '),
fail.
EXAMPLE 65
% Computer science.
% Discalimer.... out of date, and doesn't quite work... Please fix
note('class(identifier, name, units)').
class(cs201, 'Computer Science I', 4).
class(cs202, 'Computer Science II', 4).
class(cs260, 'Machine Architecture', 4).
class(cs310, 'Computer Systems Organisation I', 5).
class(cs311, 'Computer Systems Organisation II', 5).
class(cs330, 'Data Structures', 4).
class(cs320, 'Programming Languages', 4).
class(cs331, 'Algorithm Analysis', 4).
class(cs320, 'Programming Languages', 4).
class(cs350, 'File Systems', 4).
class(cs455, 'Software Engineering', 4).
class(cs460, 'Operating Systems', 4).
class(cs488, 'Ethics and the Computing Professional', 2).
class(cs489, 'Senior Seminar', 2).
class(cs410, 'Advanced Computer Architecture', 5).
class(cs430, 'Data Communications and Networks', 4).
class(cs480, 'Data base Systems', 4).
class(cs411, 'Artificial Intelligence', 4).
class(cs420, 'Computer Graphics', 4).
class(cs511, 'Expert Systems', 4).
class(cs540, 'System Simulation', 4).
class(cs520, 'Advanced Computer Graphics', 4).
class(cs575, 'Internship', 5).
class(cs580, 'Advanced Data Base Systems', 4).
class(cs595, 'Independent Study', Units):-member(Units, [1,2,3,4,5,6]).
class(m211, 'Basic Concepts of Calculus', 4).
class(m212, 'Calculus II', 4).
class(m213, 'Calculus III', 4).
class(m251, 'Multivariable Calculus', 4).
class(m272, 'Discrete Mathematics', 4).
class(m331, 'Linear Algebra', 4).
class(m372, 'Combinatorics', 4).
class(p221, 'General Physics I', 5).
class(p222, 'General Physics II', 5).
class(p223, 'General Physics III', 5).
class(b100, 'Topics from Biology', 5).
class(b200, 'Biology of the Cell', 5).
class(scNNN, 'A different science class with a lab', 5).
class(X):-class(X,_,_).
note('prereq(pre-reqisite,required_for)').
prereq('Some programming and satisfactory ELM score', cs201).
prereq(cs201, cs202).
prereq(cs202, cs260).
prereq(cs260, cs310).
prereq(m272, cs310).
prereq(p222, cs310).
prereq(cs310, cs311).
prereq(cs202, cs320).
prereq(cs202, cs330).
prereq(m272, cs330).
prereq(cs330, cs331).
prereq(m272, cs331).
prereq(m372, cs331).
prereq(cs330, cs350).
prereq(cs311,cs410).
prereq(cs330,cs411).
prereq(cs330,cs420).
prereq(cs260,cs430).
prereq(cs310,cs430).
prereq(cs330,cs430).
prereq(cs330, cs455).
prereq(cs330, cs460).
prereq(cs460, cs465).
prereq(cs260, cs470).
prereq(cs320, cs470).
prereq(cs330, cs470).
prereq(cs350, cs480).
prereq('Senior standing', cs488).
prereq('Senior standing', cs489).
prereq(cs331, cs500).
prereq(cs331, cs505).
class(cs505, 'Introduction to Theory of Computation', 4).
prereq(cs330, cs511).
prereq(cs331, cs515).
class(cs515, 'Automated Reasoning', 4).
prereq(cs420, cs520).
prereq(cs330, cs540).
prereq(cs480, cs580).
prereq('Satisfactory ELM score', m211).
prereq(m211, m212).
prereq(m212, m213).
prereq(m212, m251).
prereq('Satisfactory ELM score', m272).
prereq(m213, m372).
prereq(m211, p221).
prereq(p221, p222).
prereq(p222, p223).
elective1([cs410, cs430, cs480]).
elective2([cs411, cs420, cs511, cs540]).
elective3([cs450, cs470, cs500]).
required([cs201,cs202,cs260,cs310,cs311,cs320,cs330,cs350,cs455,cs460,cs488,cs489]).
required(X):-required(Y),!,member(X,Y).
units([], 0).
units([Class|More], Total) :-
class(Class, _, Units),
units(More, TotalOfMore),
Total is TotalOfMore + Units.
units(Class, T):-class(Class, _, T).
units(X):-units(X,T),write('Total='), write(T), nl.
before(X, Y) :- prereq(X, Y).
before(X, Y) :-
prereq(X, Z),
before(Z, Y).
check_order([]).
check_order([Class]):-class(Class).
check_order([Class1, Class2|Rest]):-
before(Class1, Class2),
check_order([Class2|Rest]).
sequence(X, U):-check_order(X), units(X,U).
:-nl.
:-nl.
:-print('prereq, class, units, before, check_order, sequence, elective are loaded').
:-print(' What does this query do: sequence(P, 8)? How about sequence(P,6)?').
:-nl.
:-nl.
program([],0).
program([X],U):-class(X, _ , U).
program([X|Y],U):-class(X, _ , UX), UY is U-UX,program(Y,UY), notafter(X,Y), prepared([X],Y).
prepared(_,[]).
prepared(X,[Y|Z]):-prereqs(X,[Y|Z]), prepared([Y|X],Z).
prereqs(X,[Y|_]):-prereq(P,Y),nonmember(P,X),write('Needs '),write(P),write(' for '), write(Y), nl, false.
prereqs(_,[_|_]).
nonmember(_,[]).
nonmember(P,[Y|Z]):-P\==Y, nonmember(P,Z).
notafter(_, []).
notafter(Class, [First|Rest]):-Class\==First, not prereq(First, Class), notafter(Class,Rest).
preceeds(_, []).
preceeds(Class, [First|Rest]):-before(Class, First), preceeds(Class,Rest).
EXAMPLE 66
% Ice Cream Cones
scoop(vanilla). scoop(strawberry). scoop(chocolate).
cone(Top,Middle,Bottom):-scoop(Top), scoop(Middle), scoop(Bottom).
go:- setof(X+Y+Z, cone(X,Y,Z), List), length(List, N), write(N).
go2:- cone(X,Y,Z), write(X+Y+Z), nl, fail.
go3:- setof(X+Y+Z, (cone(X,Y,Z), X\=Y, Y\=Z, X\=Z), List), length(List, N), write(N),nl.
EXAMPLE 67
:-style_check(-singleton).
:-dynamic(cones/1).
% ice-cream cones.
scoop(vanilla). scoop(strawberry). scoop(chocolate).
cone(A,B,C):-scoop(A), scoop(B), scoop(C).
cones(0).
count:-retract(cones(X)), Y is X+1, assert(cones(Y)).
go:-cone(X,Y,Z), count,fail; cones(Number), write(number_cones(Number)).
EXAMPLE 68
% A sample crytarithm problem from Schnupp and Barnard pp94-95
% 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).
_ 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.
digit(0). digit(1). digit(2). digit(3). digit(4). digit(5). digit(6).
digit(7). digit(8). digit(9).
carry(0). carry(1).
go:-send_more_money([S,E,N,D,M,O,R,Y]),result([S,E,N,D,M,O,R,Y]).
result([S,E,N,D,M,O,R,Y]):-
nl,write(' S E N D'),tab(5), out([' ', S, E, N, D]),
nl,write(' M O R E'), tab(5), out([' ', M, O, R, E]),
nl,write('---------'), tab(5), write(--------------),
nl,write('M O N E Y'), tab(5), out([M, O, N, E, Y]),
nl.
out([]).
out([C|Rest]):-write(C), write(' '), out(Rest).
send_more_money(DigitList):-
DigitList=[S,E,N,D,M,O,R,Y],
M=1, % because M is carry into most significant
digit(S), S\=0, % because S is most significant digit
column(1,0,0,C2,M,0,DigitList), %Cn are the carries
column(2,S,M,C3,O,C2,DigitList),
column(3,E,O,C4,N,C3,DigitList),
column(4,N,R,C4,E,C5,DigitList),
column(5,D,E, 0,Y,C5,DigitList).
column(Col,DigitInLine1, DigitInLine2, Carry, DigitInLine3, NewCarry, DigitList):-
carry(Carry), %try 0 and 1 in turn
try_digit(Col,1, DigitInLine1,DigitList),
try_digit(Col,2, DigitInLine2,DigitList),
Sum is DigitInLine1+DigitInLine2+Carry,
NewCarry is Sum // 10,
X3 is Sum - (10*NewCarry),
(var(DigitInLine3), X3 not_in DigitList
; nonvar(DigitInLine3)
),
DigitInLine3=X3.
try_digit(Column,Line,Digit,DigitList):- nonvar(Digit),!.
% cuts added to reduce trail
% Column and Line are for tracing
try_digit(Column,Line,Digit,DigitList):-
var(Digit),!, digit(X1), X1 not_in DigitList, Digit=X1.
:- write(''), nl.
:- write(''), nl.
:- write('The puzzle SEND+MORE=MONEY has been loaded'), nl.
:- write('To solve it try go. ...'), nl.
EXAMPLE 69
% Factorial in prolog
f(1,1).
f(N,_):-N=<0,fail.
f(N,F):-N>1, write(N), write('! = ?'), nl,
N1 is N-1, write(' N1='), write(N1), nl,
f(N1,F1),
write(' F is '), write(F1), write(' * '), write(N), nl,
F is F1 * N,
write(N),write('! = '), write(F), nl.
EXAMPLE 70
% Factorial in prolog
% This one remembers its values, ready for the next call...
:-dynamic(f/2).
f(1,1):-!.
f(N,_):-N=<0,!,fail.
f(N,F):-N1 is N-1,
f(N1,F1),
F is F1 * N,
print(N),write('!='), print(F), nl,
Fact=.. [ :-, f(N,F),! ],
asserta(Fact).
EXAMPLE 71
% The collatz sequence
even(N):- 0 is N mod 2.
step(N,M) :- even(N), !, M is N / 2 ; !, M is 3 * N +1.
hailstone(1):-writeln(1), !.
hailstone(N):- writeln(N), !, step(N,M), hailstone(M).
EXAMPLE 72
% Example based on Page 85 (Section 2.13.2) of Sebesta
mother(joanne, jake).
father(vern, joanne).
grandparent(X, Z):-parent(X, Y), parent(Y, Z).
% the following definition of parent was not on page 84
parent(X,Y):-father(X,Y); mother(X,Y).
% commands excuted before run starts:
:- nl,nl,print('Examples to try'),nl.
:- print(' father(bob, darcie).'),nl.
:- print(' grandparent(vern, jake).'),nl,nl.
EXAMPLE 72
% More advanced predicates for handling family relationships.
% This includes predicates that are used as commands to assert
% family relationships that record births and marriages.
% This predicate is changes parent, male, and female: birth(Mother, Father, Child, Gender).
% This predicate is changes parent: marry(Mother, Father).
:-dynamic(parent/2).
:-dynamic(male/1).
:-dynamic(female/1).
:-style_check(-singleton).
father(X,Y):-parent(X,Y), male(X).
mother(X,Y):-parent(X,Y),female(X).
sister(X,Y):-parent(Z,X),parent(Z,Y),female(X),X\=Y.
brother(X,Y):-parent(Z,X),parent(Z,Y),male(X),X\=Y.
sibling(X,Y):-sister(X,Y).
sibling(X,Y):-brother(X,Y).
grandparent(X,Y):-parent(X,Z),parent(Z,Y).
grandfather(X,Y):-male(X),grandparent(X,Y).
grandmother(X,Y):-female(X),grandparent(X,Y).
grandchild(X,Y):-grandparent(Y,X).
child(X,Y):-parent(Y,X).
son(X,Y):-child(X,Y),male(X).
daughter(X,Y):-child(X,Y),female(X).
uncle(X,Y):-brother(X,P),parent(P,Y).
aunt(X,Y):-sister(X,P),parent(P,Y).
grandson(X,Y):-son(X,P),child(P,Y).
granddaughter(X,Y):-daughter(X,P),child(P).
% married(X,Y):-parent(X,Z), parent(Y,Z), X\=Y.
% married(X,Y):-married(Y, X), !.
wife(X,Y):-married(X,Y),female(X).
husband(X,Y):-married(X,Y),male(Y).
birth(Mother, Father, Child, son):-asserta(parent(Mother, Child)),
asserta(parent(Father, Child)),
asserta(male(Child)).
birth(Mother, Father, Child, daughter):-asserta(parent(Mother, Child)),
asserta(parent(Father, Child)),
asserta(female(Child)).
birth(Mother, Father, Child):-asserta(parent(Mother, Child)),
asserta(parent(Father, Child)).
adopt(Person, []).
adopt(Person, [Child|Rest]):-asserta(parent(Person, Child)),
adopt(Person, Rest).
marry(Man, Woman):-asserta(married(Woman, Man)),
findchildren(Man, Hiskids), adopt(Woman, Hiskids),
findchildren(Woman,Herkids), adopt(Man, Herkids).
findchildren(Person, Children):-findall(X,parent(Person,X),Children).
go:-write('Input a fact with a period(input ok at end): '),
read(Term),
( Term=ok , !;
assert(Term),
Term=..[Functor|_], listing(Functor),
go
).
EXAMPLE 73
% Predicates for handling family relations ships.
% male, female, parent are taken as fundamental
father(X,Y):-parent(X,Y), male(X).
mother(X,Y):-parent(X,Y),female(X).
sister(X,Y):-parent(Z,X),parent(Z,Y),female(X),X\=Y.
brother(X,Y):-parent(Z,X),parent(Z,Y),male(X),X\=Y.
sibling(X,Y):-sister(X,Y).
sibling(X,Y):-brother(X,Y).
grandparent(X,Y):-parent(X,Z),parent(Z,Y).
grandfather(X,Y):-male(X),grandparent(X,Y).
grandmother(X,Y):-female(X),grandparent(X,Y).
grandchild(X,Y):-grandparent(Y,X).
child(X,Y):-parent(Y,X).
son(X,Y):-child(X,Y),male(X).
daughter(X,Y):-child(X,Y),female(X).
uncle(X,Y):-brother(X,P),parent(P,Y).
aunt(X,Y):-sister(X,P),parent(P,Y).
grandson(X,Y):-son(X,P),child(P,Y).
granddaughter(X,Y):-daughter(X,P),child(P).
EXAMPLE 74
q:-halt.
:-style_check(-singleton).
% I married a widow who had a grown-up daughter.
male(me). female(widow). female(daughter).
parent(widow,daughter).
married(me, widow).
% So I became the stepfather of her daughter.
parent(me,daughter).
% Some months later, my wife gave birth to a son.
parent(widow, son).
parent(me, son). male(son).
% My father, who visited us halte often, fell in love with my step-daughter,
% and married her.
male(father). parent(father, me).
% Hence, my father became my son-in-law, and my stepdaughter became my mother.
parent(daughter, me). parent(me, father).
% The wife of my father, that is my step-daughter, also had a son.
parent(daughter, anotherson). parent(father, anotherson). male(anotherson).
% My son became became my brother-in-law.
% of my father as well as my uncle.
% and I got a brother and at the same time a grandson.
:-consult('family.plg').
% My wife is my grandmother,
% since she is my mother's mother.
% Hence, I am my wife's husband and at the same time her step-grandson;
% in other words, I am my own grandfather.
:-nl,write('Try grandfather(me, me)'),nl.
EXAMPLE 75
:-style_check(-singleton).
:-consult('family2.plg').
% I married a widow who had a grown-up daughter.
male(me). female(widow). female(daughter).
parent(widow,daughter).
:-marry(me, widow).
% So I became the stepfather of her daughter.
% Some months later, my wife gave birth to a son.
:-birth(widow, me, son, son).
% My father, who visited us quite often, fell in love with my step-daughter,
% and married her.
male(father). parent(father, me).
:-marry(father, daughter).
% Hence, my father became my son-in-law, and my stepdaughter became my mother.
% The wife of my father, that is my step-daughter, also had a son.
:-birth(daughter, father, anotherson, son).
% My son became became my brother-in-law.
% of my father as well as my uncle.
% and I got a brother and at the same time a grandson.
% My wife is my grandmother,
% since she is my mother's mother.
% Hence, I am my wife's husband and at the same time her step-grandson;
% in other words, I am my own grandfather.
:-nl,write('grandfather(me, me).'),nl.
EXAMPLE 76
% experimental functional programming feature... Use 'es' for 'is'...
%
% as a side effect 'S es T' will unify S with the result of evaluating parts of T
%
% Declare functions and macros using 'function(f(X), Expr):-condition'
:-op(700, xfx, es).
:-op(700, xfx, are).
% are is a special case for vectors:
[] are [].
[X|R] are [Y|S] :-!, X es Y, R are S.
% The following are commented out until tested.
% X es Y:-macro(Y,E), !, X=E.
% X es Y:-macro(Y,E), !, X es E.
% the next 7 definitions are intended to make sure that 'es' contains
% 'is' as a special case.
% Can not evaluate an uninstantiated variable.
_ es Y:-var(Y),!, fail.
% If it is an atomic constant then copy it.
X es Y:-atomic(Y),function(Y,X),!.
X es X:-atomic(X),!.
X es +Y:-!,X es Y.
X es -Y:- !,MY es Y, X is -MY.
X es Y+Z:-!,VY es Y, VZ es Z, X is VY+VZ.
X es Y*Z:-!,VY es Y, VZ es Z, X is VY*VZ.
X es Y-Z:-!,VY es Y, VZ es Z, X is VY-VZ.
X es Y/Z:-!,VY es Y, VZ es Z, X is VY/VZ.
X es Y mod Z:-!,VY es Y, VZ es Z, X is VY mod VZ.
% The next two define the value of a vector as a vector of values
% and are needed to handle the general case
X es []:-!,X=[].
[X|RX] es [Y|RY]:-!,X es Y, RX es RY.
% This is the general case - Y = F(Args).
X es Y :-Y=..[F|Args],
ArgVals es Args,
FY=..[F|ArgVals],
function(FY,E),!,X es E.
% The next alternative leaves functors (undeclared functions) unevaluated.
% while evaluating any arguments that can be evaluated.
% X es Y :-Y=..[F|Args],
% write('Warning: '),write(F),write(' is an undefined function.'),nl,
% ArgVals es Args,
% X=..[F|ArgVals].
go:-prompt(_, 'Expression=? '), repeat, read(Term), Val es Term,
write(' Value='), write(Val), nl.
:-dynamic(function/2).
function:-write('Define a function by: assert(function(Form, Value)).'),nl,
write('or assert(function(Form, Expression):-ConditionsEtc).'),nl.
function(sq(X), X*X).
EXAMPLE 77
% experimental functional programming feature... Use 'es' for 'is'...
%
% as a side effect 'S es T' will unify S with the result of evaluating parts of T
%
% Declare functions and macros using 'function(f(X), Expr):-condition'
:-op(700, xfx, es).
:-op(700, xfx, are).
% are is a special case for vectors:
[] are [].
[X|R] are [Y|S] :-!, X es Y, R are S.
% The following are commented out until tested.
% X es Y:-macro(Y,E), !, X=E.
% X es Y:-macro(Y,E), !, X es E.
% Can not evaluate an uninstantiated variable.
X es Y:-var(Y),!, fail.
% If it is an atomic constant then copy it.
X es X:-atomic(X),!.
% X es +Y:-!,X es Y.
function(+X,X).
% X es -Y:- !,MY es Y, X is -MY.
function(-X,Y):- Y is -Y.
% X es Y+Z:-!,VY es Y, VZ es Z, X is VY+VZ.
% X es Y*Z:-!,VY es Y, VZ es Z, X is VY*VZ.
% X es Y-Z:-!,VY es Y, VZ es Z, X is VY-VZ.
% X es Y/Z:-!,VY es Y, VZ es Z, X is VY/VZ.
% X es Y mod Z:-!,VY es Y, VZ es Z, X is VY mod VZ.
% The next two define the value of a vector as a vector of values
% and vectors of vectors!
% They are needed to handle the general case
X es []:-!,X=[].
[X|RX] es [Y|RY]:-!,X es Y, RX es RY.
% This is the general case - Y = F(Args).
X es Y :-Y=..[F|Args],
ArgVals es Args,
FY=..[F|ArgVals],
(function(FY,E),!,X es E ; X = FY).
% The last alternative leaves functors (undeclared functions) unevaluated.
% while evaluating any arguments that can be evaluated.
:- write(''), nl.
:- write('X es Y loaded. Define functions like this: function(f(...), nl,e).').
doit:-prompt(_, 'Expression=? '), repeat, read(Term), Val es Term,
prin(' Value='), write(Val), nl.
:- write('Input 'doit?'... end each expression with a period.'), nl.
examples('function(sq(X), X*X).').
examples('function(factorial(0), 1).').
examples('function(factorial(N), N*factorial(N-1)).').
function:-print('Define a function by inputting 'function(Form, Value).''),
print('or 'function(Form, Expression):-ConditionsEtc.'').
EXAMPLE 78
% Generate lotto numbers
% -----------lotto(Number_of_Numbers, Largest_Number, Pick)-----------
lotto(0,_,[]).
lotto(Length,Largest,Pick):-
Length > 0, Length1 is Length - 1,
lotto(Length1, Largest, OldPick),
pick_one(Largest, OldPick, Pick).
% ----------------nonmember(Item, List)-----------
non_member(_, []).
non_member(E, [A|B]) :-
E \= A,
non_member(E, B).
% ------------------pick_one(Largest_Number, OldPick, OldPick_with_New_Digit)
pick_one(Largest, OldPick, [Random|OldPick]) :-
Random is random( Largest)+1,
non_member(Random, OldPick),
!.
% ---------sample(number_of_items_in_sample).
sample(0).
sample(N) :-
lotto(6, 49, P),
write(P), nl,
N1 is N - 1,
sample(N1).
% -----------repeatedly pick 6 numbers in range 1 to 49-------
pick:-repeat, lotto(6, 49, P), write(P).
pick(P):- repeat, lotto(6, 49, P).
:- write('sample(Number_wanted). pick(More). pick. are loaded'), nl.
:- write('M I S S I O N - I M P O S S I B L E'), nl.
:- write('----------------------------------------'), nl.
:-write('Your mission, if you choose to accept it, is to find out why'),nl.
:-write('this version self destructs, at random'),nl.
EXAMPLE 79
% Allow singleton vars:
:-style_check(-singleton).
% Allow numbers to be changed -- shuffled
:-dynamic(number/2).
% ------generate sample of N lottery picks
sample(N) :-
for(I, N),
pick,
fail.
sample(N).
% -------- The picked numbers are the first 6 numbers.
show_pick :-
for(I, 6),
number(I, P),
(P < 10 , write(' ') ; P >= 10 , write(' ')),
write(P),
fail.
show_pick :- nl,nl.
% --------number(I,J) stores a permutation of 1..50, See Botting 74.
number(33, 43).
number(26, 17).
number(40, 19).
number(48, 49).
number(24, 22).
number(9, 24).
number(25, 20).
number(17, 5).
number(41, 9).
number(16, 11).
number(7, 38).
number(22, 45).
number(12, 27).
number(20, 29).
number(29, 28).
number(38, 6).
number(11, 15).
number(47, 13).
number(18, 48).
number(37, 2).
number(46, 14).
number(14, 26).
number(28, 16).
number(49, 21).
number(34, 3).
number(19, 1).
number(13, 10).
number(50, 23).
number(21, 41).
number(32, 7).
number(30, 46).
number(44, 31).
number(39, 33).
number(35, 36).
number(8, 12).
number(36, 32).
number(42, 8).
number(15, 30).
number(1, 4).
number(27, 25).
number(2, 47).
number(45, 42).
number(3, 34).
number(43, 44).
number(4, 18).
number(10, 37).
number(5, 39).
number(31, 35).
number(6, 40).
number(23, 50).
% -------pick Californian ticket -------
pick :-
shuffle,
!,
sort,
!,
show_pick,
!.
% -------setup an initial datbase, in case it got corrupted.
setup :-
abolish(number,2),
for(I, 50),
assert(number(I, I)),
fail.
% ---- exchange to items in number
swap(I, J) :-
I=J,!.
swap(I,J):-
retract(number(I, A)),
retract(number(J, B)),
assert(number(I, B)),
assert(number(J, A)),
!.
% ---- prolog's for loop
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).
% How to shuffle the numbers
shuffle :-
for(I, 6),
shuffle(I),
fail.
shuffle :- true.
shuffle(I) :-
J is random( 50)+1,
swap(I, J),
!.
% How to sort the first 6 numbers
sort:-
for(I,5),K is 6-I,
pass(I,K),
fail.
sort:-true.
% I'th pass throught the 6 numbers in the sort.
% I is lint left in for debugging purposes
pass(I,K):- for(J,1,K),
J1 is J+1,
number(J,N),number(J1,N1),
order(J,N,J1,N1),
fail.
pass(I,K):-true.
% Put a pair of numbers into order
order(J,N,J1,N1):-
(N=<N1
; swap(J,J1)
),!.
:- write('To generate a pick: pick. To sample N: sample(N).'), nl.
EXAMPLE 80
% Find all 3 by 3 magic squares.
% 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, 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),
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).
Comments
Post a Comment