├── Chapter1 ├── program-1.1.prolog └── program-1.2.prolog ├── Chapter10 ├── program-10.1.prolog ├── program-10.2.prolog ├── program-10.3.prolog ├── program-10.4.prolog ├── program-10.5.prolog ├── program-10.6.prolog ├── program-10.7.prolog ├── program-10.8.prolog └── program-10.9.prolog ├── Chapter11 ├── program-11.1.prolog ├── program-11.10.prolog ├── program-11.11a.prolog ├── program-11.11b.prolog ├── program-11.2.prolog ├── program-11.3.prolog ├── program-11.4.prolog ├── program-11.5.prolog ├── program-11.6.prolog ├── program-11.7.prolog ├── program-11.8.prolog ├── program-11.9a.prolog └── program-11.9b.prolog ├── Chapter12 ├── program-12.1.prolog ├── program-12.2.prolog ├── program-12.3.prolog ├── program-12.4.prolog ├── program-12.5.prolog ├── program-12.6.prolog ├── program-12.7.prolog ├── program-12.8.prolog └── program-12.9.prolog ├── Chapter13 ├── program-13.1.prolog ├── program-13.2.prolog └── program-13.3.prolog ├── Chapter14 ├── program-14.1.prolog ├── program-14.10.prolog ├── program-14.11.prolog ├── program-14.12.prolog ├── program-14.13.prolog ├── program-14.14.prolog ├── program-14.15.prolog ├── program-14.16.prolog ├── program-14.17.prolog ├── program-14.2.prolog ├── program-14.3.prolog ├── program-14.4.prolog ├── program-14.5.prolog ├── program-14.6.prolog ├── program-14.7.prolog ├── program-14.8.prolog └── program-14.9.prolog ├── Chapter15 ├── program-15.1.prolog ├── program-15.10.prolog ├── program-15.11.prolog ├── program-15.12.prolog ├── program-15.2.prolog ├── program-15.3.prolog ├── program-15.4.prolog ├── program-15.5.prolog ├── program-15.6.prolog ├── program-15.7.prolog ├── program-15.8.prolog └── program-15.9.prolog ├── Chapter16 ├── program-16.1.prolog ├── program-16.2.prolog ├── program-16.3.prolog ├── program-16.4.prolog ├── program-16.5.prolog ├── program-16.6.prolog ├── program-16.7.prolog └── program-16.8.prolog ├── Chapter17 ├── program-17.1.prolog ├── program-17.10.prolog ├── program-17.11.prolog ├── program-17.12.prolog ├── program-17.13.prolog ├── program-17.14.prolog ├── program-17.15.prolog ├── program-17.16.prolog ├── program-17.17.prolog ├── program-17.18.prolog ├── program-17.19.prolog ├── program-17.2.prolog ├── program-17.20.prolog ├── program-17.21.prolog ├── program-17.22.prolog ├── program-17.23.prolog ├── program-17.3.prolog ├── program-17.4.prolog ├── program-17.5.prolog ├── program-17.6.prolog ├── program-17.7.prolog ├── program-17.8.prolog └── program-17.9.prolog ├── Chapter18 ├── program-18.1.prolog ├── program-18.2.prolog ├── program-18.3.prolog ├── program-18.4.prolog ├── program-18.5.prolog ├── program-18.6.prolog ├── program-18.7.prolog ├── program-18.8.prolog └── program-18.9.prolog ├── Chapter19 ├── program-19.1.prolog ├── program-19.2.prolog ├── program-19.3.prolog ├── program-19.4.prolog ├── program-19.5.prolog ├── program-19.6.prolog ├── program-19.7.prolog ├── program-19.8.prolog └── program-19.9.prolog ├── Chapter2 ├── program-2.1.prolog ├── program-2.2.prolog ├── program-2.3.prolog ├── program-2.4.prolog ├── program-2.5.prolog ├── program-2.6.prolog └── program-2.7.prolog ├── Chapter20 ├── program-20.1.prolog ├── program-20.10.prolog ├── program-20.11.prolog ├── program-20.2.prolog ├── program-20.3.prolog ├── program-20.4.prolog ├── program-20.5.prolog ├── program-20.6.prolog ├── program-20.7.prolog ├── program-20.8.prolog └── program-20.9.prolog ├── Chapter21 ├── program-21.1.prolog ├── program-21.2.prolog └── program-21.3.prolog ├── Chapter22 ├── program-22.1.prolog └── program-22.2.prolog ├── Chapter23 ├── program-23.1.prolog └── program-23.2.prolog ├── Chapter24 ├── program-24.1.prolog └── program-24.2.prolog ├── Chapter3 ├── program-3.1.prolog ├── program-3.10.prolog ├── program-3.11.prolog ├── program-3.12.prolog ├── program-3.13.prolog ├── program-3.14.prolog ├── program-3.15.prolog ├── program-3.16.prolog ├── program-3.17.prolog ├── program-3.18.prolog ├── program-3.19.prolog ├── program-3.2.prolog ├── program-3.20.prolog ├── program-3.21.prolog ├── program-3.22.prolog ├── program-3.23.prolog ├── program-3.24.prolog ├── program-3.25.prolog ├── program-3.26.prolog ├── program-3.27.prolog ├── program-3.28.prolog ├── program-3.29.prolog ├── program-3.3.prolog ├── program-3.30.prolog ├── program-3.31.prolog ├── program-3.32.prolog ├── program-3.4.prolog ├── program-3.5.prolog ├── program-3.6.prolog ├── program-3.7.prolog ├── program-3.8a.prolog ├── program-3.8b.prolog └── program-3.9.prolog ├── Chapter5 └── program-5.1.prolog ├── Chapter7 ├── program-7.1.prolog ├── program-7.10.prolog ├── program-7.2.prolog ├── program-7.3.prolog ├── program-7.4.prolog ├── program-7.5.prolog ├── program-7.6.prolog ├── program-7.7.prolog ├── program-7.8.prolog └── program-7.9.prolog ├── Chapter8 ├── program-8.1.prolog ├── program-8.10.prolog ├── program-8.11.prolog ├── program-8.12.prolog ├── program-8.2.prolog ├── program-8.3.prolog ├── program-8.4.prolog ├── program-8.5.prolog ├── program-8.6a.prolog ├── program-8.6b.prolog ├── program-8.7a.prolog ├── program-8.7b.prolog ├── program-8.8.prolog └── program-8.9.prolog ├── Chapter9 ├── program-9.1a.prolog ├── program-9.1b.prolog ├── program-9.2.prolog ├── program-9.3.prolog ├── program-9.4.prolog ├── program-9.5a.prolog └── program-9.5b.prolog └── README.md /Chapter1/program-1.1.prolog: -------------------------------------------------------------------------------- 1 | father(terach,abraham). male(terach). 2 | father(terach,nachor). male(abraham). 3 | father(terach,haran). male(nachor). 4 | father(abraham,isaac). male(haran). 5 | father(haran,lot). male(isaac). 6 | father(haran,milcah). male(lot). 7 | father(haran,yiscah). 8 | 9 | female(sarah). 10 | mother(sarah,isaac). female(milcah). 11 | female(yiscah). 12 | 13 | % Program 1.1: A biblical family database 14 | -------------------------------------------------------------------------------- /Chapter1/program-1.2.prolog: -------------------------------------------------------------------------------- 1 | 2 | father(abraham,isaac). male(isaac). 3 | father(haran,lot). male(lot). 4 | father(haran,milcah). female(milcah). 5 | father(haran,yiscah). female(yiscah). 6 | 7 | son(X,Y) :- father(Y,X), male(X). 8 | daughter(X,Y) :- father(Y,X), female(X). 9 | 10 | % Program 1.2: Biblical family relationships 11 | 12 | -------------------------------------------------------------------------------- /Chapter10/program-10.1.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | plus(X,Y,Z) :- The sum of the numbers X and Y is Z. 3 | */ 4 | plus(X,Y,Z) :- nonvar(X), nonvar(Y), Z is X + Y. 5 | plus(X,Y,Z) :- nonvar(X), nonvar(Z), Y is Z - X. 6 | plus(X,Y,Z) :- nonvar(Y), nonvar(Z), X is Z - Y. 7 | 8 | % Program 10.1 Multiple uses for plus 9 | -------------------------------------------------------------------------------- /Chapter10/program-10.2.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | length(Xs,N) :- The list Xs has length N. 3 | */ 4 | length(Xs,N) :- nonvar(Xs), length1(Xs,N). 5 | length(Xs,N) :- var(Xs), nonvar(N), length2(Xs,N). 6 | 7 | /* 8 | length1(Xs,N) :- N is the length of the list Xs. 9 | */ 10 | length1([X|Xs],N) :- length1(Xs,N1), N is N1+1. 11 | length1([],0). 12 | 13 | /* 14 | length2(Xs,N) :- Xs is a list of length N. 15 | */ 16 | length2([X|Xs],N) :- N > 0, N1 is N-1, length2(Xs,N1). 17 | length2([],0). 18 | 19 | % Program 10.2 A multipurpose length program 20 | 21 | -------------------------------------------------------------------------------- /Chapter10/program-10.3.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | grandparent(X,Z) :- X is the grandparent of Z. 3 | */ 4 | grandparent(X,Z) :- nonvar(X), parent(X,Y), parent(Y,Z). 5 | grandparent(X,Z) :- nonvar(Z), parent(Y,Z), parent(X,Y). 6 | 7 | % Program 10.3 A more efficient version of grandparent 8 | -------------------------------------------------------------------------------- /Chapter10/program-10.4.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | ground(Term) :- Term is a ground term. 3 | */ 4 | ground(Term) :- 5 | nonvar(Term), 6 | constant(Term). 7 | ground(Term) :- 8 | nonvar(Term), 9 | compound(Term), 10 | functor(Term,F,N), 11 | ground(N,Term). 12 | 13 | ground(N,Term) :- 14 | N > 0, 15 | arg(N,Term,Arg), 16 | ground(Arg), 17 | N1 is N-1, 18 | ground(N1,Term). 19 | ground(0,Term). 20 | 21 | % Program 10.4 Testing if a term is ground 22 | -------------------------------------------------------------------------------- /Chapter10/program-10.5.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | unify(Term1,Term2) :- 3 | Term1 and Term2 are unified, ignoring the occurs check. 4 | */ 5 | unify(X,Y) :- 6 | var(X), var(Y), X=Y. 7 | unify(X,Y) :- 8 | var(X), nonvar(Y), X=Y. 9 | unify(X,Y) :- 10 | var(Y), nonvar(X), Y=X. 11 | unify(X,Y) :- 12 | nonvar(X), nonvar(Y), constant(X), constant(Y), X=Y. 13 | unify(X,Y) :- 14 | nonvar(X), nonvar(Y), compound(X), compound(Y), term_unify(X,Y). 15 | 16 | term_unify(X,Y) :- 17 | functor(X,F,N), functor(Y,F,N), unify_args(N,X,Y). 18 | 19 | unify_args(N,X,Y) :- 20 | N > 0, unify_arg(N,X,Y), N1 is N-1, unify_args(N1,X,Y). 21 | unify_args(0,X,Y). 22 | 23 | unify_arg(N,X,Y) :- 24 | arg(N,X,ArgX), arg(N,Y,ArgY), unify(ArgX,ArgY). 25 | 26 | 27 | % Program 10.5 Unification algorithm 28 | -------------------------------------------------------------------------------- /Chapter10/program-10.6.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | unify(Term1,Term2) :- Term1 and Term2 are unified with the occurs check. 3 | */ 4 | unify(X,Y) :- 5 | var(X), var(Y), X=Y. 6 | unify(X,Y) :- 7 | var(X), nonvar(Y), not_occurs_in(X,Y), X=Y. 8 | unify(X,Y) :- 9 | var(Y), nonvar(X), not_occurs_in(Y,X), Y=X. 10 | unify(X,Y) :- 11 | nonvar(X), nonvar(Y), constant(X), constant(Y), X=Y. 12 | unify(X,Y) :- 13 | nonvar(X), nonvar(Y), compound(X), compound(Y), term_unify(X,Y). 14 | 15 | not_occurs_in(X,Y) :- 16 | var(Y), X \== Y. 17 | not_occurs_in(X,Y) :- 18 | nonvar(Y), constant(Y). 19 | not_occurs_in(X,Y) :- 20 | nonvar(Y), compound(Y), functor(Y,F,N), not_occurs_in(N,X,Y). 21 | 22 | not_occurs_in(N,X,Y) :- 23 | N > 0, arg(N,Y,Arg), not_occurs_in(X,Arg), N1 is N-1, 24 | not_occurs_in(N1,X,Y). 25 | not_occurs_in(0,X,Y). 26 | 27 | term_unify(X,Y) :- 28 | functor(X,F,N), functor(Y,F,N), unify_args(N,X,Y). 29 | 30 | unify_args(N,X,Y) :- 31 | N > 0, unify_arg(N,X,Y), N1 is N-1, unify_args(N1,X,Y). 32 | unify_args(0,X,Y). 33 | 34 | unify_arg(N,X,Y) :- 35 | arg(N,X,ArgX), arg(N,Y,ArgY), unify(ArgX,ArgY). 36 | 37 | % Program 10.6 Unification with the occurs check 38 | -------------------------------------------------------------------------------- /Chapter10/program-10.7.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | occurs_in(Sub,Term) :- 3 | Sub is a subterm of the (possibly non-ground term) Term. 4 | */ 5 | % a: Using == 6 | 7 | occurs_in(X,Term) :- subterm(Sub,Term), X == Sub. 8 | 9 | % b: Using freeze $$$$ freeze is not in Standard Prolog 10 | 11 | occurs_in(X,Term) :- freeze(X,Xf), freeze(Y,Termf), subterm(Xf,Termf). 12 | 13 | /* 14 | subterm(Sub,Term) :- Sub is a subterm of the ground term Term. 15 | */ 16 | subterm(Term,Term). 17 | subterm(Sub,Term) :- 18 | compound(Term), functor(Term,F,N), subterm(N,Sub,Term). 19 | 20 | subterm(N,Sub,Term) :- 21 | arg(N,Term,Arg), subterm(Sub,Arg). 22 | subterm(N,Sub,Term) :- 23 | N > 1, N1 is N-1, subterm(N1,Sub,Term). 24 | 25 | % Program 10.7 Occurs in 26 | -------------------------------------------------------------------------------- /Chapter10/program-10.8.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | numbervars(Term,N1,N2) :- 3 | The variables in Term are numbered from N1 to N2-1. 4 | */ 5 | 6 | numbervars('$VAR'(N),N,N1) :- N1 is N+1. 7 | numbervars(Term,N1,N2) :- 8 | nonvar(Term), functor(Term,Name,N), numbervars(0,N,Term,N1,N2). 9 | 10 | numbervars(N,N,Term,N1,N1). 11 | numbervars(I,N,Term,N1,N3) :- 12 | I < N, 13 | I1 is I+1, 14 | arg(I1,Term,Arg), 15 | numbervars(Arg,N1,N2), 16 | numbervars(I1,N,Term,N2,N3). 17 | 18 | % Program 10.8: Numbering the variables in a term 19 | -------------------------------------------------------------------------------- /Chapter10/program-10.9.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | X : Y :- X or Y. 3 | * 4 | * Note: used ':' instead of ';' as ';' is a system predicate. 5 | */ 6 | :- op(1100,xfy,[':']). 7 | 8 | X : Y :- X. 9 | X : Y :- Y. 10 | 11 | % Program 10.9 Logical disjunction 12 | -------------------------------------------------------------------------------- /Chapter11/program-11.1.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | merge(Xs,Ys,Zs) :- 3 | Zs is an ordered list of integers obtained from merging 4 | the ordered lists of integers Xs and Ys. 5 | */ 6 | merge([X|Xs],[Y|Ys],[X|Zs]) :- 7 | X < Y, merge(Xs,[Y|Ys],Zs). 8 | merge([X|Xs],[Y|Ys],[X,Y|Zs]) :- 9 | X =:= Y, merge(Xs,Ys,Zs). 10 | merge([X|Xs],[Y|Ys],[Y|Zs]) :- 11 | X > Y, merge([X|Xs],Ys,Zs). 12 | merge(Xs,[],Xs). 13 | merge([],Xs,Xs). 14 | 15 | % Program 11.1 Merging ordered lists 16 | -------------------------------------------------------------------------------- /Chapter11/program-11.10.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | if_then_else(P,Q,R) :- Either P and Q, or not P and R. 3 | */ 4 | if_then_else(P,Q,R) :- P, !, Q. 5 | if_then_else(P,Q,R) :- R. 6 | 7 | % Program 11.10 If-then-else statement 8 | -------------------------------------------------------------------------------- /Chapter11/program-11.11a.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | pension(Person,Pension) :- Pension is the type of pension received by Person. 3 | */ 4 | pension(X,invalid_pension) :- invalid(X). 5 | pension(X,old_age_pension) :- over_65(X), paid_up(X). 6 | pension(X,supplem_benefit) :- over_65(X). 7 | 8 | invalid(mc_tavish). 9 | 10 | over_65(mc_tavish). over_65(mc_donald). over_65(mc_duff). 11 | 12 | paid_up(mc_tavish). paid_up(mc_donald). 13 | 14 | % Program 11.11a Determining welfare payments 15 | -------------------------------------------------------------------------------- /Chapter11/program-11.11b.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | pension(Person,Pension) :- Pension is the type of pension received by Person. 3 | */ 4 | pension(X,invalid_pension) :- invalid(X), !. 5 | pension(X,old_age_pension) :- over_65(X), paid_up(X), !. 6 | pension(X,supplem_benefit) :- over_65(X), !. 7 | pension(X,nothing). 8 | 9 | invalid(mc_tavish). 10 | 11 | over_65(mc_tavish). over_65(mc_donald). over_65(mc_duff). 12 | 13 | paid_up(mc_tavish). paid_up(mc_donald). 14 | 15 | % Program 11.11b Determining welfare payments 16 | -------------------------------------------------------------------------------- /Chapter11/program-11.2.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | merge(Xs,Ys,Zs) :- 3 | Zs is an ordered list of integers obtained from merging 4 | the ordered lists of integers Xs and Ys. 5 | */ 6 | merge([X|Xs],[Y|Ys],[X|Zs]) :- 7 | X < Y, !, merge(Xs,[Y|Ys],Zs). 8 | merge([X|Xs],[Y|Ys],[X,Y|Zs]) :- 9 | X =:= Y, !, merge(Xs,Ys,Zs). 10 | merge([X|Xs],[Y|Ys],[Y|Zs]) :- 11 | X > Y, !, merge([X|Xs],Ys,Zs). 12 | merge(Xs,[],Xs) :- !. 13 | merge([],Xs,Xs) :- !. 14 | 15 | % Program 11.2 Merging with cuts 16 | 17 | -------------------------------------------------------------------------------- /Chapter11/program-11.3.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | minimum(X,Y,Min) :- Min is the minimum of the numbers X and Y. 3 | */ 4 | minimum(X,Y,X) :- X =< Y, !. 5 | minimum(X,Y,Y) :- X > Y, !. 6 | 7 | % Program 11.3 Minimum with cuts 8 | -------------------------------------------------------------------------------- /Chapter11/program-11.4.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | polynomial(Term,X) :- Term is a polynomial in X. 3 | */ 4 | :- op(350, xfx,[^]). 5 | 6 | polynomial(X,X) :- !. 7 | polynomial(Term,X) :- 8 | constant(Term), !. 9 | polynomial(Term1+Term2,X) :- 10 | !, polynomial(Term1,X), polynomial(Term2,X). 11 | polynomial(Term1-Term2,X) :- 12 | !, polynomial(Term1,X), polynomial(Term2,X). 13 | polynomial(Term1*Term2,X) :- 14 | !, polynomial(Term1,X), polynomial(Term2,X). 15 | polynomial(Term1/Term2,X) :- 16 | !, polynomial(Term1,X), constant(Term2). 17 | polynomial(Term ^ N,X) :- % $$$$ ^ 18 | !, integer(N), N >= 0, polynomial(Term,X). 19 | 20 | % Program 11.4 Recognizing polynomials 21 | -------------------------------------------------------------------------------- /Chapter11/program-11.5.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | sort(Xs,Ys) :- 3 | Ys is an ordered permutation of the list of integers Xs. 4 | */ 5 | sort(Xs,Ys) :- 6 | append(As,[X,Y|Bs],Xs), 7 | X > Y, 8 | !, 9 | append(As,[Y,X|Bs],Xs1), 10 | sort(Xs1,Ys). 11 | sort(Xs,Xs) :- 12 | ordered(Xs), !. 13 | 14 | ordered([]). 15 | ordered([X]). 16 | ordered([X,Y|Ys]) :- X =< Y, ordered([Y|Ys]). 17 | 18 | % Program 11.5 Interchange sort 19 | -------------------------------------------------------------------------------- /Chapter11/program-11.6.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | not X :- X is not provable. 3 | */ 4 | :- op(900, fx, [not]). 5 | 6 | not X :- X, !, fail. 7 | not X. 8 | 9 | % Program 11.6 Negation as failure 10 | -------------------------------------------------------------------------------- /Chapter11/program-11.7.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | variants(Term1,Term2) :- Term1 and Term2 are variants. 3 | */ 4 | variants(Term1,Term2) :- 5 | verify((numbervars(Term1,0,N), 6 | numbervars(Term2,0,N), 7 | Term1=Term2)). 8 | 9 | verify(Goal) :- not (not Goal). 10 | 11 | numbervars('$VAR'(N),N,N1) :- 12 | N1 is N+1. 13 | numbervars(Term,N1,N2) :- 14 | nonvar(Term), functor(Term,Name,N), 15 | numbervars(0,N,Term,N1,N2). 16 | 17 | numbervars(N,N,Term,N1,N1). 18 | numbervars(I,N,Term,N1,N3) :- 19 | I < N, 20 | I1 is I+1, 21 | arg(I1,Term,Arg), 22 | numbervars(Arg,N1,N2), 23 | numbervars(I1,N,Term,N2,N3). 24 | 25 | % Program 11.7 Testing if terms are variants 26 | -------------------------------------------------------------------------------- /Chapter11/program-11.8.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | X \= Y :- X and Y are not unifiable. 3 | */ 4 | :- op(700, xfx, \=). 5 | 6 | X \= X :- !, fail. 7 | X \= Y. 8 | 9 | % Program 11.8 Implementing \= 10 | 11 | -------------------------------------------------------------------------------- /Chapter11/program-11.9a.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | delete(Xs,X,Ys) :- 3 | Ys is the result of deleting all occurrences of X from the list Xs. 4 | */ 5 | delete([X|Xs],X,Ys) :- !, delete(Xs,X,Ys). 6 | delete([X|Xs],Z,[X|Ys]) :- Y \== X, !, delete(Xs,Z,Ys). 7 | delete([],X,[]). 8 | 9 | % Program 11.9a Deleting elements from a list 10 | -------------------------------------------------------------------------------- /Chapter11/program-11.9b.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | delete(Xs,X,Ys) :- 3 | Ys is the result of deleting all occurrences of X from the list Xs. 4 | */ 5 | delete([X|Xs],X,Ys) :- !, delete(Xs,X,Ys). 6 | delete([X|Xs],Z,[X|Ys]) :- !, delete(Xs,Z,Ys). 7 | delete([],X,[]). 8 | 9 | % Program 11.9b Deleting elements from a list 10 | -------------------------------------------------------------------------------- /Chapter12/program-12.1.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | writeln(Xs) :- 3 | The list of terms Xs is written on the output stream by side-effect. 4 | */ 5 | writeln([X|Xs]) :- write(X), writeln(Xs). 6 | writeln([]) :- nl. 7 | 8 | % Program 12.1 Writing a list of terms 9 | -------------------------------------------------------------------------------- /Chapter12/program-12.2.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | read_word_list(Words) :- 3 | Words is a list of words read from the input stream via side effects. 4 | */ 5 | read_word_list(Words) :- 6 | get_char(FirstChar), read_words(FirstChar,Words). 7 | 8 | read_words(Char,[Word|Words]) :- 9 | word_char(Char), 10 | read_word(Char,Word,NextChar), 11 | read_words(NextChar,Words). 12 | read_words(Char,Words) :- 13 | fill_char(Char), 14 | get_char(NextChar), 15 | read_words(NextChar,Words). 16 | read_words(Char,[]) :- 17 | end_of_words_char(Char). 18 | 19 | read_word(Char,Word,NextChar) :- 20 | word_chars(Char,Chars,NextChar), 21 | atom_list(Word,Chars). 22 | 23 | word_chars(Char,[Char|Chars],FinalChar) :- 24 | word_char(Char), !, 25 | get_char(NextChar), 26 | word_chars(NextChar,Chars,FinalChar). 27 | word_chars(Char,[],Char) :- 28 | not word_char(Char). 29 | 30 | word_char(C) :- 97 =< C, C =< 122. % Lower-case letter 31 | word_char(C) :- 65 =< C, C =< 90. % Upper-case letter 32 | word_char(95). % Hyphen 33 | word_char(C) :- 48 =< C, C =< 57. % numeric digits as well 34 | 35 | fill_char(32). % Blank 36 | end_of_words_char(46). % Period 37 | 38 | % Program 12.2 Reading in a list of words 39 | -------------------------------------------------------------------------------- /Chapter12/program-12.3.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | hanoi(N,A,B,C,Moves) :- 3 | Moves is the sequence of moves required to move N discs 4 | from peg A to peg B using peg C as an intermediary 5 | according to the rules of the Towers of Hanoi puzzle 6 | */ 7 | 8 | :- op(100, xfx, [to]). 9 | 10 | hanoi(1,A,B,C,[A to B]). 11 | hanoi(N,A,B,C,Moves) :- 12 | N > 1, 13 | N1 is N -1, 14 | lemma(hanoi(N1,A,C,B,Ms1)), 15 | hanoi(N1,C,B,A,Ms2), 16 | append(Ms1,[A to B|Ms2],Moves). 17 | 18 | lemma(P):- P, asserta((P :- !)). 19 | 20 | /* Testing */ 21 | 22 | test_hanoi(N,Pegs,Moves) :- 23 | hanoi(N,A,B,C,Moves), Pegs = [A,B,C]. 24 | 25 | % Program 12.3: Towers of Hanoi using a memo-function 26 | -------------------------------------------------------------------------------- /Chapter12/program-12.4.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | echo :- An interactive loop. 3 | */ 4 | echo :- read(X), echo(X). 5 | 6 | echo(X) :- last_input(X), !. 7 | echo(X) :- write(X), nl, read(Y), !, echo(Y). 8 | 9 | % Program 12.4 Basic interactive loop 10 | -------------------------------------------------------------------------------- /Chapter12/program-12.5.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | edit :- A line editor. 3 | 4 | Files are represented in the form file(Before,After), where After is a 5 | list of lines after the current cursor position and Before is a list 6 | of lines before the cursor in reverse order. 7 | 8 | * Note: Program has been augmented to accomodate boundary 9 | * condition. 10 | */ 11 | 12 | edit :- edit(file([],[])). 13 | 14 | edit(File) :- 15 | write_prompt, read(Command), edit(File,Command). 16 | 17 | edit(File,exit) :- !. 18 | edit(File,Command) :- 19 | apply(Command,File,File1), !, edit(File1). 20 | edit(File,Command) :- 21 | writeln([Command,' is not applicable']), !, edit(File). 22 | 23 | apply(up,file([X|Xs],Ys),file(Xs,[X|Ys])). 24 | apply(up,file([],Ys),file([],Ys)). 25 | apply(up(N),file(Xs,Ys),file(Xs1,Ys1)) :- 26 | N > 0, up(N,Xs,Ys,Xs1,Ys1). 27 | apply(down,file(Xs,[Y|Ys]),file([Y|Xs],Ys)). 28 | apply(down,file(Xs,[]),file(Xs,[])). 29 | apply(insert(Line),file(Xs,Ys),file(Xs,[Line|Ys])). 30 | apply(delete,file(Xs,[Y|Ys]),file(Xs,Ys)). 31 | apply(delete,file(Xs,[]),file(Xs,[])). 32 | apply(print,file([X|Xs],Ys),file([X|Xs],Ys)) :- 33 | write(X), nl. 34 | apply(print,file([],Ys),file([],Ys)) :- 35 | write('<>'), nl. 36 | apply(print(*),file(Xs,Ys),file(Xs,Ys)) :- 37 | reverse(Xs,Xs1), write_file(Xs1), write_file(Ys). 38 | 39 | up(N,[],Ys,[],Ys). 40 | up(0,Xs,Ys,Xs,Ys). 41 | up(N,[X|Xs],Ys,Xs1,Ys1) :- 42 | N > 0, N1 is N-1, up(N1,Xs,[X|Ys],Xs1,Ys1). 43 | 44 | write_file([X|Xs]) :- 45 | write(X), nl, write_file(Xs). 46 | write_file([]). 47 | 48 | write_prompt :- write('>>'), nl. 49 | 50 | % Program 12.5: A line editor 51 | -------------------------------------------------------------------------------- /Chapter12/program-12.6.prolog: -------------------------------------------------------------------------------- 1 | 2 | shell :- shell_prompt, read(Goal), shell(Goal). 3 | 4 | shell(exit) :- !. 5 | shell(Goal) :- 6 | ground(Goal), !, shell_solve_ground(Goal), shell. 7 | shell(Goal) :- 8 | shell_solve(Goal), shell. 9 | 10 | shell_solve(Goal) :- 11 | Goal, write(Goal), nl, fail. 12 | shell_solve(Goal) :- 13 | write('No (more) solutions'), nl. 14 | 15 | shell_solve_ground(Goal) :- 16 | Goal, !, write('Yes'), nl. 17 | shell_solve_ground(Goal) :- 18 | write('No'), nl. 19 | 20 | shell_prompt :- write('Next command? '). 21 | 22 | % Program 12.6 An interactive shell 23 | -------------------------------------------------------------------------------- /Chapter12/program-12.7.prolog: -------------------------------------------------------------------------------- 1 | 2 | logg :- shell_flag(logg). 3 | 4 | shell_flag(Flag) :- 5 | shell_prompt, shell_read(Goal,Flag), shell(Goal,Flag). 6 | 7 | shell(exit,Flag) :- 8 | !, close_logging_file. 9 | shell(nolog,Flag) :- 10 | !, shell_flag(nolog). 11 | shell(logg,Flag) :- 12 | !, shell_flag(logg). 13 | shell(Goal,Flag) :- 14 | ground(Goal), !, shell_solve_ground(Goal,Flag), shell_flag(Flag). 15 | shell(Goal,Flag) :- 16 | shell_solve(Goal,Flag), shell_flag(Flag). 17 | 18 | shell_solve(Goal,Flag) :- 19 | Goal, flag_write(Goal,Flag), nl. 20 | shell_solve(Goal,Flag) :- 21 | flag_write('No (more) solutions',Flag), nl. 22 | 23 | shell_solve_ground(Goal,Flag) :- 24 | Goal, !, flag_write('Yes',Flag), nl. 25 | shell_solve_ground(Goal,Flag) :- 26 | flag_write('No',Flag), nl. 27 | 28 | shell_prompt :- write('Next command? '). 29 | 30 | shell_read(X,logg) :- 31 | read(X), 32 | file_write(['Next command? ',X],'prolog.log'). 33 | shell_read(X,nolog) :- read(X). 34 | 35 | flag_write(X,nolog) :- write(X). 36 | flag_write(X,logg) :- write(X), file_write(X,'prolog.log'). 37 | 38 | file_write(X,File) :- write_term(File,Term,[]). 39 | close_logging_file :- close('prolog.log'). 40 | 41 | % Program 12.7 Logging a session 42 | -------------------------------------------------------------------------------- /Chapter12/program-12.8.prolog: -------------------------------------------------------------------------------- 1 | 2 | echo :- repeat_, read(X), echo(X), !. 3 | 4 | echo(X) :- last_input(X), !. 5 | echo(X) :- write(X), nl, fail. 6 | 7 | repeat_. 8 | repeat_ :- repeat_. 9 | 10 | % Program 12.8 Basic interactive repeat loop 11 | -------------------------------------------------------------------------------- /Chapter12/program-12.9.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | consult_(File) :- 3 | The clauses of the program in the file File are read and asserted. 4 | */ 5 | 6 | consult_(File) :- open(File,read,DD), consult_loop(DD), close(DD). 7 | 8 | consult_loop(DD) :- repeat, read(Clause), process(Clause,DD)), !. 9 | 10 | process(Clause,DD) :- at_end_of_stream(DD). 11 | process(Clause,DD) :- assertz(Clause), fail. 12 | 13 | % Program 12.9: Consulting a file 14 | 15 | -------------------------------------------------------------------------------- /Chapter13/program-13.1.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | union(Xs,Ys,Us) :- Us is the union of the elements in Xs and Ys. 3 | */ 4 | 5 | union([X|Xs],Ys,Us) :- member(X,Ys), union(Xs,Ys,Us). 6 | union([X|Xs],Ys,[X|Us]) :- nonmember(X,Ys), union(Xs,Ys,Us). 7 | union([],Ys,Ys). 8 | 9 | % Program 13.1 Finding the union of two lists -------------------------------------------------------------------------------- /Chapter13/program-13.2.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | intersection(Xs,Ys,Is) :- Is is the intersection of the elements in Xs and Ys. 3 | */ 4 | 5 | intersection([X|Xs],Ys,[X|Is]) :- member(X,Ys), intersection(Xs,Ys,Is). 6 | intersection([X|Xs],Ys,Is) :- nonmember(X,Ys), intersection(Xs,Ys,Is). 7 | intersection([],Ys,[]). 8 | 9 | % Program 13.2 Finding the intersection of two lists -------------------------------------------------------------------------------- /Chapter13/program-13.3.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | union_intersect(Xs,Ys,Us) :- 3 | Us and is are the union and intersection, respectively, of the 4 | elements in Xs and Ys. 5 | */ 6 | 7 | union_intersect([X|Xs],Ys,Us,[X|Is]) :- 8 | member(X,Ys), union_intersect(Xs,Ys,Us,Is). 9 | union_intersect([X|Xs],Ys,[X|Us],Is) :- 10 | nonmember(X,Ys), union_intersect(Xs,Ys,Us,Is). 11 | union_intersect([],Ys,Ys,[]). 12 | 13 | % Program 13.3 Finding the union and intersection of two lists -------------------------------------------------------------------------------- /Chapter14/program-14.1.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | verb(Sentence,Verb) :- 3 | Verb is a verb in the list of words Sentence. 4 | */ 5 | 6 | verb(Sentence,Word) :- member(Word,Sentence), verb(Word). 7 | noun(Sentence,Word) :- member(Word,Sentence), noun(Word). 8 | article(Sentence,Word) :- member(Word,Sentence), article(Word). 9 | 10 | /* Vocabulary */ 11 | 12 | noun(man). noun(woman). 13 | article(a). verb(loves). 14 | 15 | % Program 14.1: Finding parts of speech in a sentence 16 | -------------------------------------------------------------------------------- /Chapter14/program-14.10.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | connected(X,Y) :- 3 | Node X is connected to node Y in the graph defined by edge/2. 4 | */ 5 | 6 | connected(X,Y) :- connected(X,Y,[X]). 7 | 8 | connected(X,X,Visited). 9 | connected(X,Y,Visited) :- 10 | edge(X,N), not member(N,Visited), connected(N,Y,[N|Visited]). 11 | 12 | % Program 14.10: Connectivity in a graph 13 | -------------------------------------------------------------------------------- /Chapter14/program-14.11.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | transform(State1,State2,Plan) :- 3 | Plan is a plan of actions to transform State1 into State2. 4 | */ 5 | 6 | transform(State1,State2,Plan) :- 7 | transform(State1,State2,[State1],Plan). 8 | 9 | transform(State,State,Visited,[]). 10 | transform(State1,State2,Visited,[Action|Actions]) :- 11 | legal_action(Action,State1), 12 | update(Action,State1,State), 13 | not member(State,Visited), 14 | transform(State,State2,[State|Visited],Actions). 15 | 16 | legal_action(to_place(Block,Y,Place),State) :- 17 | on(Block,Y,State), clear(Block,State), place(Place), clear(Place,State). 18 | legal_action(to_block(Block1,Y,Block2),State) :- 19 | on(Block1,Y,State), clear(Block1,State), block(Block2), 20 | Block1 \== Block2, clear(Block2,State). 21 | 22 | clear(X,State) :- not member(on(A,X),State). 23 | on(X,Y,State) :- member(on(X,Y),State). 24 | 25 | update(to_block(X,Y,Z),State,State1) :- 26 | substitute(on(X,Y),on(X,Z),State,State1). 27 | update(to_place(X,Y,Z),State,State1) :- 28 | substitute(on(X,Y),on(X,Z),State,State1). 29 | 30 | substitute(X,Y,[X|Xs],[Y|Xs]). 31 | substitute(X,Y,[X1|Xs],[X1|Ys]) :- X \== X1, substitute(X,Y,Xs,Ys). 32 | 33 | % Program 14.11: A depth-first planner 34 | -------------------------------------------------------------------------------- /Chapter14/program-14.12.prolog: -------------------------------------------------------------------------------- 1 | /* Testing and data */ 2 | 3 | test_plan(Name,Plan) :- 4 | initial_state(Name,I), final_state(Name,F), transform(I,F,Plan). 5 | 6 | initial_state(test,[on(a,b),on(b,p),on(c,r)]). 7 | final_state(test,[on(a,b),on(b,c),on(c,r)]). 8 | 9 | block(a). block(b). block(c). 10 | place(p). place(q). place(r). 11 | 12 | % Program 14.12: Testing the depth-first planner 13 | -------------------------------------------------------------------------------- /Chapter14/program-14.13.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | analogy(Pair1,Pair2,Answers) :- 3 | An analogy holds between the pairs of figures Pair1 and Pair2. 4 | The second element of Pair2 is one of the possible Answers. 5 | */ 6 | :- op(100,xfx,[is_to]). 7 | 8 | analogy(A is_to B,C is_to X,Answers) :- 9 | match(A,B,Match), 10 | match(C,X,Match), 11 | member(X,Answers). 12 | 13 | match(inside(Figure1,Figure2),inside(Figure2,Figure1),invert). 14 | match(above(Figure1,Figure2),above(Figure2,Figure1),invert). 15 | 16 | % Program 14.13: A program solving geometric analogies 17 | -------------------------------------------------------------------------------- /Chapter14/program-14.14.prolog: -------------------------------------------------------------------------------- 1 | /* Testing and data */ 2 | 3 | :- op(40,xfx,[is_to]). 4 | 5 | test_analogy(Name,X) :- 6 | figures(Name,A,B,C), 7 | answers(Name,Answers), 8 | analogy(A is_to B,C is_to X,Answers). 9 | 10 | figures(test1,inside(square,triangle),inside(triangle,square), 11 | inside(circle,square)). 12 | answers(test1,[inside(circle,triangle),inside(square,circle), 13 | inside(triangle,square)]). 14 | 15 | % Program 14.14: Testing ANALOGY 16 | -------------------------------------------------------------------------------- /Chapter14/program-14.15.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | eliza :- Simulates a conversation via side effects. 3 | */ 4 | 5 | % For testing this program prior to Standard Prolog being widley 6 | % available, the program below uses read rather than read_word_list. 7 | % You need to type in a list of waords such as [i, am,unhappy]. 8 | 9 | eliza :- read(Input), eliza(Input), !. 10 | 11 | eliza([bye]) :- 12 | writeln(['Goodbye. I hope I have helped you']). 13 | eliza(Input) :- 14 | pattern(Stimulus,Response), 15 | match(Stimulus,Table,Input), 16 | match(Response,Table,Output), 17 | reply(Output), 18 | read(Input1), 19 | !, eliza(Input1). 20 | 21 | /* 22 | match(Patterm,Dictionary,Words) :- 23 | Pattern matches the list of words Words, and matchings 24 | are recorded in the Dictionary. 25 | */ 26 | 27 | match([N|Pattern],Table,Target) :- 28 | integer(N), 29 | lookup(N,Table,LeftTarget), 30 | append(LeftTarget,RightTarget,Target), 31 | match(Pattern,Table,RightTarget). 32 | match([Word|Pattern],Table,[Word|Target]) :- 33 | atom(Word), 34 | match(Pattern,Table,Target). 35 | match([],Table,[]). 36 | 37 | /* 38 | pattern(Stimulus,Response) :- 39 | Response is an applicable response pattern to the pattern Stimulus. 40 | */ 41 | 42 | pattern([i,am,1],['How',long,have,you,been,1,?]). 43 | pattern([1,you,2,me],['What',makes,you,think,'I',2,you,?]). 44 | pattern([i,like,1],['Does',anyone,else,in,your,family,like,1,?]). 45 | pattern([i,feel,1],['Do',you,often,feel,that,way,?]). 46 | pattern([1,X,2],['Please',you,tell,me,more,about,X]) :- 47 | important(X). 48 | pattern([1],['Please',go,on,'.']). 49 | 50 | important(father). important(mother). 51 | important(sister). important(brother). 52 | important(son). important(daughter). 53 | 54 | reply([Head|Tail]) :- write(Head), write(' '), reply(Tail). 55 | reply([]) :- nl. 56 | 57 | lookup(X,[(X,V)|XVs],V). 58 | lookup(X,[(X1,V1)|XVs],V) :- X \== X1, lookup(X,XVs,V). 59 | 60 | 61 | % Program 14.15 ELIZA 62 | -------------------------------------------------------------------------------- /Chapter14/program-14.16.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | mcsam(Story,Script) :- 3 | Script describes Story. 4 | */ 5 | 6 | mcsam(Story,Script) :- 7 | find(Story,Script,Defaults), 8 | match(Script,Story), 9 | name_defaults(Defaults). 10 | 11 | find(Story,Script,Defaults) :- 12 | filler(Slot,Story), 13 | trigger(Slot,Name), 14 | script(Name,Script,Defaults). 15 | /* 16 | match(Script,Story) :- 17 | Story is a subsequence of Script. 18 | */ 19 | 20 | match(Script,[]). 21 | match([Line|Script],[Line|Story]) :- match(Script,Story). 22 | match([Line|Script],Story) :- match(Script,Story). 23 | 24 | /* 25 | filler(Slot,Story) :- 26 | Slot is a word in Story. 27 | */ 28 | 29 | filler(Slot,Story) :- 30 | member([Action|Args],Story), 31 | member(Slot,Args), 32 | nonvar(Slot). 33 | 34 | /* 35 | name_defaults(Defaults) :- 36 | Unifies default pairs in Defaults. 37 | */ 38 | 39 | name_defaults([]). 40 | name_defaults([[N,N]|L]) :- name_defaults(L). 41 | name_defaults([[N1,N2]|L]) :- N1 \== N2, name_defaults(L). 42 | 43 | % Program 14.16: McSAM 44 | -------------------------------------------------------------------------------- /Chapter14/program-14.17.prolog: -------------------------------------------------------------------------------- 1 | % Testing and Data 2 | 3 | test_mcsam(Name,UnderstoodStory) :- 4 | story(Name,Story), mcsam(Story,UnderstoodStory). 5 | 6 | story(test,[[ptrans, john, john, X1, leones], 7 | [ingest, X2, hamburger, X3], 8 | [ptrans, Actor, Actor, X4, X5] ]). 9 | 10 | script(restaurant, 11 | [ [ptrans, Actor, Actor, Earlier_place, Restaurant], 12 | [ptrans, Actor, Actor, Door, Seat], 13 | [mtrans, Actor, Waiter, Food], 14 | [ingest, Actor, Food, [mouth, Actor] ], 15 | [atrans, Actor, Money, Actor, Waiter], 16 | [ptrans, Actor, Actor, Restaurant, Gone] ], 17 | [ [Actor, customer], [Earlier_place, place1], 18 | [Restaurant, restaurant], [Door, door], 19 | [Seat, seat], [Food, meal], [Waiter, waiter], 20 | [Money, check], [Gone, place2] ] ). 21 | 22 | trigger(leones, restaurant). trigger(waiter, restaurant). 23 | 24 | % Program 14.17: Testing McSAM 25 | -------------------------------------------------------------------------------- /Chapter14/program-14.2.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | queens(N,Queens) :- 3 | Queens is a placement that solves the N queens problem, 4 | represented as a permutation of the list of numbers [1,2,...,N]. 5 | */ 6 | 7 | queens(N,Qs) :- range(1,N,Ns), permutation(Ns,Qs), safe(Qs). 8 | 9 | /* 10 | safe(Qs) :- The placement Qs is safe. 11 | */ 12 | safe([Q|Qs]) :- safe(Qs), not attack(Q,Qs). 13 | safe([]). 14 | 15 | attack(X,Xs) :- attack(X,1,Xs). 16 | 17 | attack(X,N,[Y|Ys]) :- X is Y+N ; X is Y-N. 18 | attack(X,N,[Y|Ys]) :- N1 is N+1, attack(X,N1,Ys). 19 | 20 | 21 | permutation(Xs,[Z|Zs]) :- select(Z,Xs,Ys), permutation(Ys,Zs). 22 | permutation([],[]). 23 | 24 | select(X,[X|Xs],Xs). 25 | select(X,[Y|Ys],[Y|Zs]) :- select(X,Ys,Zs). 26 | 27 | range(M,N,[M|Ns]) :- M < N, M1 is M+1, range(M1,N,Ns). 28 | range(N,N,[N]). 29 | 30 | % Program 14.2: Naive generate-and-test program solving N queens 31 | 32 | -------------------------------------------------------------------------------- /Chapter14/program-14.3.prolog: -------------------------------------------------------------------------------- 1 | /* queens(N,Queens) :- 2 | Queens is a placement that solves the N queens problem, 3 | represented as a permutation of the list of numbers [1,2,..,N]. 4 | */ 5 | 6 | queens(N,Qs) :- range(1,N,Ns), queens(Ns,[],Qs). 7 | 8 | queens(UnplacedQs,SafeQs,Qs) :- 9 | select(Q,UnplacedQs,UnplacedQs1), 10 | not attack(Q,SafeQs), 11 | queens(UnplacedQs1,[Q|SafeQs],Qs). 12 | queens([],Qs,Qs). 13 | 14 | range(I,N,[I|Ns]) :- I < N, I1 is I+1, range(I1,N,Ns). 15 | range(N,N,[N]). 16 | 17 | select(X,[X|Xs],Xs). 18 | select(X,[Y|Ys],[Y|Zs]) :- select(X,Ys,Zs). 19 | 20 | attack(X,Xs) :- attack(X,1,Xs). 21 | 22 | attack(X,N,[Y|Ys]) :- X is Y+N ; X is Y-N. 23 | attack(X,N,[Y|Ys]) :- N1 is N+1, attack(X,N1,Ys). 24 | 25 | % Program 14.3: Placing one queen at a time 26 | -------------------------------------------------------------------------------- /Chapter14/program-14.4.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | color_map(Map,Colors) :- 3 | Map is colored with Colors, so that no two neighbors have the same 4 | color. The map is represented as an adjacency-list of regions 5 | region(Name,Color,Neighbors), where Name is the name of the 6 | region, Color is its color, and Neighbors are the colors of the 7 | neighbors. 8 | */ 9 | color_map([Region|Regions],Colors) :- 10 | color_region(Region,Colors), 11 | color_map(Regions,Colors). 12 | color_map([],Colors). 13 | /* 14 | color_region(Region,Colors) :- 15 | Region and its neighbors are colored using Colors so that the 16 | region's color is different from the color of any of its neighbors. 17 | */ 18 | color_region(region(Name,Color,Neighbors),Colors) :- 19 | select(Color,Colors,Colors1), 20 | members(Neighbors,Colors1). 21 | 22 | select(X,[X|Xs],Xs). 23 | select(X,[Y|Ys],[Y|Zs]) :- select(X,Ys,Zs). 24 | 25 | members([X|Xs],Ys) :- member(X,Ys), members(Xs,Ys). 26 | members([],Ys). 27 | 28 | % Program 14.4: Map coloring 29 | -------------------------------------------------------------------------------- /Chapter14/program-14.5.prolog: -------------------------------------------------------------------------------- 1 | 2 | /* Test data */ 3 | 4 | test_color(Name,Map) :- 5 | map(Name,Map), 6 | colors(Name,Colors), 7 | color_map(Map,Colors). 8 | 9 | map(test,[region(a,A,[B,C,D]), region(b,B,[A,C,E]), 10 | region(c,C,[A,B,D,E,F]), region(d,D,[A,C,F]), 11 | region(e,E,[B,C,F]), region(f,F,[C,D,E])]). 12 | 13 | map(west_europe, 14 | [ region(portugal,P,[E]), region(spain,E,[F,P]), 15 | region(france,F,[E,I,S,B,WG,L]), region(belgium,B,[F,H,L,WG]), 16 | region(holland,H,[B,WG]), region(west_germany,WG,[F,A,S,H,B,L]), 17 | region(luxembourg,L,[F,B,WG]), region(italy,I,[F,A,S]), 18 | region(switzerland,S,[F,I,A,WG]), region(austria,A,[I,S,WG])]). 19 | 20 | colors(X,[red,yellow,blue,white]). 21 | 22 | % Program 14.5: Test data for map coloring 23 | -------------------------------------------------------------------------------- /Chapter14/program-14.6.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | solve_puzzle(Puzzle,Solution) :- 3 | Solution is a solution of Puzzle, 4 | where Puzzle is puzzle(Clues,Queries,Solution). 5 | */ 6 | 7 | solve_puzzle(puzzle(Clues,Queries,Solution),Solution) :- 8 | solve(Clues), 9 | solve(Queries). 10 | 11 | solve([Clue|Clues]) :- 12 | Clue, solve(Clues). 13 | solve([]). 14 | 15 | % Program 14.6: A puzzle solver 16 | -------------------------------------------------------------------------------- /Chapter14/program-14.7.prolog: -------------------------------------------------------------------------------- 1 | /* Test data */ 2 | 3 | test_puzzle(Name,Solution) :- 4 | structure(Name,Structure), 5 | clues(Name,Structure,Clues), 6 | queries(Name,Structure,Queries,Solution), 7 | solve_puzzle(puzzle(Clues,Queries,Solution),Solution). 8 | 9 | structure(test,[friend(N1,C1,S1), friend(N2,C2,S2), friend(N3,C3,S3)]). 10 | 11 | clues(test,Friends, 12 | [(did_better(Man1Clue1, Man2Clue1, Friends), % Clue 1 13 | name_(Man1Clue1, michael), sport(Man1Clue1,basketball), 14 | nationality(Man2Clue1,american)), 15 | (did_better(Man1Clue2, Man2Clue2, Friends), % Clue 2 16 | name_(Man1Clue2, simon), nationality(Man1Clue2,israeli), 17 | sport(Man2Clue2,tennis)), 18 | (first(Friends,ManClue3),sport(ManClue3,cricket)) 19 | ]). 20 | 21 | queries(test, Friends, 22 | [ member(Q1,Friends), 23 | name_(Q1,Name), 24 | nationality(Q1,australian), % Query 1 25 | member(Q2,Friends), 26 | name_(Q2,richard), 27 | sport(Q2,Sport) % Query 2 28 | ], 29 | [['The Australian is', Name], ['Richard plays ', Sport]] 30 | ). 31 | 32 | did_better(A,B,[A,B,C]). 33 | did_better(A,C,[A,B,C]). 34 | did_better(B,C,[A,B,C]). 35 | 36 | name_(friend(A,B,C),A). 37 | nationality(friend(A,B,C),B). 38 | sport(friend(A,B,C),C). 39 | 40 | first([X|Xs],X). 41 | 42 | % Program 14.7: A description of a puzzle 43 | -------------------------------------------------------------------------------- /Chapter14/program-14.8.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | connected(X,Y) :- 3 | Node X is connected to node Y, 4 | given an edge/2 relation describing a DAG. 5 | */ 6 | 7 | connected(X,X). 8 | connected(X,Y) :- edge(X,N), connected(N,Y). 9 | 10 | /* Data */ 11 | 12 | edge(a,b). edge(a,c). edge(a,d). edge(a,e). edge(d,j). 13 | edge(c,f). edge(c,g). edge(f,h). edge(e,k). edge(f,i). 14 | edge(x,y). edge(y,z). edge(z,x). edge(y,u). edge(z,v). 15 | 16 | % Program 14.8: Connectivity in a finite DAG 17 | -------------------------------------------------------------------------------- /Chapter14/program-14.9.prolog: -------------------------------------------------------------------------------- 1 | /* path(X,Y,Path) :- 2 | Path is a path between two nodes X and Y in the 3 | DAG defined by the relation edge/2 4 | */ 5 | path(X,X,[X]). 6 | path(X,Y,[X|P]) :- edge(X,N), path(N,Y,P). 7 | 8 | % Program 14.9: Finding a path by depth-first search 9 | -------------------------------------------------------------------------------- /Chapter15/program-15.1.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | append_dl(As,Bs,Cs) :- 3 | The difference-list Cs is the result of appending Bs to As, 4 | where As and Bs are compatible difference-lists. 5 | */ 6 | :- op(40,xfx,\). 7 | 8 | append_dl(Xs\Ys,Ys\Zs,Xs\Zs). 9 | 10 | % Program 15.1: Concatenating difference_lists 11 | -------------------------------------------------------------------------------- /Chapter15/program-15.10.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | freeze(A,B) :- Freeze term A into B. 3 | */ 4 | 5 | freeze(A,B) :- 6 | copy_term(A,B), numbervars(B,0,N). 7 | 8 | /* 9 | melt_new(A,B) :- Melt the frozen term A into B. 10 | 11 | */ 12 | melt_new(A,B) :- 13 | melt(A,B,Dictionary), !. 14 | 15 | melt('$VAR'(N),X,Dictionary) :- 16 | lookup(N,Dictionary,X). 17 | melt(X,X,Dictionary) :- 18 | constant(X). 19 | melt(X,Y,Dictionary) :- 20 | compound(X), 21 | functor(X,F,N), 22 | functor(Y,F,N), 23 | melt(N,X,Y,Dictionary). 24 | 25 | melt(N,X,Y,Dictionary) :- 26 | N > 0, 27 | arg(N,X,ArgX), 28 | melt(ArgX,ArgY,Dictionary), 29 | arg(N,Y,ArgY), 30 | N1 is N-1, 31 | melt(N1,X,Y,Dictionary). 32 | melt(0,X,Y,Dictionary). 33 | 34 | numbervars('$VAR'(N),N,N1) :- 35 | N1 is N + 1. 36 | numbervars(Term,N1,N2) :- 37 | nonvar(Term), functor(Term,Name,N), numbervars(0,N,Term,N1,N2). 38 | 39 | numbervars(N,N,Term,N1,N1). 40 | numbervars(I,N,Term,N1,N3) :- 41 | I < N, I1 is I + 1, arg(I1,Term,Arg), 42 | numbervars(Arg,N1,N2), numbervars(I1,N,Term,N2,N3). 43 | 44 | lookup(Key,dict(Key,X,Left,Right),Value) :- 45 | !, X = Value. 46 | lookup(Key,dict(Key,1,Left,Right),Value) :- 47 | Key < Key1 , !, lookup(Key,Left,Value). 48 | lookup(Key,dict(Key1,Left,Right),Value) :- 49 | Key > Key1, !, lookup(Key,Right,Value). 50 | 51 | % Program 15.10: Melting a term 52 | -------------------------------------------------------------------------------- /Chapter15/program-15.11.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | queue(S) :- 3 | S is a sequence of enqueue and dequeue operations, 4 | represented as a list of terms enqueue(X) and dequeue(X). 5 | */ 6 | :- op(40,xfx,\). 7 | 8 | queue(S) :- queue(S,Q\Q). 9 | 10 | queue([enqueue(X)|Xs],Q) :- 11 | enqueue(X,Q,Q1), queue(Xs,Q1). 12 | queue([dequeue(X)|Xs],Q) :- 13 | dequeue(X,Q,Q1), queue(Xs,Q1). 14 | queue([],Q). 15 | 16 | enqueue(X,Qh\[X|Qt],Qh\Qt). 17 | dequeue(X,[X|Qh]\Qt,Qh\Qt). 18 | 19 | % Program 15.11: A queue process 20 | -------------------------------------------------------------------------------- /Chapter15/program-15.12.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | flatten(Xs,Ys) :- 3 | Ys is a flattened list containing the elements in Xs. 4 | */ 5 | :- op(40,xfx,\). 6 | 7 | flatten(Xs,Ys) :- flatten_q(Xs,Qs\Qs,Ys). 8 | 9 | flatten_q([X|Xs],Ps\[Xs|Qs],Ys) :- 10 | flatten_q(X,Ps\Qs,Ys). 11 | flatten_q(X,[Q|Ps]\Qs,[X|Ys]) :- 12 | constant(X), X \= [], flatten_q(Q,Ps\Qs,Ys). 13 | flatten_q([],Q,Ys) :- 14 | non_empty(Q), dequeue(X,Q,Q1), flatten_q(X,Q1,Ys). 15 | flatten_q([],[]\[],[]). 16 | 17 | non_empty([]\[]) :- !, fail. 18 | non_empty(Q). 19 | 20 | dequeue(X,[X|Qh]\Qt,Qh\Qt). 21 | 22 | % Program 15.12: Flattening a list using a queue 23 | 24 | -------------------------------------------------------------------------------- /Chapter15/program-15.2.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | flatten(Xs,Ys) :- 3 | Ys is a flattened list containing the elements in Xs. 4 | */ 5 | :- op(40,xfx,\). 6 | 7 | flatten(Xs,Ys) :- flatten_dl(Xs,Ys\[]). 8 | 9 | flatten_dl([X|Xs],Ys\Zs) :- 10 | flatten_dl(X,Ys\Ys1), flatten_dl(Xs,Ys1\Zs). 11 | flatten_dl(X,[X|Xs]\Xs) :- 12 | constant(X), X \== []. 13 | flatten_dl([],Xs\Xs). 14 | 15 | % Program 15.2 : Flattening a list of lists using difference-lists 16 | -------------------------------------------------------------------------------- /Chapter15/program-15.3.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | reverse(Xs,Ys) :- Ys is the reversal of the list Xs. 3 | */ 4 | :- op(40,xfx,\). 5 | 6 | reverse(Xs,Ys) :- reverse_dl(Xs,Ys\[]). 7 | 8 | reverse_dl([X|Xs],Ys\Zs) :- 9 | reverse_dl(Xs,Ys\[X|Zs]). 10 | reverse_dl([],Xs\Xs). 11 | 12 | 13 | % Program 15.3: Reverse with difference-lists. 14 | -------------------------------------------------------------------------------- /Chapter15/program-15.4.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | quicksort(List,Sortedlist) :- 3 | Sortedlist is an ordered permutation of list. 4 | 5 | */ 6 | :- op(40,xfx,\). 7 | 8 | quicksort(Xs,Ys) :- quicksort_dl(Xs,Ys\[]). 9 | 10 | quicksort_dl([X|Xs],Ys\Zs) :- 11 | partition(Xs,X,Littles,Bigs), 12 | quicksort_dl(Littles,Ys\[X|Ys1]), 13 | quicksort_dl(Bigs,Ys1\Zs). 14 | quicksort_dl([],Xs\Xs). 15 | 16 | partition([X|Xs],Y,[X|Ls],Bs) :- 17 | X =< Y, !, partition(Xs,Y,Ls,Bs). 18 | partition([X|Xs],Y,Ls,[X|Bs]) :- 19 | X > Y, !, partition(Xs,Y,Ls,Bs). 20 | partition([],Y,[],[]). 21 | 22 | % Program 15.4: Quicksort using difference-lists. 23 | -------------------------------------------------------------------------------- /Chapter15/program-15.5.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | dutch(Xs,RedsWhitesBlues) :- 3 | RedsWhitesBlues is a list of elements of Xs ordered 4 | by color: red, then white, then blue. 5 | */ 6 | 7 | dutch(Xs,RedsWhitesBlues) :- 8 | distribute(Xs,Reds,Whites,Blues), 9 | append(Whites,Blues,WhitesBlues), 10 | append(Reds,WhitesBlues,RedsWhitesBlues). 11 | 12 | /* 13 | distribute(Xs,Reds,Whites,Blues) :- 14 | Reds, Whites, and Blues are the lists of red, white, 15 | and blue elements in Xs, respectively. 16 | */ 17 | 18 | distribute([red(X)|Xs],[red(X)|Reds],Whites,Blues) :- 19 | distribute(Xs,Reds,Whites,Blues). 20 | distribute([white(X)|Xs],Reds,[white(X)|Whites],Blues) :- 21 | distribute(Xs,Reds,Whites,Blues). 22 | distribute([blue(X)|Xs],Reds,Whites,[blue(X)|Blues]) :- 23 | distribute(Xs,Reds,Whites,Blues). 24 | distribute([],[],[],[]). 25 | 26 | % Program 15.5: A solution to the Dutch flag problem 27 | 28 | -------------------------------------------------------------------------------- /Chapter15/program-15.6.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | dutch(Xs,RedsWhitesBlues) :- 3 | RedsWhitesBlues is a list of elements of Xs ordered 4 | by color: red, then white, then blue. 5 | */ 6 | :- op(40,xfx,\). 7 | 8 | dutch(Xs,RedsWhitesBlues) :- 9 | distribute_dls(Xs,RedsWhitesBlues\WhitesBlues, 10 | WhitesBlues\Blues,Blues\[]). 11 | 12 | /* 13 | distribute_dls(Xs,Reds,Whites,Blues) :- 14 | Reds,Whites,Blues are difference-lists of red, white, 15 | and blue elements in Xs, respectively. 16 | */ 17 | 18 | distribute_dls([red(X)|Xs],[red(X)|Reds]\Reds1,Whites,Blues) :- 19 | distribute_dls(Xs,Reds\Reds1,Whites,Blues). 20 | distribute_dls([white(X)|Xs],Reds,[white(X)|Whites]\Whites1,Blues) :- 21 | distribute_dls(Xs,Reds,Whites\Whites1,Blues). 22 | distribute_dls([blue(X)|Xs],Reds,Whites,[blue(X)|Blues]\Blues1) :- 23 | distribute_dls(Xs,Reds,Whites,Blues\Blues1). 24 | distribute_dls([],Reds\Reds,Whites\Whites,Blues\Blues). 25 | 26 | % Program 15.6: Dutch Flag with difference-lists. 27 | -------------------------------------------------------------------------------- /Chapter15/program-15.7.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | normalize(Sum,NormalisedSum) :- 3 | NormalizedSum is the result of normalizing the sum expression Sum. 4 | 5 | */ 6 | :- op(50,xfx,++). 7 | 8 | normalize(Exp,Norm) :- normalize_ds(Exp,Norm++0). 9 | 10 | normalize_ds(A+B,Norm++Space) :- 11 | normalize_ds(A,Norm++NormB), normalize_ds(B,NormB++Space). 12 | normalize_ds(A,(A+Space)++Space) :- 13 | constant(A). 14 | 15 | % Program 15.7 : Normalizing plus expressions. 16 | -------------------------------------------------------------------------------- /Chapter15/program-15.8.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | lookup(Key,Dictionary,Value) :- 3 | Dictionary contains Value indexed under key. 4 | Dictionary is represented as an incomplete 5 | list of pairs of the form (Key,Value). 6 | */ 7 | 8 | lookup(Key,[(Key,Value)|Dict],Value). 9 | lookup(Key,[(Key1,Value1)|Dict],Value) :- 10 | Key \== Key1, lookup(Key,Dict,Value). 11 | 12 | % Program 15.8: Dictionary lookup from a list of tuples 13 | -------------------------------------------------------------------------------- /Chapter15/program-15.9.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | lookup(Key,Dictionary,Value) :- 3 | Dictionary contains the value indexed under Key. 4 | Dictionary is represented as an ordered binary tree. 5 | 6 | */ 7 | 8 | lookup(Key,dict(Key,X,Left,Right),Value) :- 9 | !, X = Value. 10 | lookup(Key,dict(Key1,X,Left,Right),Value) :- 11 | Key < Key1 , lookup(Key,Left,Value). 12 | lookup(Key,dict(Key1,X,Left,Right),Value) :- 13 | Key > Key1, lookup(Key,Right,Value). 14 | 15 | % Program 15.9: Dictionary lookup in a binary tree 16 | -------------------------------------------------------------------------------- /Chapter16/program-16.1.prolog: -------------------------------------------------------------------------------- 1 | 2 | father(terach,abraham). father(haran,lot). 3 | father(terach,nachor). father(haran,milcah). 4 | father(terach,haran). father(haran,yiscah). 5 | father(abraham,isaac). 6 | male(abraham). male(haran). female(yiscah). 7 | male(isaac). male(nachor). female(milcah). 8 | male(lot). 9 | 10 | % Program 16.1: Sample data 11 | -------------------------------------------------------------------------------- /Chapter16/program-16.2.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | for_all(Goal,Condition) :- 3 | For all solutions of Goal, Condition is true 4 | 5 | */ 6 | 7 | for_all(Goal,Condition) :- 8 | findall(Condition,Goal,Cases), check(Cases). 9 | 10 | check([Case|Cases]) :- Case, check(Cases). 11 | check([]). 12 | 13 | % Program 16.2 : Applying set predicates 14 | -------------------------------------------------------------------------------- /Chapter16/program-16.3.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | find_all_dl(X,Goal,Instances) :- Instances is the multiset 3 | of instances of X for which Goal is true. The multiplicity 4 | of an element is the number of different ways Goal can be 5 | proved with it as an instance of X. 6 | */ 7 | :- op(40,xfx,\). 8 | 9 | find_all_dl(X,Goal,Xs) :- 10 | asserta('$instance'('$mark')), 11 | Goal, 12 | asserta('$instance'(X)), 13 | fail. 14 | find_all_dl(X,Goal,Xs\Ys) :- 15 | retract('$instance'(X)), 16 | reap(X,Xs\Ys), !. 17 | 18 | reap(X,Xs\Ys) :- 19 | X \== '$mark', 20 | retract('$instance'(X1)), ! , 21 | reap(X1,Xs\[X|Ys]). 22 | reap('$mark',Xs\Xs). 23 | 24 | % Program 16.3 : Implementing an all-solutions predicate using 25 | % difference-lists, assert and retract 26 | 27 | -------------------------------------------------------------------------------- /Chapter16/program-16.4.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | connected(X,Y) :- 3 | Node X is connected to node Y in the DAG defined 4 | by edge/2 facts. 5 | */ 6 | :- op(40,xfx,\). 7 | 8 | connected(X,Y) :- enqueue(X,Q\Q,Q1), connected_bfs(Q1,Y). 9 | 10 | connected_bfs(Q,Y) :- empty(Q), !, fail. 11 | connected_bfs(Q,Y) :- dequeue(X,Q,Q1), X=Y. 12 | connected_bfs(Q,Y) :- 13 | dequeue(X,Q,Q1), enqueue_edges(X,Q1,Q2), connected_bfs(Q2,Y). 14 | 15 | enqueue(X,Qh\[X|Qt],Qh\Qt). 16 | dequeue(X,[X|Qh]\Qt,Qh\Qt). 17 | empty([]\[]). 18 | 19 | enqueue_edges(X,Xs\Ys,Xs\Zs) :- find_all_dl(N,edge(X,N),Ys\Zs), !. 20 | 21 | % findall_dl/3 :- see Program 16.3 22 | 23 | % Data 24 | 25 | edge(a,b). edge(a,c). edge(a,d). edge(a,e). edge(d,j). 26 | edge(c,f). edge(c,g). edge(f,h). edge(e,k). edge(f,i). 27 | edge(x,y). edge(y,z). edge(z,x). edge(y,u). edge(z,v). 28 | 29 | % Program 16.4: Testing connectivity breadth-first in a DAG 30 | -------------------------------------------------------------------------------- /Chapter16/program-16.5.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | connected(X,Y) :- 3 | Node X is connected to node Y in the graph defined by edge/2 facts. 4 | */ 5 | :- op(40,xfx,\). 6 | 7 | connected(X,Y) :- enqueue(X,Q\Q,Q1), connected_bfs(Q1,Y,[X]). 8 | 9 | connected_bfs(Q,Y,Visited) :- empty(Q), !, fail. 10 | connected_bfs(Q,Y,Visited) :- dequeue(X,Q,Q1), X=Y. 11 | connected_bfs(Q,Y,Visited) :- 12 | dequeue(X,Q,Q1), 13 | findall(N,edge(X,N),Edges), 14 | filter(Edges,Visited,Visited1,Q1,Q2), 15 | connected_bfs(Q2,Y,Visited1). 16 | 17 | filter([N|Ns],Visited,Visited1,Q,Q1) :- 18 | member(N,Visited), !, filter(Ns,Visited,Visited1,Q,Q1). 19 | filter([N|Ns],Visited,Visited1,Q,Q2) :- 20 | not member(N,Visited), !, 21 | enqueue(N,Q,Q1), 22 | filter(Ns,[N|Visited],Visited1,Q1,Q2). 23 | filter([],Visited,Visited,Q,Q). 24 | 25 | enqueue(X,Qh\[X|Qt],Qh\Qt). 26 | dequeue(X,[X|Qh]\Qt,Qh\Qt). 27 | empty([]\[]). 28 | 29 | % Data 30 | 31 | edge(a,b). edge(a,c). edge(a,d). edge(a,e). edge(d,j). 32 | edge(c,f). edge(c,g). edge(f,h). edge(e,k). edge(f,i). 33 | edge(x,y). edge(y,z). edge(z,x). edge(y,u). edge(z,v). 34 | 35 | % Program 16.5: Testing connectivity breadth-first in a graph 36 | -------------------------------------------------------------------------------- /Chapter16/program-16.6.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | lee_route(Source,Destination,Obstacles,Path) :- 3 | Path is a minimal length path from Source to 4 | Destination which does not cross Obstacles. 5 | */ 6 | 7 | lee_route(A,B,Obstacles,Path) :- 8 | waves(B,[[A],[]],Obstacles,Waves), 9 | path(A,B,Waves,Path). 10 | 11 | /* 12 | waves(Destination,Wavessofar,Obstacles,Waves) :- 13 | Waves is a list of waves including Wavessofar 14 | (except,perhaps,its last wave) that leads to Destination 15 | without crossing Obstacles. 16 | */ 17 | 18 | waves(B,[Wave|Waves],Obstacles,Waves) :- member(B,Wave), !. 19 | waves(B,[Wave,LastWave|LastWaves],Obstacles,Waves) :- 20 | next_wave(Wave,LastWave,Obstacles,NextWave), 21 | waves(B,[NextWave,Wave,LastWave|LastWaves],Obstacles,Waves). 22 | 23 | /* 24 | next_waves(Wave,LastWave,Obstacles,NextWave) :- 25 | Nextwave is the set of admissible points from Wave, 26 | that is excluding points from Lastwave, Wave, 27 | and points under Obstacles. 28 | */ 29 | 30 | next_wave(Wave,LastWave,Obstacles,NextWave) :- 31 | findall(X,admissible(X,Wave,LastWave,Obstacles),NextWave). 32 | 33 | admissible(X,Wave,LastWave,Obstacles) :- 34 | adjacent(X,Wave,Obstacles), 35 | not member(X,LastWave), 36 | not member(X,Wave). 37 | 38 | adjacent(X,Wave,Obstacles) :- 39 | member(X1,Wave), 40 | neighbor(X1,X), 41 | not obstructed(X,Obstacles). 42 | 43 | neighbor(X1-Y,X2-Y) :- next_to(X1,X2). 44 | neighbor(X-Y1,X-Y2) :- next_to(Y1,Y2). 45 | 46 | next_to(X,X1) :- X1 is X+1. 47 | next_to(X,X1) :- X > 0, X1 is X-1. 48 | 49 | obstructed(Point,Obstacles) :- 50 | member(Obstacle,Obstacles), obstructs(Point,Obstacle). 51 | 52 | obstructs(X-Y,obstacle(X-Y1,X2-Y2)) :- Y1 =< Y, Y =< Y2. 53 | obstructs(X-Y,obstacle(X1-Y1,X-Y2)) :- Y1 =< Y, Y =< Y2. 54 | obstructs(X-Y,obstacle(X1-Y,X2-Y2)) :- X1 =< X, X =< X2. 55 | obstructs(X-Y,obstacle(X1-Y1,X2-Y)) :- X1 =< X, X =< X2. 56 | 57 | /* 58 | path(Source,Destination,Waves,Path) :- 59 | Path is a path from Source to destination going through Waves. 60 | */ 61 | 62 | path(A,A,Waves,[A]) :- !. 63 | path(A,B,[Wave|Waves],[B|Path]) :- 64 | member(B1,Wave), neighbor(B,B1), !, path(A,B1,Waves,Path). 65 | 66 | % Testing and Data 67 | 68 | test_lee(Name,Path) :- 69 | data(Name,A,B,Obstacles), lee_route(A,B,Obstacles,Path). 70 | 71 | data(test1,1-1,3-3,[]). 72 | data(test2,1-1,5-5,[obstacle(2-3,4-5)]). 73 | data(test,1-1,5-5,[obstacle(2-3,4-5),obstacle(6-6,8-8)]). 74 | 75 | % Program 16.6 Lee routing 76 | -------------------------------------------------------------------------------- /Chapter16/program-16.7.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | kwic(Titles,KWTitles) :- 3 | KWTitles is a KWIC index of the list of titles Titles. 4 | */ 5 | kwic(Titles,KWTitles) :- 6 | setof(Ys,Xs^(member(Xs,Titles),rotate_and_filter(Xs,Ys)),KWTitles). 7 | 8 | /* 9 | rotate_and_filter(Xs,Ys) :- 10 | Ys is a rotation of the list Xs such that 11 | the first word of Ys is significant and | 12 | is inserted after the last word of Xs. 13 | */ 14 | 15 | rotate_and_filter(Xs,Ys) :- 16 | append(As,[Key|Bs],Xs), 17 | not insignificant(Key), 18 | append([Key|Bs],[`|`|As],Ys). 19 | 20 | % Vocabulary 21 | 22 | insignificant(a). insignificant(the). 23 | insignificant(in). insignificant(for). 24 | 25 | % Testing and data 26 | 27 | test_kwic(Books,Kwic) :- 28 | titles(Books,Titles), kwic(Titles,Kwic). 29 | 30 | titles(lp,[[logic,for,problem,solving], 31 | [logic,programming], 32 | [algorithmic,program,debugging], 33 | [programming,in,prolog]]). 34 | 35 | % Program 16.7 Producing a keyword in context (KWIC) index 36 | -------------------------------------------------------------------------------- /Chapter16/program-16.8.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | has_property(Xs,P) :- 3 | Each element in the list Xs has property P. 4 | */ 5 | 6 | has_property([X|Xs],P) :- 7 | apply(P,X), has_property(Xs,P). 8 | has_property([],P). 9 | 10 | apply(male,X) :- male(X). 11 | 12 | /* 13 | map_list(Xs,P,Ys) :- 14 | Each element in the list Xs stands in relation 15 | P to its corresponding element in the list Ys. 16 | */ 17 | 18 | map_list([X|Xs],P,[Y|Ys]) :- 19 | apply(P,X,Y), map_list(Xs,P,Ys). 20 | map_list([],P,[]). 21 | 22 | apply(dict,X,Y) :- dict(X,Y). 23 | 24 | % Program 16.8: Second-order predicates in Prolog 25 | -------------------------------------------------------------------------------- /Chapter17/program-17.1.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | accept(Xs) :- 3 | The string represented by the list Xs is accepted by 4 | the NDFA defined by initial/1, delta/3, and final/1. 5 | */ 6 | accept(Xs) :- initial(Q), accept(Xs,Q). 7 | 8 | accept([X|Xs],Q) :- delta(Q,X,Q1), accept(Xs,Q1). 9 | accept([],Q) :- final(Q). 10 | 11 | % Program 17.1: An interpreter for a nondeterministic finite automaton (NDFA) 12 | -------------------------------------------------------------------------------- /Chapter17/program-17.10.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | solve(Goal,Certainty,Threshold) :- 3 | Certainty is our confidence, greater than threshold, that Goal is true. 4 | */ 5 | solve(true,1,T) :- !. 6 | solve((A,B),C,T) :- !, 7 | solve(A,C1,T), solve(B,C2,T), minimum(C1,C2,C). 8 | solve(A,1,T) :- builtin(A), !, A. 9 | solve(A,C,T) :- 10 | clause_cf(A,B,C1), C1 > T, T1 is T/C1, 11 | solve(B,C2,T1), C is C1 * C2. 12 | 13 | minimum(X,Y,X) :- X =< Y, !. 14 | minimum(X,Y,Y) :- X > Y, !. 15 | 16 | % Program 17.10 Reasoning with uncertainty with threshold cutoff 17 | -------------------------------------------------------------------------------- /Chapter17/program-17.11.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | solve(A,D,Overflow) :- 3 | A has a proof tree of depth less than D and Overflow equals 4 | no_overflow,or A has a branch in the computation tree longer 5 | than D, and Overflow contains a list of its first D elements. 6 | */ 7 | solve(true,D,no_overflow) :- !. 8 | solve(A,0,overflow([])). 9 | solve((A,B),D,Overflow) :- !, 10 | D > 0, 11 | solve(A,D,OverflowA), 12 | solve_conjunction(OverflowA,B,D,Overflow). 13 | solve(A,D,Overflow) :- 14 | D > 0, 15 | clause(A,B), 16 | D1 is D - 1, 17 | solve(B,D1,OverflowB), 18 | return_overflow(OverflowB,A,Overflow). 19 | solve(A,D,no_overflow) :- 20 | D > 0, 21 | system(A), A. 22 | 23 | solve_conjunction(overflow(S),B,D,overflow(S)). 24 | solve_conjunction(no_overflow,B,D,Overflow) :- 25 | solve(B,D,Overflow). 26 | 27 | return_overflow(no_overflow,A,no_overflow). 28 | return_overflow(overflow(S),A,overflow([A|S])). 29 | 30 | % Program 17.11 :A meta-interpreter detecting a stack overflow 31 | -------------------------------------------------------------------------------- /Chapter17/program-17.12.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | isort(Xs,Ys) :- 3 | Ys is an ordered permutation of Xs. Nontermination program. 4 | */ 5 | 6 | isort([X|Xs],Ys) :- 7 | isort(Xs,Zs), insert(X,Zs,Ys). 8 | isort([],[]). 9 | 10 | insert(X,[Y|Ys],[X,Y|Ys]) :- X < Y. 11 | insert(X,[Y|Ys],[Y|Zs]) :- X >= Y, insert(Y,[X|Ys],Zs). 12 | insert(X,[],[X]). 13 | 14 | % Program 17.12 A nonterminating insertion sort 15 | -------------------------------------------------------------------------------- /Chapter17/program-17.13.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | isort(Xs,Ys) :- Buggy insertion sort. 3 | */ 4 | isort([X|Xs],Ys) :- 5 | isort(Xs,Zs), insert(X,Zs,Ys). 6 | isort([],[]). 7 | 8 | insert(X,[Y|Ys],[X,Y|Ys]) :- X >= Y. 9 | insert(X,[Y|Ys],[Y|Zs]) :- X > Y, insert(X,Ys,Zs). 10 | insert(X,[],[X]). 11 | 12 | % Program 17.13 An incorrect and incomplete insertion sort 13 | -------------------------------------------------------------------------------- /Chapter17/program-17.14.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | false_solution(A,Clause) :- 3 | If A is a provable false instance, then Clause is 4 | a false clause in the program. Bottom up algorithm. 5 | */ 6 | false_solution(A,Clause) :- 7 | solve(A,Proof), 8 | false_clause(Proof,Clause). 9 | 10 | solve(true,true) :- !. 11 | solve((A,B),(ProofA,ProofB)) :- !, 12 | solve(A,ProofA), solve(B,ProofB). 13 | solve(A,(A:-builtin)) :- builtin(A), !, A. 14 | solve(A,(A:-Proof)) :- 15 | clause(A,B), solve(B,Proof). 16 | 17 | false_clause(true,ok). 18 | false_clause(builtin,ok). 19 | false_clause((A,B),Clause) :- 20 | false_clause(A,ClauseA), 21 | check_conjunction(ClauseA,B,Clause). 22 | false_clause((A :- B),Clause) :- 23 | false_clause(B,ClauseB), 24 | check_clause(ClauseB,A,B,Clause). 25 | 26 | check_conjunction(ok,B,Clause) :- 27 | false_clause(B,Clause). 28 | check_conjunction((A :- B1),B,(A :- B1)). 29 | 30 | check_clause(ok,A,B,Clause) :- 31 | query_goal(A,Answer), 32 | check_answer(Answer,A,B,Clause). 33 | check_clause((A1 :- B1),A,B,(A1 :- B1)). 34 | 35 | check_answer(true,A,B,ok). 36 | check_answer(false,A,B,(A :- B1)) :- 37 | extract_body(B,B1). 38 | 39 | extract_body(true,true). 40 | extract_body((A :- B),A). 41 | extract_body(((A :- B),Bs),(A,As)) :- 42 | extract_body(Bs,As). 43 | 44 | query_goal(A,true) :- builtin(A). 45 | query_goal(Goal,Answer) :- 46 | not builtin(Goal), 47 | writeln(['Is the Goal',Goal,'true?']), 48 | read(Answer). 49 | 50 | writeln([T|Ts]) :- write(T), write(' '), writeln(Ts). 51 | writeln([]) :- nl. 52 | 53 | % Program 17.14 Bottom-up diagnosis of a false solution 54 | -------------------------------------------------------------------------------- /Chapter17/program-17.15.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | false_solution(A,Clause) :- 3 | If A is a provable false instance, then Clause 4 | is a false clause in the program. Top down algorithm. 5 | */ 6 | false_solution(A,Clause) :- 7 | solve(A,Proof), 8 | false_goal(Proof,Clause). 9 | 10 | solve(true,true) :- !. 11 | solve((A,B),(ProofA,ProofB)) :- !, 12 | solve(A,ProofA), solve(B,ProofB). 13 | solve(A,(A:-builtin)) :- builtin(A), !, A. 14 | solve(A,(A:-Proof)) :- 15 | clause(A,B), solve(B,Proof). 16 | 17 | false_goal((A :- B),Clause) :- 18 | false_conjunction(B,Clause), !. 19 | false_goal((A :- B),(A :- B1)) :- 20 | extract_body(B,B1). 21 | 22 | false_conjunction(((A :- B),Bs),Clause) :- 23 | query_goal(A,false), !, 24 | false_goal((A :- B),Clause). 25 | false_conjunction((A :- B),Clause) :- 26 | query_goal(A,false), !, 27 | false_goal((A :- B),Clause). 28 | false_conjunction((A,As),Clause) :- 29 | false_conjunction(As,Clause). 30 | 31 | extract_body(true,true). 32 | extract_body((A :- B),A). 33 | extract_body(((A :- B),Bs),(A,As)) :- 34 | extract_body(Bs,As). 35 | 36 | query_goal(A,true) :- builtin(A). 37 | query_goal(Goal,Answer) :- 38 | not builtin(Goal), 39 | writeln(['Is the Goal',Goal,'true?']), 40 | read(Answer). 41 | 42 | writeln([T|Ts]) :- write(T), write(' '), writeln(Ts). 43 | writeln([]) :- nl. 44 | 45 | % Program 17.15: Top-down diagnosis of a false solution 46 | -------------------------------------------------------------------------------- /Chapter17/program-17.16.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | missing_solution(A,Goal) :- 3 | If A is a non-provable true ground goal,then Goal is a 4 | true ground goal which is uncovered by the program. 5 | 6 | */ 7 | 8 | missing_solution((A,B),Goal) :- !, 9 | ( not A,missing_solution(A,Goal); 10 | A, missing_solution(B,Goal)). 11 | missing_solution(A,Goal) :- 12 | clause(A,B), 13 | query_clause((A :- B)), !, 14 | missing_solution(B,Goal). 15 | missing_solution(A,A) :- 16 | not system(A). 17 | 18 | query_clause(Clause) :- 19 | writeln(['Enter a true ground instance of ']), Clause, 20 | 'if there is no such,or "no" otherwise']), 21 | read(Answer), 22 | !, check_answer(Answer,Clause). 23 | 24 | check_answer(no,Clause) :- !, fail. 25 | check_answer(Clause,Clause) :- !. 26 | check_answer(Answer,Clause) :- 27 | write('Illegal Answer'), 28 | !, query_clause(Clause). 29 | 30 | writeln([T|Ts]) :- write(T), write(' '), writeln(Ts). 31 | writeln([]) :- nl. 32 | 33 | % Program 17.16: Diagnosing missing solution 34 | -------------------------------------------------------------------------------- /Chapter17/program-17.17.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | 3 | Rule base for a simple expert system for placing dishes in an oven. 4 | The predicates used in the rules are 5 | place_in_oven(Dish,Rack) :- 6 | Dish should be placed in the oven at level Rack for baking. 7 | pastry(Dish) :- Dish is a pastry. 8 | main_meal(Dish) :- Dish is a main meal. 9 | slow_cooker(Dish) :- Dish is a slow cooker. 10 | type(Dish,Type) :- Dish is best described as Type. 11 | size(Dish,Size) :- The size of Dish is Size. 12 | 13 | The rules have the form rule(Head,Body,Name). 14 | */ 15 | 16 | 17 | :- op(40,xfy,&). 18 | :- op(30,xf,is_true). 19 | 20 | 21 | rule(place_in_oven(Dish,top), 22 | pastry(Dish) is_true & size(Dish,small) is_true,place1). 23 | rule(place_in_oven(Dish,middle), 24 | pastry(Dish) is_true & size(Dish,big) is_true,place2). 25 | rule(place_in_oven(Dish,middle),main_meal(Dish) is_true,place3). 26 | rule(place_in_oven(Dish,bottom),slow_cooker(Dish) is_true,place4). 27 | 28 | rule(pastry(Dish),type(Dish,cake) is_true,pastry1). 29 | rule(pastry(Dish),type(Dish,bread) is_true,pastry2). 30 | 31 | rule(main_meal(Dish),type(Dish,meat) is_true,main_meal). 32 | 33 | rule(slow_cooker(Dish),type(Dish,milk_pudding) is_true,slow_cooker). 34 | 35 | fact(type(dish1,bread)). 36 | fact(size(dish1,big)). 37 | 38 | % Program 17.17: Oven placement rule-based system 39 | -------------------------------------------------------------------------------- /Chapter17/program-17.18.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | monitor(Goal) :- 3 | Succeeds if a result of yes is returned from solving Goal 4 | at the solve level, or when the end of the computation is reached. 5 | */ 6 | monitor(Goal) :- solve(Goal,Result), filter(Result). 7 | monitor(Goal). 8 | 9 | filter(yes). 10 | % filter(no) fail. 11 | 12 | /* 13 | solve(Goal,Result) :- 14 | Given a set of rules of the form rule(A,B,Name), Goal has 15 | Result yes if it follows from the rules and no if it does not. 16 | */ 17 | solve(A,yes) :- fact(A). 18 | solve(A,Result) :- rule(A,B,Name), solve_body(B,Result). 19 | solve(A,no). 20 | 21 | solve_body(A&B,Result) :- 22 | solve(A,ResultA), solve_and(ResultA,B,Result). 23 | solve_body(A is_true,Result) solve(A,Result). 24 | 25 | solve_and(no,A,no). 26 | solve_and(yes,B,Result) solve(B,Result). 27 | 28 | % Program 17.18: A skeleton two-level rule interpreter 29 | -------------------------------------------------------------------------------- /Chapter17/program-17.19.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | solve(Goal,Result) :- 3 | Given a set of rules of the form rule(A,B,Name), Goal has 4 | Result yes if it follows from the rules and no if it does not. 5 | The user is prompted for missing information. 6 | */ 7 | solve(A,yes) :- fact(A). 8 | solve(A,Result) :- rule(A,B,Name), solve_body(B,Result). 9 | solve(A,Result) :- askable(A), solve_askable(A,Result). 10 | solve(A,no). 11 | 12 | solve_body(A&B,Result) :- 13 | solve_body(A,ResultA), solve_and(ResultA,B,Result). 14 | solve_body(A is_true,Result) :- solve(A,Result). 15 | 16 | solve_and(no,A,no). 17 | solve_and(yes,B,Result) :- solve(B,Result). 18 | 19 | solve_askable(A,Result) :- 20 | not known(A), ask(A,Response), respond(Response,A,Result). 21 | 22 | % The following predicates facilitate interaction with the user. 23 | 24 | ask(A,Response) :- display_query(A), read(Response). 25 | 26 | respond(yes,A,yes) :- assert(known_to_be_true(A)). 27 | respond(no,A,no) :- assert(known_to_be_false(A)). 28 | 29 | known(A) :- known_to_be_true(A). 30 | known(A) :- known_to_be_false(A). 31 | 32 | display_query(A) write(A), write(`? '). 33 | 34 | % Program 17.19: An interactive rule interpreter 35 | -------------------------------------------------------------------------------- /Chapter17/program-17.2.prolog: -------------------------------------------------------------------------------- 1 | initial(q0). 2 | final(q0). 3 | 4 | delta(q0,a,q1). 5 | delta(q1,b,q0). 6 | 7 | % Program 17.2: An NDFA that accepts the language (ab)* 8 | -------------------------------------------------------------------------------- /Chapter17/program-17.20.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | monitor(Goal) :- 3 | Succeeds if a result of yes is returned from solving Goal 4 | at the solve level, or when the end of the computation is reached. 5 | */ 6 | monitor(Goal) :- solve(Goal,Result,[ ]), filter(Result). 7 | monitor(Goal). 8 | 9 | filter(yes). 10 | % filter(no) :- fail. 11 | 12 | /* 13 | solve(Goal,Result,Rules) :- 14 | Given a set of rules of the form rule(A,B,Name), Goal has 15 | Result yes if it follows from the rules and no if it does not. 16 | Rules is the current list of rules that have been used. 17 | */ 18 | solve(A,yes,Rules) :- fact(A). 19 | solve(A,Result,Rules) :- 20 | rule(A,B,Name), RulesB = [NamejRules], 21 | solve_body(B,Result,RulesB). 22 | solve(A,no,Rules). 23 | 24 | solve_body(A&B,Result,Rules) :- 25 | solve_body(A,ResultA,Rules), 26 | solve_and(ResultA,B,Result,Rules). 27 | solve_body(A is_true,Result,Rules) :- solve(A,Result,Rules). 28 | 29 | solve_and(no,A,no,Rules). 30 | solve_and(yes,B,Result,Rules) :- solve(B,Result,Rules). 31 | 32 | % Program 17.20: A two-level rule interpreter carrying rules 33 | -------------------------------------------------------------------------------- /Chapter17/program-17.21.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | monitor(Goal,Proof) :- 3 | Succeeds if a result of yes is returned from solving Goal at the 4 | solve level, in which case Proof is a proof tree representing the 5 | successful computation, or when the end of the computation is reached, 6 | in which case Proof is a list of failure branches since the last success. 7 | */ 8 | monitor(Goal,Proof) :- 9 | set_search_tree, solve(Goal,Result,Proof), 10 | filter(Result,Proof). 11 | monitor(Goal,Proof) :- 12 | collect_proof(P), reverse(P,[ ],P1), 13 | Proof = failed(Goal,P1). 14 | 15 | filter(yes,Proof) :- reset_search_tree. 16 | filter(no,Proof) :- store_proof(Proof), fail. 17 | 18 | /* 19 | solve(Goal,Result,Proof) :- 20 | Given a set of rules of the form rule(A,B,Name), Goal has 21 | Result yes if it follows from the rules and no if it does not. 22 | Proof is a proof tree if the result is yes and a failure branch 23 | of the search tree if the result is no. 24 | */ 25 | :- op(40,xfy,because). 26 | :- op(30,xfy,with). 27 | 28 | solve(A,yes,Tree) :- fact(A), Tree = fact(A). 29 | solve(A,Result,Tree) :- 30 | rule(A,B,Name), solve_body(B,Result,Proof), 31 | Tree = A because B with Proof. 32 | solve(A,no,Tree) :- 33 | not fact(A), not rule(A,B,Name), Tree = no_match(A). 34 | 35 | solve_body(A&B,Result,Proof) :- 36 | solve_body(A,ResultA,ProofA), 37 | solve_and(ResultA,B,Result,ProofB), 38 | Proof = ProofA & ProofB. 39 | solve_body(A is_true,Result,Proof) :- solve(A,Result,Proof). 40 | 41 | solve_and(no,A,no,unsearched). 42 | solve_and(yes,B,Result,Tree) :- solve(B,Result,Tree). 43 | 44 | % The following predicates use side effects to record and remove 45 | % branches of the search tree. 46 | 47 | collect_proof(Proof) :- retract(`search tree'(Proof)). 48 | 49 | store_proof(Proof) :- 50 | retract(`search tree'(Tree)), 51 | assert(`search tree'([ProofjTree])). 52 | 53 | set_search_tree :- assert(`search tree'([ ])). 54 | 55 | reset_search_tree :- 56 | retract(`search tree'(Proof)), 57 | assert(`search tree'([ ])). 58 | 59 | reverse([],[]). 60 | reverse([X|Xs],Zs) :- reverse(Xs,Ys), append(Ys,[X],Zs). 61 | 62 | % Program 17.21: A two-level rule interpreter with proof trees 63 | -------------------------------------------------------------------------------- /Chapter17/program-17.22.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | explain(Goal) :- 3 | Explains how the goal Goal was proved. 4 | */ 5 | explain(Goal) :- monitor(Goal,Proof), interpret(Proof). 6 | 7 | % monitor(Goal,Proof) See Program 17.21. 8 | 9 | interpret(ProofA&ProofB) :- 10 | interpret(ProofA), interpret(ProofB). 11 | interpret(failed(A,Branches)) :- 12 | nl, writeln([A,` has failed with the following failure branches:']), 13 | interpret(Branches). 14 | interpret([Fail|Fails]) :- 15 | interpret(Fail), nl, write(`NEW BRANCH'), nl, 16 | interpret(Fails). 17 | interpret([ ]). 18 | interpret(fact(A)) :- 19 | nl, writeln([A,` is a fact in the database.']). 20 | interpret(A because B with Proof) :- 21 | nl, writeln([A,` is proved using the rule']), 22 | display_rule(rule(A,B)), interpret(Proof). 23 | interpret(no_match(A)) :- 24 | nl, writeln([A,` has no matching fact or rule in the rule base.']). 25 | interpret(unsearched) :- 26 | nl, writeln([`The rest of the conjunct is unsearched.']). 27 | 28 | display_rule(rule(A,B)) :- 29 | write(`IF '), write_conjunction(B), writeln([`THEN ',A ]). 30 | 31 | write_conjunction(A&B) :- 32 | write_conjunction(A), write(` AND '), 33 | write_conjunction(B). 34 | 35 | write_conjunction(A is_true) :- write(A). 36 | 37 | writeln([X|Xs]) :- write(X), writeln(Xs). 38 | writeln([]) :- nl. 39 | 40 | % Program 17.22: Explaining a proof 41 | -------------------------------------------------------------------------------- /Chapter17/program-17.23.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | monitor(Goal,Proof) :- 3 | Succeeds if a result of yes is returned from solving Goal at the 4 | solve level, in which case Proof is a proof tree representing the 5 | successful computation, or when the end of the computation is reached, 6 | in which case Proof is a list of failure branches since the last success. 7 | */ 8 | 9 | monitor(Goal,Proof) :- 10 | set_search_tree, solve(Goal,Result,[ ],Proof), 11 | filter(Result,Proof). 12 | monitor(Goal,Proof) :- 13 | collect_proof(P), reverse(P,[ ],P1), 14 | Proof = failed(Goal,P1). 15 | 16 | filter(yes,Proof) :- reset_search_tree. 17 | filter(no,Proof) :- store_proof(Proof), fail. 18 | 19 | /* 20 | solve(Goal,Result,Rules,Proof) :- 21 | Given a set of rules of the form rule(A,B,Name), Goal has 22 | Result yes if it follows from the rules and no if it does not. 23 | Rules is the current list of rules that have been used. 24 | Proof is a proof tree if the result is yes and a failure branch 25 | of the search tree if the result is no. 26 | */ 27 | 28 | :- op(40,xfy,because). 29 | :- op(30,xfy,with). 30 | 31 | solve(A,yes,Rules,Tree) :- fact(A), Tree = fact(A). 32 | solve(A,Result,Rules,Tree) :- 33 | rule(A,B,Name), RulesB = [NamejRules], 34 | solve_body(B,Result,RulesB,Proof), 35 | Tree = A because B with Proof. 36 | solve(A,Result,Rules,Tree) :- 37 | askable(A), solve_askable(A,Result,Rules), Tree = user(A). 38 | solve(A,no,Rules,Tree) :- 39 | not fact(A), not rule(A,B,Name), Tree = no_match(A). 40 | 41 | solve_body(A&B,Result,Rules,Proof) :- 42 | solve_body(A,ResultA,Rules,ProofA), 43 | solve_and(ResultA,B,Result,Rules,ProofB), 44 | Proof = ProofA & ProofB. 45 | solve_body(A is_true,Result,Rules,Proof) :- 46 | solve(A,Result,Rules,Proof). 47 | 48 | solve_and(no,A,no,Rules,unsearched). 49 | solve_and(yes,B,Result,Rules,Tree) :- solve(B,Result,Rules,Tree). 50 | 51 | % The following predicates use side effects to record and remove 52 | % branches of the search tree. 53 | 54 | collect_proof(Proof) :- retract(`search tree'(Proof)). 55 | 56 | store_proof(Proof) :- 57 | retract(`search tree'(Tree)), 58 | assert(`search tree'([ProofjTree])). 59 | 60 | set_search_tree :- assert(`search tree'([ ])). 61 | 62 | reset_search_tree :- 63 | retract(`search tree'(Proof)), 64 | assert(`search tree'([ ])). 65 | 66 | reverse([],[]). 67 | reverse([X|Xs],Zs) :- reverse(Xs,Ys), append(Ys,[X],Zs). 68 | 69 | % The following predicates facilitate interaction with the user. 70 | 71 | ask(A,Response) :- display_query(A), read(Response). 72 | 73 | respond(yes,A,yes) :- assert(known_to_be_true(A)). 74 | respond(no,A,no) :- assert(known_to_be_false(A)). 75 | respond(why,A,[RulejRules]) :- 76 | display_rule(Rule), ask(A,Answer), respond(Answer,A,Rules). 77 | respond(why,A,[ ]) :- 78 | writeln([`No more explanation possible']), ask(A,Answer), 79 | respond(Answer,A,[ ]). 80 | 81 | known(A) :- known_to_be_true(A). 82 | known(A) :- known_to_be_false(A). 83 | 84 | display_query(A) :- write(A), write(`? '). 85 | 86 | display_rule(rule(A,B)) :- 87 | write(`IF '), write_conjunction(B), writeln([`THEN ',A ]). 88 | 89 | write_conjunction(A&B) :- 90 | write_conjunction(A), write(` AND '), 91 | write_conjunction(B). 92 | 93 | write_conjunction(A is_true) :- write(A). 94 | 95 | 96 | writeln([X|Xs]) :- write(X), writeln(Xs). 97 | writeln([]) :- nl. 98 | 99 | % Program 17.23: An explanation shell 100 | 101 | 102 | -------------------------------------------------------------------------------- /Chapter17/program-17.3.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | accept(Xs) :- 3 | The string represented by the list Xs is accepted by 4 | the NPDA defined by initial/1, delta/5, and final/1. 5 | */ 6 | 7 | accept(Xs) :- initial(Q), accept(Xs,Q,[]). 8 | 9 | accept([X|Xs],Q,S) :- delta(Q,X,S,Q1,S1), accept(Xs,Q1,S1). 10 | accept([],Q,[]) :- final(Q). 11 | 12 | % Program 17.3: An interpreter for a nondeterministic pushdown automaton (NPDA) 13 | -------------------------------------------------------------------------------- /Chapter17/program-17.4.prolog: -------------------------------------------------------------------------------- 1 | initial(q0). final(q1). 2 | 3 | delta(q0,X,S,q0,[X|S]). 4 | delta(q0,X,S,q1,[X|S]). 5 | delta(q0,X,S,q1,S). 6 | delta(q1,X,[X|S],q1,S). 7 | 8 | % Program 17.4:An NPDA for palindromes over a finite alphabet 9 | -------------------------------------------------------------------------------- /Chapter17/program-17.5.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | solve(Goal) :- 3 | Goal is true given the pure Prolog program defined by clause/2. 4 | */ 5 | 6 | solve(true). 7 | solve((A,B)) :- solve(A), solve(B). 8 | solve(A) :- clause(A,B), solve(B). 9 | 10 | % Program 17.5 A meta-interpreter for pure Prolog 11 | -------------------------------------------------------------------------------- /Chapter17/program-17.6.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | solve(Goal) :- 3 | Goal is true given the pure Prolog program defined by clause/2. 4 | */ 5 | 6 | solve(Goal) :- solve(Goal,[]). 7 | 8 | solve([],[]). 9 | solve([],[G|Goals]) :- solve(G,Goals). 10 | solve([A|B],Goals) :- append(B,Goals,Goals1),solve(A,Goals1). 11 | solve(A,Goals) :- rule(A,B), solve(B,Goals). 12 | 13 | % Program 17.6 A meta-interpreter for pure Prolog in continuation style 14 | -------------------------------------------------------------------------------- /Chapter17/program-17.7.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | solve_trace(Goal) :- 3 | Goal is true given the pure Prolog program defined by 4 | clause/2. The program traces the proof by side effects. 5 | */ 6 | 7 | solve_trace(Goal) :- 8 | solve_trace(Goal,0). 9 | 10 | solve_trace(true,Depth) :- !. 11 | solve_trace((A,B),Depth) :- !, 12 | solve_trace(A,Depth), solve_trace(B,Depth). 13 | solve_trace(A,Depth) :- 14 | builtin(A), !, A, display(A,Depth), nl. 15 | solve_trace(A,Depth) :- 16 | clause(A,B), 17 | display(A,Depth), nl, 18 | Depth1 is Depth + 1, 19 | solve_trace(B,Depth1). 20 | 21 | display(A,Depth) :- Spacing is 3*Depth, put_spaces(Spacing), write(A). 22 | 23 | put_spaces(N) :- between(1,N,I), put_char(' '), fail. 24 | put_spaces(N). 25 | 26 | between(I,J,I) :- I =< J. 27 | between(I,J,K) :- I < J, I1 is I + 1, between(I1,J,K). 28 | 29 | % Program 17.7 A tracer for Prolog 30 | -------------------------------------------------------------------------------- /Chapter17/program-17.8.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | solve(Goal,Tree) :- 3 | Tree is a proof tree for Goal given the program 4 | defined by clause/2. 5 | */ 6 | solve(true,true) :- !. 7 | solve((A,B),(ProofA,ProofB)) :- !, 8 | solve(A,ProofA), solve(B,ProofB). 9 | solve(A,(A:-builtin)) :- builtin(A), !, A. 10 | solve(A,(A:-Proof)) :- 11 | clause(A,B), solve(B,Proof). 12 | 13 | % Program 17.8 A meta-interpreter for building a proof tree 14 | -------------------------------------------------------------------------------- /Chapter17/program-17.9.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | solve(Goal,Certainty) :- 3 | Certainty is our confidence that Goal is true. 4 | */ 5 | solve(true,1) :- !. 6 | solve((A,B),C) :- !, 7 | solve(A,C1), solve(B,C2), minimum(C1,C2,C). 8 | solve(A,1) :- builtin(A), !, A. 9 | solve(A,C) :- 10 | clause_cf(A,B,C1), solve(B,C2), C is C1 * C2. 11 | 12 | minimum(X,Y,X) :- X =< Y, !. 13 | minimum(X,Y,Y) :- X > Y, !. 14 | 15 | % Program 17.9 A meta-interpreter for reasoning with uncertainty 16 | -------------------------------------------------------------------------------- /Chapter18/program-18.1.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | palindrome(Xs) :- 3 | The string represented by the list Xs is a palindrome. 4 | */ 5 | 6 | palindrome(Xs) :- palindrome(Xs,push,[]). 7 | 8 | palindrome([X|Xs],push,S) :- palindrome(Xs,push,[X|S]). 9 | palindrome([X|Xs],push,S) :- palindrome(Xs,pop,[X|S]). 10 | palindrome([X|Xs],push,S) :- palindrome(Xs,pop,S). 11 | palindrome([X|Xs],pop,[X|S]) :- palindrome(Xs,pop,S). 12 | palindrome([],pop,[]). 13 | 14 | % Program 18.1 : A program accepting palindromes 15 | -------------------------------------------------------------------------------- /Chapter18/program-18.2.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | preduce(Goal,Residue) :- 3 | Partially reduce Goal to leave the residue Residue. 4 | */ 5 | preduce(true,true) :- !. 6 | preduce((A,B),(PA,PB)) :- !, preduce(A,PA), preduce(B,PB). 7 | preduce(A,B) :- should_fold(A,B), !. 8 | preduce(A,Residue) :- 9 | should_unfold(A), !, clause(A,B), preduce(B,Residue). 10 | preduce(A,A). 11 | 12 | % Program 18.2: A meta-interpreter for determining a residue 13 | -------------------------------------------------------------------------------- /Chapter18/program-18.3.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | process(Program, RedProgram) :- 3 | Partially reduce each of the clauses in Program to produce 4 | RedProgram. 5 | */ 6 | process(Prog,NewProg) :- 7 | findall(PCl,(member(Cl,Prog),preduce(Cl,PCl)),NewProg). 8 | 9 | test(Name,Program) :- 10 | program(Name,Clauses), process(Clauses,Program). 11 | 12 | /* 13 | preduce(Goal,Residue) :- 14 | Partially reduce Goal to leave the residue Residue. 15 | */ 16 | preduce((A :- B),(PA :- PB)) :- 17 | !, preduce(B,PB), preduce(A,PA). 18 | preduce(true,true) :- !. 19 | preduce((A,B),Res) :- 20 | !, preduce(A,PA), preduce(B,PB), combine(PA,PB,Res). 21 | preduce(A,B) :- should_fold(A,B), !. 22 | preduce(A,Residue) :- 23 | should_unfold(A), !, clause(A,B), preduce(B,Residue). 24 | preduce(A,A). 25 | 26 | combine(true,B,B) :- !. 27 | combine(A,true,A) :- !. 28 | combine(A,B,(A,B)). 29 | 30 | % Program 18.3: A simple partial reduction system 31 | -------------------------------------------------------------------------------- /Chapter18/program-18.4.prolog: -------------------------------------------------------------------------------- 1 | program(npda,[(accept(Xs1) :- initial(Q1), accept(Xs1,Q1,[ ])), 2 | (accept([X2jXs2],Q2,S2) :- delta(Q2,X2,S2,Q12,S12), 3 | accept(Xs2,Q12,S12)), (accept([ ],Q3,[ ]) :- true)]). 4 | 5 | should_unfold(initial(Q)). 6 | should_unfold(final(Q)). 7 | should_unfold(delta(A,B,C,D,E)). 8 | 9 | should_fold(accept(Q,Xs,Q1),palindrome(Q,Xs,Q1)). 10 | should_fold(accept(Xs),palindrome(Xs)). 11 | 12 | % Program 18.4: Specializing an NPDA 13 | -------------------------------------------------------------------------------- /Chapter18/program-18.5.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | Rule interpreter for counting reductions 3 | */ 4 | solve(A,1) :- fact(A). 5 | solve(A,N) :- rule(A,B,Name), solve_body(B,NB), N is NB+1. 6 | 7 | solve_body(A&B,N) :- 8 | solve_body(A,NA), solve_body(B,NB), N is NA+NB. 9 | solve_body(A is_true,N) :- solve(A,N). 10 | 11 | % Sample rule base 12 | 13 | rule(oven(Dish,top),pastry(Dish) is_true 14 | & size(Dish,small) is_true,place1). 15 | rule(oven(Dish,middle),pastry(Dish) is_true 16 | & size(Dish,big) is_true,place2). 17 | rule(oven(Dish,middle),main_meal(Dish) is_true,place3). 18 | rule(oven(Dish,bottom),slow_cooker(Dish) is_true,place4). 19 | rule(pastry(Dish),type(Dish,cake) is_true,pastry1). 20 | rule(pastry(Dish),type(Dish,bread) is_true,pastry2). 21 | rule(main_meal(Dish),type(Dish,meat) is_true,main_meal). 22 | rule(slow_cooker(Dish),type(Dish,milk_pudding) 23 | is_true,slow_cooker). 24 | 25 | should_fold(solve(oven(D,P),N),oven(D,P,N)). 26 | should_fold(solve(pastry(D),N),pastry(D,N)). 27 | should_fold(solve(main_meal(D),N),main_meal(D,N)). 28 | should_fold(solve(slow_cooker(D),N),slow_cooker(D,N)). 29 | should_fold(solve(type(D,P),N),type(D,P,N)). 30 | should_fold(solve(size(D,P),N),size(D,P,N)). 31 | 32 | should_unfold(solve_body(G,N)). 33 | should_unfold(rule(A,B,Name)). 34 | 35 | program(rule_interpreter,[(solve(A1,1) :- fact(A1)), 36 | (solve(A2,N) :- rule(A2,B,Name), solve_body(B,NB), N is NB+1)]). 37 | 38 | % Program 18.5: Specializing a rule interpreter 39 | -------------------------------------------------------------------------------- /Chapter18/program-18.6.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | compose(Program1,Program2,Skeleton,FinalProgram) :- 3 | FinalProgram is the result of composing Program1 and 4 | Program2, which are both enhancements of Skeleton. 5 | */ 6 | 7 | compose([Cl1|Cls1],[Cl2|Cls2],[ClSkel|ClsSkel],[Cl|Cls]) :- 8 | compose_clause(Cl1,Cl2,ClSkel,Cl), 9 | compose(Cls1,Cls2,ClsSkel,Cls). 10 | compose([ ],[ ],[ ],[ ]). 11 | 12 | compose_clause((A1 :- B1),(A2 :- B2),(ASkel :- BSkel),(A :- B)) :- 13 | composition_specification(A1,A2,ASkel,A), 14 | compose_bodies(BSkel,B1,B2,B\true). 15 | 16 | compose_bodies(SkelBody,Body1,Body2,B\BRest) :- 17 | first(SkelBody,G), !, 18 | align(G,Body1,G1,RestBody1,B\B1), 19 | align(G,Body2,G2,RestBody2,B1\(Goal,B2)), 20 | compose_goal(G1,G2,Goal), 21 | rest(SkelBody,Gs), 22 | compose_bodies(Gs,RestBody1,RestBody2,B2\BRest). 23 | compose_bodies(true,Body1,Body2,B\BRest) :- 24 | rest_goals(Body1,B\B1), rest_goals(Body2,B1\BRest). 25 | 26 | align(Goal,Body,G,RestBody,B\B) :- 27 | first(Body,G), correspond(G,Goal), !, rest(Body,RestBody). 28 | align(Goal,(G,Body),CorrespondingG,RestBody,(G,B)\B1) :- 29 | align(Goal,Body,CorrespondingG,RestBody,B\B1). 30 | 31 | first((G,Gs),G). 32 | first(G,G) G \== (A,B), G \== true. 33 | 34 | rest((G,Gs),Gs). 35 | rest(G,true) :- G \== (A,B). 36 | 37 | correspond(G,G). 38 | correspond(G,B) :- map(G,B). 39 | 40 | compose_goal(G,G,G) :- !. 41 | compose_goal(A1,A2,A) :- 42 | !, composition_specification(A1,A2,ASkel,A). 43 | 44 | rest_goals(true,B\B) :- !. 45 | rest_goals(Body,(G,B)\BRest) :- 46 | first(Body,G), !, rest(Body,Body1), rest_goals(Body1,B\BRest). 47 | 48 | % Program 18.6: Composing two enhancements of a skeleton 49 | -------------------------------------------------------------------------------- /Chapter18/program-18.7.prolog: -------------------------------------------------------------------------------- 1 | test_compose(X,Prog) :- 2 | program1(X,Prog1), program2(X,Prog2), 3 | skeleton(X,Skeleton), compose(Prog1,Prog2,Skeleton,Prog). 4 | 5 | program1(test,[ 6 | (union([X1jXs1],Ys1,Zs1) :- 7 | member(X1,Ys1), union(Xs1,Ys1,Zs1)), 8 | (union([X2|Xs2],Ys2,[X2|Zs2]) :- 9 | nonmember(X2,Ys2), union(Xs2,Ys2,Zs2)), 10 | (union([ ],Ys3,Ys3) :- true)]). 11 | 12 | program2(test,[ 13 | (common([X1|Xs1],Ys1,N1) :- 14 | member(X1,Ys1), common(Xs1,Ys1,M1), N1 is M1+1), 15 | (common([X2|Xs2],Ys2,N2) :- 16 | nonmember(X2,Ys2), common(Xs2,Ys2,N2)), 17 | (common([ ],Ys3,0) :- true)]). 18 | 19 | skeleton(test,[ 20 | (skel([X1|Xs1],Ys1) :- member(X1,Ys1), skel(Xs1,Ys1)), 21 | (skel([X2|Xs2],Ys2) :- nonmember(X2,Ys2), skel(Xs2,Ys2)), 22 | (skel([ ],Ys3) :- true)]). 23 | 24 | composition_specification(union(Xs,Ys,Us), common(Xs,Ys,N), 25 | skel(Xs,Ys),uc(Xs,Ys,Us,N)). 26 | 27 | map(union(Xs,Ys,Zs), skel(Xs,Ys)). 28 | map(common(Xs,Ys,N), skel(Xs,Ys)). 29 | 30 | % Program 18.7: Testing program composition 31 | -------------------------------------------------------------------------------- /Chapter18/program-18.8.prolog: -------------------------------------------------------------------------------- 1 | s(As\Xs) :- a(As\Bs), b(Bs\Cs), c(Cs\Xs). 2 | 3 | a(Xs\Ys) :- connect([a],Xs\Xs1), a(Xs1\Ys). 4 | a(Xs\Ys) :- connect([ ],Xs\Ys). 5 | 6 | b(Xs\Ys) :- connect([b],Xs\Xs1), b(Xs1\Ys). 7 | b(Xs\Ys) :- connect([ ],Xs\Ys). 8 | 9 | c(Xs\Ys) :- connect([c],Xs\Xs1), c(Xs1\Ys). 10 | c(Xs\Ys) :- connect([ ],Xs\Ys). 11 | 12 | connect([ ],Xs\Xs). 13 | connect([W|Ws],[W|Xs]\Ys) :- connect(Ws,Xs\Ys). 14 | 15 | % Program 18.8: A Prolog program parsing the language a*b*c 16 | -------------------------------------------------------------------------------- /Chapter18/program-18.9.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | translate(Grammar,Program) :- 3 | Program is the Prolog equivalent of the context-free 4 | grammar Grammar. 5 | */ 6 | translate([Rule|Rules],[Clause|Clauses]) :- 7 | translate_rule(Rule,Clause), 8 | translate(Rules,Clauses). 9 | translate([ ],[ ]). 10 | 11 | /* 12 | translate_rule(GrammarRule,PrologClause) :- 13 | PrologClause is the Prolog equivalent of the grammar 14 | rule GrammarRule. 15 | */ 16 | translate_rule((Lhs --> Rhs),(Head :- Body)) :- 17 | translate_head(Lhs,Head,Xs\Ys), 18 | translate_body(Rhs,Body,Xs\Ys),!. 19 | 20 | translate_head(A,A1,Xs) :- 21 | translate_goal(A,A1,Xs). 22 | 23 | translate_body((A,B),(A1,B1),Xs\Ys) :- 24 | !, translate_body(A,A1,Xs\Xs1), translate_body(B,B1,Xs1\Ys). 25 | translate_body(A,A1,Xs) :- 26 | translate_goal(A,A1,Xs). 27 | 28 | translate_goal(A,A1,DList) :- 29 | nonterminal(A), functor(A1,A,1), arg(1,A1,DList). 30 | translate_goal(Terms,connect(Terms,S),S) :- 31 | terminals(Terms). 32 | 33 | non_terminal(A) :- atom(A). 34 | 35 | terminals(Xs) :- list(Xs). 36 | 37 | list([]). 38 | list([X|Xs]) :- list(Xs). 39 | 40 | % Program 18.9: Translating grammar rules to Prolog clauses 41 | -------------------------------------------------------------------------------- /Chapter19/program-19.1.prolog: -------------------------------------------------------------------------------- 1 | s(N) --> a(NA), b(NB), c(NC), {N is NA+NB+NC}. 2 | 3 | a(N) --> [a], a(N1), {N is N1+1}. 4 | a(0) --> [ ]. 5 | 6 | b(N) --> [b], b(N1), {N is N1+1}. 7 | b(0) --> [ ]. 8 | 9 | c(N) --> [c], c(N1), {N is N1+1}. 10 | c(0) --> [ ]. 11 | 12 | % Program 19.1: Enhancing the language a*b*c 13 | -------------------------------------------------------------------------------- /Chapter19/program-19.2.prolog: -------------------------------------------------------------------------------- 1 | s(N) --> a(N), b(N), c(N). 2 | 3 | a(N) --> [a], a(N1), {N is N1+1}. 4 | a(0) --> [ ]. 5 | 6 | b(N) --> [b], b(N1), {N is N1+1}. 7 | b(0) --> [ ]. 8 | 9 | c(N) --> [c], c(N1), {N is N1+1}. 10 | c(0) --> [ ]. 11 | 12 | % Program 19.2: Recognizing the language a^Nb^Nc^N 13 | -------------------------------------------------------------------------------- /Chapter19/program-19.3.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | The grammar for the declarative part of a Pascal program. 3 | */ 4 | declarative_part --> 5 | const_declaration, type_declaration, 6 | var_declaration, procedure_declaration. 7 | 8 | % Constant declarations 9 | 10 | const_declaration --> [ ]. 11 | const_declaration --> 12 | [const], const_definition, [;], const_definitions. 13 | 14 | const_definitions --> [ ]. 15 | const_definitions --> 16 | const_definition, [;], const_definitions. 17 | 18 | const_definition --> identifier, [=], constant. 19 | 20 | identifier --> [X], {atom(X)}. 21 | 22 | constant --> [X], {constant(X)}. 23 | 24 | % Type declarations 25 | 26 | type_declaration --> [ ]. 27 | type_declaration --> 28 | [type], type_definition, [;], type_definitions. 29 | 30 | type_definitions --> [ ]. 31 | type_definitions --> type_definition, [;], type_definitions. 32 | 33 | type_definition --> identifier, [=], type. 34 | 35 | type --> [`INTEGER']. 36 | type --> [`REAL']. 37 | type --> [`BOOLEAN']. 38 | type --> [`CHAR']. 39 | 40 | % Variable declarations 41 | 42 | var_declaration --> [ ]. 43 | var_declaration --> 44 | [var], var_definition, [;], var_definitions. 45 | 46 | var_definitions --> [ ]. 47 | var_definitions --> var_definition, [;], var_definitions. 48 | var_definition --> identifiers, [:], type. 49 | 50 | identifiers --> identifier. 51 | identifiers --> identifier, [,], identifiers. 52 | 53 | % Procedure declarations 54 | 55 | procedure_declaration --> [ ]. 56 | procedure_declaration --> procedure_heading, [;], block. 57 | 58 | procedure_heading --> 59 | [procedure], identifier, formal_parameter_part. 60 | 61 | formal_parameter_part --> [ ]. 62 | formal_parameter_part --> [(], formal_parameter_section, [)]. 63 | 64 | formal_parameter_section --> formal_parameters. 65 | formal_parameter_section --> 66 | formal_parameters, [;], formal_parameter_section. 67 | 68 | formal_parameters --> value_parameters. 69 | 70 | formal_parameters --> variable_parameters. 71 | 72 | value_parameters --> var_definition. 73 | 74 | variable_parameters --> [var], var_definition. 75 | 76 | % Program 19.3: Parsing the declarative part of a Pascal block -------------------------------------------------------------------------------- /Chapter19/program-19.4.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | parse(Start,Tokens) :- 3 | The sequence of tokens Tokens represented as a difference-list 4 | can be reached by applying the grammar rules defined by -->/2, 5 | starting from Start. 6 | */ 7 | parse(A,Tokens) :- 8 | nonterminal(A), A --> B, parse(B,Tokens). 9 | parse((A,B),Tokens\Xs) :- 10 | parse(A,Tokens\Tokens1), parse(B,Tokens1\Xs). 11 | 12 | parse(A,Tokens) :- terminals(A), connect(A,Tokens). 13 | parse({A},Xs\Xs) :- A. 14 | 15 | terminals(Xs) :- list(Xs). 16 | 17 | list([]). 18 | list([X|Xs]) :- list(Xs). 19 | 20 | connect([ ],Xs\Xs). 21 | connect([W|Ws],[W|Xs]\Ys) :- connect(Ws,Xs\Ys). 22 | 23 | % Program 19.4: A definite clause grammar (DCG) interpreter 24 | -------------------------------------------------------------------------------- /Chapter19/program-19.5.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | parse(Start,Tokens,N) :- 3 | The sequence of tokens Tokens, represented as a difference-list, 4 | can be reached by applying the grammar rules defined by -->/2, 5 | starting from Start, and N tokens are found. 6 | */ 7 | parse(A,Tokens,N) :- 8 | nonterminal(A), A --> B, parse(B,Tokens,N). 9 | parse((A,B),Tokens\Xs,N) :- 10 | parse(A,Tokens\Tokens1,NA), parse(B,Tokens1\Xs,NB) 11 | N is NA+NB. 12 | 13 | parse(A,Tokens,N) :- terminals(A), connect(A,Tokens), length(A,N). 14 | parse({A},Xs\Xs,0) :- A. 15 | 16 | terminals(Xs) :- list(Xs). 17 | 18 | list([]). 19 | list([X|Xs]) :- list(Xs). 20 | 21 | connect([ ],Xs\Xs). 22 | connect([W|Ws],[W|Xs]\Ys) :- connect(Ws,Xs\Ys). 23 | 24 | length([X|Xs],N) :- length(Xs,N1), N is N1+1. 25 | length([],0). 26 | 27 | % Program 19.5: A DCG interpreter that counts words 28 | -------------------------------------------------------------------------------- /Chapter19/program-19.6.prolog: -------------------------------------------------------------------------------- 1 | % Grammar Rules 2 | 3 | sentence --> noun_phrase, verb_phrase. 4 | 5 | noun_phrase --> determiner, noun_phrase2. 6 | noun_phrase --> noun_phrase2. 7 | 8 | noun_phrase2 --> adjective, noun_phrase2. 9 | noun_phrase2 --> noun. 10 | 11 | verb_phrase --> verb. 12 | verb_phrase --> verb, noun_phrase. 13 | 14 | % Vocabulary 15 | 16 | determiner --> [the]. adjective --> [decorated] 17 | determiner --> [a]. 18 | 19 | noun --> [pieplate]. verb --> [contains]. 20 | noun --> [surprise]. 21 | 22 | % Program 19.6: A DCG context-free grammar 23 | -------------------------------------------------------------------------------- /Chapter19/program-19.7.prolog: -------------------------------------------------------------------------------- 1 | sentence(sentence(NP,VP)) --> noun_phrase(NP), verb_phrase(VP). 2 | 3 | noun_phrase(np(D,N)) --> determiner(D), noun_phrase2(N). 4 | noun_phrase(np(N)) --> noun_phrase2(N). 5 | 6 | noun_phrase2(np2(A,N)) --> adjective(A), noun_phrase2(N). 7 | noun_phrase2(np2(N)) --> noun(N). 8 | 9 | verb_phrase(vp(V)) --> verb(V). 10 | verb_phrase(vp(V,N)) --> verb(V), noun_phrase(N). 11 | 12 | % Vocabulary 13 | 14 | determiner(det(the)) --> [the]. 15 | determiner(det(a)) --> [a]. 16 | 17 | noun(noun(pieplate)) --> [pieplate]. 18 | noun(noun(surprise)) --> [surprise]. 19 | 20 | adjective(adj(decorated)) --> [decorated]. 21 | 22 | verb(verb(contains)) --> [contains]. 23 | 24 | % Program 19.7: A DCG computing a parse tree 25 | -------------------------------------------------------------------------------- /Chapter19/program-19.8.prolog: -------------------------------------------------------------------------------- 1 | sentence(sentence(NP,VP)) --> 2 | noun_phrase(NP,Num), verb_phrase(VP,Num). 3 | 4 | noun_phrase(np(D,N),Num) --> 5 | determiner(D,Num), noun_phrase2(N,Num). 6 | noun_phrase(np(N),Num) --> noun_phrase2(N,Num). 7 | 8 | noun_phrase2(np2(A,N),Num) --> 9 | adjective(A), noun_phrase2(N,Num). 10 | noun_phrase2(np2(N),Num) --> noun(N,Num). 11 | 12 | verb_phrase(vp(V),Num) --> verb(V,Num). 13 | verb_phrase(vp(V,N),Num) --> 14 | verb(V,Num), noun_phrase(N,Num1). 15 | 16 | % Vocabulary 17 | 18 | determiner(det(the),Num) --> [the]. 19 | determiner(det(a),singular) --> [a]. 20 | 21 | noun(noun(pieplate),singular) --> [pieplate]. 22 | noun(noun(pieplates),plural) --> [pieplates]. 23 | noun(noun(surprise),singular) --> [surprise]. 24 | noun(noun(surprises),plural) --> [surprises]. 25 | 26 | adjective(adj(decorated)) --> [decorated]. 27 | 28 | verb(verb(contains),singular) --> [contains]. 29 | verb(verb(contain),plural) --> [contain]. 30 | 31 | % Program 19.8: A DCG with subject/object number agreement 32 | -------------------------------------------------------------------------------- /Chapter19/program-19.9.prolog: -------------------------------------------------------------------------------- 1 | number(0) --> [zero]. 2 | number(N) --> xxx(N). 3 | 4 | xxx(N) --> 5 | digit(D), [hundred], rest_xxx(N1), {N is D100+N1}. 6 | xxx(N) --> xx(N). 7 | 8 | rest_xxx(0) --> [ ]. 9 | rest_xxx(N) --> [and], xx(N). 10 | 11 | xx(N) --> digit(N). 12 | xx(N) --> teen(N). 13 | xx(N) --> tens(T), rest_xx(N1), {N is T+N1}. 14 | 15 | rest_xx(0) --> [ ]. 16 | rest_xx(N) --> digit(N). 17 | 18 | digit(1) --> [one]. teen(10) --> [ten]. 19 | digit(2) --> [two]. teen(11) --> [eleven]. 20 | digit(3) --> [three]. teen(12) --> [twelve]. 21 | digit(4) --> [four]. teen(13) --> [thirteen]. 22 | digit(5) --> [five]. teen(14) --> [fourteen]. 23 | digit(6) --> [six]. teen(15) --> [fifteen]. 24 | digit(7) --> [seven]. teen(16) --> [sixteen]. 25 | digit(8) --> [eight]. teen(17) --> [seventeen]. 26 | digit(9) --> [nine]. teen(18) --> [eighteen]. 27 | teen(19) --> [nineteen]. 28 | tens(20) --> [twenty]. 29 | tens(30) --> [thirty]. 30 | tens(40) --> [forty]. 31 | tens(50) --> [fifty]. 32 | tens(60) --> [sixty]. 33 | tens(70) --> [seventy]. 34 | tens(80) --> [eighty]. 35 | tens(90) --> [ninety]. 36 | 37 | % Program 19.9: A DCG for recognizing numbers 38 | -------------------------------------------------------------------------------- /Chapter2/program-2.1.prolog: -------------------------------------------------------------------------------- 1 | 2 | uncle(Uncle,Person) :- 3 | brother(Uncle,Parent), parent(Parent,Person). 4 | 5 | sibling(Sib1,Sib2) :- 6 | parent(Parent,Sib1), parent(Parent,SIb2), Sib1 \= Sib2. 7 | 8 | cousin(Cousin1,Cousin2) :- 9 | parent(Parent1,Cousin1), 10 | parent(Parent2,Cousin2), 11 | sibling(Parent1,Parent2). 12 | 13 | % Program 2.1: Defining family relationships 14 | -------------------------------------------------------------------------------- /Chapter2/program-2.2.prolog: -------------------------------------------------------------------------------- 1 | resistor(power,n1). 2 | resistor(power,n2). 3 | 4 | transistor(n2,ground,n1). 5 | transistor(n3,n4,n2). 6 | transistor(n5,ground,n4). 7 | 8 | /* 9 | inverter(Input,Output) :- 10 | Output is the inversion of Input. 11 | */ 12 | 13 | inverter(Input,Output) :- 14 | transistor(Input,ground,Output), 15 | resistor(power,Output). 16 | 17 | /* 18 | nand_gate(Input1,Input2,Output):- 19 | Output is the logical nand of Input1 and Input2. 20 | */ 21 | 22 | nand_gate(Input1,Input2,Output) :- 23 | transistor(Input1,X,Output), 24 | transistor(Input2,ground,X), 25 | resistor(power,Output). 26 | 27 | /* 28 | and_gate(Input1,Input2,Output):- 29 | Output is the logical and of Input1 and Input2. 30 | */ 31 | 32 | and_gate(Input1,Input2,Output) :- 33 | nand_gate(Input1,Input2,X), 34 | inverter(X,Output). 35 | 36 | % Program 2.2: A circuit for a logical and-gate 37 | -------------------------------------------------------------------------------- /Chapter2/program-2.3.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | resistor(R,Node1,Node2) :- 3 | R is a resistor between Node1 and Node2. 4 | */ 5 | resistor(r1,power,n1). 6 | resistor(r2,power,n2). 7 | 8 | /* 9 | transistor(T,Gate,Source,Drain) :- 10 | T is a transistor whose gate is Gate, 11 | source is Source, and drain is Drain. 12 | */ 13 | 14 | transistor(t1,n2,ground,n1). 15 | transistor(t2,n3,n4,n2). 16 | transistor(t3,n5,ground,n4). 17 | 18 | /* 19 | inverter(I,Input,Output) :- 20 | I is an inverter which inverts Input to Output. 21 | */ 22 | inverter(inv(T,R),Input,Output) :- 23 | transistor(T,Input,ground,Output), 24 | resistor(R,power,Output). 25 | 26 | /* 27 | nand_gate(Nand,Input1,Input2,Output):- 28 | Nand is a gate forming the logical nand, Output, 29 | of Input1 and Input2. 30 | */ 31 | nand_gate(nand(T1,T2,R),INput1,Input2,Output) :- 32 | transistor(T1,Input1,X,Output), 33 | transistor(T2,Input2,ground,X), 34 | resistor(R,power,Output). 35 | 36 | /* 37 | and_gate(And,Input1,Input2,Output):- 38 | And is a gate forming the logical and, Output, 39 | of Input1 and Input2. 40 | */ 41 | 42 | and_gate(and(N,I),INput1,Input2,Output) :- 43 | nand_gate(N,Input1,Input2,X), 44 | inverter(I,X,Output). 45 | 46 | % Program 2.3: The circuit database with names 47 | -------------------------------------------------------------------------------- /Chapter2/program-2.4.prolog: -------------------------------------------------------------------------------- 1 | lecturer(Lecturer,Course) :- 2 | course(Course,Time,Lecturer,Location). 3 | 4 | duration(Course,Length) :- 5 | course(Course,time(Day,Start,Finish),Lecturer,Location), 6 | plus(Start,Length,Finish). 7 | 8 | teaches(Lecturer,Day) :- 9 | course(Course,time(Day,Start,Finish),Lecturer,Location). 10 | 11 | occupied(Room,Day,Time) :- 12 | course(Course,time(Day,Start,Finish),Lecturer,Location), 13 | Start =< Time, Time =< Finish. 14 | 15 | % Program 2.4: Course rules 16 | -------------------------------------------------------------------------------- /Chapter2/program-2.5.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | ancestor(Ancestor,Descendant) :- 3 | Ancestor is an ancestor of Descendant. 4 | */ 5 | ancestor(Ancestor,Descendant) :- 6 | parent(Ancestor,Descendant). 7 | ancestor(Ancestor,Descendant) :- 8 | parent(Ancestor,Person), ancestor(Person,Descendant). 9 | 10 | % Program 2.5: The ancestor relationship 11 | -------------------------------------------------------------------------------- /Chapter2/program-2.6.prolog: -------------------------------------------------------------------------------- 1 | edge(a,b). edge(a,c). edge(b,d). 2 | edge(c,d). edge(d,e). edge(f,g). 3 | 4 | % Program 2.6: A directed graph 5 | -------------------------------------------------------------------------------- /Chapter2/program-2.7.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | connected(Node1,Node2) :- 3 | Node1 is connected to Node2 in the graph 4 | defined by the edge/2 relation. 5 | */ 6 | connected(Node,Node). 7 | connected(Node1,Node2) :- edge(Node1,Link), connected(Link,Node2). 8 | 9 | % Program 2.7: The transitive closure of the edge relationship 10 | -------------------------------------------------------------------------------- /Chapter20/program-20.1.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | solve_dfs(State,History,Moves) :- 3 | Moves is the sequence of moves to reach a desired final state 4 | from the current State, where History contains the states 5 | visited previously. 6 | */ 7 | solve_dfs(State,History,[]) :- 8 | final_state(State). 9 | solve_dfs(State,History,[Move|Moves]) :- 10 | move(State,Move), 11 | update(State,Move,State1), 12 | legal(State1), 13 | not member(State1,History), 14 | solve_dfs(State1,[State1|History],Moves). 15 | 16 | /* Testing the framework */ 17 | 18 | test_dfs(Problem,Moves) :- 19 | initial_state(Problem,State), solve_dfs(State,[State],Moves). 20 | 21 | % Program 20.1 A depth-first state-transition framework for problem solving 22 | -------------------------------------------------------------------------------- /Chapter20/program-20.10.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | evaluate_and_choose(Moves,Position,Depth,Flag,Record,BestMove) :- 3 | Chooses the BestMove from the set of Moves from the current Position 4 | using the minimax algorithm searching Depth ply ahead. 5 | Flag indicates if we are currently minimizing or maximizing. 6 | Record records the current best move 7 | */ 8 | 9 | evaluate_and_choose([Move|Moves],Position,D,MaxMin,Record,BestMove) :- 10 | move(Move,Position,Position1), 11 | minimax(D,Position1,MaxMin,MoveX,Value), 12 | update(Move,Value,Record,Record1), 13 | evaluate_and_choose(Moves,Position,D,MaxMin,Record1,BestMove). 14 | evaluate_and_choose([],Position,D,MaxMin,Record,Record). 15 | 16 | minimax(0,Position,MaxMin,Move,Value) :- 17 | value(Position,V), 18 | Value is V * MaxMin. 19 | minimax(D,Position,MaxMin,Move,Value) :- 20 | D > 0, 21 | findall(M,move(Position,M),Moves), 22 | D1 is D - 1, 23 | MinMax is -MaxMin, 24 | evaluate_and_choose(Moves,Position,D1,MinMax,(nil,-1000),(Move,Value)). 25 | 26 | update(Move,Value,(Move1,Value1),(Move1,Value1)) :- 27 | Value =< Value1. 28 | update(Move,Value,(Move1,Value1),(Move,Value)) :- 29 | Value > Value1. 30 | 31 | % Program 20.10 Choosing the best move with the minimax algorithm 32 | -------------------------------------------------------------------------------- /Chapter20/program-20.11.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | evaluate_and_choose(Moves,Position,Depth,Alpha,Beta,Record,BestMove) :- 3 | Chooses the BestMove from the set of Moves from the current Position 4 | using the minimax algorithm with alpha-beta cutoff searching 5 | Depth ply ahead. Alpha and Beta are the parameters of the algorithm. 6 | Record records the current best move 7 | */ 8 | evaluate_and_choose([Move|Moves],Position,D,Alpha,Beta,Move1,BestMove) :- 9 | move(Move,Position,Position1), 10 | alpha_beta(D,Position1,Alpha,Beta,MoveX,Value), 11 | Value1 is -Value, 12 | cutoff(Move,Value1,D,Alpha,Beta,Moves,Position,Move1,BestMove). 13 | evaluate_and_choose([],Position,D,Alpha,Beta,Move,(Move,Alpha)). 14 | 15 | alpha_beta(0,Position,Alpha,Beta,Move,Value) :- 16 | value(Position,Value). 17 | alpha_beta(D,Position,Alpha,Beta,Move,Value) :- 18 | findall(M,move(Position,M),Moves), 19 | Alpha1 is -Beta, 20 | Beta1 is -Alpha, 21 | D1 is D-1, 22 | evaluate_and_choose(Moves,Position,D1,Alpha1,Beta1,nil,(Move,Value)). 23 | 24 | cutoff(Move,Value,D,Alpha,Beta,Moves,Position,Move1,(Move,Value)) :- 25 | Value >= Beta. 26 | cutoff(Move,Value,D,Alpha,Beta,Moves,Position,Move1,BestMove) :- 27 | Alpha < Value, Value < Beta, 28 | evaluate_and_choose(Moves,Position,D,Value,Beta,Move,BestMove). 29 | cutoff(Move,Value,D,Alpha,Beta,Moves,Position,Move1,BestMove) :- 30 | Value =< Alpha, 31 | evaluate_and_choose(Moves,Position,D,Alpha,Beta,Move1,BestMove). 32 | 33 | % Program 20.11 Choosing a move using minimax with alpha-beta pruning 34 | -------------------------------------------------------------------------------- /Chapter20/program-20.2.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | States for the wolf, goat and cabbage problem are a structure 3 | wgc(Boat,Left,Right), where Boat is the bank on which the boat 4 | currently is, Left is the list of occupants on the left bank of 5 | the river, and Right is the list of occupants on the right bank. 6 | */ 7 | initial_state(wgc,wgc(left,[wolf,goat,cabbage],[])). 8 | 9 | final_state(wgc(right,[],[wolf,goat,cabbage])). 10 | 11 | move(wgc(left,L,R),Cargo) :- member(Cargo,L). 12 | move(wgc(right,L,R),Cargo) :- member(Cargo,R). 13 | move(wgc(B,L,R),alone). 14 | 15 | update(wgc(B,L,R),Cargo,wgc(B1,L1,R1)) :- 16 | update_boat(B,B1), update_banks(Cargo,B,L,R,L1,R1). 17 | 18 | update_boat(left,right). 19 | update_boat(right,left). 20 | 21 | update_banks(alone,B,L,R,L,R). 22 | update_banks(Cargo,left,L,R,L1,R1) :- 23 | select(Cargo,L,L1), insert(Cargo,R,R1). 24 | update_banks(Cargo,right,L,R,L1,R1) :- 25 | select(Cargo,R,R1), insert(Cargo,L,L1). 26 | 27 | insert(X,[Y|Ys],[X,Y|Ys]) :- 28 | precedes(X,Y). 29 | insert(X,[Y|Ys],[Y|Zs]) :- 30 | precedes(Y,X), insert(X,Ys,Zs). 31 | insert(X,[],[X]). 32 | 33 | precedes(wolf,X). 34 | precedes(X,cabbage). 35 | 36 | legal(wgc(left,L,R)) :- not illegal(R). 37 | legal(wgc(right,L,R)) :- not illegal(L). 38 | 39 | illegal(Bank) :- member(wolf,Bank), member(goat,Bank). 40 | illegal(Bank) :- member(goat,Bank), member(cabbage,Bank). 41 | 42 | select(X,[X|Xs],Xs). 43 | select(X,[Y|Ys],[Y|Zs]) :- 44 | select(X,Ys,Zs). 45 | 46 | % Program 20.2: Solving the wolf, goat, and cabbage problem -------------------------------------------------------------------------------- /Chapter20/program-20.3.prolog: -------------------------------------------------------------------------------- 1 | /* Problem Solving :- Water Jugs Problem */ 2 | 3 | initial_state(jugs,jugs(0,0)). 4 | 5 | final_state(jugs(4,V2)). 6 | final_state(jugs(V1,4)). 7 | 8 | move(jugs(V1,V2),fill(1)). 9 | move(jugs(V1,V2),fill(2)). 10 | move(jugs(V1,V2),empty(1)). 11 | move(jugs(V1,V2),empty(2)). 12 | move(jugs(V1,V2),transfer(2,1)). 13 | move(jugs(V1,V2),transfer(1,2)). 14 | 15 | update(jugs(V1,V2),fill(1),jugs(C1,V2)) :- capacity(1,C1). 16 | update(jugs(V1,V2),fill(2),jugs(V1,C2)) :- capacity(2,C2). 17 | update(jugs(V1,V2),empty(1),jugs(0,V2)). 18 | update(jugs(V1,V2),empty(2),jugs(V1,0)). 19 | update(jugs(V1,V2),transfer(2,1),jugs(W1,W2)) :- 20 | capacity(1,C1), 21 | Liquid is V1 + V2, 22 | Excess is Liquid - C1, 23 | adjust(Liquid,Excess,W1,W2). 24 | update(jugs(V1,V2),transfer(1,2),jugs(W1,W2)) :- 25 | capacity(2,C2), 26 | Liquid is V1 + V2, 27 | Excess is Liquid - C2, 28 | adjust(Liquid,Excess,W2,W1). 29 | 30 | adjust(Liquid, Excess,Liquid,0) :- Excess =< 0. 31 | adjust(Liquid,Excess,V,Excess) :- Excess > 0, V is Liquid - Excess. 32 | 33 | legal(jugs(V1,V2)). 34 | 35 | capacity(1,8). 36 | capacity(2,5). 37 | 38 | % Program 20.3 Solving the water jugs problem 39 | -------------------------------------------------------------------------------- /Chapter20/program-20.4.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | solve_hill_climb(State,History,Moves) :- 3 | Moves is the sequence of moves to reach a desired final state 4 | from the current State, where History are the states 5 | visited previously. 6 | */ 7 | 8 | solve_hill_climb(State,History,[]) :- 9 | final_state(State). 10 | solve_hill_climb(State,History,[Move|Moves]) :- 11 | hill_climb(State,Move), 12 | update(State,Move,State1), 13 | legal(State1), 14 | not member(State1,History), 15 | solve_hill_climb(State1,[State1|History],Moves). 16 | 17 | hill_climb(State,Move) :- 18 | findall(M,move(State,M),Moves), 19 | evaluate_and_order(Moves,State,[],MVs), 20 | member((Move,Value),MVs). 21 | 22 | /* 23 | evaluate_and_order(Moves,State,SoFar,OrderedMVs) :- 24 | All the Moves from the current State are evaluated and 25 | ordered as OrderedMVs. SoFar is an accumulator for 26 | partial computations. 27 | */ 28 | evaluate_and_order([Move|Moves],State,MVs,OrderedMVs) :- 29 | update(State,Move,State1), 30 | value(State1,Value), 31 | insert((Move,Value),MVs,MVs1), 32 | evaluate_and_order(Moves,State,MVs1,OrderedMVs). 33 | evaluate_and_order([],State,MVs,MVs). 34 | 35 | insert(MV,[],[MV]). 36 | insert((M,V),[(M1,V1)|MVs],[(M,V),(M1,V1)|MVs]) :- 37 | V >= V1. 38 | insert((M,V),[(M1,V1)|MVs],[(M1,V1)|MVs1]) :- 39 | V < V1, insert((M,V),MVs,MVs1). 40 | 41 | /* Testing the Framework */ 42 | 43 | test_hill_climb(Problem,Moves) :- 44 | initial_state(Problem,State), 45 | solve_hill_climb(State,[State],Moves). 46 | 47 | % Program 20.4: Hill climbing framework for problem solving 48 | -------------------------------------------------------------------------------- /Chapter20/program-20.5.prolog: -------------------------------------------------------------------------------- 1 | % Data 2 | 3 | initial_state(tree,a). value(a,0). final_state(j). 4 | 5 | move(a,b). value(b,1). move(c,g). value(g,6). 6 | move(a,c). value(c,5). move(d,j). value(j,9). 7 | move(a,d). value(d,7). move(e,k). value(k,1). 8 | move(a,e). value(e,2). move(f,h). value(h,3). 9 | move(c,f). value(f,4). move(f,i). value(i,2). 10 | 11 | % Program 20.5 Test data 12 | -------------------------------------------------------------------------------- /Chapter20/program-20.6.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | solve_best(Frontier,History,Moves) :- 3 | Moves is the sequence of moves to reach a desired final state 4 | from the initial state, where Frontier contains the current 5 | states under consideration, and History contains the states 6 | visited previously. 7 | */ 8 | 9 | solve_best([state(State,Path,Value)|Frontier],History,Moves) :- 10 | final_state(State), reverse(Path,Moves). 11 | solve_best([state(State,Path,Value)|Frontier],History,FinalPath) :- 12 | findall(M,move(State,M),Moves), 13 | updates(Moves,Path,State,States), 14 | legals(States,States1), 15 | news(States1,History,States2), 16 | evaluates(States2,Values), 17 | inserts(Values,Frontier,Frontier1), 18 | solve_best(Frontier1,[State|History],FinalPath). 19 | 20 | /* 21 | updates(Moves,Path,State,States) :- 22 | States is the list of possible states accessible from the 23 | current State, according to the list of possible Moves, 24 | where Path is a path from the initial node to State. 25 | */ 26 | 27 | updates([Move|Moves],Path,State,[(State1,[Move|Path])|States]) :- 28 | update(State,Move,State1), updates(Moves,Path,State,States). 29 | updates([],Path,State,[]). 30 | 31 | /* 32 | legals(States,States1) :- 33 | States1 is the subset of the list of States that are legal. 34 | */ 35 | 36 | legals([(S,P)|States],[(S,P)|States1]) :- 37 | legal(S), legals(States,States1). 38 | legals([(S,P)|States],States1) :- 39 | not legal(S), legals(States,States1). 40 | legals([],[]). 41 | 42 | /* 43 | news(States,History,States1) :- 44 | States1 is the list of states in States but not in History. 45 | */ 46 | news([(State,Path)|States],History,States1) :- 47 | member(State,History), news(States,History,States1). 48 | news([(State,Path)|States],History,[(State,Path)|States1]) :- 49 | not member(State,History), news(States,History,States1). 50 | news([],History,[]). 51 | 52 | /* 53 | evaluates(States,Values) :- 54 | Values is the list of tuples of States augmented by their value. 55 | */ 56 | evaluates([(State,Path)|States],[state(State,Path,Value)|Values]) :- 57 | value(State,Value), evaluates(States,Values). 58 | evaluates([],[]). 59 | 60 | /* 61 | inserts(States,Frontier,Frontier1) :- 62 | Frontier1 is the result of inserting States into the current Frontier. 63 | */ 64 | inserts([Value|Values],Frontier,Frontier1) :- 65 | insert(Value,Frontier,Frontier0), 66 | inserts(Values,Frontier0,Frontier1). 67 | inserts([],Frontier,Frontier). 68 | 69 | insert(State,[],[State]). 70 | insert(State,[State1|States],[State,State1|States]) :- 71 | lesseq_value(State,State1). 72 | insert(State,[State1|States],[State|States]) :- 73 | equals(State,State1). 74 | insert(State,[State1|States],[State1|States1]) :- 75 | greater_value(State,State1), insert(State,States,States1). 76 | 77 | equals(state(S,P,V),state(S,P1,V)). 78 | 79 | lesseq_value(state(S1,P1,V1),state(S2,P2,V2)) :- S1 \== S2, V1 =< V2. 80 | 81 | greater_value(state(S1,P1,V1),state(S2,P2,V2)) :- V1 > V2. 82 | 83 | % Program 20.6 Best first framework for problem solving 84 | -------------------------------------------------------------------------------- /Chapter20/program-20.7.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | solve_best(Frontier,History,Moves) :- 3 | Moves is the sequence of moves to reach a desired final state 4 | from the initial state. Frontier contains the current states 5 | under consideration. History contains the states visited previously. 6 | */ 7 | solve_best([state(State,Path,Value)|Frontier],History,Moves) :- 8 | final_state(State), reverse(Path,[],Moves). 9 | solve_best([state(State,Path,Value)|Frontier],History,FinalPath) :- 10 | findall(M,move(State,M),Moves), 11 | update_frontier(Moves,State,Path,History,Frontier,Frontier1), 12 | solve_best(Frontier1,[State|History],FinalPath). 13 | 14 | update_frontier([Move|Moves],State,Path,History,Frontier,Frontier1) :- 15 | update(State,Move,State1), 16 | legal(State1), 17 | value(State1,Value), 18 | not member(State1,History), 19 | insert(state(State1,[Move|Path],Value),Frontier,Frontier0), 20 | update_frontier(Moves,State,Path,History,Frontier0,Frontier1). 21 | update_frontier([],State,Path,History,Frontier,Frontier). 22 | 23 | 24 | insert(State,[],[State]). 25 | insert(State,[State1|States],[State,State1|States]) :- 26 | lesseq_value(State,State1). 27 | insert(State,[State1|States],[State|States]) :- 28 | equals(State,State1). 29 | insert(State,[State1|States],[State1|States1]) :- 30 | greater_value(State,State1), insert(State,States,States1). 31 | 32 | equals(state(S,P,V),state(S,P1,V)). 33 | 34 | lesseq_value(state(S1,P1,V1),state(S2,P2,V2)) :- S1 \== S2, V1 =< V2. 35 | 36 | greater_value(state(S1,P1,V1),state(S2,P2,V2)) :- V1 > V2. 37 | 38 | reverse([X|Xs],Acc,Ys) :- reverse(Xs,[X|Acc],Ys). 39 | reverse([],Ys,Ys). 40 | 41 | % Program 20.7 Concise best first framework for problem solving 42 | -------------------------------------------------------------------------------- /Chapter20/program-20.8.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | play(Game) :- Play game with name Game. 3 | */ 4 | play(Game) :- 5 | initialize(Game,Position,Player), 6 | display_game(Position,Player), 7 | play(Position,Player,Result). 8 | 9 | play(Position,Player,Result) :- 10 | game_over(Position,Player,Result), !, announce(Result). 11 | play(Position,Player,Result) :- 12 | choose_move(Position,Player,Move), 13 | move(Move,Position,Position1), 14 | display_game(Position1,Player), 15 | next_player(Player,Player1), 16 | !, play(Position1,Player1,Result). 17 | 18 | % Program 20.8 : Framework for Game Playing. 19 | -------------------------------------------------------------------------------- /Chapter20/program-20.9.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | evaluate_and_choose(Moves,Position,Record,BestMove) :- 3 | Chooses the BestMove from the set of Moves from the current 4 | Position, Record records the current best move. 5 | */ 6 | evaluate_and_choose([Move|Moves],Position,Record,BestMove) :- 7 | move(Move,Position,Position1), 8 | value(Position1,Value), 9 | update(Move,Value,Record,Record1), 10 | evaluate_and_choose(Moves,Position,Record1,BestMove). 11 | evaluate_and_choose([],Position,(Move,Value),Move). 12 | 13 | update(Move,Value,(Move1,Value1),(Move1,Value1)) :- 14 | Value =< Value1. 15 | update(Move,Value,(Move1,Value1),(Move,Value)) :- 16 | Value > Value1. 17 | 18 | % Program 20.9 Choosing the best move 19 | -------------------------------------------------------------------------------- /Chapter21/program-21.1.prolog: -------------------------------------------------------------------------------- 1 | mastermind(Code) :- 2 | cleanup, guess(Code), check(Code), announce. 3 | 4 | guess(Code) :- 5 | Code = [X1,X2,X3,X4], selects(Code,[1,2,3,4,5,6,7,8,9,0]). 6 | 7 | /* Verify the proposed guess */ 8 | 9 | check(Guess) :- 10 | not(inconsistent(Guess)), ask(Guess). 11 | 12 | inconsistent(Guess) :- 13 | query(OldGuess,Bulls,Cows), 14 | not(bulls_and_cows_match(OldGuess,Guess,Bulls,Cows)). 15 | 16 | bulls_and_cows_match(OldGuess,Guess,Bulls,Cows) :- 17 | exact_matches(OldGuess,Guess,N1), 18 | Bulls =:= N1, 19 | common_members(OldGuess,Guess,N2), 20 | Cows =:= N2 - Bulls. 21 | 22 | exact_matches(X,Y,N) :- 23 | size_of(A,same_place(A,X,Y),N). 24 | 25 | common_members(X,Y,N) :- 26 | size_of(A,(member(A,X),member(A,Y)),N). 27 | 28 | same_place(X,[X|Xs],[X|Ys]). 29 | same_place(A,[X|Xs],[Y|Ys]) :- same_place(A,Xs,Ys). 30 | 31 | /* Asking a guess */ 32 | 33 | ask(Guess) :- 34 | repeat, 35 | writeln(['How many bulls and cows in ',Guess,'?']), 36 | read((Bulls,Cows)), 37 | sensible(Bulls,Cows), !, 38 | assert(query(Guess,Bulls,Cows)), 39 | Bulls =:= 4. 40 | 41 | sensible(Bulls,Cows) :- 42 | integer(Bulls), integer(Cows), Bulls + Cows =< 4. 43 | 44 | /* Bookkeeping */ 45 | 46 | cleanup :- abolish(query,3), dynamic(query/3). 47 | 48 | announce :- 49 | size_of(X,query(X,A,B),N), 50 | writeln(['Found the answer after ',N,' queries']). 51 | 52 | size_of(X,Goal,N) :- 53 | findall(X,Goal,Instances), length(Instances,N). 54 | 55 | selects([X|Xs],Ys) :- 56 | select(X,Ys,Ys1),selects(Xs,Ys1). 57 | selects([],Ys). 58 | 59 | select(X,[X|Xs],Xs). 60 | select(X,[Y|Ys],[Y|Zs]) :- 61 | select(X,Ys,Zs). 62 | 63 | /* 64 | length(Xs,N) :- length(Xs,0,N). 65 | length([X|Xs],Acc,N) :- 66 | Acc1 is Acc + 1, 67 | length(Xs,Acc1,N). 68 | length([],N,N). 69 | */ 70 | 71 | % Program 21.1 Playing mastermind 72 | -------------------------------------------------------------------------------- /Chapter21/program-21.2.prolog: -------------------------------------------------------------------------------- 1 | 2 | /* The play framework */ 3 | 4 | play(Game) :- 5 | initialize(Game,Position,Player), 6 | display_game(Position,Player), 7 | play(Position,Player,Result). 8 | 9 | play(Position,Player,Result) :- 10 | game_over(Position,Player,Result), !, announce(Result). 11 | play(Position,Player,Result) :- 12 | choose_move(Position,Player,Move), 13 | move(Move,Position,Position1), 14 | display_game(Position1,Player), 15 | next_player(Player,Player1), 16 | !, 17 | play(Position1,Player1,Result). 18 | 19 | /* Filling in the game-playing framework */ 20 | 21 | initialize(nim,[1,3,5,7],opponent). 22 | 23 | display_game(Position,X) :- write(Position), nl. 24 | 25 | game_over([],Player,Player). 26 | 27 | announce(computer) :- write('You won! Congratulations.'), nl. 28 | announce(opponent) :- write('I won.'), nl. 29 | 30 | /* Choosing moves */ 31 | 32 | choose_move(Position,opponent,Move) :- 33 | writeln(['Please make move']), read(Move), legal(Move,Position). 34 | 35 | legal((K,N),Position) :- nth_member(N,Position,M), N =< M. 36 | 37 | nth_member(1,[X|Xs],X). 38 | nth_member(N,[X|Xs],Y) :- N > 1, N1 is N-1, nth_member(N1,Xs,Y). 39 | 40 | choose_move(Position,computer,Move) :- 41 | evaluate(Position,Safety,Sum), 42 | decide_move(Safety,Position,Sum,Move). 43 | 44 | evaluate(Position,Safety,Sum) :- 45 | nim_sum(Position,[],Sum), safety(Sum,Safety). 46 | 47 | safety(Sum,safe) :- zero(Sum), !. 48 | safety(Sum,unsafe) :- not(zero(Sum)), !. 49 | 50 | decide_move(safe,Position,Sum,(1,1)). % The computer's arbitrary move 51 | decide_move(unsafe,Position,Sum,Move) :- 52 | safe_move(Position,Sum,Move). 53 | 54 | /* 55 | move(Move,Position,Position1) :- 56 | Position1 is the result of executing the move Move 57 | from the current Position. 58 | */ 59 | move((K,M),[N|Ns],[N|Ns1]) :- 60 | K > 1, K1 is K - 1, move((K1,M),Ns,Ns1). 61 | move((1,N),[N|Ns],Ns). 62 | move((1,M),[N|Ns],[N1|Ns]) :- 63 | N > M, N1 is N - M. 64 | 65 | next_player(computer,opponent). next_player(opponent,computer). 66 | 67 | /* 68 | nim_sum(Position,SoFar,Sum) :- 69 | Sum is the nim-sum of the current Position, 70 | and SoFar is an accumulated value. 71 | */ 72 | nim_sum([N|Ns],Bs,Sum) :- 73 | binary(N,Ds), nim_add(Ds,Bs,Bs1), nim_sum(Ns,Bs1,Sum). 74 | nim_sum([],Sum,Sum). 75 | 76 | nim_add(Bs,[],Bs). 77 | nim_add([],Bs,Bs). 78 | nim_add([B|Bs],[C|Cs],[D|Ds]) :- 79 | D is (B+C) mod 2, nim_add(Bs,Cs,Ds). 80 | 81 | binary(1,[1]). 82 | binary(N,[D|Ds]) :- 83 | N > 1, D is N mod 2, N1 is div(N,2), binary(N1,Ds). 84 | 85 | decimal(Ds,N) :- decimal(Ds,0,1,N). 86 | decimal([],N,T,N). 87 | decimal([D|Ds],A,T,N) :- A1 is A+D*T, T1 is T*2, decimal(Ds,A1,T1,N). 88 | 89 | zero([]). 90 | zero([0|Zs]) :- zero(Zs). 91 | 92 | /* 93 | safe_move(Position,NimSum,Move) :- 94 | Move is a move from the current Position with 95 | the value NimSum which leaves a safe position. 96 | */ 97 | safe_move(Piles,NimSum,Move) :- 98 | safe_move(Piles,NimSum,1,Move). 99 | 100 | safe_move([Pile|Piles],NimSum,K,(K,M)) :- 101 | binary(Pile,Bs), can_zero(Bs,NimSum,Ds,0), decimal(Ds,M). 102 | safe_move([Pile|Piles],NimSum,K,Move) :- 103 | K1 is K + 1, safe_move(Piles,NimSum,K1,Move). 104 | 105 | can_zero([],NimSum,[],0) :- 106 | zero(NimSum). 107 | can_zero([B|Bs],[0|NimSum],[C|Ds],C) :- 108 | can_zero(Bs,NimSum,Ds,C). 109 | can_zero([B|Bs],[1|NimSum],[D|Ds],C) :- 110 | D is 1 - B*C, C1 is 1 - B, can_zero(Bs,NimSum,Ds,C1). 111 | 112 | % Program 21.2 A program for playing a winning game of Nim 113 | -------------------------------------------------------------------------------- /Chapter21/program-21.3.prolog: -------------------------------------------------------------------------------- 1 | 2 | /* Play framework */ 3 | 4 | play(Game) :- 5 | initialize(Game,Position,Player), 6 | display_game(Position,Player), 7 | play(Position,Player,Result). 8 | 9 | play(Position,Player,Result) :- 10 | game_over(Position,Player,Result), !, announce(Result). 11 | play(Position,Player,Result) :- 12 | choose_move(Position,Player,Move), 13 | move(Move,Position,Position1), 14 | display_game(Position1,Player), 15 | next_player(Player,Player1), 16 | !, 17 | play(Position1,Player1,Result). 18 | 19 | /* Choosing a move by minimax with alpha-beta cut-off */ 20 | 21 | choose_move(Position,computer,Move) :- 22 | lookahead(Depth), 23 | alpha_beta(Depth,Position,-40,40,Move,Value), 24 | nl, write(Move), nl. 25 | choose_move(Position,opponent,Move) :- 26 | nl, writeln(['please make move']), read(Move), legal(Move). 27 | 28 | evaluate_and_choose([Move|Moves],Position,D,Alpha,Beta,Move1,BestMove) :- 29 | move(Move,Position,Position1), 30 | alpha_beta(D,Position1,Alpha,Beta,MoveX,Value), 31 | Value1 is -Value, 32 | cutoff(Move,Value1,D,Alpha,Beta,Moves,Position,Move1,BestMove). 33 | evaluate_and_choose([],Position,D,Alpha,Beta,Move,(Move,Alpha)). 34 | 35 | alpha_beta(0,Position,Alpha,Beta,Move,Value) :- 36 | value(Position,Value). 37 | alpha_beta(D,Position,Alpha,Beta,Move,Value) :- 38 | findall(M,move(Position,M),Moves), 39 | Alpha1 is -Beta, 40 | Beta1 is -Alpha, 41 | D1 is D-1, 42 | evaluate_and_choose(Moves,Position,D1,Alpha1,Beta1,nil,(Move,Value)). 43 | 44 | cutoff(Move,Value,D,Alpha,Beta,Moves,Position,Move1,(Move,Value)) :- 45 | Value >= Beta. 46 | cutoff(Move,Value,D,Alpha,Beta,Moves,Position,Move1,BestMove) :- 47 | Alpha < Value, Value < Beta, 48 | evaluate_and_choose(Moves,Position,D,Value,Beta,Move,BestMove). 49 | cutoff(Move,Value,D,Alpha,Beta,Moves,Position,Move1,BestMove) :- 50 | Value =< Alpha, 51 | evaluate_and_choose(Moves,Position,D,Alpha,Beta,Move1,BestMove). 52 | 53 | move(Board,[M|Ms]) :- 54 | member(M,[1,2,3,4,5,6]), 55 | stones_in_hole(M,Board,N), 56 | extend_move(N,M,Board,Ms). 57 | move(board([0,0,0,0,0,0],K,Ys,L),[]). 58 | 59 | stones_in_hole(M,board(Hs,K,Ys,L),Stones) :- 60 | nth_member(M,Hs,Stones), Stones > 0. 61 | 62 | extend_move(Stones,M,Board,[]) :- 63 | Stones =\= (7-M) mod 13, !. 64 | extend_move(Stones,M,Board,Ms) :- 65 | Stones =:= (7-M) mod 13, !, 66 | distribute_stones(Stones,M,Board,Board1), 67 | move(Board1,Ms). 68 | 69 | /* Executing a move */ 70 | 71 | move([N|Ns],Board,FinalBoard) :- 72 | stones_in_hole(N,Board,Stones), 73 | distribute_stones(Stones,N,Board,Board1), 74 | move(Ns,Board1,FinalBoard). 75 | move([],Board1,Board2) :- 76 | swap(Board1,Board2). 77 | 78 | /* distribute_stones(Stones,Hole,Board,Board1) :- 79 | Board1 is the result of distributing the number of stones, 80 | Stones, from Hole from the current Board. 81 | It consists of two stages: distributing the stones in the player's 82 | holes, distribute_my_holes, and distributing the stones in 83 | the opponent's holes, distribute_your_holes. 84 | */ 85 | 86 | distribute_stones(Stones,Hole,Board,FinalBoard) :- 87 | distribute_my_holes(Stones,Hole,Board,Board1,Stones1), 88 | distribute_your_holes(Stones1,Board1,FinalBoard). 89 | 90 | distribute_my_holes(Stones,N,board(Hs,K,Ys,L),board(Hs1,K1,Ys,L),Stones1) :- 91 | Stones > 7-N, !, 92 | pick_up_and_distribute(N,Stones,Hs,Hs1), 93 | K1 is K+1, Stones1 is Stones+N-7. 94 | distribute_my_holes(Stones,N,board(Hs,K,Ys,L),Board,0) :- 95 | pick_up_and_distribute(N,Stones,Hs,Hs1), 96 | check_capture(N,Stones,Hs1,Hs2,Ys,Ys1,Pieces), 97 | update_kalah(Pieces,N,Stones,K,K1), 98 | check_if_finished(board(Hs2,K1,Ys1,L),Board). 99 | 100 | check_capture(N,Stones,Hs,Hs1,Ys,Ys1,Pieces) :- 101 | FinishingHole is N+Stones, 102 | nth_member(FinishingHole,Hs,1), 103 | OppositeHole is 7-FinishingHole, 104 | nth_member(OppositeHole,Ys,Y), 105 | Y > 0, !, 106 | n_substitute(OppositeHole,Ys,0,Ys1), 107 | n_substitute(FinishingHole,Hs,0,Hs1), 108 | Pieces is Y+1. 109 | check_capture(N,Stones,Hs,Hs,Ys,Ys,0) :- !. 110 | 111 | check_if_finished(board(Hs,K,Ys,L),board(Hs,K,Hs,L1)) :- 112 | zero(Hs), !, sumlist(Ys,YsSum), L1 is L+YsSum. 113 | check_if_finished(board(Hs,K,Ys,L),board(Ys,K1,Ys,L)) :- 114 | zero(Ys), !, sumlist(Hs,HsSum), K1 is K+HsSum. 115 | check_if_finished(Board,Board) :- !. 116 | 117 | update_kalah(0,Stones,N,K,K) :- Stones < 7-N, !. 118 | update_kalah(0,Stones,N,K,K1) :- Stones =:= 7-N, !, K1 is K+1. 119 | update_kalah(Pieces,Stones,N,K,K1) :- Pieces > 0, !, K1 is K+Pieces. 120 | 121 | distribute_your_holes(0,Board,Board) :- !. 122 | distribute_your_holes(Stones,board(Hs,K,Ys,L),board(Hs,K,Ys1,L)) :- 123 | 1 =< Stones, Stones =< 6, 124 | non_zero(Hs), !, 125 | distribute(Stones,Ys,Ys1). 126 | distribute_your_holes(Stones,board(Hs,K,Ys,L),board(Hs,K,Ys1,L)) :- 127 | Stones > 6, !, 128 | distribute(6,Ys,Ys1), 129 | Stones1 is Stones-6, 130 | distribute_stones(Stones1,0,board(Hs,K,Ys1,L),Board). 131 | distribute_your_holes(Stones,board(Hs,K,Ys,L),board(Hs,K,Hs,L1)) :- 132 | zero(Hs), !, sumlist(Ys,YsSum), L1 is Stones+YsSum+L. 133 | 134 | /* Lower level stone distribution */ 135 | 136 | pick_up_and_distribute(0,N,Hs,Hs1) :- 137 | !, distribute(N,Hs,Hs1). 138 | pick_up_and_distribute(1,N,[H|Hs],[0|Hs1]) :- 139 | !, distribute(N,Hs,Hs1). 140 | pick_up_and_distribute(K,N,[H|Hs],[H|Hs1]) :- 141 | K > 1, !, K1 is K-1, pick_up_and_distribute(K1,N,Hs,Hs1). 142 | 143 | distribute(0,Hs,Hs) :- !. 144 | distribute(N,[H|Hs],[H1|Hs1]) :- 145 | N > 0, !, N1 is N-1, H1 is H+1, distribute(N1,Hs,Hs1). 146 | distribute(N,[],[]) :- !. 147 | 148 | /* Evaluation function */ 149 | 150 | value(board(H,K,Y,L),Value) :- Value is K-L. 151 | 152 | /* Testing for the end of the game */ 153 | 154 | game_over(board(0,N,0,N),Player,draw) :- 155 | pieces(K), N =:= 6*K, !. 156 | game_over(board(H,K,Y,L),Player,Player) :- 157 | pieces(N), K > 6*N, !. 158 | game_over(board(H,K,Y,L),Player,Opponent) :- 159 | pieces(N), L > 6*N, next_player(Player,Opponent). 160 | 161 | announce(opponent) :- writeln(['You won! Congratulations.']). 162 | announce(computer) :- writeln(['I won.']). 163 | announce(draw) :- writeln(['The game is a draw.']). 164 | 165 | /* Miscellaneous game utilities */ 166 | 167 | nth_member(N,[H|Hs],K) :- 168 | N > 1, !, N1 is N - 1, nth_member(N1,Hs,K). 169 | nth_member(1,[H|Hs],H). 170 | 171 | n_substitute(1,[X|Xs],Y,[Y|Xs]) :- !. 172 | n_substitute(N,[X|Xs],Y,[X|Xs1]) :- 173 | N > 1, !, N1 is N-1, n_substitute(N1,Xs,Y,Xs1). 174 | 175 | next_player(computer,opponent). 176 | next_player(opponent,computer). 177 | 178 | legal([N|Ns]) :- 0 < N, N < 7, legal(Ns). 179 | legal([]). 180 | 181 | swap(board(Hs,K,Ys,L),board(Ys,L,Hs,K)). 182 | 183 | display_game(Position,computer) :- 184 | show(Position). 185 | display_game(Position,opponent) :- 186 | swap(Position,Position1), show(Position1). 187 | 188 | show(board(H,K,Y,L)) :- 189 | reverse(H,HR), write_stones(HR), write_kalahs(K,L), write_stones(Y). 190 | 191 | write_stones(H) :- 192 | nl, tab(5), display_holes(H). 193 | 194 | display_holes([H|Hs]) :- 195 | write_pile(H), display_holes(Hs). 196 | display_holes([]) :- nl. 197 | 198 | write_pile(N) :- N < 10, write(N), tab(4). 199 | write_pile(N) :- N >= 10, write(N), tab(3). 200 | 201 | write_kalahs(K,L) :- 202 | write(K), tab(34), write(L), nl. 203 | 204 | zero([0,0,0,0,0,0]). 205 | 206 | non_zero(Hs) :- Hs \== [0,0,0,0,0,0]. 207 | 208 | /* Initializing */ 209 | 210 | lookahead(2). 211 | initialize(kalah,board([N,N,N,N,N,N],0,[N,N,N,N,N,N],0),opponent) :- 212 | pieces(N). 213 | 214 | pieces(6). 215 | 216 | % Program 21.3 A complete program for playing Kalah 217 | -------------------------------------------------------------------------------- /Chapter22/program-22.1.prolog: -------------------------------------------------------------------------------- 1 | /* Credit Evaluation 2 | 3 | credit(Client,Answer) :- 4 | Answer is the reply to a request by Client for credit. 5 | */ 6 | 7 | credit(Client,Answer) :- 8 | ok_profile(Client), 9 | collateral_rating(Client,CollateralRating), 10 | financial_rating(Client,FinancialRating), 11 | bank_yield(Client,Yield), 12 | evaluate(profile(CollateralRating,FinancialRating,Yield),Answer) , !. 13 | 14 | /* The collateral rating module 15 | 16 | collateral_rating(Client,Rating) :- 17 | Rating is a qualitative description assessing the collateral 18 | offered by Client to cover the request for credit. 19 | */ 20 | collateral_rating(Client,Rating) :- 21 | collateral_profile(Client,FirstClass,SecondClass,Illiquid), 22 | collateral_evaluation(FirstClass,SecondClass,Illiquid,Rating). 23 | 24 | collateral_profile(Client,FirstClass,SecondClass,Illiquid) :- 25 | requested_credit(Client,Credit), 26 | collateral_percent(first_class,Client,Credit,FirstClass), 27 | collateral_percent(second_class,Client,Credit,SecondClass), 28 | collateral_percent(Illiquid,Client,Credit,Illiquid). 29 | 30 | collateral_percent(Type,Client,Total,Value) :- 31 | findall(X,(collateral(Collateral,Type), 32 | amount(Collateral,Client,X)),Xs), 33 | sumlist(Xs,Sum), 34 | Value is Sum*100/Total. 35 | 36 | /* Evaluation rules */ 37 | 38 | collateral_evaluation(FirstClass,_,_,excellent) :- 39 | FirstClass >= 100. 40 | collateral_evaluation(FirstClass,SecondClass,_,excellent) :- 41 | FirstClass > 70, FirstClass + SecondClass >= 100. 42 | collateral_evaluation(FirstClass,SecondClass,Illiquid,good) :- 43 | FirstClass + SecondClass > 60, 44 | FirstClass + SecondClass < 70, 45 | FirstClass + SecondClass + Illiquid >= 100. 46 | 47 | /* Bank data - classification of collateral */ 48 | 49 | collateral(local_currency_deposits,first_class). 50 | collateral(foreign_currency_deposits,first_class). 51 | collateral(negotiate_instruments,second_class). 52 | collateral(mortgage,illiquid). 53 | 54 | % Financial rating 55 | 56 | /* 57 | financial_rating(Client,Rating) :- 58 | Rating is a qualitative description assessing the financial 59 | record offered by Client to support the request for credit. 60 | */ 61 | financial_rating(Client,Rating) :- 62 | financial_factors(Factors), 63 | score(Factors,Client,0,Score), 64 | calibrate(Score,Rating). 65 | 66 | /* Financial evalauation rules */ 67 | 68 | calibrate(Score,bad) :- Score =< -500. 69 | calibrate(Score,medium) :- -500 < Score, Score < 150. 70 | calibrate(Score,good) :- 150 =< Score, Score < 1000. 71 | calibrate(Score,excellent) :- Score >= 1000. 72 | 73 | /* Bank data - weighting factors */ 74 | 75 | financial_factors([(net_worth_per_assets,5), 76 | (last_year_sales_growth,1), 77 | (gross_profits_on_sales,5), 78 | (short_term_debt_per_annual_sales,2) ]). 79 | 80 | score([(Factor,Weight)|Factors],Client,Acc,Score) :- 81 | value(Factor,Client,Value), 82 | Acc1 is Acc + Weight*Value, 83 | score(Factors,Client,Acc1,Score). 84 | score([],_,Score,Score). 85 | 86 | /* Final evaluation 87 | 88 | evaluate(Profile,Outcome) :- 89 | Outcome is the reply to the client's Profile. 90 | */ 91 | evaluate(Profile,Answer) :- 92 | rule(Conditions,Answer), verify(Conditions,Profile). 93 | 94 | verify([condition(Type,Test,Rating)|Conditions],Profile) :- 95 | scale(Type,Scale), 96 | select_value(Type,Profile,Fact), 97 | compare(Test,Scale,Fact,Rating), 98 | verify(Conditions,Profile). 99 | verify([],_). 100 | 101 | compare('=',_,Rating,Rating). 102 | compare('>',Scale,Rating1,Rating2) :- 103 | precedes(Scale,Rating1,Rating2). 104 | compare('>=',Scale,Rating1,Rating2) :- 105 | precedes(Scale,Rating1,Rating2) ; Rating1 = Rating2. 106 | compare('<',Scale,Rating1,Rating2) :- 107 | precedes(Scale,Rating2,Rating1). 108 | compare('=<',Scale,Rating1,Rating2) :- 109 | precedes(Scale,Rating2,Rating1) ; Rating1 = Rating2. 110 | 111 | precedes([R1|_],R1,_). 112 | precedes([R|Rs],R1,R2) :- R \== R2, precedes(Rs,R1,R2). 113 | 114 | select_value(collateral,profile(C,_,_),C). 115 | select_value(finances,profile(_,F,_),F). 116 | select_value(yield,profile(_,_,Y),Y). 117 | 118 | /* Utilities */ 119 | 120 | sumlist(Is,Sum) :- 121 | sumlist(Is,0,Sum). 122 | sumlist([I|Is],Temp,Sum) :- 123 | Temp1 is Temp + I, 124 | sumlist(Is,Temp1,Sum). 125 | sumlist([],Sum,Sum). 126 | 127 | 128 | /* Bank data and rules */ 129 | 130 | rule([condition(collateral,'>=',excellent),condition(finances,'>=',good), 131 | condition(yield,'>=',reasonable)],give_credit). 132 | rule([condition(collateral,'=',good),condition(finances,'=',good), 133 | condition(yield,'>=',reasonable)],consult_superior). 134 | rule([condition(collateral,'=<',moderate),condition(finances,'=<',medium)], 135 | refuse_credit). 136 | 137 | scale(collateral,[excellent,good,moderate]). 138 | scale(finances,[excellent,good,medium,bad]). 139 | scale(yield,[excellent,reasonable,poor]). 140 | 141 | % Program 22.1: A credit evaluation system 142 | -------------------------------------------------------------------------------- /Chapter22/program-22.2.prolog: -------------------------------------------------------------------------------- 1 | /* Client data */ 2 | 3 | bank_yield(client1,excellent). 4 | requested_credit(client1,5000). 5 | 6 | amount(local_currency_deposits,client1,3000). 7 | amount(foreign_currency_deposits,client1,2000). 8 | amount(bank_guarantees,client1,300). 9 | 10 | amount(negotiate_instruments,client1,500). 11 | amount(stocks,client1,900). 12 | 13 | amount(mortgage,client1,1200). 14 | amount(documents,client1,1400). 15 | 16 | value(net_worth_per_assets,client1,40). 17 | value(last_year_sales_growth,client1,20). 18 | value(gross_profits_on_sales,client1,45). 19 | value(short_term_debt_per_annual_sales,client1,9). 20 | 21 | ok_profile(client1). 22 | 23 | 24 | % Program 22.2: Test data for the credit evaluation system 25 | -------------------------------------------------------------------------------- /Chapter23/program-23.1.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | solve_equation(Equation,Unknown,Solution) :- 3 | Solution is a solution to the equation Equation 4 | in the unknown Unknown. 5 | */ 6 | :- op(40,xfx,\). 7 | :- op(50,xfx,^). 8 | 9 | solve_equation(A*B=0,X,Solution) :- 10 | !, 11 | factorize(A*B,X,Factors\[]), 12 | remove_duplicates(Factors,Factors1), 13 | solve_factors(Factors1,X,Solution). 14 | 15 | solve_equation(Equation,X,Solution) :- 16 | single_occurrence(X,Equation), 17 | !, 18 | position(X,Equation,[Side|Position]), 19 | maneuver_sides(Side,Equation,Equation1), 20 | isolate(Position,Equation1,Solution). 21 | 22 | solve_equation(Lhs=Rhs,X,Solution) :- 23 | is_polynomial(Lhs,X), 24 | is_polynomial(Rhs,X), 25 | !, 26 | polynomial_normal_form(Lhs-Rhs,X,PolyForm), 27 | solve_polynomial_equation(PolyForm,X,Solution). 28 | 29 | solve_equation(Equation,X,Solution) :- 30 | offenders(Equation,X,Offenders), 31 | multiple(Offenders), 32 | homogenize(Equation,X,Offenders,Equation1,X1), 33 | solve_equation(Equation1,X1,Solution1), 34 | solve_equation(Solution1,X,Solution). 35 | 36 | /* The factorization method 37 | 38 | factorize(Expression,Subterm,Factors) :- 39 | Factors is a difference-list consisting of the factors of 40 | the multiplicative term Expression that contains the Subterm. 41 | */ 42 | factorize(A*B,X,Factors\Rest) :- 43 | !, factorize(A,X,Factors\Factors1), factorize(B,X,Factors1\Rest). 44 | factorize(C,X,[C|Factors]\Factors) :- 45 | subterm(X,C), !. 46 | factorize(_,_,Factors\Factors). 47 | 48 | /* solve_factors(Factors,Unknown,Solution) :- 49 | Solution is a solution of the equation Factor=0 in 50 | the Unknown for some Factor in the list of Factors. 51 | */ 52 | solve_factors([Factor|_],X,Solution) :- 53 | solve_equation(Factor=0,X,Solution). 54 | solve_factors([_|Factors],X,Solution) :- 55 | solve_factors(Factors,X,Solution). 56 | 57 | /* The isolation method */ 58 | 59 | maneuver_sides(1,Lhs = Rhs,Lhs = Rhs) :- !. 60 | maneuver_sides(2,Lhs = Rhs,Rhs = Lhs) :- !. 61 | 62 | isolate([N|Position],Equation,IsolatedEquation) :- 63 | isolax(N,Equation,Equation1), 64 | isolate(Position,Equation1,IsolatedEquation). 65 | isolate([],Equation,Equation). 66 | 67 | /* Axioms for Isolation */ 68 | 69 | isolax(1,-Lhs = Rhs,Lhs = -Rhs). % Unary minus 70 | 71 | isolax(1,Term1+Term2 = Rhs,Term1 = Rhs-Term2). % Addition 72 | isolax(2,Term1+Term2 = Rhs,Term2 = Rhs-Term1). % Addition 73 | 74 | isolax(1,Term1-Term2 = Rhs,Term1 = Rhs+Term2). % Subtraction 75 | isolax(2,Term1-Term2 = Rhs,Term2 = Term1-Rhs). % Subtraction 76 | 77 | isolax(1,Term1*Term2 = Rhs,Term1 = Rhs/Term2) :- % Multiplication 78 | Term2 \== 0. 79 | isolax(2,Term1*Term2 = Rhs,Term2 = Rhs/Term1) :- % Multiplication 80 | Term1 \== 0. 81 | 82 | isolax(1,Term1/Term2 = Rhs,Term1 = Rhs*Term2) :- % Division 83 | Term2 \== 0. 84 | isolax(2,Term1/Term2 = Rhs,Term2 = Term1/Rhs) :- % Division 85 | Rhs \== 0. 86 | 87 | isolax(1,Term1^Term2 = Rhs,Term1 = Rhs^(-Term2)). % Exponentiation $$$ ^ 88 | isolax(2,Term1^Term2 = Rhs,Term2 = log(base(Term1),Rhs)). % Exponentiation 89 | 90 | isolax(1,sin(U) = V,U = arcsin(V)). % Sine 91 | isolax(1,sin(U) = V,U = 180 - arcsin(V)). % Sine 92 | isolax(1,cos(U) = V,U = arccos(V)). % Cosine 93 | isolax(1,cos(U) = V,U = -arccos(V)). % Cosine 94 | 95 | /* The polynomial method */ 96 | 97 | polynomial(X,X) :- !. 98 | polynomial(Term,_) :- 99 | constant(Term), !. 100 | polynomial(Term1+Term2,X) :- 101 | !, polynomial(Term1,X), polynomial(Term2,X). 102 | polynomial(Term1-Term2,X) :- 103 | !, polynomial(Term1,X), polynomial(Term2,X). 104 | polynomial(Term1*Term2,X) :- 105 | !, polynomial(Term1,X), polynomial(Term2,X). 106 | polynomial(Term1/Term2,X) :- 107 | !, polynomial(Term1,X), constant(Term2). 108 | polynomial(Term ^ N,X) :- 109 | !, integer(N), N >= 0, polynomial(Term,X). 110 | 111 | /* 112 | polynomial_normal_form(Expression,Term,PolyNormalForm) :- 113 | PolyNormalForm is the polynomial normal form of the 114 | Expression, which is a polynomial in Term. 115 | */ 116 | polynomial_normal_form(Polynomial,X,NormalForm) :- 117 | polynomial_form(Polynomial,X,PolyForm), 118 | remove_zero_terms(PolyForm,NormalForm), !. 119 | 120 | polynomial_form(X,X,[(1,1)]). 121 | polynomial_form(X^N,X,[(1,N)]). 122 | polynomial_form(Term1+Term2,X,PolyForm) :- 123 | polynomial_form(Term1,X,PolyForm1), 124 | polynomial_form(Term2,X,PolyForm2), 125 | add_polynomials(PolyForm1,PolyForm2,PolyForm). 126 | polynomial_form(Term1-Term2,X,PolyForm) :- 127 | polynomial_form(Term1,X,PolyForm1), 128 | polynomial_form(Term2,X,PolyForm2), 129 | subtract_polynomials(PolyForm1,PolyForm2,PolyForm). 130 | polynomial_form(Term1*Term2,X,PolyForm) :- 131 | polynomial_form(Term1,X,PolyForm1), 132 | polynomial_form(Term2,X,PolyForm2), 133 | multiply_polynomials(PolyForm1,PolyForm2,PolyForm). 134 | polynomial_form(Term^N,X,PolyForm) :- !, 135 | polynomial_form(Term,X,PolyForm1), 136 | binomial(PolyForm1,N,PolyForm). 137 | polynomial_form(Term,X,[(Term,0)]) :- 138 | free_of(X,Term), !. 139 | 140 | remove_zero_terms([(0,_)|Poly],Poly1) :- 141 | !, remove_zero_terms(Poly,Poly1). 142 | remove_zero_terms([(C,N)|Poly],[(C,N)|Poly1]) :- 143 | C \== 0, !, remove_zero_terms(Poly,Poly1). 144 | remove_zero_terms([],[]). 145 | 146 | /* Polynomial manipulation routines */ 147 | 148 | /* add_polynomials(Poly1,Poly2,Poly) :- 149 | Poly is the sum of Poly1 and Poly2, where 150 | Poly1, Poly2 and Poly are all in polynomial form. 151 | */ 152 | add_polynomials([],Poly,Poly) :- !. 153 | add_polynomials(Poly,[],Poly) :- !. 154 | add_polynomials([(Ai,Ni)|Poly1],[(Aj,Nj)|Poly2],[(Ai,Ni)|Poly]) :- 155 | Ni > Nj, !, add_polynomials(Poly1,[(Aj,Nj)|Poly2],Poly). 156 | add_polynomials([(Ai,Ni)|Poly1],[(Aj,Nj)|Poly2],[(A,Ni)|Poly]) :- 157 | Ni =:= Nj, !, A is Ai+Aj, add_polynomials(Poly1,Poly2,Poly). 158 | add_polynomials([(Ai,Ni)|Poly1],[(Aj,Nj)|Poly2],[(Aj,Nj)|Poly]) :- 159 | Ni < Nj, !, add_polynomials([(Ai,Ni)|Poly1],Poly2,Poly). 160 | 161 | /* subtract_polynomials(Poly1,Poly2,Poly) :- 162 | Poly is the difference of Poly1 and Poly2, where 163 | Poly1, Poly2 and Poly are all in polynomial form. 164 | */ 165 | subtract_polynomials(Poly1,Poly2,Poly) :- 166 | multiply_single(Poly2,(-1,0),Poly3), 167 | add_polynomials(Poly1,Poly3,Poly), !. 168 | 169 | /* multiply_single(Poly1,Monomial,Poly) :- 170 | Poly is the product of Poly1 and Monomial, where 171 | Poly1, and Poly are in polynomial form, and Monomial 172 | has the form (C,N) denoting the monomial C*X^N. 173 | */ 174 | 175 | multiply_single([(C1,N1)|Poly1],(C,N),[(C2,N2)|Poly]) :- 176 | C2 is C1*C, N2 is N1+N, multiply_single(Poly1,(C,N),Poly). 177 | multiply_single([],_,[]). 178 | 179 | /* multiply_polynomials(Poly1,Poly2,Poly) :- 180 | Poly is the product of Poly1 and Poly2, where 181 | Poly1, Poly2 and Poly are all in polynomial form. 182 | */ 183 | multiply_polynomials([(C,N)|Poly1],Poly2,Poly) :- 184 | multiply_single(Poly2,(C,N),Poly3), 185 | multiply_polynomials(Poly1,Poly2,Poly4), 186 | add_polynomials(Poly3,Poly4,Poly). 187 | multiply_polynomials([],_,[]). 188 | 189 | binomial(Poly,1,Poly). 190 | 191 | /* solve_polynomial_equation(Equation,Unknown,Solution) :- 192 | Solution is a solution to the polynomial Equation 193 | in the unknown Unknown. 194 | */ 195 | 196 | solve_polynomial_equation(PolyEquation,X,X = -B/A) :- 197 | linear(PolyEquation), !, 198 | pad(PolyEquation,[(A,1),(B,0)]). 199 | solve_polynomial_equation(PolyEquation,X,Solution) :- 200 | quadratic(PolyEquation), !, 201 | pad(PolyEquation,[(A,2),(B,1),(C,0)]), 202 | discriminant(A,B,C,Discriminant), 203 | root(X,A,B,C,Discriminant,Solution). 204 | 205 | discriminant(A,B,C,D) :- D is B*B - 4*A*C. 206 | 207 | root(X,A,B,_,0,X= -B/(2*A)). 208 | root(X,A,B,_,D,X= (-B+sqrt(D))/(2*A)) :- D > 0. 209 | root(X,A,B,_,D,X= (-B-sqrt(D))/(2*A)) :- D > 0. 210 | 211 | pad([(C,N)|Poly],[(C,N)|Poly1]) :- 212 | !, pad(Poly,Poly1). 213 | pad(Poly,[(0,_)|Poly1]) :- 214 | pad(Poly,Poly1). 215 | pad([],[]). 216 | 217 | linear([(_,1)|_]). 218 | 219 | quadratic([(_,2)|_]). 220 | 221 | /* The homogenization method 222 | 223 | homogenize(Equation,X,Equation1,X1) :- 224 | The Equation in X is transformed to the polynomial 225 | Equation1 in X1 where X1 contains X. 226 | */ 227 | homogenize(Equation,X,Equation1,X1) :- 228 | offenders(Equation,X,Offenders), 229 | reduced_term(X,Offenders,Type,X1), 230 | rewrite(Offenders,Type,X1,Substitutions), 231 | substitute(Equation,Substitutions,Equation1). 232 | 233 | /* offenders(Equation,Unknown,Offenders) 234 | Offenders is the set of offenders of the equation in the Unknown */ 235 | 236 | offenders(Equation,X,Offenders) :- 237 | parse(Equation,X,Offenders1\[]), 238 | remove_duplicates(Offenders1,Offenders), 239 | multiple(Offenders). 240 | 241 | reduced_term(X,Offenders,Type,X1) :- 242 | classify(Offenders,X,Type), 243 | candidate(Type,Offenders,X,X1). 244 | 245 | /* Heuristics for exponential equations */ 246 | 247 | classify(Offenders,X,exponential) :- 248 | exponential_offenders(Offenders,X). 249 | 250 | exponential_offenders([A^B|Offs],X) :- 251 | free_of(X,A), subterm(X,B), exponential_offenders(Offs,X). 252 | exponential_offenders([],_). 253 | 254 | candidate(exponential,Offenders,X,A^X) :- 255 | base(Offenders,A), polynomial_exponents(Offenders,X). 256 | 257 | base([A^_|Offs],A) :- base(Offs,A). 258 | base([],_). 259 | 260 | polynomial_exponents([_^B|Offs],X) :- 261 | polynomial(B,X), polynomial_exponents(Offs,X). 262 | polynomial_exponents([],_). 263 | 264 | /* Parsing the equation and making substitutions */ 265 | 266 | /* parse(Expression,Term,Offenders) 267 | Expression is traversed to produce the set of Offenders in Term, 268 | that is the non-algebraic subterms of Expression containing Term */ 269 | 270 | parse(A+B,X,L1\L2) :- 271 | !, parse(A,X,L1\L3), parse(B,X,L3\L2). 272 | parse(A*B,X,L1\L2) :- 273 | !, parse(A,X,L1\L3), parse(B,X,L3\L2). 274 | parse(A-B,X,L1\L2) :- 275 | !, parse(A,X,L1\L3), parse(B,X,L3\L2). 276 | parse(A=B,X,L1\L2) :- 277 | !, parse(A,X,L1\L3), parse(B,X,L3\L2). 278 | parse(A^B,X,L) :- 279 | integer(B), !, parse(A,X,L). 280 | parse(A,X,L\L) :- 281 | free_of(X,A), !. 282 | parse(A,X,[A|L]\L) :- 283 | subterm(X,A), !. 284 | 285 | /* substitute(Equation,Substitutions,Equation1) :- 286 | Equation1 is the result of applying the list of 287 | Substitutions to Equation. 288 | */ 289 | substitute(A+B,Subs,NewA+NewB) :- 290 | !, substitute(A,Subs,NewA), substitute(B,Subs,NewB). 291 | substitute(A*B,Subs,NewA*NewB) :- 292 | !, substitute(A,Subs,NewA), substitute(B,Subs,NewB). 293 | substitute(A-B,Subs,NewA-NewB) :- 294 | !, substitute(A,Subs,NewA), substitute(B,Subs,NewB). 295 | substitute(A=B,Subs,NewA=NewB) :- 296 | !, substitute(A,Subs,NewA), substitute(B,Subs,NewB). 297 | substitute(A^B,Subs,NewA^B) :- 298 | integer(B), !, substitute(A,Subs,NewA). 299 | substitute(A,Subs,B) :- 300 | member(A=B,Subs), !. 301 | substitute(A,_,A). 302 | 303 | /* Finding homogenization rewrite rules */ 304 | 305 | rewrite([Off|Offs],Type,X1,[Off=Term|Rewrites]) :- 306 | homogenize_axiom(Type,Off,X1,Term), 307 | rewrite(Offs,Type,X1,Rewrites). 308 | rewrite([],_,_,[]). 309 | 310 | /* Homogenization axioms */ 311 | 312 | homogenize_axiom(exponential,A^(N*X),A^X,(A^X)^N). 313 | homogenize_axiom(exponential,A^(-X),A^X,1/(A^X)). 314 | homogenize_axiom(exponential,A^(X+B),A^X,A^B*A^X). 315 | 316 | /* Utilities */ 317 | 318 | subterm(Term,Term). 319 | subterm(Sub,Term) :- 320 | compound1(Term), functor(Term,_,N), subterm(N,Sub,Term). 321 | 322 | subterm(N,Sub,Term) :- 323 | arg(N,Term,Arg), subterm(Sub,Arg). 324 | subterm(N,Sub,Term) :- 325 | N > 0, 326 | N1 is N - 1, 327 | subterm(N1,Sub,Term). 328 | 329 | position(Term,Term,[]) :- !. 330 | position(Sub,Term,Path) :- 331 | compound1(Term), functor(Term,_,N), position(N,Sub,Term,Path), !. 332 | 333 | position(N,Sub,Term,[N|Path]) :- 334 | arg(N,Term,Arg), position(Sub,Arg,Path). 335 | position(N,Sub,Term,Path) :- 336 | N > 1, N1 is N-1, position(N1,Sub,Term,Path). 337 | 338 | 339 | free_of(Subterm,Term) :- 340 | occurrence(Subterm,Term,N), !, N=0. 341 | 342 | single_occurrence(Subterm,Term) :- 343 | occurrence(Subterm,Term,N), !, N=1. 344 | 345 | occurrence(Term,Term,1) :- !. 346 | occurrence(Sub,Term,N) :- 347 | compound1(Term), !, functor(Term,_,M), occurrence(M,Sub,Term,0,N). 348 | occurrence(Sub,Term,0) :- Term \== Sub. 349 | 350 | occurrence(M,Sub,Term,N1,N2) :- 351 | M > 0, !, arg(M,Term,Arg), occurrence(Sub,Arg,N), N3 is N+N1, 352 | M1 is M-1, occurrence(M1,Sub,Term,N3,N2). 353 | occurrence(0,_,_,N,N). 354 | 355 | multiple([_,_|_]). 356 | 357 | remove_duplicates(Xs,Ys) :- no_doubles(Xs,Ys). 358 | 359 | no_doubles([X|Xs],Ys) :- 360 | member(X,Xs), no_doubles(Xs,Ys). 361 | no_doubles([X|Xs],[X|Ys]) :- 362 | nonmember(X,Xs), no_doubles(Xs,Ys). 363 | no_doubles([],[]). 364 | 365 | nonmember(X,[Y|Ys]) :- X \== Y, nonmember(X,Ys). 366 | nonmember(_,[]). 367 | 368 | compound1(Term) :- functor(Term,_,N),N > 0,!. 369 | 370 | % Testing and data 371 | 372 | test_press(X,Y) :- equation(X,E,U), solve_equation(E,U,Y). 373 | 374 | equation(1,x^2-3*x+2=0,x). 375 | 376 | equation(2,cos(x)*(1-2*sin(x))=0,x). 377 | 378 | equation(3,2^(2*x) - 5*2^(x+1) + 16 = 0,x). 379 | 380 | % Program 23.1 A program for solving equations 381 | -------------------------------------------------------------------------------- /Chapter23/program-23.2.prolog: -------------------------------------------------------------------------------- 1 | 2 | % Program 22.2 /* Testing and data */ 3 | 4 | -------------------------------------------------------------------------------- /Chapter24/program-24.1.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | compile(Tokens,ObjectCode) :- 3 | ObjectCode is the result of compilation of a list of tokens 4 | representing a PL program. 5 | */ 6 | :- op(40,xfx,\). 7 | :- op(800,fx,#). 8 | :- op(780,xf,^). 9 | 10 | compile(String,ObjectCode) :- 11 | string_to_list(String, Codes), 12 | phrase(lexer(Tokens), Codes), 13 | parse(Tokens,Structure), 14 | encode(Structure,Dictionary,Code), 15 | assemble(Code,Dictionary,ObjectCode). 16 | 17 | /* The parser 18 | 19 | parse(Tokens,Structure) :- 20 | Structure represents the successfully parsed list of Tokens. 21 | */ 22 | lexer(Ts) --> 23 | whitespace, % whitespace is ignored 24 | lexer(Ts). 25 | 26 | lexer([T|Ts]) --> 27 | lexem(T), lexer(Ts). 28 | 29 | lexer([]) --> []. 30 | 31 | whitespace --> 32 | [W], 33 | {char_type(W,space)}. % space is whitespace 34 | 35 | lexem(K) --> % key(K) is a lexem 36 | key(K). % if K is a key 37 | lexem(S) --> % sep(S) is a lexem 38 | sep(S). % if S is a separator 39 | lexem(S) --> % sep(S) is a lexem 40 | sep(S). % if S is a separator 41 | 42 | lexem(IA) --> 43 | lidentifier(I), 44 | !, % longest input match 45 | {atom_chars(IA,I)}. 46 | lexem(NA) --> 47 | number(A), 48 | !, % longest input match 49 | {number_chars(NA,A), integer(NA)}. 50 | 51 | 52 | % rules for your keywords here 53 | key(program) --> "program". 54 | key(read) --> "read". 55 | key(write) --> "write". 56 | key(if) --> "if". 57 | key(then) --> "then". 58 | key(else) --> "else". 59 | key(begin) --> "begin". 60 | key(while) --> "while". 61 | key(while) --> "end". 62 | 63 | lidentifier([C|Cs]) --> % identifiers are 64 | alpha(C), % alpha letters 65 | ident(Cs). % followed by other cl's 66 | 67 | ident([C|Cs]) --> 68 | alpha(C), 69 | ident(Cs). 70 | ident([]) --> 71 | []. 72 | 73 | alpha(C) --> 74 | [C], % alphas are 75 | {char_type(C,alpha)}. % alpha letters 76 | 77 | number([D|Ds]) --> % numbers are 78 | digit(D), % a digit followed 79 | digits(Ds). % by other digits 80 | 81 | digits([D|Ds]) --> 82 | digit(D), 83 | digits(Ds). 84 | digits([]) --> 85 | []. 86 | 87 | digit(D) --> % a single digit 88 | [D], 89 | {char_type(D,digit)}. 90 | 91 | % rules for your seperators 92 | sep(';') --> ";". 93 | sep(':=') --> ":=". 94 | sep('+') --> "+". 95 | sep('-') --> "-". 96 | sep('*') --> "*". 97 | sep('/') --> "/". 98 | 99 | parse(Source,Structure) :- 100 | % pl_program(Z, Source\[],Structure). 101 | pl_program(Structure, Source,Z). 102 | 103 | pl_program(S) --> [program], identifier(X), [';'], statement(S). 104 | 105 | statement((S;Ss)) --> 106 | [begin], statement(S), rest_statements(Ss). 107 | statement(assign(X,V)) --> 108 | identifier(X), [':='], expression(V). 109 | statement(if(T,S1,S2)) --> 110 | [if], test(T), [then], statement(S1), [else], statement(S2). 111 | statement(while(T,S)) --> 112 | [while], test(T), [do], statement(S). 113 | statement(read(X)) --> 114 | [read], identifier(X). 115 | statement(write(X)) --> 116 | [write], expression(X). 117 | 118 | rest_statements((S;Ss)) --> [';'], statement(S), rest_statements(Ss). 119 | rest_statements(void) --> [end]. 120 | 121 | expression(X) --> pl_constant(X). 122 | expression(expr(Op,X,Y)) --> pl_constant(X), arithmetic_op(Op), expression(Y). 123 | 124 | arithmetic_op('+') --> ['+']. 125 | arithmetic_op('-') --> ['-']. 126 | arithmetic_op('*') --> ['*']. 127 | arithmetic_op('/') --> ['/']. 128 | 129 | pl_constant(name(X)) --> identifier(X). 130 | pl_constant(number(X)) --> pl_integer(X). 131 | 132 | identifier(X) --> [X], {atom(X)}. 133 | pl_integer(X) --> [X], {integer(X)}. 134 | 135 | test(compare(Op,X,Y)) --> expression(X), comparison_op(Op), expression(Y). 136 | 137 | comparison_op('=') --> ['=']. 138 | comparison_op('\\=') --> ['\\=']. 139 | comparison_op('>') --> ['>']. 140 | comparison_op('<') --> ['<']. 141 | comparison_op('>=') --> ['>=']. 142 | comparison_op('=<') --> ['=<']. 143 | 144 | /* The code generator 145 | 146 | encode(Structure,Dictionary,RelocatableCode) :- 147 | RelocatableCode is generated from the parsed Structure 148 | building a Dictionary associating variables with addresses. 149 | */ 150 | encode((X;Xs),D,(Y;Ys)) :- 151 | encode(X,D,Y), encode(Xs,D,Ys). 152 | encode(void,D,no_op). 153 | encode(assign(Name,E),D,(Code; instr(store,Address))) :- 154 | lookup(Name,D,Address), encode_expression(E,D,Code). 155 | encode(if(Test,Then,Else),D, 156 | (TestCode; ThenCode; instr(jump,L2); label(L1); ElseCode; label(L2))) :- 157 | encode_test(Test,L1,D,TestCode), 158 | encode(Then,D,ThenCode), 159 | encode(Else,D,ElseCode). 160 | encode(while(Test,Do),D, 161 | (label(L1); TestCode; DoCode; instr(jump,L1); label(L2))) :- 162 | encode_test(Test,L2,D,TestCode), encode(Do,D,DoCode). 163 | encode(read(X),D,instr(read,Address)) :- 164 | lookup(X,D,Address). 165 | encode(write(E),D,(Code; instr(write,0))) :- 166 | encode_expression(E,D,Code). 167 | 168 | /* encode_expression(Expression,Dictionary,Code) :- 169 | Code corresponds to an arithmetic Expression. 170 | */ 171 | encode_expression(number(C),D,instr(loadc,C)). 172 | encode_expression(name(X),D,instr(load,Address)) :- 173 | lookup(X,D,Address). 174 | encode_expression(expr(Op,E1,E2),D,(Load;Instruction)) :- 175 | single_instruction(Op,E2,D,Instruction), 176 | encode_expression(E1,D,Load). 177 | encode_expression(expr(Op,E1,E2),D,Code) :- 178 | not(single_instruction(Op,E2,D,Instruction)), 179 | single_operation(Op,E1,D,E2Code,Code), 180 | encode_expression(E2,D,E2Code). 181 | 182 | single_instruction(Op,number(C),D,instr(OpCode,C)) :- 183 | literal_operation(Op,OpCode). 184 | single_instruction(Op,name(X),D,instr(OpCode,A)) :- 185 | memory_operation(Op,OpCode), lookup(X,D,A). 186 | 187 | single_operation(Op,E,D,Code,(Code;Instruction)) :- 188 | commutative(Op), single_instruction(Op,E,D,Instruction). 189 | single_operation(Op,E,D,Code, 190 | (Code;instr(store,Address);Load;instr(OpCode,Address))) :- 191 | not(commutative(Op)), 192 | lookup('$temp',D,Address), 193 | encode_expression(E,D,Load), 194 | op_code(E,Op,OpCode). 195 | 196 | op_code(number(C),Op,OpCode) :- literal_operation(Op,OpCode). 197 | op_code(name(X),Op,OpCode) :- memory_operation(Op,OpCode). 198 | 199 | literal_operation('+',addc). 200 | literal_operation('-',subc). 201 | literal_operation('*',mulc). 202 | literal_operation('/',divc). 203 | 204 | memory_operation('+',add). 205 | memory_operation('-',sub). 206 | memory_operation('*',mul). 207 | memory_operation('/',div). 208 | 209 | commutative('+'). 210 | commutative('*'). 211 | 212 | encode_test(compare(Op,E1,E2),Label,D,(Code; instr(OpCode,Label))) :- 213 | comparison_opcode(Op,OpCode), 214 | encode_expression(expr('-',E1,E2),D,Code). 215 | 216 | comparison_opcode('=',jumpne). 217 | comparison_opcode('\\=',jumpeq). 218 | comparison_opcode('>',jumple). 219 | comparison_opcode('>=',jumplt). 220 | comparison_opcode('<',jumpge). 221 | comparison_opcode('=<',jumpgt). 222 | 223 | lookup(Key,dict(Key,X,Left,Right),Value) :- 224 | !, X = Value. 225 | lookup(Key,dict(Key1,X,Left,Right),Value) :- 226 | Key @< Key1 , lookup(Key,Left,Value). 227 | lookup(Key,dict(Key1,X,Left,Right),Value) :- 228 | Key @> Key1, lookup(Key,Right,Value). 229 | 230 | /* The assembler 231 | 232 | assemble(Code,Dictionary,TidyCode) :- 233 | TidyCode is the result of assembling Code removing 234 | no_ops and labels, and filling in the Dictionary. 235 | */ 236 | 237 | assemble(Code,Dictionary,TidyCode) :- 238 | tidy_and_count(Code,1,N,TidyCode\(instr(halt,0);block(L))), 239 | N1 is N + 1, 240 | allocate(Dictionary,N1,N2), 241 | L is N2 - N1, !. 242 | 243 | tidy_and_count((Code1;Code2),M,N,TCode1\TCode2) :- 244 | tidy_and_count(Code1,M,M1,TCode1\Rest), 245 | tidy_and_count(Code2,M1,N,Rest\TCode2). 246 | tidy_and_count(instr(X,Y),N,N1,(instr(X,Y);Code)\Code) :- 247 | N1 is N + 1. 248 | tidy_and_count(label(N),N,N,Code\Code). 249 | tidy_and_count(no_op,N,N,Code\Code). 250 | 251 | allocate(void,N,N). 252 | allocate(dict(Name,N1,Before,After),N0,N) :- 253 | allocate(Before,N0,N1), 254 | N2 is N1 + 1, 255 | allocate(After,N2,N). 256 | 257 | print_asm((instr(X,Y);Rest)) :- format("~w ~w~n", [X,Y]), print_asm(Rest). 258 | print_asm(block(X)). 259 | 260 | % Program 24.1: A compiler from PL to machine language 261 | -------------------------------------------------------------------------------- /Chapter24/program-24.2.prolog: -------------------------------------------------------------------------------- 1 | test_compiler(X,Y) :- 2 | program(X,P), compile(P,Y). 3 | 4 | program(test1,[program,test1,';',begin,write,x,'+',y,'-',z,'/',2,end]). 5 | 6 | program(test2,[program,test2,';', 7 | begin,if,a,'>',b,then,max,':=',a,else,max,':=',b,end]). 8 | 9 | program(factorial, 10 | [program,factorial,';' 11 | ,begin 12 | ,read,value,';' 13 | ,count,':=',1,';' 14 | ,result,':=',1,';' 15 | ,while,count,'<',value,do 16 | ,begin 17 | ,count,':=',count,'+',1,';' 18 | ,result,':=',result,'*',count 19 | ,end,';' 20 | ,write,result 21 | ,end]). 22 | 23 | % Program 24.2 Test data 24 | -------------------------------------------------------------------------------- /Chapter3/program-3.1.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | natural_number(X) :- X is a natural number. 3 | */ 4 | 5 | natural_number(0). 6 | natural_number(s(X)) :- natural_number(X). 7 | 8 | % Program 3.1: Defining the natural numbers 9 | -------------------------------------------------------------------------------- /Chapter3/program-3.10.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | gcd(X,Y,Z) :- Z is the greatest common divisor of the 3 | natural numbers X and Y. 4 | */ 5 | 6 | gcd(X,Y,Gcd) :- mod(X,Y,Z), gcd(Y,Z,Gcd). 7 | gcd(X,0,X) :- X > 0. 8 | 9 | % Program 3.10: The Euclidean algorithm 10 | -------------------------------------------------------------------------------- /Chapter3/program-3.11.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | list(Xs) :- Xs is a list. 3 | */ 4 | 5 | list([]). 6 | list([X|Xs]) :- list(Xs). 7 | 8 | % Program 3.11: Defining a list 9 | -------------------------------------------------------------------------------- /Chapter3/program-3.12.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | member(Element,List) :- Element is an element of the list List 3 | */ 4 | 5 | member(X,[X|Xs]). 6 | member(X,[Y|Ys]) :- member(X,Ys). 7 | 8 | % Program 3.12: Membership of a list 9 | -------------------------------------------------------------------------------- /Chapter3/program-3.13.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | prefix(Prefix,List) :- Prefix is a prefix of List. 3 | */ 4 | 5 | prefix([],Ys). 6 | prefix([X|Xs],[X|Ys]) :- prefix(Xs,Ys). 7 | 8 | /* 9 | suffix(Suffix,List) :- Suffix is a suffix of List. 10 | */ 11 | 12 | suffix(Xs,Xs). 13 | suffix(Xs,[Y|Ys]) :- suffix(Xs,Ys). 14 | 15 | % Program 3.13: Prefixes and suffixes of a list 16 | -------------------------------------------------------------------------------- /Chapter3/program-3.14.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | sublist(Sub,List) :- Sub is a sublist of List. 3 | */ 4 | 5 | % a: Suffix of a prefix 6 | sublist(Xs,Ys) :- prefix(Ps,Ys), suffix(Xs,Ps). 7 | 8 | % b: Prefix of a suffix 9 | sublist(Xs,Ys) :- prefix(Xs,Ss), suffix(Ss,Ys). 10 | 11 | % c: Recursive definition of a sublist 12 | sublist(Xs,Ys) :- prefix(Xs,Ys). 13 | sublist(Xs,[Y|Ys]) :- sublist(Xs,Ys). 14 | 15 | % d: Prefix of a suffix, using append 16 | sublist(Xs,AsXsBs) :- 17 | append(As,XsBs,AsXsBs), append(Xs,Bs,XsBs). 18 | 19 | % e: Suffix of a prefix, using append 20 | sublist(Xs,AsXsBs) :- 21 | append(AsXs,Bs,AsXsBs), append(As,Xs,AsXs). 22 | 23 | % Program 3.14: Determining sublists of lists 24 | -------------------------------------------------------------------------------- /Chapter3/program-3.15.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | append(Xs,Ys,XsYs) :- 3 | XsYs is the result of concatening the lists Xs and Ys. 4 | */ 5 | 6 | append([],Ys,Ys). 7 | append([X|Xs],Ys,[X|Zs]) :- append(Xs,Ys,Zs). 8 | 9 | % Program 3.15: Appending two lists 10 | -------------------------------------------------------------------------------- /Chapter3/program-3.16.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | reverse(List,Tsil):- 3 | Tsil is the result of reversing the list List. 4 | */ 5 | % a: Naive reverse 6 | reverse([],[]). 7 | reverse([X|Xs],Zs) :- reverse(Xs,Ys), append(Ys,[X],Zs). 8 | 9 | % b: Reverse-accumulate 10 | 11 | reverse(Xs,Ys):- reverse(Xs,[],Ys). 12 | reverse([X|Xs],Acc,Ys) :- reverse(Xs,[X|Acc],Ys). 13 | reverse([],Ys,Ys). 14 | 15 | % Program 3.16: Reversing a list 16 | -------------------------------------------------------------------------------- /Chapter3/program-3.17.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | length(Xs,N) :- The list Xs has N elements. 3 | */ 4 | 5 | length([],0). 6 | length([X|Xs],s(N)) :- length(Xs,N). 7 | 8 | % Program 3.17: Determining the length of a list 9 | -------------------------------------------------------------------------------- /Chapter3/program-3.18.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | delete(List,X,HasNoXs) :- 3 | The list HasNoXs is the result of removing all 4 | occurrences of X from the list List. 5 | */ 6 | 7 | delete([X|Xs],X,Ys) :- delete(Xs,X,Ys). 8 | delete([X|Xs],Z,[X|Ys]) :- X \== Z, delete(Xs,Z,Ys). 9 | delete([],X,[]). 10 | 11 | % Program 3.18: Deleting all occurrences of an element from a list 12 | -------------------------------------------------------------------------------- /Chapter3/program-3.19.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | select(X,HasXs,OneLessXs) :- 3 | The list OneLessXs is the result of removing one 4 | occurrence of X from the list HasXs. 5 | */ 6 | 7 | select(X,[X|Xs],Xs). 8 | select(X,[Y|Ys],[Y|Zs]) :- select(X,Ys,Zs). 9 | 10 | % Program 3.19: Selecting an element from a list 11 | -------------------------------------------------------------------------------- /Chapter3/program-3.2.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | X lesseq Y :- X and Y are natural numbers, 3 | such that X is less than or equal to Y. 4 | 5 | We use lesseq to represent the operator rather than cause problems 6 | with an error message from Prolog about redefining an operator! 7 | */ 8 | 9 | :- op(xfx, 40, lesseq). 10 | 0 lesseq X :- natural_number(X). 11 | s(X) lesseq s(Y) :- X lesseq Y. 12 | 13 | natural_number(0). 14 | natural_number(s(X)) :- natural_number(X). 15 | 16 | % Program 3.2: The less than or equal relation 17 | -------------------------------------------------------------------------------- /Chapter3/program-3.20.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | sort(Xs,Ys) :- 3 | The list Ys is an ordered permutation of the list Xs. 4 | */ 5 | 6 | sort(Xs,Ys) :- permutation(Xs,Ys), ordered(Ys). 7 | 8 | permutation(Xs,[Z|Zs]) :- select(Z,Xs,Ys), permutation(Ys,Zs). 9 | permutation([],[]). 10 | 11 | ordered([]). 12 | ordered([X]). 13 | ordered([X,Y|Ys]) :- X =< Y, ordered([Y|Ys]). 14 | 15 | select(X,[X|Xs],Xs). 16 | select(X,[Y|Ys],[Y|Zs]) :- select(X,Ys,Zs). 17 | 18 | % Program 3.20 Permutation sort 19 | -------------------------------------------------------------------------------- /Chapter3/program-3.21.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | sort(Xs,Ys) :- 3 | The list Ys is an ordered permutation of the list Xs. 4 | */ 5 | 6 | sort([X|Xs],Ys) :- sort(Xs,Zs), insert(X,Zs,Ys). 7 | sort([],[]). 8 | 9 | insert(X,[],X). 10 | insert(X,[Y|Ys],[Y|Zs]) :- X > Y, insert(X,Ys,Zs). 11 | insert(X,[Y|Ys],[X,Y|Ys]) :- X =< Y. 12 | 13 | % Program 3.21: Insertion sort 14 | -------------------------------------------------------------------------------- /Chapter3/program-3.22.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | sort(Xs,Ys) :- 3 | The list Ys is an ordered permutation of the list Xs. 4 | */ 5 | quicksort([X|Xs],Ys) :- 6 | partition(Xs,X,Littles,Bigs), 7 | quicksort(Littles,Ls), 8 | quicksort(Bigs,Bs), 9 | append(Ls,[X|Bs],Ys). 10 | quicksort([],[]). 11 | 12 | partition([X|Xs],Y,[X|Ls],Bs) :- X =< Y, partition(Xs,Y,Ls,Bs). 13 | partition([X|Xs],Y,Ls,[X|Bs]) :- X > Y, partition(Xs,Y,Ls,Bs). 14 | partition([],Y,[],[]). 15 | 16 | append([],Ys,Ys). 17 | append([X|Xs],Ys,[X|Zs]) :- append(Xs,Ys,Zs). 18 | 19 | % Program 3.22: Quicksort 20 | -------------------------------------------------------------------------------- /Chapter3/program-3.23.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | binary_tree(Tree) :- Tree is a binary tree. 3 | */ 4 | binary_tree(void). 5 | binary_tree(tree(Element,Left,Right)) :- 6 | binary_tree(Left), binary_tree(Right). 7 | 8 | % Program 3.23: Defining binary trees 9 | -------------------------------------------------------------------------------- /Chapter3/program-3.24.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | tree_member(Element,Tree):- 3 | Element is an element of the binary tree Tree 4 | */ 5 | tree_member(X,tree(X,Left,Right)). 6 | tree_member(X,tree(Y,Left,Right)) :- tree_member(X,Left). 7 | tree_member(X,tree(Y,Left,Right)) :- tree_member(X,Right). 8 | 9 | % Program 3.24: Testing tree membership 10 | 11 | -------------------------------------------------------------------------------- /Chapter3/program-3.25.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | isotree(Tree1,Tree2) :- 3 | Tree1 and Tree2 are isomorphic binary trees 4 | */ 5 | isotree(void,void). 6 | isotree(tree(X,Left1,Right1),tree(X,Left2,Right2)) :- 7 | isotree(Left1,Left2), isotree(Right1,Right2). 8 | isotree(tree(X,Left1,Right1),tree(X,Left2,Right2)) :- 9 | isotree(Left1,Right2), isotree(Right1,Left2). 10 | 11 | % Program 3.25: Determining when trees are isomorphic 12 | -------------------------------------------------------------------------------- /Chapter3/program-3.26.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | substitute(X,Y,TreeX,TreeY) :- 3 | The binary tree TreeY is the result of replacing all 4 | occurrences of X in the binary tree TreeX by Y. 5 | */ 6 | 7 | substitute(X,Y,void,void). 8 | substitute(X,Y,tree(Leaf,Left,Right),tree(Leaf1,Left1,Right1)) :- 9 | replace(X,Y,Leaf,Leaf1), 10 | substitute(X,Y,Left,Left1), 11 | substitute(X,Y,Right,Right1). 12 | 13 | replace(X,Y,X,Y). 14 | replace(X,Y,Z,Z) :- X \== Z. 15 | 16 | % Program 3.26: Substituting for a term in a tree 17 | -------------------------------------------------------------------------------- /Chapter3/program-3.27.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | preorder(Tree,Pre) :- 3 | Pre is a preorder traversal of the binary tree Tree. 4 | */ 5 | preorder(tree(X,L,R),Xs) :- 6 | preorder(L,Ls), preorder(R,Rs), append([X|Ls],Rs,Xs). 7 | preorder(void,[]). 8 | 9 | /* 10 | inorder(Tree,In) :- 11 | In is an inorder traversal of the binary tree Tree. 12 | */ 13 | inorder(tree(X,L,R),Xs) :- 14 | inorder(L,Ls), inorder(R,Rs), append(Ls,[X|Rs],Xs). 15 | inorder(void,[]). 16 | /* 17 | postorder(Tree,Post) :- 18 | Post is a postorder traversal of the binary tree Tree. 19 | */ 20 | postorder(tree(X,L,R),Xs) :- 21 | postorder(L,Ls), 22 | postorder(R,Rs), 23 | append(Rs,[X],Rs1), 24 | append(Ls,Rs1,Xs). 25 | postorder(void,[]). 26 | 27 | % Program 3.27: Traversals of a binary tree 28 | -------------------------------------------------------------------------------- /Chapter3/program-3.28.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | heapify(Tree,Heap) :- 3 | The elements of the complete binary tree Tree have been adjusted 4 | to form the binary tree Heap, which has the same shape as Tree 5 | and satisfies the heap property that the value of each parent node 6 | is greater than or equal to the values of its children. 7 | */ 8 | 9 | heapify(void,void). 10 | heapify(tree(X,L,R),Heap) :- 11 | heapify(L,HeapL), heapify(R,HeapR), adjust(X,HeapL,HeapR,Heap). 12 | 13 | adjust(X,HeapL,HeapR,tree(X,HeapL,HeapR)) :- 14 | greater(X,HeapL), greater(X,HeapR). 15 | adjust(X,tree(X1,L,R),HeapR,tree(X1,HeapL,HeapR)) :- 16 | X < X1, greater(X1,HeapR), adjust(X,L,R,HeapL). 17 | adjust(X,HeapL,tree(X1,L,R),tree(X1,HeapL,HeapR)) :- 18 | X < X1, greater(X1,HeapL), adjust(X,L,R,HeapR). 19 | 20 | greater(X,void). 21 | greater(X,tree(X1,L,R)) :- X >= X1. 22 | 23 | % Program 3.28 Adjusting a binary tree to satisfy the heap property 24 | -------------------------------------------------------------------------------- /Chapter3/program-3.29.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | polynomial(Expression,X) :- 3 | Expression is a polynomial in X. 4 | */ 5 | polynomial(X,X). 6 | polynomial(Term,X) :- constant(Term). 7 | polynomial(Term1+Term2,X) :- 8 | polynomial(Term1,X), polynomial(Term2,X). 9 | polynomial(Term1-Term2,X) :- 10 | polynomial(Term1,X), polynomial(Term2,X). 11 | polynomial(Term1*Term2,X) :- 12 | polynomial(Term1,X), polynomial(Term2,X). 13 | polynomial(Term1/Term2,X) :- 14 | polynomial(Term1,X), constant(Term2). 15 | polynomial(Term ^ N,X) :- 16 | natural_number(N), polynomial(Term,X). 17 | 18 | % Program 3.29: Recognizing polynomials 19 | -------------------------------------------------------------------------------- /Chapter3/program-3.3.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | plus(X,Y,Z) :- 3 | X, Y and Z are natural numbers 4 | such that Z is the sum of X and Y. 5 | */ 6 | 7 | plus(0,X,X) :- natural_number(X). 8 | plus(s(X),Y,s(Z)):- plus(X,Y,Z). 9 | 10 | natural_number(0). 11 | natural_number(s(X)) :- natural_number(X). 12 | 13 | % Program 3.3: Addition 14 | -------------------------------------------------------------------------------- /Chapter3/program-3.30.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | derivative(Expression,X,DifferentiatedExpression) :- 3 | DifferentiatedExpression is the derivative of 4 | Expression with respect to X. 5 | */ 6 | 7 | derivative(X,X,s(0)). 8 | derivative(X ^ s(N),X,s(N) * X ^ N). 9 | derivative(sin(X),X,cos(X)). 10 | derivative(cos(X),X,-sin(X)). 11 | derivative(e ^ X,X,e ^ X). 12 | derivative(log(X),X,1/X). 13 | 14 | derivative(F+G,X,DF+DG) :- 15 | derivative(F,X,DF), derivative(G,X,DG). 16 | derivative(F-G,X,DF-DG) :- 17 | derivative(F,X,DF), derivative(G,X,DG). 18 | derivative(F*G,X,F*DG + DF*G) :- 19 | derivative(F,X,DF), derivative(G,X,DG). 20 | derivative(1/F,X,-DF/(F*F)) :- 21 | derivative(F,X,DF). 22 | derivative(F/G,X,(G*DF-F*DG)/(G*G)) :- 23 | derivative(F,X,DF), derivative(G,X,DG). 24 | 25 | % Program 3.30: Derivative rules 26 | -------------------------------------------------------------------------------- /Chapter3/program-3.31.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | hanoi(N,A,B,C,Moves) :- 3 | Moves is a sequence of moves for solving the Towers of 4 | Hanoi puzzle with N disks and three pegs, A, B and C. 5 | */ 6 | 7 | :- op(40,xfx,[to]). 8 | 9 | hanoi(s(0),A,B,C,[A to B]). 10 | hanoi(s(N),A,B,C,Moves) :- 11 | hanoi(N,A,C,B,Ms1), 12 | hanoi(N,C,B,A,Ms2), 13 | append(Ms1,[A to B|Ms2],Moves). 14 | 15 | % Program 3.31: Towers of Hanoi 16 | -------------------------------------------------------------------------------- /Chapter3/program-3.32.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | satisfiable(Formula) :- 3 | There is a true instance of the Boolean formula Formula. 4 | */ 5 | :- op(950, xfx, [&]). 6 | :- op(950, xfx, [|]). 7 | :- op(900, fx, [~]). 8 | 9 | 10 | satisfiable(true). 11 | satisfiable(X & Y) :- satisfiable(X), satisfiable(Y). 12 | satisfiable(X | Y) :- satisfiable(X). 13 | satisfiable(X | Y) :- satisfiable(Y). 14 | satisfiable((~ X)) :- invalid(Y). 15 | /* 16 | invalid(Formula) :- 17 | There is a false instance of the Boolean formula Formula. 18 | */ 19 | invalid(false). 20 | invalid(X | Y) :- invalid(X), invalid(Y). 21 | invalid(X & Y) :- invalid(X). 22 | invalid(X & Y) :- invalid(Y). 23 | invalid((~ X)) :- satisfiable(X). 24 | 25 | % Program 3.32: Satisfiability of Boolean formulae 26 | -------------------------------------------------------------------------------- /Chapter3/program-3.4.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | times(X,Y,Z) :- 3 | X, Y and Z are natural numbers 4 | such that Z is the product of X and Y 5 | */ 6 | 7 | times(0,X,0). 8 | times(s(X),Y,Z) :- times(X,Y,XY), plus(XY,Y,Z). 9 | 10 | plus(0,X,X) :- natural_number(X). 11 | plus(s(X),Y,s(Z)):- plus(X,Y,Z). 12 | 13 | natural_number(0). 14 | natural_number(s(X)) :- natural_number(X). 15 | 16 | % Program 3.4: Multiplication as repeated addition 17 | -------------------------------------------------------------------------------- /Chapter3/program-3.5.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | exp(N,X,Y) :- 3 | N, X and Y are natural numbers 4 | such that Y equals X raised to the power N. 5 | */ 6 | 7 | exp(s(N),0,0). 8 | exp(0,s(X),s(0)). 9 | exp(s(N),X,Y) :- exp(N,X,Z), times(Z,X,Y). 10 | 11 | times(0,Y,0). 12 | times(s(X),Y,Z) :- times(X,Y,XY), plus(XY,Y,Z). 13 | 14 | plus(0,X,X) :- natural_number(X). 15 | plus(s(X),Y,s(Z)):- plus(X,Y,Z). 16 | 17 | natural_number(0). 18 | natural_number(s(X)) :- natural_number(X). 19 | 20 | % Program 3.5: Exponentiation as repeated multiplication 21 | -------------------------------------------------------------------------------- /Chapter3/program-3.6.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | factorial(N,F) :- F equals N factorial. 3 | */ 4 | 5 | factorial(0,s(0)). 6 | factorial(s(N),F) :- factorial(N,F1), times(s(N),F1,F). 7 | 8 | times(0,X,0). 9 | times(s(X),Y,Z) :- times(X,Y,XY), plus(XY,Y,Z). 10 | 11 | plus(0,X,X) :- natural_number(X). 12 | plus(s(X),Y,s(Z)):- plus(X,Y,Z). 13 | 14 | natural_number(0). 15 | natural_number(s(X)) :- natural_number(X). 16 | 17 | % Program 3.6: Computing factorials 18 | -------------------------------------------------------------------------------- /Chapter3/program-3.7.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | minimum(N1,N2,Min) :- 3 | The minimum of natural numbers N1 and N2 is Min. 4 | 5 | We use lesseq to represent the operator rather than cause problems 6 | with an error message from Prolog about redefining an operator! 7 | */ 8 | 9 | :- op(xfx, 40, lesseq). 10 | 11 | minimum(N1,N2,N1) :- N1 lesseq N2. 12 | minimum(N1,N2,N2) :- N2 lesseq N1. 13 | 14 | 0 lesseq X :- natural_number(X). 15 | s(X) lesseq s(Y) :- X lesseq Y. 16 | 17 | natural_number(0). 18 | natural_number(s(X)) :- natural_number(X). 19 | 20 | % Program 3.7: The minimum of two numbers 21 | 22 | -------------------------------------------------------------------------------- /Chapter3/program-3.8a.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | mod(X,Y,Z) :- 3 | Z is the remainder of the integer division of X by Y. 4 | */ 5 | 6 | mod(X,Y,Z) :- Z < Y, times(Y,Q,QY), plus(QY,Z,X). 7 | 8 | times(0,X,0). 9 | times(s(X),Y,Z) :- times(X,Y,XY), plus(XY,Y,Z). 10 | 11 | plus(0,X,X) :- natural_number(X). 12 | plus(s(X),Y,s(Z)):- plus(X,Y,Z). 13 | 14 | natural_number(0). 15 | natural_number(s(X)) :- natural_number(X). 16 | 17 | % Program 3.8a: A nonrecursive definition of modulus 18 | -------------------------------------------------------------------------------- /Chapter3/program-3.8b.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | mod(X,Y,Z) :- 3 | Z is the remainder of the integer division of X and Y. 4 | */ 5 | 6 | mod(X,Y,X):- X < Y. 7 | mod(X,Y,Z) :- plus(X1,Y,X), mod(X1,Y,Z). 8 | 9 | plus(0,X,X) :- natural_number(X). 10 | plus(s(X),Y,s(Z)):- plus(X,Y,Z). 11 | 12 | natural_number(0). 13 | natural_number(s(X)) :- natural_number(X). 14 | 15 | % Program 3.8b: A recursive definition of modulus 16 | -------------------------------------------------------------------------------- /Chapter3/program-3.9.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | ackermann(X,Y,A) :- 3 | A is the value of Ackermann's function for 4 | the natural numbers X and Y. 5 | */ 6 | 7 | ackermann(0,N,s(N)). 8 | ackermann(s(M),0,Val) :- ackermann(M,s(0),Val). 9 | ackermann(s(M),s(N),Val) :- 10 | ackermann(s(M),N,Val1), ackermann(M,Val1,Val). 11 | 12 | % Program 3.9: Ackermann's function 13 | 14 | -------------------------------------------------------------------------------- /Chapter5/program-5.1.prolog: -------------------------------------------------------------------------------- 1 | parent(terach,abraham). parent(abraham,isaac). 2 | parent(isaac,jacob). parent(jacob,benjamin). 3 | 4 | ancestor(X,Y) :- parent(X,Y). 5 | ancestor(X,Z) :- parent(X,Y), ancestor(Y,Z). 6 | 7 | % Program 5.1 Yet another family example 8 | -------------------------------------------------------------------------------- /Chapter7/program-7.1.prolog: -------------------------------------------------------------------------------- 1 | parent(terach,abraham). parent(abraham,isaac). 2 | parent(isaac,jacob). parent(jacob,benjamin). 3 | 4 | ancestor(X,Y) :- parent(X,Y). 5 | ancestor(X,Z) :- parent(X,Y), ancestor(Y,Z). 6 | 7 | % Program 7.1 Yet another family example 8 | -------------------------------------------------------------------------------- /Chapter7/program-7.10.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | nd_reverse(Xs,Ys) :- 3 | Ys is the reversal of the list obtained by 4 | removing duplicate elements from the list Xs. 5 | */ 6 | nd_reverse(Xs,Ys) :- nd_reverse(Xs,[],Ys). 7 | 8 | nd_reverse([X|Xs],Revs,Ys) :- 9 | member(X,Revs), nd_reverse(Xs,Revs,Ys). 10 | nd_reverse([X|Xs],Revs,Ys) :- 11 | nonmember(X,Revs), nd_reverse(Xs,[X|Revs],Ys). 12 | nd_reverse([],Ys,Ys). 13 | 14 | nonmember(X,[Y|Ys]) :- X \== Y, nonmember(X,Ys). 15 | nonmember(X,[]). 16 | 17 | % Program 7.10 Reversing with no duplicates 18 | -------------------------------------------------------------------------------- /Chapter7/program-7.2.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | merge(Xs,Ys,Zs) :- 3 | Zs is an ordered list of integers obtained from 4 | merging the ordered lists of integers Xs and Ys. 5 | */ 6 | merge([X|Xs],[Y|Ys],[X|Zs]) :- 7 | X < Y, merge(Xs,[Y|Ys],Zs). 8 | merge([X|Xs],[Y|Ys],[X,X|Zs]) :- 9 | X =:= Y, merge(Xs,Ys,Zs). 10 | merge([X|Xs],[Y|Ys],[Y|Zs]) :- 11 | X > Y, merge([X|Xs],Ys,Zs). 12 | merge([],[X|Xs],[X|Xs]). 13 | merge(Xs,[],Xs). 14 | 15 | % Program 7.2 Merging ordered lists 16 | -------------------------------------------------------------------------------- /Chapter7/program-7.3.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | member_check(X,Xs) :- X is a member of the list Xs. 3 | */ 4 | member_check(X,[X|Xs]). 5 | member_check(X,[Y|Ys]) :- X \== Y, member_check(X,Ys). 6 | 7 | % Program 7.3 Checking for list membership 8 | -------------------------------------------------------------------------------- /Chapter7/program-7.4.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | select_first(X,Xs,Ys) :- 3 | Ys is the list obtained by removing the 4 | first occurrence of X from the list Xs. 5 | */ 6 | select_first(X,[X|Xs],Xs). 7 | select_first(X,[Y|Ys],[Y|Zs]) :- X \== Y, select_first(X,Ys,Zs). 8 | 9 | % Program 7.4 Selecting the first occurrence of an element from a list 10 | -------------------------------------------------------------------------------- /Chapter7/program-7.5.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | nonmember(X,Xs) :- X is not a member of the list Xs. 3 | */ 4 | nonmember(X,[Y|Ys]) :- X \== Y, nonmember(X,Ys). 5 | nonmember(X,[]). 6 | 7 | % Program 7.5 Nonmembership of a list 8 | -------------------------------------------------------------------------------- /Chapter7/program-7.6.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | members(Xs,Ys) :- Each element of the list Xs is an element of the list Ys. 3 | */ 4 | members([X|Xs],Ys) :- member(X,Ys), members(Xs,Ys). 5 | members([],Ys). 6 | 7 | % Program 7.6 Testing for a subset 8 | -------------------------------------------------------------------------------- /Chapter7/program-7.7.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | selects(Xs,Ys) :- The list Xs is a subset of the list Ys. 3 | */ 4 | selects([X|Xs],Ys) :- select(X,Ys,Ys1), selects(Xs,Ys1). 5 | selects([],Ys). 6 | 7 | select(X,[X|Xs],Xs). 8 | select(X,[Y|Ys],[Y|Zs]) :- select(X,Ys,Zs). 9 | 10 | % Program 7.7 Testing for a subset 11 | -------------------------------------------------------------------------------- /Chapter7/program-7.8.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | translate(Words,Mots) :- 3 | Mots is a list of French words that is the 4 | translation of the list of English words Words. 5 | */ 6 | translate([Word|Words],[Mot|Mots]) :- 7 | dict(Word,Mot), translate(Words,Mots). 8 | translate([],[]). 9 | 10 | dict(the,le). dict(dog,chien). 11 | dict(chases,chasse). dict(cat,chat). 12 | 13 | % Program 7.8 Translating word for word 14 | -------------------------------------------------------------------------------- /Chapter7/program-7.9.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | no_doubles(Xs,Ys) :- 3 | Ys is the list obtained by removing 4 | duplicate elements from the list Xs. 5 | */ 6 | 7 | no_doubles([X|Xs],Ys) :- 8 | member(X,Xs), no_doubles(Xs,Ys). 9 | no_doubles([X|Xs],[X|Ys]) :- 10 | nonmember(X,Xs), no_doubles(Xs,Ys). 11 | no_doubles([],[]). 12 | 13 | nonmember(X,[Y|Ys]) :- X \== Y, nonmember(X,Ys). 14 | nonmember(X,[]). 15 | 16 | % Program 7.9 Removing duplicates from a list -------------------------------------------------------------------------------- /Chapter8/program-8.1.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | greatest_common_divisor(X,Y,Z) :- 3 | Z is the greatest common divisor of the integers X and Y. 4 | */ 5 | greatest_common_divisor(I,0,I). 6 | greatest_common_divisor(I,J,Gcd) :- 7 | J > 0, R is I mod J, greatest_common_divisor(J,R,Gcd). 8 | 9 | % Program 8.1 Computing the greatest common divisor of two integers 10 | -------------------------------------------------------------------------------- /Chapter8/program-8.10.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | length(Xs,N) :- Xs is a list of length N. 3 | */ 4 | length([X|Xs],N) :- N > 0, N1 is N-1, length(Xs,N1). 5 | length([],0). 6 | 7 | % Program 8.10 Checking the length of a list 8 | -------------------------------------------------------------------------------- /Chapter8/program-8.11.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | length(Xs,N) :- N is the length of the list Xs. 3 | */ 4 | length([X|Xs],N) :- length(Xs,N1), N is N1+1. 5 | length([],0). 6 | 7 | % Program 8.11 Finding the length of a list 8 | -------------------------------------------------------------------------------- /Chapter8/program-8.12.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | range(M,N,Ns) :- Ns is the list of integers between M and N inclusive. 3 | */ 4 | range(M,N,[M|Ns]) :- M < N, M1 is M+1, range(M1,N,Ns). 5 | range(N,N,[N]). 6 | 7 | % Program 8.12 Generating a list of integers in a given range 8 | 9 | -------------------------------------------------------------------------------- /Chapter8/program-8.2.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | factorial(N,F) :- F is the integer N factorial. 3 | */ 4 | factorial(N,F) :- 5 | N > 0, N1 is N-1, factorial(N1,F1), F is N*F1. 6 | factorial(0,1). 7 | % 8 | % Program 8.2 Computing the factorial of a number 9 | -------------------------------------------------------------------------------- /Chapter8/program-8.3.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | factorial(N,F) :- F is the integer N factorial. 3 | */ 4 | factorial(N,F) :- factorial(0,N,1,F). 5 | 6 | factorial(I,N,T,F) :- 7 | I < N, I1 is I+1, T1 is T*I1, factorial(I1,N,T1,F). 8 | factorial(N,N,F,F). 9 | 10 | % Program 8.3 An iterative factorial 11 | -------------------------------------------------------------------------------- /Chapter8/program-8.4.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | factorial(N,F) :- F is the integer N factorial. 3 | */ 4 | factorial(N,F) :- factorial(N,1,F). 5 | 6 | factorial(N,T,F) :- 7 | N > 0, T1 is T*N, N1 is N-1, factorial(N1,T1,F). 8 | factorial(0,F,F). 9 | 10 | % Program 8.4 Another iterative factorial 11 | -------------------------------------------------------------------------------- /Chapter8/program-8.5.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | between(I,J,K) :- K is an integer between the integers I and J inclusive. 3 | */ 4 | between(I,J,I) :- I =< J. 5 | between(I,J,K) :- I < J, I1 is I + 1, between(I1,J,K). 6 | 7 | % Program 8.5 Generating a range of integers 8 | -------------------------------------------------------------------------------- /Chapter8/program-8.6a.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | sumlist(Is,Sum) :- Sum is the sum of the list of integers Is. 3 | */ 4 | sumlist([I|Is],Sum) :- sumlist(Is,IsSum), Sum is I+IsSum. 5 | sumlist([],0). 6 | 7 | % Program 8.6a Summing a list of integers 8 | -------------------------------------------------------------------------------- /Chapter8/program-8.6b.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | sumlist(Is,Sum) :- Sum is the sum of the list of integers Is. 3 | */ 4 | sumlist(Is,Sum) :- sumlist(Is,0,Sum). 5 | 6 | sumlist([I|Is],Temp,Sum) :- 7 | Temp1 is Temp+I, sumlist(Is,Temp1,Sum). 8 | sumlist([],Sum,Sum). 9 | 10 | % Program 8.6b Iterative version of summing a list of integers 11 | % using an accumulator 12 | -------------------------------------------------------------------------------- /Chapter8/program-8.7a.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | inner_product(Xs,Ys,Value) :- 3 | Value is the inner product of the vectors 4 | represented by the lists of integers Xs and Ys. 5 | */ 6 | inner_product([X|Xs],[Y|Ys],IP) :- 7 | inner_product(Xs,Ys,IP1), IP is X*Y + IP1. 8 | inner_product([],[],0). 9 | 10 | % Program 8.7a Computing inner products of vectors 11 | -------------------------------------------------------------------------------- /Chapter8/program-8.7b.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | inner_product(Xs,Ys,Value) :- 3 | Value is the inner product of the vectors 4 | represented by the lists of integers Xs and Ys. 5 | */ 6 | inner_product(Xs,Ys,IP) :- inner_product(Xs,Ys,0,IP). 7 | 8 | inner_product([X|Xs],[Y|Ys],Temp,IP) :- 9 | Temp1 is X*Y+Temp, inner_product(Xs,Ys,Temp1,IP). 10 | inner_product([],[],IP,IP). 11 | 12 | % Program 8.7b Computing inner products of vectors iteratively 13 | -------------------------------------------------------------------------------- /Chapter8/program-8.8.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | area(Chain,Area) :- 3 | Area is the area of the polygon enclosed by the list of points 4 | Chain, where the coordinates of each point are represented by 5 | a pair (X,Y) of integers. 6 | */ 7 | area([Tuple],0). 8 | area([(X1,Y1),(X2,Y2)|XYs],Area) :- 9 | area([(X2,Y2)|XYs],Area1), 10 | Area is (X1*Y2-Y1*X2)/2 + Area1. 11 | 12 | % Program 8.8 Computing the area of polygons 13 | 14 | -------------------------------------------------------------------------------- /Chapter8/program-8.9.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | maxlist(Xs,N) :- N is the maximum of the list of integers Xs. 3 | */ 4 | maxlist([X|Xs],M) :- maxlist(Xs,X,M). 5 | 6 | maxlist([X|Xs],Y,M) :- maximum(X,Y,Y1), maxlist(Xs,Y1,M). 7 | maxlist([],M,M). 8 | 9 | maximum(X,Y,Y) :- X =< Y. 10 | maximum(X,Y,X) :- X > Y. 11 | 12 | % Program 8.9 Finding the maximum of a list of integers 13 | -------------------------------------------------------------------------------- /Chapter9/program-9.1a.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | flatten(Xs,Ys) :- Ys is a list of the elements of Xs. 3 | */ 4 | 5 | flatten([X|Xs],Ys) :- 6 | flatten(X,Ys1), flatten(Xs,Ys2), append(Ys1,Ys2,Ys). 7 | flatten(X,[X]) :- 8 | constant(X), X \== []. 9 | flatten([],[]). 10 | 11 | 12 | % Program 9.1a Flattening a list with double recursion 13 | -------------------------------------------------------------------------------- /Chapter9/program-9.1b.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | flatten(Xs,Ys) :- Ys is a list of the elements of Xs. 3 | */ 4 | flatten(Xs,Ys) :- flatten(Xs,[],Ys). 5 | 6 | flatten([X|Xs],S,Ys) :- 7 | list(X), flatten(X,[Xs|S],Ys). 8 | flatten([X|Xs],S,[X|Ys]) :- 9 | constant(X), X \== [], flatten(Xs,S,Ys). 10 | flatten([],[X|S],Ys) :- 11 | flatten(X,S,Ys). 12 | flatten([],[],[]). 13 | 14 | list([X|Xs]). 15 | 16 | % Program 9.1b Flattening a list using a stack 17 | 18 | -------------------------------------------------------------------------------- /Chapter9/program-9.2.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | subterm(Sub,Term) :- Sub is a subterm of the ground term Term. 3 | */ 4 | subterm(Term,Term). 5 | subterm(Sub,Term) :- 6 | compound(Term), functor(Term,F,N), subterm(N,Sub,Term). 7 | 8 | subterm(N,Sub,Term) :- 9 | N > 1, N1 is N-1, subterm(N1,Sub,Term). 10 | subterm(N,Sub,Term) :- 11 | arg(N,Term,Arg), subterm(Sub,Arg). 12 | 13 | % Program 9.2 Finding subterms of a term 14 | 15 | -------------------------------------------------------------------------------- /Chapter9/program-9.3.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | substitute(Old,New,OldTerm,NewTerm) :- NewTerm is the result of replacing 3 | all occurences of Old in OldTerm by New. 4 | */ 5 | substitute(Old,New,Old,New). 6 | substitute(Old,New,Term,Term) :- 7 | constant(Term), Term \== Old. 8 | substitute(Old,New,Term,Term1) :- 9 | compound(Term), 10 | functor(Term,F,N), 11 | functor(Term1,F,N), 12 | substitute(N,Old,New,Term,Term1). 13 | 14 | substitute(N,Old,New,Term,Term1) :- 15 | N > 0, 16 | arg(N,Term,Arg), 17 | substitute(Old,New,Arg,Arg1), 18 | arg(N,Term1,Arg1), 19 | N1 is N-1, 20 | substitute(N1,Old,New,Term,Term1). 21 | substitute(0,Old,New,Term,Term1). 22 | 23 | % Program 9.3 A program for substituting in a term 24 | -------------------------------------------------------------------------------- /Chapter9/program-9.4.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | subterm(Sub,Term) :- Sub is a subterm of the ground term Term. 3 | */ 4 | subterm(Term,Term). 5 | subterm(Sub,Term) :- 6 | compound(Term), Term =.. [F|Args], subterm_list(Sub,Args). 7 | 8 | subterm_list(Sub,[Arg|Args]) :- 9 | subterm(Sub,Arg). 10 | subterm_list(Sub,[Arg|Args]) :- 11 | subterm_list(Sub,Args). 12 | 13 | % Program 9.4 Subterm defined using univ 14 | -------------------------------------------------------------------------------- /Chapter9/program-9.5a.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | univ(Term, List) :- List is a list containing the functor of Term followed 3 | by the arguments of Term. 4 | */ 5 | univ(Term, [F|Args]) :- 6 | functor(Term,F,N), args(0,N,Term,Args). 7 | 8 | args(I,N,Term,Arg,Args) :- 9 | I < N, I1 is I+1, arg(I1,Term,Arg), args(I1,N,Term,Args). 10 | args(N,N,Term,[]). 11 | 12 | % Program 9.5a Constructing a list corresponding to a term 13 | -------------------------------------------------------------------------------- /Chapter9/program-9.5b.prolog: -------------------------------------------------------------------------------- 1 | /* 2 | univ(Term, List) :- 3 | The functor of Term is the first element of the list List, 4 | and its arguments are the rest of List's elements. 5 | */ 6 | 7 | univ(Term, [F|Args]) :- 8 | length(Args,N), functor(Term,F,N), args(Args,Term,1). 9 | 10 | args([Arg|Args],Term,N) :- 11 | arg(N,Term,Arg), N1 is N+1, args(Args,Term,N1). 12 | args([],Term,N). 13 | /* 14 | length(Xs,N) :- N is the length of the list Xs. 15 | */ 16 | length([X|Xs],N) :- length(Xs,N1), N is N1+1. 17 | length([],0). 18 | 19 | % Program 9.5b Constructing a term corresponding to a list 20 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # aop 2 | Art of Prolog Code 3 | 4 | This repository contains the source code from the book "Sterling, Leon, and Ehud Y. Shapiro. The art of Prolog: advanced programming techniques. MIT press, 1994. 5 | APA". The goal is to get it into a state where I can just run it from emacs or other prolog IDEs. 6 | --------------------------------------------------------------------------------