https://sites.google.com/site/prologsite/prolog-problems

99.pl.tar.gz

p1_01.pl

% 1.01 (*): Find the last element of a list
 
% my_last(X,L) :- X is the last element of the list L
%    (element,list) (?,?)
 
% Note: last(?Elem, ?List) is predefined
 
my_last(X,[X]).
my_last(X,[_|L]) :- my_last(X,L).

p1_02.pl

% 1.02 (*): Find the last but one element of a list
 
% last_but_one(X,L) :- X is the last but one element of the list L
%    (element,list) (?,?)
 
last_but_one(X,[X,_]).
last_but_one(X,[_,Y|Ys]) :- last_but_one(X,[Y|Ys]).

p1_03.pl

% 1.03 (*): Find the K'th element of a list.
% The first element in the list is number 1.
 
% element_at(X,L,K) :- X is the K'th element of the list L
%    (element,list,integer) (?,?,+)
 
% Note: nth1(?Index, ?List, ?Elem) is predefined
 
element_at(X,[X|_],1).
element_at(X,[_|L],K) :- K > 1, K1 is K - 1, element_at(X,L,K1).

p1_04.pl

% 1.04 (*): Find the number of elements of a list.
 
% my_length(L,N) :- the list L contains N elements
%    (list,integer) (+,?) 
 
% Note: length(?List, ?Int) is predefined
 
my_length([],0).
my_length([_|L],N) :- my_length(L,N1), N is N1 + 1.

p1_05.pl

% 1.05 (*): Reverse a list.
 
% my_reverse(L1,L2) :- L2 is the list obtained from L1 by reversing 
%    the order of the elements.
%    (list,list) (?,?)
 
% Note: reverse(+List1, -List2) is predefined
 
my_reverse(L1,L2) :- my_rev(L1,L2,[]).
 
my_rev([],L2,L2) :- !.
my_rev([X|Xs],L2,Acc) :- my_rev(Xs,L2,[X|Acc]).

p1_06.pl

% 1.06 (*): Find out whether a list is a palindrome
% A palindrome can be read forward or backward; e.g. [x,a,m,a,x]
 
% is_palindrome(L) :- L is a palindrome list
%    (list) (?)
 
is_palindrome(L) :- reverse(L,L).

p1_07.pl

% 1.07 (**): Flatten a nested list structure.
 
% my_flatten(L1,L2) :- the list L2 is obtained from the list L1 by
%    flattening; i.e. if an element of L1 is a list then it is replaced
%    by its elements, recursively. 
%    (list,list) (+,?)
 
% Note: flatten(+List1, -List2) is a predefined predicate
 
my_flatten(X,[X]) :- \+ is_list(X).
my_flatten([],[]).
my_flatten([X|Xs],Zs) :- my_flatten(X,Y), my_flatten(Xs,Ys), append(Y,Ys,Zs).

p1_08.pl

% 1.08 (**): Eliminate consecutive duplicates of list elements.
 
% compress(L1,L2) :- the list L2 is obtained from the list L1 by
%    compressing repeated occurrences of elements into a single copy
%    of the element.
%    (list,list) (+,?)
 
compress([],[]).
compress([X],[X]).
compress([X,X|Xs],Zs) :- compress([X|Xs],Zs).
compress([X,Y|Ys],[X|Zs]) :- X \= Y, compress([Y|Ys],Zs).

p1_09.pl

% 1.09 (**):  Pack consecutive duplicates of list elements into sublists.
 
% pack(L1,L2) :- the list L2 is obtained from the list L1 by packing
%    repeated occurrences of elements into separate sublists.
%    (list,list) (+,?)
 
pack([],[]).
pack([X|Xs],[Z|Zs]) :- transfer(X,Xs,Ys,Z), pack(Ys,Zs).
 
% transfer(X,Xs,Ys,Z) Ys is the list that remains from the list Xs
%    when all leading copies of X are removed and transfered to Z
 
transfer(X,[],[],[X]).
transfer(X,[Y|Ys],[Y|Ys],[X]) :- X \= Y.
transfer(X,[X|Xs],Ys,[X|Zs]) :- transfer(X,Xs,Ys,Zs).

p1_10.pl

% 1.10 (*):  Run-length encoding of a list
 
% encode(L1,L2) :- the list L2 is obtained from the list L1 by run-length
%    encoding. Consecutive duplicates of elements are encoded as terms [N,E],
%    where N is the number of duplicates of the element E.
%    (list,list) (+,?)
 
:- ensure_loaded(p1_09).
 
encode(L1,L2) :- pack(L1,L), transform(L,L2).
 
transform([],[]).
transform([[X|Xs]|Ys],[[N,X]|Zs]) :- length([X|Xs],N), transform(Ys,Zs).

p1_11.pl

% 1.11 (*):  Modified run-length encoding
 
% encode_modified(L1,L2) :- the list L2 is obtained from the list L1 by 
%    run-length encoding. Consecutive duplicates of elements are encoded 
%    as terms [N,E], where N is the number of duplicates of the element E.
%    However, if N equals 1 then the element is simply copied into the 
%    output list.
%    (list,list) (+,?)
 
:- ensure_loaded(p1_10).
 
encode_modified(L1,L2) :- encode(L1,L), strip(L,L2).
 
strip([],[]).
strip([[1,X]|Ys],[X|Zs]) :- strip(Ys,Zs).
strip([[N,X]|Ys],[[N,X]|Zs]) :- N > 1, strip(Ys,Zs).

p1_12.pl

% 1.12 (**): Decode a run-length compressed list.
 
% decode(L1,L2) :- L2 is the uncompressed version of the run-length
%    encoded list L1.
%    (list,list) (+,?)
 
decode([],[]).
decode([X|Ys],[X|Zs]) :- \+ is_list(X), decode(Ys,Zs).
decode([[1,X]|Ys],[X|Zs]) :- decode(Ys,Zs).
decode([[N,X]|Ys],[X|Zs]) :- N > 1, N1 is N - 1, decode([[N1,X]|Ys],Zs).

p1_13.pl

% 1.13 (**): Run-length encoding of a list (direct solution) 
 
% encode_direct(L1,L2) :- the list L2 is obtained from the list L1 by 
%    run-length encoding. Consecutive duplicates of elements are encoded 
%    as terms [N,E], where N is the number of duplicates of the element E.
%    However, if N equals 1 then the element is simply copied into the 
%    output list.
%    (list,list) (+,?)
 
encode_direct([],[]).
encode_direct([X|Xs],[Z|Zs]) :- count(X,Xs,Ys,1,Z), encode_direct(Ys,Zs).
 
% count(X,Xs,Ys,K,T) Ys is the list that remains from the list Xs
%    when all leading copies of X are removed. T is the term [N,X],
%    where N is K plus the number of X's that can be removed from Xs.
%    In the case of N=1, T is X, instead of the term [1,X].
 
count(X,[],[],1,X).
count(X,[],[],N,[N,X]) :- N > 1.
count(X,[Y|Ys],[Y|Ys],1,X) :- X \= Y.
count(X,[Y|Ys],[Y|Ys],N,[N,X]) :- N > 1, X \= Y.
count(X,[X|Xs],Ys,K,T) :- K1 is K + 1, count(X,Xs,Ys,K1,T).

p1_14.pl

% 1.14 (*): Duplicate the elements of a list
 
% dupli(L1,L2) :- L2 is obtained from L1 by duplicating all elements.
%    (list,list) (?,?)
 
dupli([],[]).
dupli([X|Xs],[X,X|Ys]) :- dupli(Xs,Ys).

p1_15.pl

% 1.15 (**): Duplicate the elements of a list agiven number of times
 
% dupli(L1,N,L2) :- L2 is obtained from L1 by duplicating all elements
%    N times.
%    (list,integer,list) (?,+,?)
 
dupli(L1,N,L2) :- dupli(L1,N,L2,N).
 
% dupli(L1,N,L2,K) :- L2 is obtained from L1 by duplicating its leading
%    element K times, all other elements N times.
%    (list,integer,list,integer) (?,+,?,+)
 
dupli([],_,[],_).
dupli([_|Xs],N,Ys,0) :- dupli(Xs,N,Ys,N).
dupli([X|Xs],N,[X|Ys],K) :- K > 0, K1 is K - 1, dupli([X|Xs],N,Ys,K1).

p1_16.pl

% 1.16 (**):  Drop every N'th element from a list
 
% drop(L1,N,L2) :- L2 is obtained from L1 by dropping every N'th element.
%    (list,integer,list) (?,+,?)
 
drop(L1,N,L2) :- drop(L1,N,L2,N).
 
% drop(L1,N,L2,K) :- L2 is obtained from L1 by first copying K-1 elements
%    and then dropping an element and, from then on, dropping every
%    N'th element.
%    (list,integer,list,integer) (?,+,?,+)
 
drop([],_,[],_).
drop([_|Xs],N,Ys,1) :- drop(Xs,N,Ys,N).
drop([X|Xs],N,[X|Ys],K) :- K > 1, K1 is K - 1, drop(Xs,N,Ys,K1).

