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

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%                             6.1 Records                             %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
% complex arithmetic p186.
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. 

% complex arithmetic goal p187
gp187(Y,C3) :- C1 = c(1,3), C2 = c(2, Y), c_add(C1, C2, C3).
 
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%                             6.2 Lists                               %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% append program p189.
append([],Y,Y).   
append([U|X], Y, [U|Z])  :-  append(X,Y,Z). 
 
% append goals
gp189 :- append([1,2],_,[1,2,3]).
gp190(X,Y) :- append(X,Y,[1,2]).

% alldifferent program Ex 6.3 p190.
alldifferent_neq([]). 
alldifferent_neq([Y|Ys]) :- not_member(Y, Ys), alldifferent_neq(Ys). 
 
not_member(_X, []). 
not_member(X, [Y|Ys]) :- 	
	X \= Y, %% beware not_member will only work correctly
		    %% when both arguments are fixed, in particular
		    %% not for goal alldifferent_neq([A,B,C]).
	not_member(X, Ys).
 
% plate program ex 6.4 p 191.
rows([_, _]).                                                  %(RW1) 
rows([R1, R2, R3 | Rs]) :- 
	cols(R1, R2, R3), rows([R2, R3 | Rs]).                 %(RW2)
 
cols([_, _], [_, _], [_, _]).                                  %(CL1) 
cols([_TL, T, TR | Ts], [ML, M, MR | Ms], [_BL, B, BR | Bs]) :-  %(CL2) 
     M $= (T + ML + MR + B) / 4, 
     cols([T, TR | Ts], [M, MR | Ms], [B, BR | Bs]). 

% plate goal p192.
gp192(P) :-
	P = [[100,100,100,100,100,100,100],
     	     [  0,  _,  _,  _,  _,  _,  0],
     	     [  0,  _,  _,  _,  _,  _,  0],
     	     [  0,  _,  _,  _,  _,  _,  0],
     	     [  0,  _,  _,  _,  _,  _,  0],
     	     [  0,  0,  0,  0,  0,  0,  0]],
	rows(P).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%                         6.3 Association Lists                       %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% member program p193. 
member(X, [X | _]).  
member(X, [_ | R])  :-  member(X, R). 
 
% member goal
gp193(N) :- member(p(kim,N), [p(peter, 5551616), 
			      p(kim, 5559282), 
			      p(nicole, 5559282)]).
 
% lookup program p194.
lookup(AList, Key, Info) :- member(p(Key, Info), AList). 

% lookup goal
gp194(Key) :- lookup([p(peter, 5551616), 
		      p(kim, 5559282), 
		      p(nicole, 5559282)], Key, 5559282).

% abstract operations for association list p194-195.
empty_alist([]). 
  
addkey(AList0, Key, Info, AList) :- AList = [p(Key, Info)|AList0]. 
  
delkey([], _Key, _Info, []). 
delkey([p(Key, Info)|AList], Key, Info, AList). 
delkey([p(Key0, _Info0) | AList0], Key, Info, [_E|AList]) :- 
	Key \= Key0, delkey(AList0, Key, Info, AList).
 
modkey(AList0, Key, Info, AList) :-
      delkey(AList0, Key, Info, AList1), addkey(AList1, Key, Info, AList).


% predicate with single answer house (p196).
house( [p(foundations,[]), 
 	p(int_walls,[foundations]),
 	p(chimney,[foundations]),
 	p(ext_walls,[foundations]),
 	p(roof,[ext_walls]),
 	p(windows, [ext_walls]),
 	p(tiles, [chimney, roof]),
 	p(doors, [int_walls])]).
 
% First predecessors program Ex 6.5 p 196.
predecessors196(N, AList, Pre) :- 
     lookup(AList, N, NImPre), 
     list_predecessors(NImPre, AList, ListOfPre), 
     list_append([NImPre | ListOfPre], Pre). 
 
list_predecessors([], _, []). 
list_predecessors([N|Ns], AList, [NPre|NsPres]) :- 
     predecessors196(N, AList, NPre), 
     list_predecessors(Ns, AList, NsPres). 
 
list_append([], []). 
list_append([L|Ls], All) :- 
     list_append(Ls, AppendedLs), 
     append(L,  AppendedLs, All).

% predecessors goal p197.
gp197(Pre) :- house(H), predecessors196(tiles, H, Pre).
 
% Improved predecessors program p 197.
predecessors197(N, List, Pre0, Pre) :- 
     lookup(List, N, NImPre), 
     cumul_predecessors(NImPre, List, Pre0, Pre).
 
