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