Solving Einstein’s Riddle using nondeterministic computing

If you ever read Structure and Interpretation of Computer Programs, you will recall learning about nondeterministic computing, which is a fancy name for backtracking techniques. In section 4.3.2, there are a couple of typical problems for which these techniques are appropriate, the first being the resolution of logic puzzles, and the second a minimal implementation of a natural language parser. Let’s focus on the former. Years ago I remember solving a fun riddle written by Albert Einstein -don’t fret, nothing related to physics-, which I will show below, in case it doesn’t ring a bell. But first of all, I encourage anyone to try to solve it using only its logic skills, since it is a very rewarding experience, especially when its creator declared that “98% of the world population would not be able to solve it”

The Riddle

1. In a town, there are five houses, each painted with a different color.
2. In every house leaves a person of different nationality.
3. Each homeowner drink a different beverage, smokes a different brand of cigar, and owns a different type of pet.

The Question
Who owns the fishes?

Hints

1. The Brit lives in a red house.
2. The Swede keeps dogs as pets.
3. The Dane drinks tea.
4. The Green house is next to, and on the left of the White house.
5. The owner of the Green house drinks coffee.
6. The person who smokes Pall Mall rears birds.
7. The owner of the Yellow house smokes Dunhill.
8. The man living in the center house drinks milk.
9. The Norwegian lives in the first house.
10. The man who smokes Blends lives next to the one who keeps cats.
11. The man who keeps horses lives next to the man who smokes Dunhill.
12. The man who smokes Blue Master drinks beer.
13. The German smokes Prince.
14. The Norwegian lives next to the blue house.
15. The man who smokes Blends has a neighbor who drinks water.

This seemed a bit of neat problem to solve using the material explained in the book, just for fun. We will use both helper procedures defined in the text:

(define (require p)
  (if (not p) (amb)))

and

(define (distinct? items)
  (cond ((null? items) true)
        ((null? (cdr items)) true)
        ((member (car items) (cdr items)) false)
        (else (distinct? (cdr items)))))

Also, the houses will be abstracted using a constructor and several selector procedures. The constructor simply glues together the information related to a house:

(define (make-house number color pet beverage nationality cigar)
  (list number color pet beverage nationality cigar))

The selectors are responsible for the extraction of the information of a house we are interested on:

(define (number-of house) (car house))
(define (color-of house) (car (cdr house)))
(define (pet-of house) (car (cdr (cdr house))))
(define (beverage-of house) (car (cdr (cdr (cdr house)))))
(define (nationality-of house) (car (cdr (cdr (cdr (cdr house))))))
(define (cigar-of house) (car (cdr (cdr (cdr (cdr (cdr house)))))))

Every house, in order to be eligible for a solution, must fulfill a set of rules as described in the hints list above, namely:

