% declaration to load rational solver
:- use_module(library(clpq)).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%           7.1 Estimating the Efficiency of a CLP Program            %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
% sumlist program p214.
sumlist([], SS) :- {SS = 0}. 
sumlist([N|L], SS) :- {SS = N + S}, sumlist(L, S). 
 
% goals for sumlist
gsuml1(S) :- sumlist([1], S).
gsum2(L,S) :-  L=[1,2], {S > _Z}, sumlist(L,S).
gsum3(L) :- sumlist(L,2). 
gsum4(L,S) :- {S > 3}, sumlist(L,S), {O = 1, T = 2}, L=[O,T].

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%                     7.2 Controlling Search: An Example              %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
% First sum program p217.
sum12(N, SS)  :-  {SS = S + N, N1 = N - 1}, sum12(N1, S).   %% S1 
sum12(N, SS)  :- {N = 0, SS = 0}.                           %% S2
 
% Goal for sum program p217.
gp217a(S) :- sum12(1,S).
 

% Second sum program p217.
sum34(N, SS)  :-  {N = 0, SS = 0}.	                    %% S3
sum34(N, SS)  :-  {SS = S + N, N1 = N - 1}, sum34(N1, S).   %% S4

% Goal for second sum program p217.
gp217b(S) :- sum34(1,S).
gp217c :- sum34(1,0).
  
% First sum program p219.
sum56(N, SS)  :-  {N = 0, SS = 0}.                                  %% S5
sum56(N, SS)  :-  {SS = N + S, N1 = N - 1}, sum56(N1, S), {N >= 1}. %% S6

% Goal for first sum program p219.
gp219a :- sum56(1,0).
 
% Second sum program p219.
sum78(N, SS)  :-  {N = 0, SS = 0}.                                 %% S7
sum78(N, SS)  :-  {N >= 1, SS = N + S, N1 = N - 1}, sum78(N1, S). %% S8
 
% Goal for second sum program p219.
gp219b :- sum78(1,0).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%                         7.4 Literal Ordering                        %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% Small database rules p222.
father(jim,edward). 
father(jim,maggy). 
father(edward,peter). 
father(edward,helen). 
father(edward,kitty). 
father(bill,fi). 
 
mother(maggy,fi). 
mother(fi,lillian).
 
% First grandfather defn p222.
grandfather1(Z,X)  :- father(Z,Y), father(Y,X).
grandfather1(Z,X)  :- father(Z,Y), mother(Y,X).

% goal for grandfather
gp222a(X) :- grandfather1(X,peter).
 
% Second grandfather defn p222.
grandfather2(Z,X)  :- father(Y,X), father(Z,Y).
grandfather2(Z,X)  :- mother(Y,X), father(Z,Y).

% goal for grandfather
gp222b(X) :- grandfather2(X,peter).
 
% Rules for parent p223. 
parent(Y,X)  :- father(Y,X).
parent(Y,X)  :- mother(Y,X).
 
% First grandfather defn p223.
grandfather3(Z,X)  :- father(Z,Y), parent(Y,X).
 
% Second grandfather defn p223.
grandfather4(Z,X)  :- parent(Y,X), father(Z,Y).
 
% New goals for sum p224.
gp224a(N) :- sum78(N,6).
gp224b(N) :- sum78(N,7).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%                     7.5 Adding Redundant Constraints                %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  
% Sum program p225.
sum910(N,SS) :- {N = 0, SS = 0}.                                        %% S9
sum910(N, SS) :- {N >= 1, SS = S+N, S >= 0, N1 = N-1}, sum910(N1, S). %% S10

% New goal for sum p225.
gp225a(N) :- sum910(N,7).


% Factorial program p225. 
fac12(N, FF) :- {N = 0, FF = 1}.                                       %% F1
fac12(N, FF)  :-  {N >= 1, FF = N * F, N1 = N - 1}, fac12(N1, F).     %% F2

% Goal for factorial program p225.
% problems {ERROR: not_normalized(rat(97692469875,5303305507500))} ??
gp225b(N) :- fac12(N,7).
 
% First factorial program p226. 
fac34(N, FF) :- {N = 0, FF = 1}.                                         %% F3
fac34(N, FF)  :-  {N >= 1, FF = N*F, F >= 1, N1 = N-1}, fac34(N1, F).  %% F4

