
% Some examples from "The Craft of Prolog," chapter 4

% This is for section 4.5

:- ensure_loaded(library(trees)).


% Section 4.1

% page 114

dutch_national_flag(Input, Output) :-
    red_items(Input, Output, Output1),
    white_items(Input, Output1, Output2),
    blue_items(Input, Output2, []).

red_items([], Rest, Rest).
red_items([Item|Items], [Item|SubSet], Rest) :-
    red(Item),
    red_items(Items, SubSet, Rest).
red_items([Item|Items], SubSet, Rest) :-
    white(Item),
    red_items(Items, SubSet, Rest).
red_items([Item|Items], SubSet, Rest) :-
    blue(Item),
    red_items(Items, SubSet, Rest).

white_items([], Rest, Rest).
white_items([Item|Items], SubSet, Rest) :-
    red(Item),
    white_items(Items, SubSet, Rest).
white_items([Item|Items], [Item|SubSet], Rest) :-
    white(Item),
    white_items(Items, SubSet, Rest).
white_items([Item|Items], SubSet, Rest) :-
    blue(Item),
    white_items(Items, SubSet, Rest).

blue_items([], Rest, Rest).
blue_items([Item|Items], SubSet, Rest) :-
    red(Item),
    blue_items(Items, SubSet, Rest).
blue_items([Item|Items], SubSet, Rest) :-
    white(Item),
    blue_items(Items, SubSet, Rest).
blue_items([Item|Items], [Item|SubSet], Rest) :-
    blue(Item),
    blue_items(Items, SubSet, Rest).

% Some trivial predicates just to make this work:

red(red).
white(white).
blue(blue).


% page 118, renamed (note:  same as page 117, but with cuts)

d_n_f(Input, Output) :-
    d_n_f(Input, Output, Output1,
	         Output1, Output2,
	         Output2, []).

d_n_f([], R, R, W, W, B, B).
d_n_f([Item|Items], [Item|R1], R, W0, W, B0, B) :-
    red(Item),
    !,
    d_n_f(Items, R1, R, W0, W, B0, B).
d_n_f([Item|Items], R0, R, [Item|W1], W, B0, B) :-
    white(Item),
    !,
    d_n_f(Items, R0, R, W1, W, B0, B).
d_n_f([Item|Items], R0, R, W0, W, [Item|B1], B) :-
    blue(Item),
    !,
    d_n_f(Items, R0, R, W0, W, B1, B).


% page 119

dnf(Input, Output) :-
    dnf(Input, Output, X, X, Y, Y, []).

dnf([], R, R, W, W, B, B).
dnf([Item|Items], R0, R, W0, W, B0, B) :-
    colour(Item, Colour),
    dnf(Colour, R0, R, W0, W, B0, B, Item, Items).

dnf(red, [Item|R1], R, W0, W, B0, B, Item, Items) :-
    dnf(Items, R1, R, W0, W, B0, B).
dnf(white, R0, R, [Item|W1], W, B0, B, Item, Items) :-
    dnf(Items, R0, R, W1, W, B0, B).
dnf(blue, R0, R, W0, W, [Item|B1], B, Item, Items) :-
    dnf(Items, R0, R, W0, W, B1, B).

colour(red, red).
colour(white, white).
colour(blue, blue).


% Section 4.2

% page 119, using lists of integers, so "@<=" is instantiated as "=<"

ordered_list([]).
ordered_list([_]).
ordered_list([X1,X2|Rest]) :-
    X1 =< X2,
    ordered_list([X2|Rest]).

% page 120, top

merge(L1, L2, M) :-
    append(L1, L2, L),
    permutation(L, M),
    ordered_list(M).

% append found on page 29

append([], L, L).
append([H|T], L, [H|R]) :-
    append(T, L, R).

% permutation & insert found on page 38

permutation(Xs, Ys) :-
    permutation(Xs, Ys, Ys).

permutation([], [], []).
permutation([X|Xs], Ys1, [_|Bound]) :-
    permutation(Xs, Ys, Bound),
    insert(Ys, X, Ys1).

insert(L, X, [X|L]).
insert([H|T], X, [H|L]) :-
    insert(T, X, L).

% page 120, bottom

ordered_list2([]).
ordered_list2([Head|Tail]) :-
    ordered_list2(Tail, Head).

ordered_list2([], _).
ordered_list2([Head|Tail], Prev) :-
    Prev =< Head,
    ordered_list2(Tail, Head).

% same merge as before but with ordered_list2

merge2(L1, L2, M) :-
    append(L1, L2, L),
    permutation(L, M),
    ordered_list2(M).

% page 121

merge3(L1, [X|L2], [X|M1]) :-
    less_than_head(X, L1),
    !,
    merge3(L1, L2, M1).
merge3([X|L1], L2, [X|M1]) :-
    merge3(L1, L2, M1).
merge3([], L2, L2).

less_than_head(X, [H|_]) :-
    X < H.


% Section 4.3

% page 122

is_tree([]).
is_tree(node(_,_,Lson,Rson)) :-
    is_tree(Lson),
    is_tree(Rson).

% page 123

size_of_tree(Tree, Size) :-
    size_of_tree(Tree, 0, Size).

size_of_tree([], Size, Size).
size_of_tree(node(_,_,Lson,Rson),Size0,Size) :-
    Size1 is Size0 + 1,
    size_of_tree(Lson, Size1, Size2),
    size_of_tree(Rson, Size2, Size).


% Section 4.4

% page 126 (prepare to wait about 30 sec. when you call this one)