cumul_predecessors([], _, Pre, Pre). 
cumul_predecessors([N|Ns], List, Pre0, Pre) :- 
     member(N, Pre0),  
     cumul_predecessors(Ns, List, Pre0, Pre). 
cumul_predecessors([N|Ns], List, Pre0, Pre) :- 
     not_member(N, Pre0), 
     predecessors197(N, List, [N|Pre0], Pre1), 
     cumul_predecessors(Ns, List, Pre1, Pre). 

% predecessors goal p198.
gp198(Pre) :- house(H), predecessors197(tiles, H, [], Pre).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%                           6.4 Binary Trees                          %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
% tree traversal p198.
traverse(null, []). 
traverse(node(T1,I,T2), L):-
	traverse(T1, L1), 
	traverse(T2, L2),
	append(L1, [I|L2], L). 

% traverse goal p199.
gp199a(L) :- 
    	traverse(node(node(null,harald,null),kim,node(null,peter,null)), L).

% binary search tree lookup program p199. 
find199(node(_TL, I, _TR), E)  :-  E = I. 
find199(node(TL, I, _TR), E)  :-  less_than199(E, I), find199(TL, E). 
find199(node(_TL, I, TR), E)  :-  less_than199(I, E), find199(TR, E). 
 
less_than199(harald, kim). 
less_than199(harald, peter). 
less_than199(kim, peter). 

% lookup goal p199.
gp199b :- find199(node(node(null,harald,null),kim,node(null,peter,null)),
		  peter).
 
% binary search tree insertion program p200. 
insert_bst(null, E, node(null,E,null)). 
insert_bst(node(TL, I, TR), E, node(TL, I, TR)) :- E = I. 
insert_bst(node(TL, I, TR), E, node(NTL, I, TR)) :- 
	less_than200(E, I), insert_bst(TL, E, NTL). 
insert_bst(node(TL, I, TR), E, node(TL, I, NTR)) :- 
	less_than200(I, E), insert_bst(TR, E, NTR). 
 
% new less than definition p200. 
less_than200(p(Key1, _), p(Key2, _)) :- key_less_than(Key1, Key2).

find200(node(_TL, I, _TR), E)  :-  E = I. 
find200(node(TL, I, _TR), E)  :-  less_than200(E, I), find200(TL, E). 
find200(node(_TL, I, TR), E)  :-  less_than200(I, E), find200(TR, E). 

% abstract operations for association list p
tree_lookup(AList, Key, Info) :- find200(AList, p(Key, Info)). 
tree_empty_alist(null). 
tree_addkey(Key, Info, AList0, AList) :- 
	insert_bst(AList0, p(Key, Info), AList). 

% goal for assocation list p201. 
number(peter, N) :- N $= 3.
number(kim, N) :- N $= 1.
number(nicole, N) :- N $= 2.

key_less_than(K1, K2) :-
	N1 $< N2,
	number(K1,N1),
	number(K2,N2).

gp201(Number) :-
	tree_empty_alist(L0), 
	tree_addkey(peter, 5551616, L0, L1),  %% ERROR in TEXT 
	tree_lookup(L1, peter, Number).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%                  6.5 Heirarchical Modelling                         %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
% RLC Circuit program p202.
resistor(R, V, I, _W) :- c_mult(I, c(R,0), V). 
inductor(L, V, I, W) :- WL $= W*L, c_mult(c(0,WL), I, V). 
capacitor(C, V, I, W) :- WC $= W*C, c_mult(c(0,WC), V, I). 

circuit(resistor(R), V, I, W) :- resistor(R, V, I, W). 
circuit(inductor(L), V, I, W) :- inductor(L, V, I, W). 
circuit(capacitor(C), V, I, W) :- capacitor(C, V, I, W). 
circuit(series(C1, C2), V, I, W) :- 
     circuit(C1, V1, I, W),
     circuit(C2, V2, I, W),
     c_add(V1, V2, V).
circuit(parallel(C1, C2), V, I, W) :- 
     circuit(C1, V, I1, W),
     circuit(C2, V, I2, W),
     c_add(I1, I2, I).
 
% goal for RLC circuit program p203.
% rather useless without simplification
gp203(V,I) :- circuit(series(parallel(resistor(100),capacitor(0.001)), 
                      parallel(inductor(2),resistor(50))), 
                      V, I, 60).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%                        6.6 Tree Layout                              %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 