% Goal for factorial program p226.
gp226a(N) :- fac34(N,7).
 
% Second factorial program p226. 
fac56(N,FF):-{N = 0, FF = 1}.                                               %F5
fac56(N,FN):-{FN = F*N, N >= 1, F >= 1, N =< FN, N1 = N-1}, fac56(N1,F). %F6
	      
% Goal for factorial program p226.
gp226b(N) :- fac56(N,7).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%                           7.6 Minimization                          %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
% Leaf level program p227.
leaflevel(node(null, X, null), X, D) :- {D = 0}.       
leaflevel(node(TL, _, _), X, D1) :-  {D1 = D+1}, leaflevel(TL, X, D).        
leaflevel(node(_, _, TR), X, D1) :-  {D1 = D+1}, leaflevel(TR, X, D).      
 
treea(node(node(node(node(null,h,null),
                         d,
			 node(node(null,j,null),
			      i,
			      node(null,k,null))),
		    b,
		    node(null,e, node(node(null,m,null),
				      l,
			              node(node(null,o,null),
				           n,
					   node(null,p,null))))),
	       a,
	       node(node(null,f,null),
		    c,
		    node(node(node(null,s,null),
			      q,
			      node(null,t,null)),
			 g,
			 node(null,r,null))))).


% leaf level goal p227.
gp227(X,N) :-
	treea(TA),
	leaflevel(TA, X, N).
 
% leaf level goal minimization goal p228.
gp228a(X,D) :- treea(TA), minimize(leaflevel(TA, X, D), D).
 
% effective minimization foal p228.
gp228b(X,D) :-
     treea(TA), {D < 3},  leaflevel(TA, X, D).
 
% Improved lieaflevel program p229.
leaflevel229(node(null,X,null),X,D) :- {D = 0}.       
leaflevel229(node(TL, _, _), X, D1) :- 
	{D1 = D+1, D >= 0}, leaflevel229(TL, X, D).        
leaflevel229(node(_, _, TR), X, D1) :- 
	{D1 = D+1, D >= 0}, leaflevel229(TR, X, D).      
 
% leaf level goal minimization goal p229.
gp229a(X,D) :- treea(TA), minimize(leaflevel229(TA, X, D), D).

% leaf level goal maximization goal p229.
gp229b(X,D) :- {MD = -D}, treea(TA), minimize(leaflevel229(TA, X, D), MD).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%              7.7 Identifying Deterministic Subgoals                 %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
% absolute value program using if-then-else p231.
abs(X, Y) :- ({X >= 0} -> {Y = X} ; {Y = -X}).
 
% absolute value goal p231.
gp231a(A) :- abs(4, A).
gp231b(A) :- abs(-4, A).
 
% absolute value program without if-then-else p231.
abs2(X, X) :- {X >= 0}.
abs2(X, Y) :- {X < 0, Y = -X}.
 
% complex goals for absolute value p232.
gp232a(X) :- abs(X, 2), {X < 0}.
gp232b(X) :- {X < 0}, abs(X, 2).
gp232c(X) :- abs2(X, 2), {X < 0}.
gp232d(X) :- {X < 0, Y = 2}, abs2(X, Y).

% far or equal program p232. 
far_or_equal(X, Y) :- (apart(X,Y,4) -> true ; X = Y). 
 
apart(X,Y,D) :- {X >= Y + D}. 
apart(X,Y,D) :- {Y >= X + D}. 
 
% goals for far_or_equal p232.
gp232e :- far_or_equal(1, 6).
gp232f :- far_or_equal(1, 3).
gp232g :- far_or_equal(1, Y), {Y = 6}.
 
% cumulative predecessors using if-then-else p234.
cumul_predecessors_ift([], _, Pre, Pre). 
cumul_predecessors_ift([N|Ns], AList, Pre0, Pre) :- 
     (member(N, Pre0) -> 
           Pre1 = Pre0 
     ; 
          predecessors(N, AList, [N|Pre0], Pre1)
     ),
     cumul_predecessors_ift(Ns, AList, Pre1, Pre).
 
% intersection program p235.
intersect(L1, L2) :- member(X,L1), member(X,L2).
 
% goal for intersection p235.
gp235a :- intersect([a,b,e,g,h], [b,e,f,g,i]).
 