p1_17.pl

% 1.17 (*): Split a list into two parts
 
% split(L,N,L1,L2) :- the list L1 contains the first N elements
%    of the list L, the list L2 contains the remaining elements.
%    (list,integer,list,list) (?,+,?,?)
 
split(L,0,[],L).
split([X|Xs],N,[X|Ys],Zs) :- N > 0, N1 is N - 1, split(Xs,N1,Ys,Zs).

p1_18.pl

% 1.18 (**):  Extract a slice from a list
 
% slice(L1,I,K,L2) :- L2 is the list of the elements of L1 between
%    index I and index K (both included).
%    (list,integer,integer,list) (?,+,+,?)
 
slice([X|_],1,1,[X]).
slice([X|Xs],1,K,[X|Ys]) :- K > 1, 
   K1 is K - 1, slice(Xs,1,K1,Ys).
slice([_|Xs],I,K,Ys) :- I > 1, 
   I1 is I - 1, K1 is K - 1, slice(Xs,I1,K1,Ys).

p1_19.pl

% 1.19 (**): Rotate a list N places to the left 
 
% rotate(L1,N,L2) :- the list L2 is obtained from the list L1 by 
%    rotating the elements of L1 N places to the left.
%    Examples: 
%    rotate([a,b,c,d,e,f,g,h],3,[d,e,f,g,h,a,b,c])
%    rotate([a,b,c,d,e,f,g,h],-2,[g,h,a,b,c,d,e,f])
%    (list,integer,list) (+,+,?)
 
:- ensure_loaded(p1_17).
 
rotate(L1,N,L2) :- N >= 0, 
   length(L1,NL1), N1 is N mod NL1, rotate_left(L1,N1,L2).
rotate(L1,N,L2) :- N < 0,
   length(L1,NL1), N1 is NL1 + (N mod NL1), rotate_left(L1,N1,L2).
 
rotate_left(L,0,L).
rotate_left(L1,N,L2) :- N > 0, split(L1,N,S1,S2), append(S2,S1,L2).

p1_20.pl

% 1.20 (*): Remove the K'th element from a list.
% The first element in the list is number 1.
 
% remove_at(X,L,K,R) :- X is the K'th element of the list L; R is the
%    list that remains when the K'th element is removed from L.
%    (element,list,integer,list) (?,?,+,?)
 
remove_at(X,[X|Xs],1,Xs).
remove_at(X,[Y|Xs],K,[Y|Ys]) :- K > 1, 
   K1 is K - 1, remove_at(X,Xs,K1,Ys).

p1_21.pl

% P21 (*): Insert an element at a given position into a list
% The first element in the list is number 1.
 
% insert_at(X,L,K,R) :- X is inserted into the list L such that it
%    occupies position K. The result is the list R.
%    (element,list,integer,list) (?,?,+,?)
 
:- ensure_loaded(p20).
 
insert_at(X,L,K,R) :- remove_at(X,R,K,L).

p1_22.pl

% 1.22 (*):  Create a list containing all integers within a given range.
 
% range(I,K,L) :- I <= K, and L is the list containing all 
%    consecutive integers from I to K.
%    (integer,integer,list) (+,+,?)
 
range(I,I,[I]).
range(I,K,[I|L]) :- I < K, I1 is I + 1, range(I1,K,L).

p1_23.pl

% 1.23 (**): Extract a given number of randomly selected elements 
%    from a list.
 
% rnd_select(L,N,R) :- the list R contains N randomly selected 
%    items taken from the list L.
%    (list,integer,list) (+,+,-)
 
:- ensure_loaded(p1_20).
 
rnd_select(_,0,[]).
rnd_select(Xs,N,[X|Zs]) :- N > 0,
    length(Xs,L),
    I is random(L) + 1,
    remove_at(X,Xs,I,Ys),
    N1 is N - 1,
    rnd_select(Ys,N1,Zs).

p1_24.pl

% 1.24 (*): Lotto: Draw N different random numbers from the set 1..M
 
% lotto(N,M,L) :- the list L contains N randomly selected distinct
%    integer numbers from the interval 1..M
%    (integer,integer,number-list) (+,+,-)
 
:- ensure_loaded(p1_22).
:- ensure_loaded(p1_23).
 
lotto(N,M,L) :- range(1,M,R), rnd_select(R,N,L).

p1_25.pl

% 1.25 (*):  Generate a random permutation of the elements of a list
 
% rnd_permu(L1,L2) :- the list L2 is a random permutation of the
%    elements of the list L1.
%    (list,list) (+,-)
 
:- ensure_loaded(p1_23).
 
rnd_permu(L1,L2) :- length(L1,N), rnd_select(L1,N,L2).

p1_26.pl

% 1.26 (**):  Generate the combinations of k distinct objects
%            chosen from the n elements of a list.
 
% combination(K,L,C) :- C is a list of K distinct elements 
%    chosen from the list L
 
combination(0,_,[]).
combination(K,L,[X|Xs]) :- K > 0,
   el(X,L,R), K1 is K-1, combination(K1,R,Xs).
 
% Find out what the following predicate el/3 exactly does.
 
el(X,[X|L],L).
el(X,[_|L],R) :- el(X,L,R).

p1_27.pl

% 1.27 (**) Group the elements of a set into disjoint subsets.
 
% Problem a)
 
% group3(G,G1,G2,G3) :- distribute the 9 elements of G into G1, G2, and G3,
%    such that G1, G2 and G3 contain 2,3 and 4 elements respectively
 
group3(G,G1,G2,G3) :- 
   selectN(2,G,G1),
   subtract(G,G1,R1),
   selectN(3,R1,G2),
   subtract(R1,G2,R2),
   selectN(4,R2,G3),
   subtract(R2,G3,[]).
 
% selectN(N,L,S) :- select N elements of the list L and put them in 
%    the set S. Via backtracking return all posssible selections, but
%    avoid permutations; i.e. after generating S = [a,b,c] do not return
%    S = [b,a,c], etc.
 
selectN(0,_,[]) :- !.
selectN(N,L,[X|S]) :- N > 0, 
   el(X,L,R), 
   N1 is N-1,
   selectN(N1,R,S).
 
el(X,[X|L],L).
el(X,[_|L],R) :- el(X,L,R).
 
% subtract/3 is predefined
 
% Problem b): Generalization
 
% group(G,Ns,Gs) :- distribute the elements of G into the groups Gs.
%    The group sizes are given in the list Ns.
 
group([],[],[]).
group(G,[N1|Ns],[G1|Gs]) :- 
   selectN(N1,G,G1),
   subtract(G,G1,R),
   group(R,Ns,Gs).

p1_28.pl

% 1.28 (**) Sorting a list of lists according to length
%
% a) length sort
%
% lsort(InList,OutList) :- it is supposed that the elements of InList 
% are lists themselves. Then OutList is obtained from InList by sorting 
% its elements according to their length. lsort/2 sorts ascendingly,
% lsort/3 allows for ascending or descending sorts.
% (list_of_lists,list_of_lists), (+,?)
 
lsort(InList,OutList) :- lsort(InList,OutList,asc).
 
% sorting direction Dir is either asc or desc
 
lsort(InList,OutList,Dir) :-
   add_key(InList,KList,Dir),
   keysort(KList,SKList),
   rem_key(SKList,OutList).
 
add_key([],[],_).
add_key([X|Xs],[L-p(X)|Ys],asc) :- !, 
	length(X,L), add_key(Xs,Ys,asc).
add_key([X|Xs],[L-p(X)|Ys],desc) :- 
	length(X,L1), L is -L1, add_key(Xs,Ys,desc).
 
rem_key([],[]).
rem_key([_-p(X)|Xs],[X|Ys]) :- rem_key(Xs,Ys).
 
% b) length frequency sort
%
% lfsort (InList,OutList) :- it is supposed that the elements of InList
% are lists themselves. Then OutList is obtained from InList by sorting
% its elements according to their length frequency; i.e. in the default,
% where sorting is done ascendingly, lists with rare lengths are placed
% first, other with more frequent lengths come later.
%
% Example:
% ?- lfsort([[a,b,c],[d,e],[f,g,h],[d,e],[i,j,k,l],[m,n],[o]],L).
% L = [[i, j, k, l], [o], [a, b, c], [f, g, h], [d, e], [d, e], [m, n]]
%
% Note that the first two lists in the Result have length 4 and 1, both
% length appear just once. The third and forth list have length 3 which
% appears, there are two list of this length. And finally, the last
% three lists have length 2. This is the most frequent length.
 
lfsort(InList,OutList) :- lfsort(InList,OutList,asc).
 
% sorting direction Dir is either asc or desc
 
lfsort(InList,OutList,Dir) :-
	add_key(InList,KList,desc),
   keysort(KList,SKList),
   pack(SKList,PKList),
   lsort(PKList,SPKList,Dir),
   flatten(SPKList,FKList),
   rem_key(FKList,OutList).
 
pack([],[]).
pack([L-X|Xs],[[L-X|Z]|Zs]) :- transf(L-X,Xs,Ys,Z), pack(Ys,Zs).
 