% goal for tree layout (p207). 
gp207(T,AL) :-
T = node(node(node(node(null,kangaroo,null),
                marsupial,
                node(null,koala,null)
           ),
           mammal,
           node(     null,
                monotreme,
                node(null,platypus,null)
           )
      ),
      animal,
      node(     node(     node(null,cockatoo,null),
                parrot,
                node(null,lorikeet,null)
          ),
           bird,
           node(     null,
                raptor,
                node(null,eagle,null)
           )
      )
),
tree_layout(T, AL).
 
% tree layout program p205-207.
layout_constraints(T,AL,W) :- 
            traverse(T, L), 
            build_assoc_list(L, AL), 
            parent_constraints(T, AL),  
            depth(T, D),  
            sideways_constraints(T, 1, D, AL), 
            place_root(T, AL), 
            width_exp(T, AL, W). 
 
tree_layout(T, AL) :- minimize(layout_constraints(T,AL,W), W). 
 
build_assoc_list([], []).
build_assoc_list([N|Ns], [p(N,c(_,_))|AL]) :- build_assoc_list(Ns, AL).
 
parent_constraints(null, _). 
parent_constraints(node(null,_,null), _). 
parent_constraints(node(null, N, node(T1,N2,T2)), AL) :- 
          lookup(AL, N, c(XN,YN)), 
          lookup(AL, N2, c(XN2,YN2)), 
          XN2 $= XN,  
          YN2 $= YN - 10, 
          parent_constraints(node(T1,N2,T2), AL). 
parent_constraints(node(node(T1,N2,T2), N,null ), AL) :- 
          lookup(AL, N, c(XN,YN)), 
          lookup(AL, N2, c(XN2,YN2)), 
          XN2 $= XN, 
          YN2 $= YN - 10, 
          parent_constraints(node(T1,N2,T2), AL). 
parent_constraints(node(node(T1,N1,T2), N, node(T3,N2,T4)), AL) :- 
          lookup(AL, N, c(XN,YN)), 
          lookup(AL, N1, c(XN1,YN1)), 
          lookup(AL, N2, c(XN2,YN2)), 
          XN1 + XN2  $= 2 * XN,  
          YN1 $= YN - 10, YN2 $= YN - 10, 
          parent_constraints(node(T1,N1,T2), AL), 
          parent_constraints(node(T3,N2,T4), AL). 
 
sideways_constraints(_T, N, D, _AL) :- 
          N $> D. 
sideways_constraints(T, N, D, AL) :- 
          N $<= D, 
          level(T, N, L), 
          separate_list(L, AL), 
          sideways_constraints(T, N+1, D, AL). 
 
level(null, _, []). 
level(node(_, N, _), D, [N]) :- D $= 1. 
level(node(T1, _N, T2), D, L) :-  
          D $>= 2,                %%% ERROR D >= 1 in book
          level(T1, D-1, L1), 
          level(T2, D-1, L2), 
          append(L1, L2, L).  
  
separate_list([F|R], AL) :- 
          lookup(AL, F, c(FX,_FY)), 
          sep_list(R, AL, FX). 
 
sep_list([], _, _). 
sep_list([N|Ns], AL, PX) :- 
          lookup(AL, N, c(XN,_YN)), 
          XN $>= PX + 10, 
          sep_list(Ns, AL, XN).
 
width_exp(null, _, W) :- W $= 0. 
width_exp(node(null,_,null), _, W) :- W $= 0. 
width_exp(node(null, _N, node(T1,N2,T2)), AL, W) :- 
              width_exp(node(T1,N2,T2), AL, W). 
width_exp(node(node(T1,N2,T2), _N, null), AL, W) :- 
              width_exp(node(T1,N2,T2), AL, W). 
width_exp(node(node(T1,N1,T2), _N, node(T3,N2,T4)), AL, W) :- 
          lookup(AL, N1, c(XN1,_YN1)), 
          lookup(AL, N2, c(XN2,_YN2)), 
              W $= XN2 - XN1 + W1 + W2,  
              width_exp(node(T1,N1,T2), AL, W1), 
              width_exp(node(T3,N2,T4), AL, W2). 

% extras not defined in the text
depth(null,D) :- D $= 0.
depth(node(T1,_,T2),D) :- 
	depth(T1,D1),
	depth(T2,D2),
	(D1 > D2 -> D $= D1 + 1 ; D $= D2 + 1).

place_root(node(_,Root,_), AL) :- lookup(AL, Root, c(37.5, 30)).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%% stuff for minimization see chapter 9 %%%%%%%%%%%%%%%%%%%
% modified to use internal database

minimize(G, E) :- 
                      get_min_value(G, E, M),
                      E $= M,
                      call(G).
  
get_min_value(G, E, _) :-
        apply_new_bound(E),
        once(G),
	rmin(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).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