% intersection program using once p235. NOTE extra brackets
intersect_once(L1, L2) :- once((member(X,L1), member(X,L2))).
 
% goals for intersection p235
gp235b :- intersect([a,b,e,g,h], [b,e,f,g,i]), 0 = 1.
gp235c :- intersect_once([a,b,e,g,h], [b,e,f,g,i]), 0 = 1.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%              7.8 An Extended Example: Bridge Building               %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
% First program for strut constraints p238.
% rather difficult to follow without simplification
struts_cons238([], [], L) :- {L = 0}. 
struts_cons238([strut(N,X1,Y1,X2,Y2) | Ss], [f(N, F) | Fs], TL) :- 
     {L = pow((X1-X2)*(X1-X2)+(Y1-Y2)*(Y1-Y2), 1/2),
     F >= - 0.5 * (6 - L), 
     TL = L + RL}, 
     struts_cons238(Ss, Fs, RL). 
 
ss([strut(a,0,0,2,1), strut(b,1,0,3,-1), strut(c,2,1,3,-1), 
			strut(d,2,1,4,1), strut(e,3,-1,4,1), 
			strut(f,3,-1,5,0), strut(g,4,1,6,0)]).

% Goal using strut constraint program p238. 
gp238a(Fs,TL) :-
	ss(SS), struts_cons238(SS, Fs, TL).
 
% Length limited strut goal p238.
gp238b(Fs,TL) :-
     ss(SS), {TL =< 5}, struts_cons238(SS, Fs, TL).
 
% Improved strut constraint program p239.
struts_cons239([], [], L) :- {L = 0}. 
struts_cons239([strut(N,X1,Y1,X2,Y2) | Ss], [f(N, F) | Fs], TL) :- 
     {L = pow((X1-X2)*(X1-X2)+(Y1-Y2)*(Y1-Y2), 1/2),
     F >= - 0.5 * (6 - L), 
     TL = L + RL,
     RL >= 0}, 
     struts_cons239(Ss, Fs, RL). 

% Length limited strut goal p239.
gp239a(Fs,TL) :-
     ss(SS), {TL =< 5}, struts_cons239(SS, Fs, TL).
 
% Partial strut knowledge goal p239.
gp239b(Fa,TL,A,B,C,D) :-
     {Fa =< -4}, struts_cons239([strut(a,A,B,C,D)], [f(a,Fa)], TL).
 
% Final strut constraint program p239.
struts_cons([], [], L) :- {L = 0}. 
struts_cons([strut(N,X1,Y1,X2,Y2) | Ss], [f(N, F) | Fs], TL) :- 
     {L = pow((X1-X2)*(X1-X2)+(Y1-Y2)*(Y1-Y2), 1/2),
     L > 0,
     F >= - 0.5 * (6 - L), 
     TL = L + RL,
     RL >= 0},
     struts_cons(Ss, Fs, RL). 

% Partial strut knowledge goal p239.
gp239c(Fa,TL,A,B,C,D) :-
     {Fa =< -4}, struts_cons([strut(a,A,B,C,D)], [f(a,Fa)], TL).
 
% program to sum forces in a strut p240.
sum_forces([], _, _, _, _, SFX, SFY) :- {SFX = 0, SFY = 0}. 
sum_forces([N|Ns], X, Y, Ss, Fs, SFX, SFY) :- 
     member(strut(N, X1, Y1, X2, Y2), Ss), 
     whichend(X1,Y1,X2,Y2,X,Y,X0,Y0), 
     member(f(N, F), Fs), 
     {F =< 2, 
     L = pow((X1-X2)*(X1-X2)+(Y1-Y2)*(Y1-Y2), 1/2),
     FX = F * (X - X0) / L, 
     SFX = FX + RFX, 
     FY = F * (Y - Y0) / L, 
     SFY = FY + RFY}, 
     sum_forces(Ns, X, Y, Ss, Fs, RFX, RFY). 
 
whichend(X, Y, X0, Y0, X, Y, X0, Y0). 
whichend(X0, Y0, X, Y, X, Y, X0, Y0). 

% program for join constraint p240. 
joins_cons([], _Ss, _Fs, _W). 
joins_cons([J|Js], Ss, Fs, W) :- 
     one_join(J, Ss, Fs, W), 
     joins_cons(Js, Ss, Fs, W). 

