Week 3: Notes

floating-point numbers

Prolog supports floating-point numbers:

?- X = 14.3.
X = 14.3.

Notice that the = operator will never consider integers and floating point numbers to be equal, since they are structurally different:

?- 1 = 1.0.
false.

The old-style 'is' operator and the comparison operators <, =<, >, and >= will work with floats:

?- X is 4.5 + 2.2.
X = 6.7.

?- 4.8 < 10.0.
true.

The '/' operator performs floating-point division:

?- X is 9.0 / 2.0.
X = 4.5.

The abs(), min() and max() functions mentioned above will also work on floating-point numbers. Furthermore, in floating-point expressions we may use the constants e and pi, and the trigonometric functions sin(), cos(), and tan():

?- X is cos(pi).
X = -1.0.

?- X is e^2.
X = 7.3890560989306495.

new-style floating-point arithmetic

Because 'is' and the comparison operators such as '<' and '=<' will only work in one direction, usually we will want to use new-style floating-point expressions, which are based on real constraints. To enable these, add this line to your init.pl file as described above:

:- use_module(library(clpr)).

New-style floating-point expressions use a completely different syntax from integer expressions. Instead of using operators such as #= and #<, we write floating-point expressions using ordinary operators such as '=', '<', '=<', but written inside braces. For example:

?- { X = 2 + 3 }.
X = 5.0

?- { 2 + 3 = X }.
X = 5.0

?- { X + 2 = 5 }.
X = 3.0

?- { X + 1 = X }.
false.

?- { X * 2 = 10 }.
X = 5.0

?- { X * 2 = 9 }.
X = 4.5

?- { 2^X = 128 }.
X = 7.0

?- { 2^X = 100 }.
X = 6.643856189774725

?- { X^2 = 16 }.
X = 4.0 ;
X = -4.0

Notice that the last query above reports two solutions separately, unlike the integer solver which was able to combine them into a single result.

Prolog's real solver can also work with inequalities, though it doesn't support the range syntax (e.g. "4..8") that we saw with integer constraints:

?- { 4 =< X, X =< 6 }.
{X>=4.0, X=<6.0}.

?- { 10 < X, X < 30, 20 < X, X < 40 }.
{X>20.0, X<30.0}.

?- { X^2 = 16, X > 0 }.
X = 4.0

Unlike the integer solver, the real solver can actually solve systems of linear equations:

?- { X + Y + Z = 9, X + Y - Z = -1, X + 2 * Y + 3 * Z = 22 }.
X = 1.0,
Y = 3.0,
Z = 5.0.

However it cannot solve a quadratic equation:

?- { X^2 - X - 2 = 0 }.
{-2.0-X+X^2=0.0}.

Let's write a few predicates using floating-point arithmetic:

% X, Y, Z are sides of a right triangle
triangle(X, Y, Z) :- { X > 0, Y > 0, Z > 0, X^2 + Y^2 = Z^2 }.

% C = celsius, F = fahrenheit
temperature(C, F) :- { F = 9 / 5 * C + 32 }.

% currency conversion
currency(Kc, Eur, USD) :- { 1.13 * Eur = USD, 21.7 * USD = Kc }.

They all work multidirectionally:

?- triangle(5, 12, H).
H = 13.0

?- triangle(5, X, 10).
X = 8.660254037844387

?- temperature(10, F).
F = 50.0

?- temperature(C, 50).
C = 10.0

?- currency(1000, Eur, USD).
Eur = 40.78137106969537,
USD = 46.082949308755765

?- currency(Kc, Eur, 1000).
Kc = 21700.0,
Eur = 884.9557522123895

list predicates, continued

Last week we saw how to write recursive predicates on lists. Let's explore this topic a bit more.

append

Last week we saw how to write the built-in predicate append(L, M, N), which succeeds if we can append L and M to make N:

append([], L, L).
append([X | L], M, [X | N]) :- append(L, M, N).

append() is a useful helper in many situations. In fact, in many cases we have a choice of writing a predicate recursively, or writing it more directly using append(). For this reason I sometimes say that "append is your friend".