% transf(L-X,Xs,Ys,Z) Ys is the list that remains from the list Xs
%    when all leading copies of length L are removed and transfed to Z
 
transf(_,[],[],[]).
transf(L-_,[K-Y|Ys],[K-Y|Ys],[]) :- L \= K.
transf(L-_,[L-X|Xs],Ys,[L-X|Zs]) :- transf(L-X,Xs,Ys,Zs).
 
test :-
   L = [[a,b,c],[d,e],[f,g,h],[d,e],[i,j,k,l],[m,n],[o]],
   write('L = '), write(L), nl,
   lsort(L,LS),
   write('LS = '), write(LS), nl,
   lsort(L,LSD,desc),
   write('LSD = '), write(LSD), nl,
   lfsort(L,LFS),
   write('LFS = '), write(LFS), nl.

p2_01.pl

% 2.01 (**) Determine whether a given integer number is prime. 
 
% is_prime(P) :- P is a prime number
%    (integer) (+)
 
is_prime(2).
is_prime(3).
is_prime(P) :- integer(P), P > 3, P mod 2 =\= 0, \+ has_factor(P,3).  
 
% has_factor(N,L) :- N has an odd factor F >= L.
%    (integer, integer) (+,+)
 
has_factor(N,L) :- N mod L =:= 0.
has_factor(N,L) :- L * L < N, L2 is L + 2, has_factor(N,L2).

p2_02.pl

% 2.02 (**) Determine the prime factors of a given positive integer. 
 
% prime_factors(N, L) :- N is the list of prime factors of N.
%    (integer,list) (+,?)
 
prime_factors(N,L) :- N > 0,  prime_factors(N,L,2).
 
% prime_factors(N,L,K) :- L is the list of prime factors of N. It is 
% known that N does not have any prime factors less than K.
 
prime_factors(1,[],_) :- !.
prime_factors(N,[F|L],F) :-                           % N is multiple of F
   R is N // F, N =:= R * F, !, prime_factors(R,L,F).
prime_factors(N,L,F) :- 
   next_factor(N,F,NF), prime_factors(N,L,NF).        % N is not multiple of F
 
 
% next_factor(N,F,NF) :- when calculating the prime factors of N
%    and if F does not divide N then NF is the next larger candidate to
%    be a factor of N.
 
next_factor(_,2,3) :- !.
next_factor(N,F,NF) :- F * F < N, !, NF is F + 2.
next_factor(N,_,N).                                 % F > sqrt(N)

p2_03.pl

% 2.03 (**) Determine the prime factors of a given positive integer (2). 
% Construct a list containing the prime factors and their multiplicity.
% Example: 
% ?- prime_factors_mult(315, L).
% L = [[3,2],[5,1],[7,1]]
 
:- ensure_loaded(p2_02).  % make sure next_factor/3 is loaded
 
% prime_factors_mult(N, L) :- L is the list of prime factors of N. It is
%    composed of terms [F,M] where F is a prime factor and M its multiplicity.
%    (integer,list) (+,?)
 
prime_factors_mult(N,L) :- N > 0, prime_factors_mult(N,L,2).
 
% prime_factors_mult(N,L,K) :- L is the list of prime factors of N. It is 
% known that N does not have any prime factors less than K.
 
prime_factors_mult(1,[],_) :- !.
prime_factors_mult(N,[[F,M]|L],F) :- divide(N,F,M,R), !, % F divides N
   next_factor(R,F,NF), prime_factors_mult(R,L,NF).
prime_factors_mult(N,L,F) :- !,                          % F does not divide N
   next_factor(N,F,NF), prime_factors_mult(N,L,NF).
 
% divide(N,F,M,R) :- N = R * F**M, M >= 1, and F is not a factor of R. 
%    (integer,integer,integer,integer) (+,+,-,-)
 
divide(N,F,M,R) :- divi(N,F,M,R,0), M > 0.
 
divi(N,F,M,R,K) :- S is N // F, N =:= S * F, !,          % F divides N
   K1 is K + 1, divi(S,F,M,R,K1).
divi(N,_,M,N,M).

p2_04.pl

% 2.04 (*) A list of prime numbers. 
% Given a range of integers by its lower and upper limit, construct a 
% list of all prime numbers in that range.
 
:- ensure_loaded(p2_01).   % make sure is_prime/1 is loaded
 
% prime_list(A,B,L) :- L is the list of prime number P with A <= P <= B
 