one_join(cjoin(X, Y, Ns), Ss, Fs, W) :- 
     Ns = [_,_|_], 
     sum_forces(Ns, X, Y, Ss, Fs, 0, W).
one_join(join(X, Y, Ns), Ss, Fs, _W) :- 
     Ns = [_,_,_| _], 
     sum_forces(Ns, X, Y, Ss, Fs, 0, 0).
 
js([cjoin(3,-1,[b,c,e,f]), join(2,1,[a,c,d]), join(4,1,[d,e,g])]).

% bridge analysis goal p241.
gp241a(W) :-
	ss(SS), js(JS), {TL =< 20, W >= 2}, 
	struts_cons(SS, Fs, TL),
	joins_cons(JS, SS, Fs, W).
 
% minimization approach to bridge design p241.
% would never work without non-linear optimization
gp241b(Ss,Js,W) :-
	{TL =< 20, MW = -W}, 
	minimize((struts_cons(Ss,Fs,TL),joins_cons(Js,Ss,Fs,W)),MW).
 
% bridge design goal p242.
% fails with not_normalized?? perhaps works for floating point
gp242a(Js,Ss,Vs,W) :-
     tpl(Js, Ss, Vs), 
     {TL =< 20}, 
     struts_cons(Ss,Fs,TL), 
     once(joins_cons(Js,Ss,Fs,W)),
     {MW = -W},
     minimize(position(Vs),MW).

% topology for design p242.
tpl([join(X1,Y1,[a,c,d]),join(X2,Y2,[d,e,g]),cjoin(X3,Y3,[b,c,e,f])], 
     [strut(a,0,0,X1,Y1), strut(b,1,0,X3,Y3), strut(c,X1,Y1,X3,Y3), 
      strut(d,X1,Y1,X2,Y2), strut(e,X3,Y3,X2,Y2), strut(f,X3,Y3,5,0), 
      strut(g,X2,Y2,6,0)], [X1,Y1,X2,Y2,X3,Y3]) :- {X3 = 3}. 
 
% bridge design goal without position search p242.
gp242b(Ss, Js, Vs, W) :-
	tpl(Js,Ss,Vs), {TL=<20}, struts_cons(Ss,Fs,TL),
	joins_cons(Js,Ss,Fs,W).
 
% program for integer positioning of joins p243.
position([]). 
position([V|Vs]) :- 
     member(VV, [6,5,4,3,2,1,0,-1,-2]),
     {V = VV},
     position(Vs).
 
% bridge constraints program p243.
bridge_constraints(W, Vs) :- 
     	tpl(Js, Ss, Vs), 
    	{TL =< 20},  
    	struts_cons(Ss, Fs, TL), 
          once(joins_cons(Js, Ss, Fs, W)). 
 
% design goal p243.
design_goal(W, Vs) :-  
    	bridge_constraints(W, Vs),
	{MW = -W},
     	once(minimize(position(Vs), MW)).

% execyte design p243.
% again fails not_normalized
gp243(W,Vs) :- design_goal(W, Vs).
	
member(X, [X|_]).
member(X, [_|R]) :- member(X, R).
 
% perturbation search program p244.
perturbation([], [], _). 
perturbation([V|Vs], [Val|Vals], D) :- 
     perturb(V, Val, D), 
     perturbation(Vs, Vals, D). 
 
perturb(V, Val, D) :- {V = Val - D}. 
perturb(V, Val, _D) :- {V = Val}. 
perturb(V, Val, D) :- {V = Val + D}. 
 
pert_goal(FW, FVs) :- 
     design_goal(W,Vs), 
     improve(Vs, W, FVs, FW, 0.5). 

improve(Vs, W, FVs, FW, D) :- 
      bridge_constraints(NW, NVs), 
      {NW >= W, MW = -NW}, 
      once(minimize(perturbation(Vs, NVs, D), MW)), 
     ( {NW < 1.01 * W} -> 
          {FVs = NVs, FW = NW} 
     ; 
	  {D2 = D/2},
          improve(NVs, NW, FVs, FW, D2)   ). 

% perturbation execution p245.
% again no useful answer a problem not_normalized
gp245a(FW, FVs) :- pert_goal(FW, FVs).

