% 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, 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)
	)).

		