prime_list(A,B,L) :- A =< 2, !, p_list(2,B,L).
prime_list(A,B,L) :- A1 is (A // 2) * 2 + 1, p_list(A1,B,L).
 
p_list(A,B,[]) :- A > B, !.
p_list(A,B,[A|L]) :- is_prime(A), !, 
   next(A,A1), p_list(A1,B,L). 
p_list(A,B,L) :- 
   next(A,A1), p_list(A1,B,L).
 
next(2,3) :- !.
next(A,A1) :- A1 is A + 2.

p2_05.pl

% 2.05 (**) Goldbach's conjecture. 
% Goldbach's conjecture says that every positive even number greater 
% than 2 is the sum of two prime numbers. Example: 28 = 5 + 23.
 
:- ensure_loaded(p2_01).
 
% goldbach(N,L) :- L is the list of the two prime numbers that
%    sum up to the given N (which must be even).
%    (integer,integer) (+,-)
 
goldbach(4,[2,2]) :- !.
goldbach(N,L) :- N mod 2 =:= 0, N > 4, goldbach(N,L,3).
 
goldbach(N,[P,Q],P) :- Q is N - P, is_prime(Q), !.
goldbach(N,L,P) :- P < N, next_prime(P,P1), goldbach(N,L,P1).
 
next_prime(P,P1) :- P1 is P + 2, is_prime(P1), !.
next_prime(P,P1) :- P2 is P + 2, next_prime(P2,P1).

p2_06.pl

% 2.06 (*) A list of Goldbach compositions. 
% Given a range of integers by its lower and upper limit, 
% print a list of all even numbers and their Goldbach composition.
 
:- ensure_loaded(p2_05).
 
% goldbach_list(A,B) :- print a list of the Goldbach composition
%    of all even numbers N in the range A <= N <= B
%    (integer,integer) (+,+)
 
goldbach_list(A,B) :- goldbach_list(A,B,2).
 
% goldbach_list(A,B,L) :- perform goldbach_list(A,B), but suppress
% all output when the first prime number is less than the limit L.
 
goldbach_list(A,B,L) :- A =< 4, !, g_list(4,B,L).
goldbach_list(A,B,L) :- A1 is ((A+1) // 2) * 2, g_list(A1,B,L).
 
g_list(A,B,_) :- A > B, !.
g_list(A,B,L) :- 
   goldbach(A,[P,Q]),
   print_goldbach(A,P,Q,L),
   A2 is A + 2,
   g_list(A2,B,L).
 
print_goldbach(A,P,Q,L) :- P >= L, !,
   writef('%t = %t + %t',[A,P,Q]), nl.
print_goldbach(_,_,_,_).

p2_07.pl

% 2.07 (**) Determine the greatest common divisor of two positive integers.
 
% gcd(X,Y,G) :- G is the greatest common divisor of X and Y
%    (integer, integer, integer) (+,+,?)
 
 
gcd(X,0,X) :- X > 0.
gcd(X,Y,G) :- Y > 0, Z is X mod Y, gcd(Y,Z,G).
 
 
% Declare gcd as an arithmetic function; so you can use it
% like this:  ?- G is gcd(36,63).
 
:- arithmetic_function(gcd/2).

p2_08.pl

% 2.08 (*) Determine whether two positive integer numbers are coprime. 
%     Two numbers are coprime if their greatest common divisor equals 1.
 
% coprime(X,Y) :- X and Y are coprime.
%    (integer, integer) (+,+)
 
:- ensure_loaded(p2_07).
 
coprime(X,Y) :- gcd(X,Y,1).

p2_09.pl

% 2.09 (**) Calculate Euler's totient function phi(m). 
%    Euler's so-called totient function phi(m) is defined as the number 
%    of positive integers r (1 <= r < m) that are coprime to m. 
%    Example: m = 10: r = 1,3,7,9; thus phi(m) = 4. Note: phi(1) = 1.
 
% totient_phi(M,Phi) :- Phi is the value of the Euler's totient function
%    phi for the argument M.
%    (integer, integer) (+,-)
 
:- ensure_loaded(p2_08).
:- arithmetic_function(totient_phi/1).
 
totient_phi(1,1) :- !.
totient_phi(M,Phi) :- t_phi(M,Phi,1,0).
 
% t_phi(M,Phi,K,C) :- Phi = C + N, where N is the number of integers R
%    such that K <= R < M and R is coprime to M.
%    (integer,integer,integer,integer) (+,-,+,+)
 
t_phi(M,Phi,M,Phi) :- !.
t_phi(M,Phi,K,C) :- 
   K < M, coprime(K,M), !, 
   C1 is C + 1, K1 is K + 1,
   t_phi(M,Phi,K1,C1).
t_phi(M,Phi,K,C) :- 
   K < M, K1 is K + 1,
   t_phi(M,Phi,K1,C).

p2_10.pl

% 2.10 (**) Calculate Euler's totient function phi(m) (2). 
% See problem 2.09 for the definition of Euler's totient function. 
% If the list of the prime factors of a number m is known in the 
% form of problem P36 then the function phi(m) can be efficiently
% calculated as follows: 
%
% Let [[p1,m1],[p2,m2],[p3,m3],...] be the list of prime factors (and their
% multiplicities) of a given number m. Then phi(m) can be calculated 
% with the following formula:
%
% phi(m) = (p1 - 1) * p1 ** (m1 - 1) * (p2 - 1) * p2 ** (m2 - 1) * 
%          (p3 - 1) * p3 ** (m3 - 1) * ...
%
% Note that a ** b stands for the b'th power of a.
 
:- ensure_loaded(p2_03).  % make sure prime_factors_mult is loaded
 
% totient_phi_2(N,Phi) :- Phi is the value of Euler's totient function
%    for the argument N.
%    (integer,integer) (+,?)
 
totient_phi_2(N,Phi) :- prime_factors_mult(N,L), to_phi(L,Phi).
 
to_phi([],1).
to_phi([[F,1]|L],Phi) :- !,
   to_phi(L,Phi1), Phi is Phi1 * (F - 1).
to_phi([[F,M]|L],Phi) :- M > 1,
   M1 is M - 1, to_phi([[F,M1]|L],Phi1), Phi is Phi1 * F.

p2_11.pl

% 2.11 (*) Compare the two methods of calculating Euler's totient function. 
% Use the solutions of problems 2.09 and 2.10 to compare the algorithms. 
% Take the number of logical inferences as a measure for efficiency.
 
:- ensure_loaded(p2_09).
:- ensure_loaded(p2_10).
 
totient_test(N) :-
   write('totient_phi (P34):'),
   time(totient_phi(N,Phi1)),
   write('result = '), write(Phi1), nl,
   write('totient_phi_2 (P37):'),
   time(totient_phi_2(N,Phi2)),
   write('result = '), write(Phi2), nl.

p3_01.pl

% 3.01 (**) Truth tables for logical expressions.
% Define predicates and/2, or/2, nand/2, nor/2, xor/2, impl/2 
% and equ/2 (for logical equivalence) which succeed or
% fail according to the result of their respective operations; e.g.
% and(A,B) will succeed, if and only if both A and B succeed.
% Note that A and B can be Prolog goals (not only the constants
% true and fail).
% A logical expression in two variables can then be written in 
% prefix notation, as in the following example: and(or(A,B),nand(A,B)).
%
% Now, write a predicate table/3 which prints the truth table of a
% given logical expression in two variables.
%
% Example:
% ?- table(A,B,and(A,or(A,B))).
% true  true  true
% true  fail  true
% fail  true  fail
% fail  fail  fail
 
and(A,B) :- A, B.
 
or(A,_) :- A.
or(_,B) :- B.
 
equ(A,B) :- or(and(A,B), and(not(A),not(B))).
 
xor(A,B) :- not(equ(A,B)).
 
nor(A,B) :- not(or(A,B)).
 
nand(A,B) :- not(and(A,B)).
 
impl(A,B) :- or(not(A),B).
 
% bind(X) :- instantiate X to be true and false successively
 
bind(true).
bind(fail).
 
table(A,B,Expr) :- bind(A), bind(B), do(A,B,Expr), fail.
 
do(A,B,_) :- write(A), write('  '), write(B), write('  '), fail.
do(_,_,Expr) :- Expr, !, write(true), nl.
do(_,_,_) :- write(fail), nl.

p3_02.pl

% 3.02 (*) Truth tables for logical expressions (2).
% Continue problem 3.01 by defining and/2, or/2, etc as being
% operators. This allows to write the logical expression in the
% more natural way, as in the example: A and (A or not B).
% Define operator precedence as usual; i.e. as in Java.
%
% Example:
% ?- table(A,B, A and (A or not B)).
% true  true  true
% true  fail  true
% fail  true  fail
% fail  fail  fail
 
:- ensure_loaded(p3_01).
 
:- op(900, fy,not).
:- op(910, yfx, and).
:- op(910, yfx, nand).
:- op(920, yfx, or).
:- op(920, yfx, nor).
:- op(930, yfx, impl).
:- op(930, yfx, equ).
:- op(930, yfx, xor).
 
% I.e. not binds stronger than (and, nand), which bind stronger than
% (or,nor) which in turn bind stronger than implication, equivalence
% and xor.

p3_03.pl

% 3.03 (**) Truth tables for logical expressions (3).
% Generalize problem P47 in such a way that the logical
% expression may contain any number of logical variables.
%
% Example:
% ?- table([A,B,C], A and (B or C) equ A and B or A and C).
% true  true  true  true
% true  true  fail  true
% true  fail  true  true
% true  fail  fail  true
% fail  true  true  true
% fail  true  fail  true
% fail  fail  true  true
% fail  fail  fail  true
 
:- ensure_loaded(p3_02).    
 
% table(List,Expr) :- print the truth table for the expression Expr,
%   which contains the logical variables enumerated in List.
 
table(VarList,Expr) :- bindList(VarList), do(VarList,Expr), fail.
 
bindList([]).
bindList([V|Vs]) :- bind(V), bindList(Vs).
 
do(VarList,Expr) :- writeVarList(VarList), writeExpr(Expr), nl.
 
writeVarList([]).
writeVarList([V|Vs]) :- write(V), write('  '), writeVarList(Vs).
 
writeExpr(Expr) :- Expr, !, write(true).
writeExpr(_) :- write(fail).

p3_04.pl

% (**) 3.04 Gray codes
 
% gray(N,C) :- C is the N-bit Gray code
 
gray(1,['0','1']).
gray(N,C) :- N > 1, N1 is N-1,
   gray(N1,C1), reverse(C1,C2),
   prepend('0',C1,C1P),
   prepend('1',C2,C2P),
   append(C1P,C2P,C).
 
prepend(_,[],[]) :- !.
prepend(X,[C|Cs],[CP|CPs]) :- atom_concat(X,C,CP), prepend(X,Cs,CPs).
 
 
% This gives a nice example for the result caching technique:
 
:- dynamic gray_c/2.
 
gray_c(1,['0','1']) :- !.
gray_c(N,C) :- N > 1, N1 is N-1, 
   gray_c(N1,C1), reverse(C1,C2),
   prepend('0',C1,C1P),
   prepend('1',C2,C2P),
   append(C1P,C2P,C),
   asserta((gray_c(N,C) :- !)).
 
% Try the following goal sequence and see what happens:
 
% ?- [p3_04]. 
% ?- listing(gray_c/2).
% ?- gray_c(5,C).
% ?- listing(gray_c/2).
 
 
% There is an alternative definition for the gray code construction:
 
gray_alt(1,['0','1']).
gray_alt(N,C) :- N > 1, N1 is N-1,
   gray_alt(N1,C1), 
   postpend(['0','1'],C1,C).   
 
postpend(_,[],[]).
postpend(P,[C|Cs],[C1P,C2P|CsP]) :- P = [P1,P2],
   atom_concat(C,P1,C1P), 
   atom_concat(C,P2,C2P),
   reverse(P,PR),
   postpend(PR,Cs,CsP).

p3_05.pl

% (***) 3.05 Huffman code
 
% We suppose a set of symbols with their frequencies, given as a list 
% of fr(S,F) terms. 
% Example: [fr(a,45),fr(b,13),fr(c,12),fr(d,16),fr(e,9),fr(f,5)]. 
% Our objective is to construct a list hc(S,C) terms, where C is the Huffman
% code word for the symbol S. In our example the result could be 
% [hc(a, '0'), hc(b, '101'), hc(c, '100'), hc(d, '111'), hc(e, '1101'), 
% hc(f, '1100')]  
 
% The task shall be performed by the predicate huffman/2 defined as follows: 
 
% huffman(Fs,Hs) :- Hs is the Huffman code table for the frequency table Fs
% (list-of-fr/2-terms, list-of-hc/2-terms)  (+,-).
 
% During the construction process, we need nodes n(F,S) where, at the 
% beginning, F is a frequency and S a symbol. During the process, as n(F,S)
% becomes an internal node, S becomes a term s(L,R) with L and R being 
% again n(F,S) terms. A list of n(F,S) terms, called Ns, is maintained 
% as a sort of priority queue.
 
huffman(Fs,Cs) :-
   initialize(Fs,Ns),
   make_tree(Ns,T),
   traverse_tree(T,Cs).
 
initialize(Fs,Ns) :- init(Fs,NsU), sort(NsU,Ns).
 
init([],[]).
init([fr(S,F)|Fs],[n(F,S)|Ns]) :- init(Fs,Ns).
 
make_tree([T],T).
make_tree([n(F1,X1),n(F2,X2)|Ns],T) :- 
   F is F1+F2,
   insert(n(F,s(n(F1,X1),n(F2,X2))),Ns,NsR),
   make_tree(NsR,T).
 
% insert(n(F,X),Ns,NsR) :- insert the node n(F,X) into Ns such that the
%    resulting list NsR is again sorted with respect to the frequency F.
 
insert(N,[],[N]) :- !.
insert(n(F,X),[n(F0,Y)|Ns],[n(F,X),n(F0,Y)|Ns]) :- F < F0, !.
insert(n(F,X),[n(F0,Y)|Ns],[n(F0,Y)|Ns1]) :- F >= F0, insert(n(F,X),Ns,Ns1).
 
% traverse_tree(T,Cs) :- traverse the tree T and construct the Huffman 
%    code table Cs,
 
traverse_tree(T,Cs) :- traverse_tree(T,'',Cs1-[]), sort(Cs1,Cs).
 
traverse_tree(n(_,A),Code,[hc(A,Code)|Cs]-Cs) :- atom(A). % leaf node
traverse_tree(n(_,s(Left,Right)),Code,Cs1-Cs3) :-         % internal node
   atom_concat(Code,'0',CodeLeft), 
   atom_concat(Code,'1',CodeRight),
   traverse_tree(Left,CodeLeft,Cs1-Cs2),
   traverse_tree(Right,CodeRight,Cs2-Cs3).
 
 
% The following predicate gives some statistical information.
 
huffman(Fs) :- huffman(Fs,Hs) , nl, report(Hs,5), stats(Fs,Hs).
 
report([],_) :- !, nl, nl.
report(Hs,0) :- !, nl, report(Hs,5).
report([hc(S,C)|Hs],N) :- N > 0, N1 is N-1, 
   writef('%w %8l  ',[S,C]), report(Hs,N1).
 
stats(Fs,Cs) :- sort(Fs,FsS), sort(Cs,CsS), stats(FsS,CsS,0,0).
 
stats([],[],FreqCodeSum,FreqSum) :- Avg is FreqCodeSum/FreqSum,
   writef('Average code length (weighted) = %w\n',[Avg]). 
stats([fr(S,F)|Fs],[hc(S,C)|Hs],FCS,FS) :- 
   atom_chars(C,CharList), length(CharList,N),
   FCS1 is FCS + F*N, FS1 is FS + F,
   stats(Fs,Hs,FCS1,FS1). 
 

p4_01.pl

% 4.01 Write a predicate istree/1 which succeeds if and only if its argument
%      is a Prolog term representing a binary tree.
%
% istree(T) :- T is a term representing a binary tree (i), (o)
 
istree(nil).
istree(t(_,L,R)) :- istree(L), istree(R).
 
 
% Test cases (can be used for other binary tree problems as well)
 
tree(1,t(a,t(b,t(d,nil,nil),t(e,nil,nil)),t(c,nil,t(f,t(g,nil,nil),nil)))).
tree(2,t(a,nil,nil)).
tree(3,nil).

p4_02.pl

% 4.02 (**) Construct completely balanced binary trees for a given 
% number of nodes.
 
% cbal_tree(N,T) :- T is a completely balanced binary tree with N nodes.
% (integer, tree)  (+,?)
 
cbal_tree(0,nil) :- !.
cbal_tree(N,t(x,L,R)) :- N > 0,
	N0 is N - 1, 
	N1 is N0//2, N2 is N0 - N1,
	distrib(N1,N2,NL,NR),
	cbal_tree(NL,L), cbal_tree(NR,R).
 
distrib(N,N,N,N) :- !.
distrib(N1,N2,N1,N2).
distrib(N1,N2,N2,N1).

p4_03.pl

% 4.03 (**) Symmetric binary trees 
% Let us call a binary tree symmetric if you can draw a vertical 
% line through the root node and then the right subtree is the mirror
% image of the left subtree.
% Write a predicate symmetric/1 to check whether a given binary
% tree is symmetric. Hint: Write a predicate mirror/2 first to check
% whether one tree is the mirror image of another.
 
% symmetric(T) :- the binary tree T is symmetric.
 
symmetric(nil).
symmetric(t(_,L,R)) :- mirror(L,R).
 
mirror(nil,nil).
mirror(t(_,L1,R1),t(_,L2,R2)) :- mirror(L1,R2), mirror(R1,L2).

p4_04.pl

% 4.04 (**) Binary search trees (dictionaries)
 
% Use the predicate add/3, developed in chapter 4 of the course,
% to write a predicate to construct a binary search tree 
% from a list of integer numbers. Then use this predicate to test 
% the solution of the problem P56
 
:- ensure_loaded(p4_03).
 
% add(X,T1,T2) :- the binary dictionary T2 is obtained by 
% adding the item X to the binary dictionary T1
% (element,binary-dictionary,binary-dictionary) (i,i,o)
 
add(X,nil,t(X,nil,nil)).
add(X,t(Root,L,R),t(Root,L1,R)) :- X @< Root, add(X,L,L1).
add(X,t(Root,L,R),t(Root,L,R1)) :- X @> Root, add(X,R,R1).
 
construct(L,T) :- construct(L,T,nil).
 
construct([],T,T).
construct([N|Ns],T,T0) :- add(N,T0,T1), construct(Ns,T,T1).
 
test_symmetric(L) :- construct(L,T), symmetric(T).

p4_05.pl

% 4.05 (**) Generate-and-test paradigm
 
% Apply the generate-and-test paradigm to construct all symmetric,
% completely balanced binary trees with a given number of nodes.
 
:- ensure_loaded(p4_02).
:- ensure_loaded(p4_03).
 
 
sym_cbal_tree(N,T) :- cbal_tree(N,T), symmetric(T).
 
sym_cbal_trees(N,Ts) :- setof(T,sym_cbal_tree(N,T),Ts).
 
investigate(A,B) :-
	between(A,B,N),
	sym_cbal_trees(N,Ts), length(Ts,L),
	writef('%w   %w',[N,L]), nl,
    fail.
investigate(_,_).

p4_06.pl

% 4.06 (**) Construct height-balanced binary trees
% In a height-balanced binary tree, the following property holds for
% every node: The height of its left subtree and the height of  
% its right subtree are almost equal, which means their
% difference is not greater than one.
% Write a predicate hbal_tree/2 to construct height-balanced
% binary trees for a given height. The predicate should
% generate all solutions via backtracking. Put the letter 'x'
% as information into all nodes of the tree.
 
% hbal_tree(D,T) :- T is a height-balanced binary tree with depth T
 
hbal_tree(0,nil) :- !.
hbal_tree(1,t(x,nil,nil)) :- !.
hbal_tree(D,t(x,L,R)) :- D > 1,
	D1 is D - 1, D2 is D - 2,
	distr(D1,D2,DL,DR),
	hbal_tree(DL,L), hbal_tree(DR,R).
 
distr(D1,_,D1,D1).
distr(D1,D2,D1,D2).
distr(D1,D2,D2,D1).

p4_07.pl

% 4.07 (**) Construct height-balanced binary trees with a given number of nodes
 
:- ensure_loaded(p4_06).
 
% minNodes(H,N) :- N is the minimum number of nodes in a height-balanced 
% binary tree of height H
% (integer,integer) (+,?)
 
minNodes(0,0) :- !.
minNodes(1,1) :- !.
minNodes(H,N) :- H > 1, 
	H1 is H - 1, H2 is H - 2,
	minNodes(H1,N1), minNodes(H2,N2),
	N is 1 + N1 + N2.
 
% maxNodes(H,N) :- N is the maximum number of nodes in a height-balanced 
% binary tree of height H
% (integer,integer) (+,?)
 
maxNodes(H,N) :- N is 2**H - 1.
 
% minHeight(N,H) :- H is the minimum height of a height-balanced 
% binary tree with N nodes
% (integer,integer) (+,?)
 
minHeight(0,0) :- !.
minHeight(N,H) :- N > 0, N1 is N//2, minHeight(N1,H1), H is H1 + 1.
 
% maxHeight(N,H) :- H is the maximum height of a height-balanced 
% binary tree with N nodes
% (integer,integer) (+,?)
 
maxHeight(N,H) :- maxHeight(N,H,1,1).
 
maxHeight(N,H,H1,N1) :- N1 > N, !, H is H1 - 1.
maxHeight(N,H,H1,N1) :- N1 =< N, 
	H2 is H1 + 1, minNodes(H2,N2), maxHeight(N,H,H2,N2).
 
% hbal_tree_nodes(N,T) :- T is a height-balanced binary tree with N nodes.
 
hbal_tree_nodes(N,T) :- 
	minHeight(N,Hmin), maxHeight(N,Hmax),
	between(Hmin,Hmax,H),
	hbal_tree(H,T), nodes(T,N).
 
% the following predicate is from the course (chapter 4)
 
%  nodes(T,N) :- the binary tree T has N nodes
% (tree,integer);  (i,*) 
 
nodes(nil,0).
nodes(t(_,Left,Right),N) :-
   nodes(Left,NLeft),
   nodes(Right,NRight),
   N is NLeft + NRight + 1.
 
% count_hbal_trees(N,C) :- there are C different height-balanced binary
% trees with N nodes.
 
count_hbal_trees(N,C) :- setof(T,hbal_tree_nodes(N,T),Ts), length(Ts,C). 

p4_08.pl

% 4.08 (*) Count the leaves of a binary tree
 
:- ensure_loaded(p4_01).
 
% count_leaves(T,N) :- the binary tree T has N leaves
 
count_leaves(nil,0).
count_leaves(t(_,nil,nil),1).
count_leaves(t(_,L,nil),N) :- L = t(_,_,_), count_leaves(L,N).
count_leaves(t(_,nil,R),N) :- R = t(_,_,_), count_leaves(R,N).
count_leaves(t(_,L,R),N) :- L = t(_,_,_), R = t(_,_,_),
   count_leaves(L,NL), count_leaves(R,NR), N is NL + NR.
 
% The above solution works in the flow patterns (i,o) and (i,i)
% without cut and produces a single correct result. Using a cut 
% we can obtain the same result in a much shorter program, like this:
 
count_leaves1(nil,0).
count_leaves1(t(_,nil,nil),1) :- !.
count_leaves1(t(_,L,R),N) :- 
    count_leaves1(L,NL), count_leaves1(R,NR), N is NL+NR.
 
% For the flow pattern (o,i) see problem 4.09

p4_09.pl

% 4.09 (*) Collect the leaves of a binary tree in a list
 
:- ensure_loaded(p4_01).
 
% leaves(T,S) :- S is the list of the leaves of the binary tree T
 
leaves(nil,[]).
leaves(t(X,nil,nil),[X]).
leaves(t(_,L,nil),S) :- L = t(_,_,_), leaves(L,S).
leaves(t(_,nil,R),S) :- R = t(_,_,_), leaves(R,S).
leaves(t(_,L,R),S) :- L = t(_,_,_), R = t(_,_,_),
    leaves(L,SL), leaves(R,SR), append(SL,SR,S).
 
% The above solution works in the flow patterns (i,o) and (i,i)
% without cut and produces a single correct result. Using a cut 
% we can obtain the same result in a much shorter program, like this:
 
leaves1(nil,[]).
leaves1(t(X,nil,nil),[X]) :- !.
leaves1(t(_,L,R),S) :- 
    leaves1(L,SL), leaves1(R,SR), append(SL,SR,S).
 
% To write a predicate that works in the flow pattern (o,i)
% is a more difficult problem, because using append/3 in
% the flow pattern (o,o,i) always generates an empty list 
% as first solution and the result is an infinite recursion
% along the left subtree of the generated binary tree.
% A possible solution is the following trick: we successively
% construct binary tree structures for a given number of nodes
% and fill the leaf nodes with the elements of the leaf list.
% We then increment the number of tree nodes successively,
% and so on. 
 
% nnodes(T,N) :- T is a binary tree with N nodes (o,i)
nnodes(nil,0) :- !.
nnodes(t(_,L,R),N) :- N > 0, N1 is N-1, 
   between(0,N1,NL), NR is N1-NL,
   nnodes(L,NL), nnodes(R,NR).
 
 
% leaves2(T,S) :- S is the list of leaves of the tree T (o,i)
 
leaves2(T,S) :- leaves2(T,S,0).
 
leaves2(T,S,N) :- nnodes(T,N), leaves1(T,S).
leaves2(T,S,N) :- N1 is N+1, leaves2(T,S,N1).
 
% OK, this was difficulty (**)

p4_10.pl

% 4.10 (*) Collect the internal nodes of a binary tree in a list
 
:- ensure_loaded(p4_01).
 
% internals(T,S) :- S is the list of internal nodes of the binary tree T.
 
internals(nil,[]).
internals(t(_,nil,nil),[]).
internals(t(X,L,nil),[X|S]) :- L = t(_,_,_), internals(L,S).
internals(t(X,nil,R),[X|S]) :- R = t(_,_,_), internals(R,S).
internals(t(X,L,R),[X|S]) :- L = t(_,_,_), R = t(_,_,_), 
   internals(L,SL), internals(R,SR), append(SL,SR,S).
 
% The above solution works in the flow patterns (i,o) and (i,i)
% without cut and produces a single correct result. Using a cut 
% we can obtain the same result in a much shorter program, like this:
 
internals1(nil,[]).
internals1(t(_,nil,nil),[]) :- !.
internals1(t(X,L,R),[X|S]) :- 
    internals1(L,SL), internals1(R,SR), append(SL,SR,S).
 
% For the flow pattern (o,i) there is the following very
% elegant solution:
 
internals2(nil,[]).
internals2(t(X,L,R),[X|S]) :- 
   append(SL,SR,S), internals2(L,SL), internals2(R,SR).

p4_11.pl

% 4.11 (*) Collect the nodes of a binary tree at a given level in a list
 
:- ensure_loaded(p4_01).
 
% atlevel(T,D,S) :- S is the list of nodes of the binary tree T at level D
% (i,i,o)
 
atlevel(nil,_,[]).
atlevel(t(X,_,_),1,[X]).
atlevel(t(_,L,R),D,S) :- D > 1, D1 is D-1,
   atlevel(L,D1,SL), atlevel(R,D1,SR), append(SL,SR,S).
 
 
% The following is a quick-and-dirty solution for the
% level-order sequence
 
levelorder(T,S) :- levelorder(T,S,1).
 
levelorder(T,[],D) :- atlevel(T,D,[]), !.
levelorder(T,S,D) :- atlevel(T,D,SD),
   D1 is D+1, levelorder(T,S1,D1), append(SD,S1,S).

p4_12.pl

% 4.12 (**) Construct a complete binary tree
%
% A complete binary tree with height H is defined as follows: 
% The levels 1,2,3,...,H-1 contain the maximum number of nodes 
% (i.e 2**(i-1) at the level i, note that we start counting the 
% levels from 1 at the root). In level H, which may contain less 
% than the maximum number possible of nodes, all the nodes are 
% "left-adjusted". This means that in a levelorder tree traversal 
% all internal nodes come first, the leaves come second, and
% empty successors (the nils which are not really nodes!) 
% come last. Complete binary trees are used for heaps.
 
:- ensure_loaded(p4_04).
 
% complete_binary_tree(N,T) :- T is a complete binary tree with
% N nodes. (+,?)
 
complete_binary_tree(N,T) :- complete_binary_tree(N,T,1).
 
complete_binary_tree(N,nil,A) :- A > N, !.
complete_binary_tree(N,t(_,L,R),A) :- A =< N,
	AL is 2 * A, AR is AL + 1,
	complete_binary_tree(N,L,AL),
	complete_binary_tree(N,R,AR).
 
 
% ----------------------------------------------------------------------
 
% This was the solution of the exercise. What follows is an application
% of this result.
 
% We define a heap as a term heap(N,T) where N is the number of elements
% and T a complete binary tree (in the sense used above).
 
% The conservative usage of a heap is first to declare it with a predicate
% declare_heap/2 and then use it with a predicate element_at/3.
 
% declare_heap(H,N) :- 
%    declare H to be a heap with a fixed number N  of elements
 
declare_heap(heap(N,T),N) :- complete_binary_tree(N,T).
 
% element_at(H,K,X) :- X is the element at address K in the heap H. 
%  The first element has address 1.
%  (+,+,?)
 
element_at(heap(_,T),K,X) :- 
   binary_path(K,[],BP), element_at_path(T,BP,X).
 
binary_path(1,Bs,Bs) :- !.
binary_path(K,Acc,Bs) :- K > 1, 
   B is K /\ 1, K1 is K >> 1, binary_path(K1,[B|Acc],Bs).
 
element_at_path(t(X,_,_),[],X) :- !.
element_at_path(t(_,L,_),[0|Bs],X) :- !, element_at_path(L,Bs,X).
element_at_path(t(_,_,R),[1|Bs],X) :- element_at_path(R,Bs,X).
 
 
% We can transform lists into heaps and vice versa with the following
% useful predicate:
 
% list_heap(L,H) :- transform a list into a (limited) heap and vice versa.
 
list_heap(L,H) :- is_list(L), list_to_heap(L,H).
list_heap(L,heap(N,T)) :- integer(N), fill_list(heap(N,T),N,1,L).
 
list_to_heap(L,H) :- 
   length(L,N), declare_heap(H,N), fill_heap(H,L,1).
 
fill_heap(_,[],_).
fill_heap(H,[X|Xs],K) :- element_at(H,K,X), K1 is K+1, fill_heap(H,Xs,K1).
 
fill_list(_,N,K,[]) :- K > N.
fill_list(H,N,K,[X|Xs]) :- K =< N, 
   element_at(H,K,X), K1 is K+1, fill_list(H,N,K1,Xs).
 
 
% However, a more aggressive usage is *not* to define the heap in the
% beginning, but to use it as a partially instantiated data structure.
% Used in this way, the number of elements in the heap is unlimited.
% This is Power-Prolog!
 
% Try the following and find out exactly what happens.
 
% ?- element_at(H,5,alfa), element_at(H,2,beta), element(H,5,A).
 
% -------------------------------------------------------------------------
 
% Test section. Suppose you have N elements in a list which must be looked
% up M times in a random order.
 
test1(N,M) :-
   length(List,N), lookup_list(List,N,M).
 
lookup_list(_,_,0) :- !.
lookup_list(List,N,M) :- 
   K is random(N)+1,       % determine a random address
   nth1(K,List,_),         % look up and throw away
   M1 is M-1,
   lookup_list(List,N,M1).
 
% ?- time(test1(100,100000)).
% 1,384,597 inferences in 3.98 seconds (347889 Lips)
% ?- time(test1(500,100000)).
% 4,721,902 inferences in 13.82 seconds (341672 Lips)
% ?- time(test1(10000,100000)).
% 84,016,719 inferences in 277.51 seconds (302752 Lips)
 
test2(N,M) :-
   declare_heap(Heap,N), 
   lookup_heap(Heap,N,M).
 
lookup_heap(_,_,0) :- !.
lookup_heap(Heap,N,M) :- 
   K is random(N)+1,       % determine a random address
   element_at(Heap,K,_),   % look up and throw away
   M1 is M-1,
   lookup_heap(Heap,N,M1).
 
% ?- time(test2(100,100000)).
% 3,002,061 inferences in 7.81 seconds (384387 Lips)                          
% ?- time(test2(500,100000)).
% 4,097,961 inferences in 10.75 seconds (381206 Lips)
% ?- time(test2(10000,100000)).
% 6,366,206 inferences in 19.16 seconds (332265 Lips)
 
% Conclusion: In this scenario, for lists longer than 500 elements 
% it is more efficient to use a heap.

p4_13.pl

% 4.13 (**) Layout a binary tree (1)
%
% Given a binary tree as the usual Prolog term t(X,L,R) (or nil).
% As a preparation for drawing the tree, a layout algorithm is
% required to determine the position of each node in a rectangular
% grid. Several layout methods are conceivable, one of them is
% the following:
%
% The position of a node v is obtained by the following two rules:
%   x(v) is equal to the position of the node v in the inorder sequence
%   y(v) is equal to the depth of the node v in the tree
%
% In order to store the position of the nodes, we extend the Prolog 
% term representing a node (and its successors) as follows:
%    nil represents the empty tree (as usual)
%    t(W,X,Y,L,R) represents a (non-empty) binary tree with root
%        W positionned at (X,Y), and subtrees L and R
%
% Write a predicate layout_binary_tree/2:
 
% layout_binary_tree(T,PT) :- PT is the "positionned" binary
%    tree obtained from the binary tree T. (+,?) or (?,+)
 
:- ensure_loaded(p4_04). % for test
 
layout_binary_tree(T,PT) :- layout_binary_tree(T,PT,1,_,1).
 
% layout_binary_tree(T,PT,In,Out,D) :- T and PT as in layout_binary_tree/2;
%    In is the position in the inorder sequence where the tree T (or PT)
%    begins, Out is the position after the last node of T (or PT) in the 
%    inorder sequence. D is the depth of the root of T (or PT). 
%    (+,?,+,?,+) or (?,+,+,?,+)
 
layout_binary_tree(nil,nil,I,I,_).
layout_binary_tree(t(W,L,R),t(W,X,Y,PL,PR),Iin,Iout,Y) :- 
   Y1 is Y + 1,
   layout_binary_tree(L,PL,Iin,X,Y1), 
   X1 is X + 1,
   layout_binary_tree(R,PR,X1,Iout,Y1).
 
% Test (see example given in the problem description):
% ?-  construct([n,k,m,c,a,h,g,e,u,p,s,q],T),layout_binary_tree(T,PT).

p4_14.pl

% 4.14 (**) Layout a binary tree (2)
%
% See problem 4.13 for the conventions.
%
% The position of a node v is obtained by the following rules:
%   (1) y(v) is equal to the depth of the node v in the tree
%   (2) if D denotes the depth of the tree (i.e. the number of
%       populated levels) then the horizontal distance between
%       nodes at level i (counted from the root, beginning with 1)
%       is equal to 2**(D-i+1). The leftmost node of the tree
%       is at position 1.
 
% layout_binary_tree2(T,PT) :- PT is the "positionned" binary
%    tree obtained from the binary tree T. (+,?)
 
:- ensure_loaded(p4_04). % for test
 
layout_binary_tree2(nil,nil) :- !. 
layout_binary_tree2(T,PT) :- 
   hor_dist(T,D4), D is D4//4, x_pos(T,X,D), 
   layout_binary_tree2(T,PT,X,1,D).
 
% hor_dist(T,D4) :- D4 is four times the horizontal distance between the 
%    root node of T and its successor(s) (if any).
%    (+,-)
 
hor_dist(nil,1).
hor_dist(t(_,L,R),D4) :- 
   hor_dist(L,D4L), 
   hor_dist(R,D4R),
   D4 is 2 * max(D4L,D4R).
 
% x_pos(T,X,D) :- X is the horizontal position of the root node of T
%    with respect to the picture co-ordinate system. D is the horizontal
%    distance between the root node of T and its successor(s) (if any).
%    (+,-,+)
 
x_pos(t(_,nil,_),1,_) :- !.
x_pos(t(_,L,_),X,D) :- D2 is D//2, x_pos(L,XL,D2), X is XL+D.
 
% layout_binary_tree2(T,PT,X,Y,D) :- T and PT as in layout_binary_tree/2;
%    D is the the horizontal distance between the root node of T and 
%    its successor(s) (if any). X, Y are the co-ordinates of the root node.
%    (+,-,+,+,+)
 
layout_binary_tree2(nil,nil,_,_,_).
layout_binary_tree2(t(W,L,R),t(W,X,Y,PL,PR),X,Y,D) :- 
   Y1 is Y + 1,
   Xleft is X - D,
   D2 is D//2,
   layout_binary_tree2(L,PL,Xleft,Y1,D2), 
   Xright is X + D,
   layout_binary_tree2(R,PR,Xright,Y1,D2).
 
% Test (see example given in the problem description):
% ?- construct([n,k,m,c,a,e,d,g,u,p,q],T),layout_binary_tree2(T,PT).

p4_15.pl

% 4.15 (***) Layout a binary tree (3)
%
% See problem 4.13 for the conventions.
%
% The position of a node v is obtained by the following rules:
%   (1) y(v) is equal to the depth of the node v in the tree
%   (2) in order to determine the horizontal positions of the nodes we
%       construct "contours" for each subtree and shift them together 
%       horizontally as close as possible. However, we maintain the
%       symmetry in each node; i.e. the horizontal distance between
%       a node and the root of its left subtree is the same as between
%       it and the root of its right subtree.
%
%       The "contour" of a tree is a list of terms c(Xleft,Xright) which
%       give the horizontal position of the outermost nodes of the tree
%       on each level, relative to the root position. In the example
%       given in the problem description, the "contour" of the tree with
%       root k would be [c(-1,1),c(-2,0),c(-1,1)]. Note that the first
%       element in the "contour" list is derived from the position of
%       the nodes c and m.
 
% layout_binary_tree3(T,PT) :- PT is the "positionned" binary
%    tree obtained from the binary tree T. (+,?)
 
:- ensure_loaded(p4_04). % for test
 
layout_binary_tree3(nil,nil) :- !. 
layout_binary_tree3(T,PT) :-
   contour_tree(T,CT),      % construct the "contour" tree CT
   CT = t(_,_,_,Contour),
   mincont(Contour,MC,0),   % find the position of the leftmost node
   Xroot is 1-MC,
   layout_binary_tree3(CT,PT,Xroot,1).
 
contour_tree(nil,nil).
contour_tree(t(X,L,R),t(X,CL,CR,Contour)) :- 
   contour_tree(L,CL),
   contour_tree(R,CR),
   combine(CL,CR,Contour).
 
combine(nil,nil,[]).
combine(t(_,_,_,CL),nil,[c(-1,-1)|Cs]) :- shift(CL,-1,Cs).
combine(nil,t(_,_,_,CR),[c(1,1)|Cs]) :- shift(CR,1,Cs).
combine(t(_,_,_,CL),t(_,_,_,CR),[c(DL,DR)|Cs]) :-
   maxdiff(CL,CR,MD,0), 
   DR is (MD+2)//2, DL is -DR,
   merge(CL,CR,DL,DR,Cs).
 
shift([],_,[]).
shift([c(L,R)|Cs],S,[c(LS,RS)|CsS]) :-
   LS is L+S, RS is R+S, shift(Cs,S,CsS).
 
maxdiff([],_,MD,MD) :- !.
maxdiff(_,[],MD,MD) :- !.
maxdiff([c(_,R1)|Cs1],[c(L2,_)|Cs2],MD,A) :- 
   A1 is max(A,R1-L2),
   maxdiff(Cs1,Cs2,MD,A1).
 
merge([],CR,_,DR,Cs) :- !, shift(CR,DR,Cs).
merge(CL,[],DL,_,Cs) :- !, shift(CL,DL,Cs).
merge([c(L1,_)|Cs1],[c(_,R2)|Cs2],DL,DR,[c(L,R)|Cs]) :-
   L is L1+DL, R is R2+DR,
   merge(Cs1,Cs2,DL,DR,Cs).
 
mincont([],MC,MC).
mincont([c(L,_)|Cs],MC,A) :- 
   A1 is min(A,L), mincont(Cs,MC,A1).
 
layout_binary_tree3(nil,nil,_,_).
layout_binary_tree3(t(W,nil,nil,_),t(W,X,Y,nil,nil),X,Y) :- !. 
layout_binary_tree3(t(W,L,R,[c(DL,DR)|_]),t(W,X,Y,PL,PR),X,Y) :- 
   Y1 is Y + 1,
   Xleft is X + DL,
   layout_binary_tree3(L,PL,Xleft,Y1), 
   Xright is X + DR,
   layout_binary_tree3(R,PR,Xright,Y1).
 
% Test (see example given in the problem description):
% ?- construct([n,k,m,c,a,e,d,g,u,p,q],T),layout_binary_tree3(T,PT).

p4_16a.pl

% 4.16a (**)  A string representation of binary trees
 
% The string representation has the following syntax:
%
% <tree> ::=  | <letter><subtrees>
%
% <subtrees> ::=  | '(' <tree> ',' <tree> ')'
%
% According to this syntax, a leaf node (with letter x) could
% be represented by x(,) and not only by the single character x.
% However, we will avoid this when generating the string 
% representation.
 
tree_string(T,S) :- nonvar(T), !, tree_to_string(T,S). 
tree_string(T,S) :- nonvar(S), string_to_tree(S,T). 
 
tree_to_string(T,S) :- tree_to_list(T,L), atom_chars(S,L).
 
tree_to_list(nil,[]).
tree_to_list(t(X,nil,nil),[X]) :- !.
tree_to_list(t(X,L,R),[X,'('|List]) :- 
   tree_to_list(L,LsL),
   tree_to_list(R,LsR),
   append(LsL,[','],List1),
   append(List1,LsR,List2),
   append(List2,[')'],List).
 
string_to_tree(S,T) :- atom_chars(S,L), list_to_tree(L,T).
 
list_to_tree([],nil).
list_to_tree([X],t(X,nil,nil)) :- char_type(X,alpha).
list_to_tree([X,'('|List],t(X,Left,Right)) :- char_type(X,alpha),
   append(List1,[')'],List),
   append(LeftList,[','|RightList],List1),
   list_to_tree(LeftList,Left),
   list_to_tree(RightList,Right).

p4_16b.pl

% 4.16b (**) A string representation of binary trees
 
% Most elegant solution using difference lists.
 
tree_string(T,S) :- nonvar(T), tree_dlist(T,L-[]), !, atom_chars(S,L). 
tree_string(T,S) :- nonvar(S), atom_chars(S,L), tree_dlist(T,L-[]).
 
% tree_dlist/2 does the trick in both directions!
 
tree_dlist(nil,L-L).
tree_dlist(t(X,nil,nil),L1-L2) :- 
   letter(X,L1-L2).
tree_dlist(t(X,Left,Right),L1-L7) :- 
   letter(X,L1-L2), 
   symbol('(',L2-L3),
   tree_dlist(Left,L3-L4),
   symbol(',',L4-L5),
   tree_dlist(Right,L5-L6),
   symbol(')',L6-L7).
 
symbol(X,[X|Xs]-Xs).
 
letter(X,L1-L2) :- symbol(X,L1-L2), char_type(X,alpha).

p4_17a.pl

% 4.17a (**) Preorder and inorder sequences of binary trees
 
% We consider binary trees with nodes that are identified by
% single lower-case letters.
 
% a) Given a binary tree, construct its preorder sequence
 
preorder(T,S) :- preorder_tl(T,L), atom_chars(S,L).
 
preorder_tl(nil,[]).
preorder_tl(t(X,Left,Right),[X|List]) :-
   preorder_tl(Left,ListLeft),
   preorder_tl(Right,ListRight),
   append(ListLeft,ListRight,List).
 
inorder(T,S) :- inorder_tl(T,L), atom_chars(S,L).
 
inorder_tl(nil,[]).
inorder_tl(t(X,Left,Right),List) :-
   inorder_tl(Left,ListLeft),
   inorder_tl(Right,ListRight),
   append(ListLeft,[X|ListRight],List).

p4_17b.pl

% 4.17b (**) Preorder and inorder sequences of binary trees
 
% b) Make preorder/2 and inorder/2 reversible.
 