answer(Solution) :-
    Solution = [_D1,_D2,_D3,_D4,_D5,_D6,_D7,_D8,_D9],
    perm([1,2,3,4,5,6,7,8,9], Solution),
    forall(append(D1_to_N, _, Solution), (
	 length(D1_to_N, N),
	 divisible(N, D1_to_N)
    )).

divisible(N, Ds) :-
    divisible(Ds, 0, N).

divisible([], 0, _).
divisible([D|Ds], R0, N) :-
    R1 is (R0*10 + D) mod N,
    divisible(Ds, R1, N).

% perm and select found on page 132

perm([], []).
perm([H|T], Perm) :-
    select(H, Perm, Rest),
    perm(T, Rest).

select(X, [X|R], R).
select(X, [H|T], [H|R]) :-
    select(X, T, R).

forall(G0, G1) :-
    \+ (G0, \+ G1).


% page 127-128

ans1([D1,D2,D3,D4,D5,D6,D7,D8,D9]) :-
    select(D1, [1,2,3,4,5,6,7,8,9], R1),
        divisible(1, [D1]),
    select(D2, R1, R2),
        divisible(2, [D1,D2]),
    select(D3, R2, R3),
        divisible(3, [D1,D2,D3]),
    select(D4, R3, R4),
        divisible(4, [D1,D2,D3,D4]),
    select(D5, R4, R5),
        divisible(5, [D1,D2,D3,D4,D5]),
    select(D6, R5, R6),
        divisible(6, [D1,D2,D3,D4,D5,D6]),
    select(D7, R6, R7),
        divisible(7, [D1,D2,D3,D4,D5,D6,D7]),
    select(D8, R7, R8),
        divisible(8, [D1,D2,D3,D4,D5,D6,D7,D8]),
    select(D9, R8, []),
        divisible(9, [D1,D2,D3,D4,D5,D6,D7,D8,D9]).

% page 130

ans2([D1,D2,D3,D4,5,D6,D7,D8,D9]) :-
    select(D1, [1,3,7,9], R1),
    select(D2, [2,4,6,8], R2),
    select(D3, R1, R3),
        divisible(3, [D1,D2,D3]),
    select(D4, R2, R4),
        divisible(4, [D3,D4]),
    select(D6, R4, [D8]),
        divisible(6, [D4,5,D6]),
    select(D7, R3, [D9]),
        divisible(7, [D1,D2,D3,D4,5,D6,D7]),
        divisible(8, [D6,D7,D8]).


% Section 4.5

% page 137

rem_create(N, F) :-
    one_to_N(N, [], List),
    list_to_tree(List, F).

one_to_N(N, List0, List) :-
    (    N =:= 0 -> List = List0
    ;    M is N-1,
	 one_to_N(M, [N|List0], List)
    ).

% page 138

rem_head(P, F, Head) :-
    get_label(P, F, H),
    (     H=:=P -> Head = P
    ;     rem_head(H,F,Head)
    ).

rem_equivalent(P, Q, F) :-
    rem_head(P, F, Head),
    rem_head(Q, F, Head).

% page 139

rem_add_link(P0, Q0, F0, F) :-
    get_label(P0, F0, P1),
    get_label(Q0, F0, Q1),
    rem_add_link(P0, P1, Q0, Q1, F0, F).

rem_add_link(P0, P1, Q0, Q1, F0, F) :-
    (     Q1 < P1 ->
	  put_label(P0, F0, Q1, F1),
	  get_label(P1, F0, P2),
	  rem_add_link(P1, P2, Q0, Q1, F1, F)
    ;     P1 < Q1 ->
	  put_label(Q0, F0, P1, F1),
	  get_label(Q1, F0, Q2),
	  rem_add_link(P0, P1, Q1, Q2, F1, F)
    ; /*P1 = Q1*/
	  F = F0
    ).

% page 140 -- probably not covered in class, but gives a way to print results
% and to test predicates

rem_dump(F) :-
    tree_size(F, N),
    rem_heads(N, F, [], Heads),
    keysort(Heads, Sorted),
    format('Class-Node pairs:  ~w~n', [Sorted]).

rem_heads(N, F, List0, List) :-
    (     N =:= 0 -> List = List0
    ;     M is N-1,
          rem_head(N, F, Head),
          rem_heads(M, F, [Head-N|List0], List)
    ).

test1 :-
    rem_create(6, F),
    test([1-2,3-4,5-6,3-6,1-4], F).

test([], _).
test([X-Y|R], F) :-
    rem_add_link(X, Y, F, G),
    format('~nAfter adding ~w<=>~w,~n', [X,Y]),
    rem_dump(G),
    test(R,G).

% Section 4.6

% page 146

% access_N_plus_K is the general idea for an N plus K tree
% instantiated here as a 3 plus 4 tree

access_3_plus_4(Index, Tree, Value) :-
    integer(Index),
    Index > 0,
    access_3_4(Index, Tree, Value).

access_3_4(Index, Tree, Value) :-
    functor(Tree, n_plus_k, 7),
    (     Index =< 3 ->
          arg(Index, Tree, Value)
    ;     SonIndex is (Index - 3 - 1) mod 4 + 3 + 1,
          NewIndex is (Index - 3 - 1) // 4 + 1,
          arg(SonIndex,Tree,Son),
          access_3_4(NewIndex, Son, Value)
    ).

% fill_tree(+number of entries)

fill_tree(N) :-
    ft(N, 0, Tree),
    numbervars(Tree, 0, _),
    write(Tree), nl.

ft(N, N, _) :- !.
ft(N, Ind, Tree) :-
    NewInd is Ind + 1,
    access_3_plus_4(NewInd, Tree, NewInd),
    ft(N, NewInd, Tree).