(define (required-rules house)
  (if (eq? (color-of house) 'red) ;by hint 1
      (require (eq? (nationality-of house) 'British)))
  (if (eq? (nationality-of house) 'British) ; by hint 1
      (require (eq? (color-of house) 'red)))
  (if (eq? (nationality-of house) 'Swede) ; by hint 2
      (require (eq? (pet-of house) 'dogs)))
  (if (eq? (pet-of house) 'dogs) ; by hint 2
      (require (eq? (nationality-of house) 'Swede)))
  (if (eq? (nationality-of house) 'Dane) ; by hint 3
      (require (eq? (beverage-of house) 'tea)))
  (if (eq? (beverage-of house) 'tea) ; by hint 3
      (require (eq? (nationality-of house) 'Dane)))
  (if (eq? (color-of house) 'green) ; by hint 5
      (require (eq? (beverage-of house) 'coffee)))
  (if (eq? (beverage-of house) 'coffee) ; by hint 5
      (require (eq? (color-of house) 'green)))
  (if (eq? (cigar-of house) 'PallMall) ; by hint 6
      (require (eq? (pet-of house) 'birds)))
  (if (eq? (pet-of house) 'birds) ; by hint 6
      (require (eq? (cigar-of house) 'PallMall)))
  (if (eq? (color-of house) 'yellow) ; by hint 7
      (require (eq? (cigar-of house) 'Dunhill)))
  (if (eq? (cigar-of house) 'Dunhill) ; by hint 7
      (require (eq? (color-of house) 'yellow)))
  (if (eq? (cigar-of house) 'BlueMaster) ; by hint 12
      (require (eq? (beverage-of house) 'beer)))
  (if (eq? (beverage-of house) 'beer) ; by hint 12
      (require (eq? (cigar-of house) 'BlueMaster)))
  (if (eq? (nationality-of house) 'German) ; by hint 13
      (require (eq? (cigar-of house) 'Prince)))
  (if (eq? (cigar-of house) 'Prince) ; by hint 13
      (require (eq? (nationality-of house) 'German))))

In addition, some of the rules are applicable only to the whole set of houses, for instance the positioning of the neighbors. To enforce those rules, the following helper procedure is defined:

(define (index-of value extractor houses)
  (define (iter index rest)
    (cond ((null? rest) 0)
          ((eq? (extractor (car rest)) value) index)
          (else (iter (+ index 1) (cdr rest)))))
  (iter 1 houses))

index-of returns the number of the house whose value matches the argument. For example, (index-of ‘beer beverage-of the-houses) will return the number of the house in which the guy who drinks beer lives. This procedure is used by the actual procedure that deals with global restrictions:

(define (require-global-rules houses)
  (let ((white-index (index-of 'white color-of houses))
        (green-index (index-of 'green color-of houses))
        (blends-index (index-of 'Blends cigar-of houses))
        (cats-index (index-of 'cats pet-of houses))
        (horses-index (index-of 'horses pet-of houses))
        (dunhill-index (index-of 'Dunhill cigar-of houses))
        (water-index (index-of 'water beverage-of houses)))
    (if (and (> green-index 0)
             (> white-index 0))
        (require (= (- white-index green-index) 1))) ; by hint 4
    (if (and (> blends-index 0)
             (> cats-index 0)
             (> water-index 0))
        (begin
          (require (= (abs (- blends-index cats-index)) 1)) ; by hint 10
          (require (= (abs (- blends-index water-index)) 1)))) ; by hint 15
    (if (and (> horses-index 0)
             (> dunhill-index 0))
        (require (= (abs (- horses-index dunhill-index)) 1))))) ; by hint 11

Finally, the main procedure that implements the nondeterministic search:

(define (einsteins-riddle)
  (let ((color-one (amb 'red 'green 'yellow))
        (pet-one (amb 'dogs 'birds 'cats 'horses 'fishes))
        (beverage-one (amb 'tea 'coffee 'beer 'water))
        (nationality-one 'Norwegian) ; by hint 9
        (cigar-one (amb 'PallMall 'Dunhill 'Blends 'BlueMaster 'Prince)))
    (let ((one (make-house 1 color-one pet-one beverage-one nationality-one cigar-one)))
      (required-rules one)
      (let ((color-two 'blue) ; by hint 14
            (pet-two (amb 'dogs 'birds 'cats 'horses 'fishes))
            (beverage-two (amb 'tea 'coffee 'beer 'water))
            (nationality-two (amb 'British 'Swede 'Dane 'German))
            (cigar-two (amb 'PallMall 'Dunhill 'Blends 'BlueMaster 'Prince)))
        (require (distinct? (list pet-one pet-two)))
        (require (distinct? (list beverage-one beverage-two)))
        (require (distinct? (list cigar-one cigar-two)))
        (let ((two (make-house 2 color-two pet-two beverage-two nationality-two cigar-two)))
          (required-rules two)
          (let ((color-three (amb 'red 'green 'yellow))
                (pet-three (amb 'dogs 'birds 'cats 'horses 'fishes))
                (beverage-three 'milk) ; by hint 8
                (nationality-three (amb 'British 'Swede 'Dane 'German))
                (cigar-three (amb 'PallMall 'Dunhill 'Blends 'BlueMaster 'Prince)))
            (require (distinct? (list color-one color-three)))
            (require (distinct? (list pet-one pet-two pet-three)))
            (require (distinct? (list nationality-two nationality-three)))
            (require (distinct? (list cigar-one cigar-two cigar-three)))
            (let ((three (make-house 3 color-three pet-three beverage-three nationality-three cigar-three)))
              (required-rules three)
              (let ((color-four (amb 'red 'green 'white 'yellow))
                    (pet-four (amb 'dogs 'birds 'cats 'horses 'fishes))
                    (beverage-four (amb 'tea 'coffee 'beer 'water))
                    (nationality-four (amb 'British 'Swede 'Dane 'German))
                    (cigar-four (amb 'PallMall 'Dunhill 'Blends 'BlueMaster 'Prince)))
                (require (distinct? (list color-one color-three color-four)))
                (require (distinct? (list pet-one pet-two pet-three pet-four)))
                (require (distinct? (list beverage-one beverage-two beverage-four)))
                (require (distinct? (list nationality-two nationality-three nationality-four)))
                (require (distinct? (list cigar-one cigar-two cigar-three cigar-four)))
                (let ((four (make-house 4 color-four pet-four beverage-four nationality-four cigar-four)))
                  (required-rules four)
                  (let ((color-five (amb 'red 'green 'white 'yellow))
                        (pet-five (amb 'dogs 'birds 'cats 'horses 'fishes))
                        (beverage-five (amb 'tea 'coffee 'beer 'water))
                        (nationality-five (amb 'British 'Swede 'Dane 'German))
                        (cigar-five (amb 'PallMall 'Dunhill 'Blends 'BlueMaster 'Prince)))
                    (require (distinct? (list color-one color-three color-four color-five)))
                    (require (distinct? (list pet-one pet-two pet-three pet-four pet-five)))
                    (require (distinct? (list beverage-one beverage-two beverage-four beverage-five)))
                    (require (distinct? (list nationality-two nationality-three nationality-four nationality-five)))
                    (require (distinct? (list cigar-one cigar-two cigar-three cigar-four cigar-five)))
                    (let ((five (make-house 5 color-five pet-five beverage-five nationality-five cigar-five)))
                      (required-rules five)
                      (require-global-rules (list one two three four five))
                      (list one two three four five))))))))))))

This procedure might seem threatening, but it is quite easy to follow. For each generated house, we require that:

1. It complies with the rules enforced by the procedure required-rules.
2. Its items are different than those of the previous houses.

After the fifth house is generated, we apply require-global-rules to filter the final solutions that are returned as a value of einsteins-riddle.

Solving the Riddle
When we pass the expression (einsteins-riddle) to the underlying nondeterministic interpreter, the final and unique solution is computed and returned:

;;; Amb-Eval input:

;;; Starting a new problem
;;; Amb-Eval value:
((1 yellow cats water Norwegian Dunhill) (2 blue horses tea Dane Blends) (3 red birds milk British PallMall) (4 green fishes coffee German Prince) (5 white dogs beer Swede BlueMaster))

;;; Amb-Eval input:
try-again

;;; There are no more values of
(einsteins-riddle)

Or more viewable:

	House 1	House 2	House 3	House 4	House 5
Color	yellow	blue	red	green	white
Pet	cats	horses	birds	fishes	dogs
Beverage	water	tea	milk	coffee	beer
Nationality	Norwegian	Dane	British	German	Swede
Cigar	Dunhill	Blends	Pall Mall	Prince	Blue Master

I wonder if this qualifies this program as part of that 2% the world population able to solve the Einstein’s Riddle…

You might want to have a look at how search optimization sucks, click here.
To subscribe to the "Guy WhoSteals" feed, click here.
You can add yourself to the GuyWhoSteals fanpage on Facebook or follow GuyWhoSteals on Twitter.
Read the personal side of me here.