% declaration to load rational solver :- use_module(library(r)). % compiler directive to load finite domain library :- use_module(library(fd)). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % 9.1 Extending the Constraint Solver % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Complex number addition and multiplication again p294. c_add(c(R1,I1),c(R2,I2),c(R3,I3)) :- R3 $= R1 + R2, I3 $= I1 + I2. c_mult(c(R1,I1),c(R2,I2),c(R3,I3)) :- R3 $= R1*R2 - I1*I2, I3 $= R1*I2 + R2*I1. % Vector addition and less-than-or-equal-to representing % vectors as lists p294. v_add([],[],[]). v_add([X1|Y1], [X2|Y2], [X|Y]) :- X $= X1+X2, v_add(Y1,Y2,Y). v_leq([],[]). v_leq([X1|Y1], [X2|Y2]) :- X1 $<= X2, v_leq(Y1,Y2). % Sequence constraints: not_empty and concatentation using lists p294. not_empty([_|_]). concat([S1],S1). concat([S1,S2|Ss],S) :- append_(S1,T,S), concat([S2|Ss],T). % The sequence problem as a constraint program p295. sequence_problem(T) :- contigs(Contigs), perm(Contigs, [C1, C2, C3]), not_empty(O12), not_empty(O23), concat([UC1,O12], C1), concat([O12,UC2,O23], C2), concat([O23,UC3], C3), concat([UC1,O12,UC2,O23,UC3], T). contigs([[a,t,c,g,g,g,c], [a,a,a,a,t,c,g], [g,c,c,a,t,t]]). delete_([X | Xs], X, Xs). delete_([X | Xs], Y, [X | R]) :- delete_(Xs, Y, R). perm([], []). perm(L, [X|R]) :- delete_(L, X, L1), perm(L1, R). % sequence problem goal p295. gp295(T) :- sequence_problem(T). % failure to find unsatisfiability p296. gp296(L1,L2,L) :- not_empty(L2), concat([L1,L2], L), L=[]. % Newton Raphson program for (X+2)^3 p 298. f(X, F) :- F $= (X+2)*(X+2)*(X+2). df(X,DF) :- DF $= 3*(X+2)*(X+2). solve_nr(E, X0, X0) :- f(X0,F0), -E $<= F0, F0 $<= E. solve_nr(E, X0, X) :- f(X0, F0), df(X0, DF0), F0 $= DF0 * X0 + C, 0 $= DF0 * X1 + C, solve_nr(E, X1, X). % goal for Newton Raphson program p298. gp296(X) :- solve_nr(0.0001, 0.0, X). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % 9.2 Combined Symbolic and Arithmetic Reasoning % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % converting a tree representation to constraints p299. evaln(x,X,X). evaln(N,_,N) :- arithmetic(N). evaln(power(x,N),X,E) :- dpow(E,X,N). %% translation of E = pow(X, N). evaln(sine(x),X,E) :- dsin(E, X). %% translation of E = sin(X). evaln(cosine(x),X,E) :- dcos(E, X). %% translation of E = cos(X). evaln(minus(F),X,E) :- E $= -EF, evaln(F,X,EF). evaln(plus(F,G),X,E) :- E $= EF + EG, evaln(F,X,EF), evaln(G,X,EG). evaln(mult(F,G),X,E) :- E $= EF * EG, evaln(F,X,EF), evaln(G,X,EG). % arithmetic defined for ECLiPSe (not in text). arithmetic(X) :- number(X). % goal for evaluating an expression p299. % doesnt work because of interaction of non-linears and rationals? gp299(X,F) :- evaln(plus(power(x,2),plus(mult(3,x),2)),X,F). % Simple derivative calculation program p300. deriv(x,1). deriv(N,0) :- arithmetic(N). deriv(power(x,N),mult(N,power(x,N1))) :- N1$=N-1. deriv(sine(x),cosine(x)). deriv(cosine(x),minus(sine(x))). deriv(minus(F),minus(DF)) :- deriv(F,DF). deriv(plus(F,G),plus(DF,DG)) :- deriv(F,DF), deriv(G,DG). deriv(mult(F,G),plus(mult(DF,G),mult(DG,F))) :- deriv(F,DF), deriv(G,DG). % Goal for derivative calculation p300. gp300a(F) :- deriv(plus(power(x,2),plus(mult(3,x),2)),F). % Improved Newton Raphson program p300. dsolve(E,F,X0,X) :- deriv(F,DF), solve_nr(E,F,DF,X0,X). solve_nr(E,F,_DF,X0,X0) :- evaln(F,X0,F0), -E $<= F0, F0 $<= E. solve_nr(E,F,DF,X0,X) :- evaln(F,X0,F0), evaln(DF,X0,DF0), F0 $= DF0 * X0 + C, 0 $= DF0 * X1 + C, solve_nr(E,F,DF,X1,X). % Goal for improved Newton-Raphson p300. % fails because of problems with evaln that I dont follow gp300b(X) :- dsolve(0.00001, plus(power(x,2), plus(mult(3,x), 2)), 5, X). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % 9.3 Programming Optimization % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Branch and Bound program p302. % Does not work because it relies on minimize returning a % single value for each of the variables in Vs % ECLiPSe seems to support this with rmin but not for me! bnb(CBest, CVals, Bnds, Best, BestVals) :- (minimize_val((F $< CBest, bounded_problem(Vs, Bnds, F)), F) -> new_bounds(Vs, Bnds, BndsL, BndsR), (BndsL = BndsR -> Best = F, BestVals = Vs ; bnb(CBest, CVals, BndsL, LBest, LVals), bnb(LBest, LVals, BndsR, Best, BestVals) ) ; Best = CBest, BestVals = CVals ). new_bounds([], [], [], []). new_bounds([V|Vs], [B|Bs], [BL|BLs], [BR|BRs]) :- (integer(V) -> % BL = B, BR = B, new_bounds(Vs, Bs, BLs, BRs) ; B = b(L,U), VL is floor(V), VU is VL + 1, BL = b(L,VL), BR = b(VU, U), BLs = Bs, BRs = Bs ). bounded_problem(Vs, Bnds, F) :- bounds(Vs, Bnds), problem(Vs, F). bounds([], []). bounds([V|Vs], [b(L,U)|Bs]) :- (L = u -> true ; L $<= V), (U = u -> true ; V $<= U), bounds(Vs, Bs). % First problem for branch and bound Ex 9.1 p303. problem([X,Y], NY) :- 2 * Y $<= 3 * X - 3, X + Y $<= 5, NY $= -Y. % Second problem for branch and bound Ex 9.2 p304. problem([W,P,C], NP) :- 4 * W + 3 * P + 2 * C $<= 9, W $>= 0, P $>= 0, C $>= 0, Profit $= 15 * W + 10 * P + 7 * C, Profit $>= 30, NP $= -Profit. % Code for minimize that returns a value (not in text) % assumes no choicepoints in goal minimize_val(G, M) :- call(G), rmin(M). % Goal for Ex 9.1 (uses the number of variables to distinguish problem) p303. gp303(Best, BestVals) :- bnb(_,_,[b(u,u),b(u,u)],Best, BestVals). % Goal for Ex 9.2 p303. gp304(Best,BestVals) :- bnb(_, _, [b(u,u),b(u,u),b(u,u)], Best, BestVals). % Optimistic partitioning search strategy p306. split_min(Data, Min, Max, Joblist0, Joblist) :- Mid is (Min + Max) // 2, (End #<= Mid, End #>= Min, schedule(Data, End, Joblist1), indomain(End) -> NewMax #= End - 1, split_min(Data, Min, NewMax, Joblist1, Joblist) ; (End #<= Max, End #>= Mid + 1, schedule(Data, End, Joblist1), indomain(End) -> NewMin #= Mid + 1, NewMax #= End - 1, split_min(Data, NewMin, NewMax, Joblist1, Joblist) ; Joblist = Joblist0 )). % problem data as predicate p273. problem([task(j1,3,[],m1), task(j2,8,[],m1), task(j3,8,[j4,j5],m1), task(j4,6,[],m2), task(j5,3,[j1],m2), task(j6,4,[j1],m2)]). % copy of schedule program p273--274. schedule(Data, End, Joblist) :- makejoblist(Data, Joblist, End), precedences(Data, Joblist), machines(Data, Joblist), labeltasks(Joblist). makejoblist([],[],_). makejoblist([task(N,D,_,_)|Ts], [job(N,D,TS)|Js], End) :- TS :: [0..1000], TS + D #<= End, makejoblist(Ts, Js, End). getjob(JL, N, D, TS) :- once(member_(job(N,D,TS), JL)). precedences([],_). precedences([task(N,_,Pre,_)|Ts], Joblist) :- getjob(Joblist, N, _, TS), prectask(Pre, TS, Joblist), precedences(Ts, Joblist). prectask([], _, _). prectask([Name|Names], PostStart, Joblist) :- getjob(Joblist, Name, D, TS), TS + D #<= PostStart, prectask(Names, PostStart, Joblist). machines([], _). machines([task(N,_,_,M)|Ts], Joblist) :- getjob(Joblist, N, D, TS), machtask(Ts, M, D, TS, Joblist), machines(Ts, Joblist). machtask([], _, _, _, _). machtask([task(SN,_,_,M0)|Ts], M, D, TS, Joblist) :- (M #= M0 -> getjob(Joblist, SN, SD, STS), exclude(D, TS, SD, STS) ; true ), machtask(Ts, M, D, TS, Joblist). exclude(_D, TS, SD, STS) :- STS + SD #<= TS. exclude(D, TS, _SD, STS) :- TS + D #<= STS. labeltasks([]). labeltasks([job(_,_,TS)|Js]) :- indomain(TS), labeltasks(Js). % optimistic partitioning goal p307. gp307(Joblist) :- problem(Problem), split_min(Problem, 19, 32, [], Joblist). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % 9.5 Negation % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % not-member program p309. not_member(_X,[]). not_member(X,[Y|L]) :- X $<> Y, not_member(X,L). % disequations using negation p310. ne(X,Y) :- not(X=Y). % Goals illustrating behaviour of disequations using negation p310-311. gp310a :- X = 2, Y = 3, ne(X,Y). gp310b :- X = 2, Y = 2, ne(X,Y). gp310c :- ne(X,Y), X = 2, Y = 3. gp311a :- Y * Y $= 4, Y $>= 0, not (Y $>= 1). gp311b :- X $<= 0, Y $>= 1, Z $>= 2, not(X $= Y * Z). % is compatible defn p311. is_compatible(G) :- not(not(G)). % Goal with test that sets up a choicepoint p312. gp312a(X,Y) :- goal1(X, Y), Z #>= 4, abs312(X,Z), goal2(X, Y). % Absolute value defn p312. abs312(X,X) :- X #>= 0. abs312(X,Y) :- X #< 0, Y #= -X. % Goal with test that sets up no choicepoints p312. gp312b(X,Y) :- goal1(X, Y), is_compatible((Z #>= 4, abs312(X,Z))), goal2(X, Y). % Definitions of goal1 and goal2 p312. goal1(X, Y) :- Y #>= 1, X + Y #= 6. goal2(_X, Y) :- member_(Y, [-21,-18,-10,-2,10,16,21,25]). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % 9.6 CLP Languages with Dynamic Scheduling % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Operator declarations to make delay declarations parse % and an implementation of call based delay :- op(60, xfy, and). :- op(70, xfy, or). and(X,Y) :- call(X), call(Y). or(X,_Y) :- call(X). or(_X,Y) :- call(Y). ground_(X) :- \+ nonground(X). delay_until(Cond,Goal) :- (call(Cond) -> call(Goal) ; make_suspension(delay_until(Cond,Goal), 3, Susp), insert_suspension(Cond, Susp, inst of suspend, suspend) ). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % delaying disequations p314. ne314(X,Y) :- delay_until(ground_(X) and ground_(Y), ne(X,Y)). % goal with delay p314. gp314 :- ne314(X,Y), X=2, Y=3. % delaying disequations using goal based delay p316. ne316(X,Y) :- delay_until(ground_(X) and ground_(Y), ne1(X,Y)). ne1(X,Y) :- not(X=Y). % delaying append p317. append317(X,Y,Z) :- delay_until(nonvar(X) or nonvar(Z), append_(X,Y,Z)). append_([], Y, Y). append_([A|X], Y, [A|Z]) :- append317(X,Y,Z). % delaying Boolean and p317. and317(X,Y,Z) :- delay_until((ground_(X) and ground_(Y)) or (ground_(X) and ground_(Z)) or (ground_(Y) and ground_(Z)), and(X,Y,Z)). and(0,0,0). and(0,1,0). and(1,0,0). and(1,1,1). % delaying Boolean not p318. bnot318(X,Y) :- delay_until(ground_(X) or ground_(Y), bnot(X,Y)). bnot(0,1). bnot(1,0). % goal for Booleans p318. gp318(X,Y,Z,T) :- and317(X, Y, Z), and317(Y, Z, T), bnot318(Y, 0), bnot318(T, 0). % deterministic delaying and p218. and318(X,Y,Z) :- delay_until((ground_(X) and ground_(Y)) or (ground_(X) and ground_(Z)) or (ground_(Y) and ground_(Z)), and318a(X,Y,Z)). and318a(X,Y,Z) :- (ground_(Z), Z = 0 -> (ground_(X), X = 0 -> true ; (ground_(Y), Y = 0 -> true ; and(X,Y,Z) )) ; and(X,Y,Z) ). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % 9.7 Meta Programming % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % traverse rule p320. traverse(node(T1,I,T2), L) :- traverse(T1, L1), traverse(T2, L2), append_(L1, [I|L2], L). % simple meta-interpreter p321. derive([]). derive(Goal) :- select(Goal, Lit, Pre, Post), replace(Lit, Rep), append_(Pre, Rep, Tmp), append_(Tmp, Post, NewGoal), derive(NewGoal). replace(Lit, Rep) :- (constraint(Lit) -> call(Lit), Rep = [] ; lrule(Lit, Rep) ). constraint(_ = _). % simple left-to-right selection rule select([Lit|Rest], Lit, [], Rest). % traverse rule represented as a fact p320. lrule(traverse(node(T1,I,T2),L), [ traverse(T1,L1), traverse(T2,L2), append_(L1,[I|L2],L)]). % append program represented as lrule facts p322. lrule(append([], Y, Y), []). lrule(append([A|X], Y, [A|Z]), [append(X, Y, Z)]). % concat program represented as lrule facts (not in text) lrule(concat([S1],S1), []). lrule(concat([S1,S2|Ss],S), [append(S1,T,S), concat([S2|Ss],T)]). % simple meta-interpreter goal p322. gp322(T) :- derive([append([a,b], [c,d], T)]). % redefinition of select for delaying append p322. select322([Lit0 | Rest], Lit, Pre, Post) :- (Lit0 = append(X,Y,Z) -> (one_nonvar(X,Z) -> Lit = append(X,Y,Z), Pre = [], Post = Rest ; Pre = [Lit0 | Pre1], select(Rest, Lit, Pre1, Post) ) ; Lit = Lit0, Pre = [], Post = Rest ). one_nonvar(X,_) :- nonvar(X). one_nonvar(_,Z) :- nonvar(Z). % redefinition of derive to use modified select (not in text) derive322([]). derive322(Goal) :- select322(Goal, Lit, Pre, Post), replace(Lit, Rep), append_(Pre, Rep, Tmp), append_(Tmp, Post, NewGoal), derive322(NewGoal). % goal for meta-interpreter with delaying append p323. gp323(L1,L2,L) :- derive322([not_empty(L2), concat([L1,L2],L), L=[]]). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % 9.8 Library Predicates % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % reading goal p324. gp324(X,Y) :- read(X), read(Y). % writing goals p325. gp325a :- X=2, Y=3, write("X + Y is: "), S $= X + Y, write(S), nl. gp325b :- X=2, write("X + Y is: "), S $= X + _Y, write(S), nl. % dump goal p325. % ECLiPSe doesn have dump gp325c :- X $< 2, Z$=X+Y, Y $< 3, dump([Z]). % input output goal p326. % fails because of problems with evaln gp326 :- write("Input function: "), read(F), write("Input x value: "), read(X), deriv(F,DF), evaln(F,X,FX), evaln(DF,X,DFX), write("The value of function "), write(F), nl, write("when x = "), write(X), write(" is "), write(FX), nl, write("and the slope is "), write(DFX), nl. % Variable examiniation goals p327. gp327a :- X = a, atom(X). gp327b :- X = f(_Y,a), atom(X). gp327c :- X $> _Y, atom(X). gp327d :- X = f(Y,b), ground_(X), Y = a. gp327e :- X = f(Y,b), Y = a, ground_(X). gp327f :- X = f(a,_Y), var(X). gp327g :- X = _Y, var(X). gp327h :- X = f(_Y), nonvar(X). % Finite domain built in goals p328. gp328a(Min,Max) :- X :: [0..8], X #>= 4, mindomain(X,Min), maxdomain(X, Max). gp328b(L) :- X :: [0..8], X #>= 3, X ## 5, dom(X,L). % functor and arg goals p328. gp328c(X,Y,F,N) :- X = record(3,Y), functor(X,F,N). gp328d(X,F,N) :- F = record, N = 2, functor(X,F,N). gp328e(X,Y,A) :- X = record(3,Y), arg(1,X,A). gp328f(N,A) :- arg(N, record(3,_Y),A). % vector program using functor and arg p329. init(N, Vec) :- functor(Vec, vec, N). access(Vec, I, E) :- arg(I, Vec, E). % determining the variables in a term p329. variables(T,L) :- variables_acc(T,[],L). variables_acc(X, L, [X|L]) :- var(X). variables_acc(X, L, L) :- atom(X). variables_acc(T, L, L1) :- compound(T), functor(T,_,A), variables_in_args(T, A, L ,L1). variables_in_args(_T, 0, L, L). variables_in_args(T, A, L, L2) :- A > 0, arg(A, T, TArg), variables_acc(TArg, L, L1), A1 is A - 1, variables_in_args(T, A1, L1, L2). % goals for determining variables p329--330 gp329(X,Y,L) :- variables(f(X,g(a,Y,X)),L). gp330a(L) :- T = harald, variables(T,L). % more complete disequation implementation p330. ne330(X,Y) :- neq(X,Y,_V,true,false). neq(X,Y,V,Pr,Nx) :- delay_until((nonvar(X) and nonvar(Y)) or ground_(V),neq1(X,Y,V,Pr,Nx)). neq1(X,Y,V,Pr,Nx) :- (ground_(V) -> true ; functor(X, F, N), functor(Y, G, M), (F = G, N = M -> X =.. [_|Xs], Y =.. [_|Ys], neqs(Xs, Ys, V, Pr, Nx) ; V = true ) ). neqs([], [] , _V, Pr, Pr). neqs([X|LX],[Y|LY],V, Pr, Nx) :- neq(X,Y,V,Pr,In), neqs(LX,LY,V,In,Nx). % goals for testing disequations p330--331 gp330b(X,Y,U,T) :- ne330(X, Y), X = f(a, U), Y = f(T, b), U = b, T = a. gp331(X,Y,U,T) :- ne330(X, Y), X = f(a, U), Y = f(T, b), U = a. % intersection program p333. intersect(L1, L2) :- member_(X, L1), member_(X, L2). member_(X, [X|_]). member_(X, [_|R]) :- member_(X, R). % member with debugging p333. member333(X,Y) :- (clause(flag(1),true) -> write("Call: "), write(member_(X,Y)), nl ; true), member1(X,Y), (clause(flag(1),true) -> write("Exit: "), write(member_(X,Y)), nl ; true). member1(X, [X|_]). member1(X, [_|R]) :- member333(X, R). % repeated copy of intersect to call debugging member (not in text) intersect333(L1, L2) :- member333(X, L1), member333(X, L2). % declarations for making flag assertable/retractable :- dynamic flag/1. % goals for debugging intersect (amended to retract previous flags) p334--335 gp334 :- retract_all(flag(_)), assert(flag(1)), intersect333([1,2], [0,2,4]). gp335a :- retract_all(flag(_)), assert(flag(0)), intersect333([1,2], [0,2,4]). % declaration for making counter assertable/retractable :- dynamic counter/1. % counting program p335. init :- assert(counter(0)). inc :- once((retract(counter(X)), X1 #= X + 1, assert(counter(X1)))). result(X) :- retract(counter(X)). % simple counting example p335. simple_count(_) :- init, X #>= 2, member_(X, [0,3,7]), inc, fail. simple_count(N) :- result(N). % goal for simple counting p335. gp335b(N) :- simple_count(N). % higher-order counting goal p335. count_answers(G,_) :- init, call(G), inc, fail. count_answers(_,N) :- result(N). % declarations to make the assertable/retractable :- dynamic bestbound/1. :- dynamic currentbound/1. % minimization program p336--337. minimize(G, E) :- get_min_value(G, E, M), E = M, call(G). get_min_value(G, E, _) :- apply_new_bound(E), once(G), record_better_bound(E), fail. get_min_value(_, _, M) :- retract(bestbound(M)). apply_new_bound(_). apply_new_bound(E) :- retract(currentbound(B)), assert(bestbound(B)), E < B, apply_new_bound(E). record_better_bound(E) :- (retract(bestbound(_)) -> true ; true), assert(currentbound(E)). % program for testing minimzation p337. p(a, 10). p(b, 5). p(c, 8). % minimization goal p337. gp337(X,Y) :- minimize(p(X,Y),Y). % debugging version as source to source transformation p341. member341(X,L) :- (clause(myspy(member_),true) -> % write("Call: "), write(member_(X,L)), nl ; true), member1341(X,L), (clause(myspy(member_),true) -> write("Exit: "), write(member_(X,L)), nl ; true), (clause(myspy(member_),true) -> retry_member(X,L) ; true). member341(X,L) :- (clause(myspy(member_),true) -> write("Fail: "), write(member_(X,L)), nl ; true), fail. retry_member(_X,_L). retry_member(X,L) :- write("Redo: "), write(member_(X,L)), nl, fail. member1341(X, [X|_]). member1341(X, [_|R]) :- member341(X,R). % declaration to make myspy assertable :- dynamic myspy/1. % goal for debugging version of member p341. gp341a :- assert(myspy(member_)), member341(X, [1,2]), member341(X,[0,2,4]). % goal for debugging intersect p341. (the dbug somehow turns off debugging!) gp341b :- spy(intersect), intersect([1,2],[0,2,4]). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % 9.10 Practical Exercises % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Goal and program for exercise P9.4 p344. gp344(N1,N2,N3,L1,L2,L3) :- N1 #>= 0, N2 #>= 0, N3 #= N1 + N2, seq_append(L1, L2, L3, N1). seq_append([], L2, L2, 0). seq_append([A|L1], L2, [A|L3], N) :- N #= N0+1, N0 #>= 0, seq_append(L1, L2, L3, N0). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%% non-linear delay solver for pow,sin,cos :- use_module(library(suspend)). freeze(Term,Goal) :- make_suspension(Goal, 3, Susp), insert_suspension(Term, Susp, inst of suspend, suspend). dpow(E,X,Y) :- % E = X^Y (Y == 0 -> E = 1 ; (Y == 1 -> E = X ; (X == 1 -> E = 1 ; ((nonground(E), nonground(X)) ; (nonground(E), nonground(Y)) ; (nonground(X), nonground(Y)) -> freeze((E,X,Y), dpow(E,X,Y)) ; (nonground(E) -> E is X ^ Y ; (nonground(X) -> X is E ^ (1/Y) ; Y is ln(E)/ln(X) )))))). dsin(E,X) :- % E = sin(X) (nonground(E), nonground(X) -> freeze((E,X), dsin(E,X)) ; (nonground(E) -> E is sin(X) ; X is asin(E) )). dcos(E,X) :- % E = cos(X) (nonground(E), nonground(X) -> freeze((E,X), dcos(E,X)) ; (nonground(E) -> E is cos(X) ; X is acos(E) )).