Prev Up Next
The power of depth-first search coupled
with backtracking becomes obvious when applied to solving
logic puzzles. These problems are extraordinarily difficult
to solve procedurally, but can be solved concisely and
declaratively with amb, without taking anything away
from the charm of solving the puzzle.
14.4.1 The Kalotan puzzle
The Kalotans are a tribe with a peculiar quirk.
6 Their males always
tell the truth. Their females never make two consecutive
true statements, or two consecutive untrue statements.
An anthropologist (let's call him Worf) has begun to
study them. Worf does not yet know the Kalotan
language. One day, he meets a Kalotan (heterosexual)
couple and their child Kibi. Worf asks Kibi: ``Are you
a boy?'' Kibi answers in Kalotan, which of course Worf
doesn't understand.
Worf turns to the parents (who know English) for
explanation. One of them says: ``Kibi said: `I am a
boy.' '' The other adds: ``Kibi is a girl. Kibi lied.''
Solve for the sex of the parents and Kibi.
--
The solution consists in introducing a bunch of variables,
allowing them to take a choice of values, and
enumerating the conditions on them as a sequence of
assert expressions.
The variables: parent1,
parent2, and kibi are the sexes of the parents (in
order of appearance) and Kibi; kibi-self-desc is
the sex Kibi claimed to be (in Kalotan); kibi-lied?
is the boolean on whether Kibi's claim was a lie.
(define solve-kalotan-puzzle
(lambda ()
(let ((parent1 (amb 'm 'f))
(parent2 (amb 'm 'f))
(kibi (amb 'm 'f))
(kibi-self-desc (amb 'm 'f))
(kibi-lied? (amb #t #f)))
(assert
(distinct? (list parent1 parent2)))
(assert
(if (eqv? kibi 'm)
(not kibi-lied?)))
(assert
(if kibi-lied?
(xor
(and (eqv? kibi-self-desc 'm)
(eqv? kibi 'f))
(and (eqv? kibi-self-desc 'f)
(eqv? kibi 'm)))))
(assert
(if (not kibi-lied?)
(xor
(and (eqv? kibi-self-desc 'm)
(eqv? kibi 'm))
(and (eqv? kibi-self-desc 'f)
(eqv? kibi 'f)))))
(assert
(if (eqv? parent1 'm)
(and
(eqv? kibi-self-desc 'm)
(xor
(and (eqv? kibi 'f)
(eqv? kibi-lied? #f))
(and (eqv? kibi 'm)
(eqv? kibi-lied? #t))))))
(assert
(if (eqv? parent1 'f)
(and
(eqv? kibi 'f)
(eqv? kibi-lied? #t))))
(list parent1 parent2 kibi))))
A note on the helper procedures: The procedure
distinct? returns true if all the elements in its
argument list are distinct, and false otherwise. The
procedure xor returns true if only one of its two
arguments is true, and false otherwise.
Typing (solve-kalotan-puzzle) will solve the puzzle.
14.4.2 Map coloring
It has been known for some time (but only lately
proven) that four colors suffice to color a terrestrial
map -- ie, to color the countries so that neighbors
are distinguished. To actually assign the colors is
still an undertaking, and the following program shows
how nondeterministic programming can help.
The following program solves the problem of coloring a
map of Western Europe. The problem and a Prolog
solution are given in The Art of
Prolog (It is instructive to compare
our solution with the book's.)
The procedure choose-color nondeterministically
returns one of four colors:
(define choose-color
(lambda ()
(amb 'red 'yellow 'blue 'white)))
In our solution, we create for each country a data
structure. The data structure is a 3-element list: The
first element of the list is the country's name; the
second element is its assigned color; and the third
element is the colors of its neighbors. Note we use
the initial of the country for its color
variable.7 Eg, the list for Belgium is
(list 'belgium b (list f h l g)), because -- per
the problem statement -- the neighbors of Belgium are
France, Holland, Luxembourg, and Germany.
Once we create the lists for each country, we state the
(single!) condition they should satisfy, viz, no
country should have the color of its neighbors. In
other words, for every country list, the second element
should not be a member of the third element.
(define color-europe
(lambda ()
;choose colors for each country
(let ((p (choose-color)) ;Portugal
(e (choose-color)) ;Spain
(f (choose-color)) ;France
(b (choose-color)) ;Belgium
(h (choose-color)) ;Holland
(g (choose-color)) ;Germany
(l (choose-color)) ;Luxemb
(i (choose-color)) ;Italy
(s (choose-color)) ;Switz
(a (choose-color)) ;Austria
)
;construct the adjacency list for
;each country: the 1st element is
;the name of the country; the 2nd
;element is its color; the 3rd
;element is the list of its
;neighbors' colors
(let ((portugal
(list 'portugal p
(list e)))
(spain
(list 'spain e
(list f p)))
(france
(list 'france f
(list e i s b g l)))
(belgium
(list 'belgium b
(list f h l g)))
(holland
(list 'holland h
(list b g)))
(germany
(list 'germany g
(list f a s h b l)))
(luxembourg
(list 'luxembourg l
(list f b g)))
(italy
(list 'italy i
(list f a s)))
(switzerland
(list 'switzerland s
(list f i a g)))
(austria
(list 'austria a
(list i s g))))
(let ((countries
(list portugal spain
france belgium
holland germany
luxembourg
italy switzerland
austria)))
;the color of a country
;should not be the color of
;any of its neighbors
(for-each
(lambda (c)
(assert
(not (memq (cadr c)
(caddr c)))))
countries)
;output the color
;assignment
(for-each
(lambda (c)
(display (car c))
(display " ")
(display (cadr c))
(newline))
countries))))))
Type (color-europe) to get a color assignment.
6 This
puzzle is due to Hunter.
7 Spain (Espana) has e so as not to
clash with Switzerland.
Prev Up Next