For example, consider the member() predicate we wrote recursively last week:

% member(X, L): true if X is a member of the list L.
member(X, [X | _]).
member(X, [_ | L]) :- member(X, L).

We can write it more succinctly using append():

member(X, L) :- append(_, [X | _], L).

select

The library predicate select(X, L, M) is true if we can remove X anywhere in L to make M. Equivalently, it's true if we can insert X anywhere in M to make L.

One possible implementation of 'select' is recursive:

select(X, [X | L], L).
select(X, [Y | L], [Y | M]) :- select(X, L, M).

Or we may write 'select' using 'append':

select(X, L, M) :- append(A, [X | B], L), append(A, B, M).

Unfortunately this version of the predicate fails to terminate for some queries:

?- select(a, L, [b, c, d]).
L = [a,b,c,d] ;
L = [b,a,c,d] ;
L = [b,c,a,d] ;
L = [b,c,d,a] ;
<hang>

The problem is that the first goal 'append(A, [X | B], L)' may produce an infinite number of results:

?- X = a, append(A, [X | B], L).
X = a,
A = [],
L = [a|B] ;
X = a,
A = [_A],
L = [_A, a|B] ;
X = a,
A = [_A, _B],
L = [_A, _B, a|B]
...

If the first goal produces an infinite number of results, then Prolog's depth-first search can never terminate (at least in the pure core language that we have studied so far).

To help Prolog's search terminate, we need to add a constraint that limits the search space. Whenever select(X, L, M) is true, L must have one more element than M. Let's add a constraint that says that:

select(X, L, M) :- same_length(L, [_ | M]), append(A, [X | B], L), append(A, B, M).

Now the predicate will terminate in any direction. If the caller specifies L, then the call to same_length() will fix the length of M. If the caller specifies M, then the call to same_length() will fix the length of L. In either case, since the lengths of L and M are known, the following calls to append() will produce only a finite number of solutions, and so the predicate 'select' will terminate either as written above, or even if we swap the two calls to 'append'.

Adding a call to same_length() will help many other list-based predicates terminate as well. I call this the "same_length trick".

standard library predicates

We now know enough Prolog to understand many of the standard library predicates listed on our quick reference page.

On that page, you'll see that each argument of each predicate is annotated with a mode indicator, which is either + or ?. These indicators are not part of the Prolog language, but are a standard convention in Prolog documentation. Any argument with a ? can be used either as input or output to the predicate. However, an argument marked with + can only be used as input.

To put it differently, if all arguments of a predicate are marked with ?, then the predicate is pure: it will work in all directions. Many standard library predicates are impure. For example, the predicate msort(+L, ?M) will sort a list:

?- msort([horse, cow, dog, bird], L).
L = [bird, cow, dog, horse].

However it won't work in the other direction:

?- msort(L, [horse, cow, dog, bird]).
ERROR: Arguments are not sufficiently instantiated

The Prolog library contains impure predicates for practical reasons. Some predicates might be difficult or inefficient to implement in a pure way, and some operations (such as I/O) are inherently impure.

However you may want to write pure code when possible. If you write a program using only pure predicates, then it will produce correct answers in every direction, unless it fails to terminate.

nested lists

A list may contain sublists:

?- L = [[a, b], [c, d], [e, f]].
L = [[a, b], [c, d], [e, f]].

In Prolog, two lists are equal if they have the same structure and elements:

?- [[a, b], [c, d], [e, f]] = [[a, b], [c, d], [e, f]].
true.

To put it differently, equality is deep and recursive.

Prolog can perform unification even between nested lists:

?- [[X, Y], [A, B]] = [L, [3, 4]].
A = 3,
B = 4,
L = [X, Y].

?- [[X, Y], [A, B]] = [[3, X], [B, A]].
X = Y, Y = 3,
A = B.

As an example of a predicate that uses nested lists, let's write a predicate flatten(LL, L) that is true if L is the concatenation of all lists in LL:

flatten([], []).
flatten([L | LL], M) :- append(L, M1, M), flatten(LL, M1).