% Similar to the solution p4_17a.pl. However, for the flow pattern (-,+) 
% we have to modify the order of the subgoals in the second clauses 
% of preorder_l/2 and inorder_l/2
 
% preorder(T,S) :- S is the preorder tre traversal sequence of the
%    nodes of the binary tree T. (tree,atom) (+,?) or (?,+)
 
preorder(T,S) :- nonvar(T), !, preorder_tl(T,L), atom_chars(S,L). 
preorder(T,S) :- atom(S), atom_chars(S,L), preorder_lt(T,L).
 
preorder_tl(nil,[]).
preorder_tl(t(X,Left,Right),[X|List]) :-
   preorder_tl(Left,ListLeft),
   preorder_tl(Right,ListRight),
   append(ListLeft,ListRight,List).
 
preorder_lt(nil,[]).
preorder_lt(t(X,Left,Right),[X|List]) :-
   append(ListLeft,ListRight,List),
   preorder_lt(Left,ListLeft),
   preorder_lt(Right,ListRight).
 
% inorder(T,S) :- S is the inorder tre traversal sequence of the
%    nodes of the binary tree T. (tree,atom) (+,?) or (?,+)
 
inorder(T,S) :- nonvar(T), !, inorder_tl(T,L), atom_chars(S,L). 
inorder(T,S) :- atom(S), atom_chars(S,L), inorder_lt(T,L).
 