% topology for design with symmetry (not in text) p245.
sym_tpl([join(X1,Y1,[a,c,d]),join(X2,Y2,[d,e,g]),cjoin(X3,Y3,[b,c,e,f])], 
     [strut(a,0,0,X1,Y1), strut(b,1,0,X3,Y3), strut(c,X1,Y1,X3,Y3), 
      strut(d,X1,Y1,X2,Y2), strut(e,X3,Y3,X2,Y2), strut(f,X3,Y3,5,0), 
      strut(g,X2,Y2,6,0)], [X1,Y1,X2,Y2,X3,Y3]) :- 
		{Y1 = Y2, X2 = 6 - X1, X3 = 3}. 

% copy of bridge design program with symmetry (not in text) 
sym_bridge_constraints(W, Vs) :- 
     	sym_tpl(Js, Ss, Vs), 
    	{TL =< 20},  
    	struts_cons(Ss, Fs, TL), 
          once(joins_cons(Js, Ss, Fs, W)). 
 
sym_design_goal(W, Vs) :-  
    	sym_bridge_constraints(W, Vs),
	{MW = -W},
     	once(minimize(position(Vs), MW)).

sym_pert_goal(FW, FVs) :- 
     sym_design_goal(W,Vs), 
     sym_improve(Vs, W, FVs, FW, 0.5). 

sym_improve(Vs, W, FVs, FW, D) :- 
      sym_bridge_constraints(NW, NVs), 
      {NW >= W, MW = -NW}, 
      once(minimize(perturbation(Vs, NVs, D), MW)), 
     ( {NW < 1.01 * W} -> 
          {FVs = NVs, FW = NW} 
     ; 
	D2 = D/2,
          sym_improve(NVs, NW, FVs, FW, D2)   ). 

% pertubation execution with symmetry p245.
% again no useful answer a problem with not_normalized?
gp245b(FW, FVs) :- sym_pert_goal(FW, FVs).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%                              7.10 Exercises                         %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% ancestor program Ex 7.3 p247.
anc(Z,X) :- anc(Y,X), parent(Z,Y).
anc(Y,X) :- parent(Y,X).
 
% erk program Ex 7.4 p247.
erk(X,Y) :- erk(X1,Y1), {X1 = X - 1, Y = Y1 + 2}. 
erk(X, Y) :- {X = 0, Y = 0}. 
 
% member with if then else Ex 7.5 p247.
member_ift(X, [Y|R]) :- (X = Y -> true ; member(X, R)).
 
% stupid sort program Ex 7.6 p248.
stupid_sort(L, P) :- perm(L, P), sorted(P). 

perm([], []). 
perm(L, [X|R]) :- delete(L, X, L1), perm(L1, R). 
 
delete([X | Xs], X, Xs). 
delete([X | Xs], Y, [X | R]) :- delete(Xs, Y, R).  
 
sorted([]). 
sorted([_]). 
sorted([X,Y|L]) :- {X =< Y}, sorted([Y|L]).
 
% stupid sort goals
gp248a(P) :-
          L = [2,6,2], P = [_,_,_], perm(L, P), sorted(P).
 
gp248b(P) :-
	   {T = 2, S = 6}, L = [T,S,T], P = [_,_,_], sorted(P), perm(L, P).
 
gp248c(P) :-
          {T = 2,S = 6}, L = [T,S,T], P = [_,_,_], sorted(P), once(perm(L, P)).
 
 
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%% stuff for minimization see chapter 9 %%%%%%%%%%%%%%%%%%%
% modified to use internal database

once(G) :- call(G),!.
erase(Key,Val) :-
	recorded(Key,Val,Ref),
	erase(Ref).
record(Key,Val) :-
	recorda(Key,Val,_).

minimize(G, E) :- 
                      get_min_value(G, E, M),
                      {E = M},
                      call(G).
  
get_min_value(G, E, _) :-
        apply_new_bound(E),
        once(G),
	minimize(E), %% additional call to ensure ground result
        record_better_bound(E),
        fail.
get_min_value(_, _, M) :- erase(bestbound,M).
  
apply_new_bound(_).
apply_new_bound(E) :- 
                          erase(currentbound,B),
                          record(bestbound,B),
                          {E < B},
                          apply_new_bound(E).
  
record_better_bound(E) :- 
                         (erase(bestbound,_) -> true ; true),
                         record(currentbound,E).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