?- flatten([[a, b], [c, d], [e, f]], L).
L = [a, b, c, d, e, f].

?- flatten([[a, b], L, [e, f]], [a, b, c, d, e, f]).
L = [c, d]

As usual, placing the recursive call last helps the predicate terminate in both directions.

Actually this predicate is also built into the standard library – it's called append, with two arguments:

?- append([[a, b], [c, d], [e, f]], L).
L = [a, b, c, d, e, f].

combinatorial recursion

We can use Prolog to solve combinatorial recursive problems such as generating subsets, permutations, combinations and so on. In Prolog we will typically write predicates that generate one solution at a time, rather than producing a list of all solutions.

For example, let's write a predicate subset(S, T) that succeeds if T is a subset of S, i.e. contains some elements of S in the same order in which they appear in S. Here is one possible implementation:

subset([], []).
subset([_ | L], M) :- subset(L, M).
subset([X | L], [X | M]) :- subset(L, M).

It works:

?- subset([a, b, c], L).
L = [] ;
L = [c] ;
L = [b] ;
L = [b, c] ;
L = [a] ;
L = [a, c] ;
L = [a, b] ;
L = [a, b, c].

Here's one way to think about this predicate. Suppose that we are given a set, and want to generate its subsets. If the set is empty, its only subset is the empty set. Otherwise it must have the form [X | L]. Then for any subset, either X is absent or it is present. The subsets without X are simply the subsets of L. The subsets with X are the subsets of L, with X prepended to each of them.

We'll solve more combinatorial problems in the tutorials.

structures

A structure is a kind of term that consists of a functor and zero or more arguments. The functor has the same syntax as an atom. The components are arbitrary terms. Here are some examples:

Two structures are equal only if they have the same functor name and the same arguments. Prolog can perform unification between arbitrary structures:

?- foo(3, 4, X) = foo(Y, 4, 5).
X = 5,
Y = 3.

?- foo(3, 4, X) = bar(Y, 4, 5).
false.

?- foo(3, 4, X) = foo(3, Y).
false.

?- a(X) = Y.
Y = a(X).

?- Y = a(X), Z = b(Y).
Y = a(X),
Z = b(a(X)).

We may define predicates that use structures. For example, here is a predicate that reverses the elements of a pair, where we represent pairs using a functor 'pair':

flip(pair(X, Y), pair(Y, X)).

Let's try it:

?- flip(pair(3, 4), P).
P = pair(4, 3).

?- flip(P, pair(4, 3)).
P = pair(3, 4).

?- flip(P, Q).
P = pair(_A, _B),
Q = pair(_B, _A).

Notice that predicates and structures have a similar syntax. Be sure to understand that in the clause above, 'flip' is a predicate and 'pair' is a functor.

As another example, suppose that we represent points (X, Y) using a structure 'point(X, Y)', and that we represent a line between two points P and Q using a structure 'line(P, Q)'. Now we may write predicates that succeed if a line is vertical or horizontal:

vertical(line(point(X, _), point(X, _))).
horizontal(line(point(_, Y), point(_, Y))).

Let's make some queries:

?- vertical(line(point(2, 4), point(2, 6))).
true.

?- vertical(line(point(1, 1), point(1, Y))).
true.

?- vertical(line(point(1, 1), point(2, Y))). 
false.

?- vertical(line(point(2, 3), P)).
P = point(2, _).

example: adding times

Suppose the we represent a time of day using a structure such as time(11, 26, 13), representing the time 11:26:13. We'd like to write a predicate add(T1, N, T2), which says that time T2 is N seconds after T1. Here is an implementation:

% Convert a time to a number of seconds after midnight.
convert(time(H, M, S), N) :-
    H in 0 .. 23, [M, S] ins 0 .. 59, N #= 3600 * H + 60 * M + S.

% Add time T1 plus N seconds to form time T2.
add(T1, N, T2) :-
    convert(T1, N1), convert(T2, N2), N1 + N #= N2.

Remarkably, add will work in every direction:

?- add(time(11, 30, 0), 75, T).
T = time(11, 31, 15).