inorder_tl(nil,[]).
inorder_tl(t(X,Left,Right),List) :-
   inorder_tl(Left,ListLeft),
   inorder_tl(Right,ListRight),
   append(ListLeft,[X|ListRight],List).
 
inorder_lt(nil,[]).
inorder_lt(t(X,Left,Right),List) :-
   append(ListLeft,[X|ListRight],List),
   inorder_lt(Left,ListLeft),
   inorder_lt(Right,ListRight).

p4_17c.pl

% 4.17c (**) Preorder and inorder sequences of binary trees
 
% If both the preorder sequence and the inorder sequence of
% the nodes of a binary tree are given, then the tree is determined
% unambiguously. 
 
:- ensure_loaded(p4_17b).
 
% pre_in_tree(P,I,T) :- T is the binary tree that has the preorder
%   sequence P and inorder sequence I.
%   (atom,atom,tree) (+,+,?)
 
pre_in_tree(P,I,T) :- preorder(T,P), inorder(T,I).
 
% This is a nice application of the generate-and-test method.
 
 
% We can push the tester inside the generator in order to get
% a (much) better performance.
 
pre_in_tree_push(P,I,T) :- 
   atom_chars(P,PL), atom_chars(I,IL), pre_in_tree_pu(PL,IL,T).
 