?- add(time(11, 30, 0), N, time(11, 31, 15)).
N = 75.

?- add(T, 75, time(11, 31, 15)).
T = time(11, 30, 0).

operator syntax

Prolog includes various predefined operators, which are actually functors. Most operators consist of punctuaction symbols (e.g. +, *, /), but some contain letters (e.g. div, mod). Operators may either be binary operators, which take two arguments, or unary operators, which take only one.

An operator may be followed by a parenthesized argument list just like with ordinary functors, but usually we will write binary operators with infix syntax. The same structure will be produced in either case:

?- X = +(3, 2).
X = 3+2.

?- X = 3 + 2.
X = 3+2.

Most unary operators use prefix syntax, meaning that they precede their argument:

?- X = + a.
X = +a.

?- X = + + a.
X = + +a.

As we can see above, there is a binary operator '+' and also a separate unary operator '+'.

Here is a table listing some of Prolog's predefined operators. The table lists operators from lowest to highest precedence; operators on the same line have equal precedence. All operators are binary unless otherwise specified.

As we have seen, some of these operators have specific meanings in arithmetic expressions. However, these operators do not all have an arithmetic meaning. And actually we can use any of these operators to hold any data that we like, and may use them even in non-arithmetic contexts.

For example, suppose that we use the operator / for representing pairs of values:

?- X = a / b.
X = a/b.

Let's write a predicate zip() that will zip two lists of items into a list of pairs:

zip([], [], []).
zip([X | L], [Y | M], [X / Y | N]) :- zip(L, M, N).

?- zip([a, b, c], [d, e, f], L).
L = [a/d, b/e, c/f].

We may even run it in reverse to unzip:

?- zip(L, M, [a/d, b/e, c/f]).
L = [a, b, c],
M = [d, e, f].

dictionaries

Often we may wish to map keys to values. We have already seen that we may represent such a mapping using a 2-argument predicate:

color(red, 10).
color(green, 20).
color(blue, 30).
color(green, 40).

This is called a temporal representation of the data. "temporal" means related to time. When we query this predicate, we get results one at a time:

?- color(K, V).
K = red,
V = 10 ;
K = green,
V = 20 ;
K = blue,
V = 30 ;
K = green,
V = 40.

Alternatively, we may want a spatial representation of the data, i.e. to hold all the keys and values in a single dictionary data structure. A simple dictionary representation in Prolog is an association list, which is simply a list of key/value pairs. As we saw above, it's convenient to use operator syntax for pairs. Here, let's use the ':' operator so that our dictionaries will look something like Python dictionaries.

For example, here is a dictionary:

colors(D) :- D = [ red : 10, green : 20, blue : 30, orange : 40 ].

Prolog does not have traditional global variables, but we can use a predicate such as this as a workaround. If we want access to this dictionary at any place in our program, we can simply call the predicate to assign it to a variable of our choice.

Let's now write a predicate 'lookup' that will let us look up keys in any dictionary:

lookup(D, K, V) :- member(K : V, D).

Now we may look up keys in the dictionary above. As usual, queries work in both directions, so we may even map values back to keys:

?- colors(_D), lookup(_D, blue, X).
X = 30

?- colors(_D), lookup(_D, C, 20).
C = green

?- colors(_D), lookup(_D, K, V).
K = red,
V = 10 ;
K = green,
V = 20 ;
K = blue,
V = 30 ;
K = orange,
V = 40.

Notice that _D is an anonymous variable since it begins with an underscore. I recommend that you add this line to your init.pl file:

:- set_prolog_flag(toplevel_print_anon, false).

This will disable the printing of anonymous variables in the REPL. So then the queries above won't print _D out, which would only clutter the output.

We have seen that we can encode a key/value mapping either temporally (using a 2-argument predicate) or spatially (using a dictionary data structure). Which approach is better? Either is reasonable in Prolog, and the best approach may depend on the problem we are trying to solve. However, note that we can easily translate a spatial to a temporal representation: the last query above does exactly that. On the other hand, we cannot translate a temporal representation to a spatial representation using the subset of Prolog that we know so far.