pre_in_tree_pu([],[],nil).
pre_in_tree_pu([X|PL],IL,t(X,Left,Right)) :- 
   append(ILeft,[X|IRight],IL),
   append(PLeft,PRight,PL),
   pre_in_tree_pu(PLeft,ILeft,Left),
   pre_in_tree_pu(PRight,IRight,Right).
 
% Nice. But there is a still better solution. See problem d)!

p4_17d.pl

% 4.17d (**) Preorder and inorder sequences of binary trees
 
% Work with difference lists
 
% pre_in_tree_d(P,I,T) :- T is the binary tree that has the preorder
%   sequence P and inorder sequence I.
%   (atom,atom,tree) (+,+,?)
 
pre_in_tree_d(P,I,T) :-  
   atom_chars(P,PL), atom_chars(I,IL), pre_in_tree_dl(PL-[],IL-[],T).
 
pre_in_tree_dl(P-P,I-I,nil).
pre_in_tree_dl(P1-P4,I1-I4,t(X,Left,Right)) :-
   symbol(X,P1-P2), symbol(X,I2-I3),
   pre_in_tree_dl(P2-P3,I1-I2,Left),
   pre_in_tree_dl(P3-P4,I3-I4,Right).
 
symbol(X,[X|Xs]-Xs).
 
 
% Isn't it cool? But the best of it is the performance!
 
% With the generate-and-test solution (p4_17c):
% ?- time(pre_in_tree(abdecfg,dbeacgf,_)).
% 9,048 inferences in 0.01 seconds (904800 Lips)  
 
% With the "pushed" generate-and-test solution (p4_17c):
% ?- time(pre_in_tree_push(abdecfg,dbeacgf,_)).
% 67 inferences in 0.00 seconds (Infinite Lips)
 
% With the difference list solution (p4_17d):
% ?- time(pre_in_tree_d(abdecfg,dbeacgf,_)).
% 32 inferences in 0.00 seconds (Infinite Lips)                     
 
% Note that the predicate pre_in_tree_dl/3 runs in almost any
% flow pattern. Try it out!