Mini Kanren and the Da Vinci challenge

The film adaption of Dan Brown's bestseller "The Da Vinci Code" is about to be released. This prompted the marketing people of Colombia Pictures and Google to create the Google Da Vinci Quest. The quest consists of 24 puzzles to be solved. To avoid cheating each person can expect to get his own set of puzzles. According to 4-time World Puzzle Championship Individual Winner and co-creator of the quest Wei-Hwa Huang there is a total of 12,358 puzzles.


The first class of puzzle is a board puzzle. A 4x4 board needs to be filled with symbols in such a way that all symbols in each row, column and colored areas are different. The symbols given are 4 blades, 4 fleur-de-lis, 4 omegas and 4 crosses. A few symbols are filled in from the beginning and can't be moved. [The image above shows a different puzzle than the one solved below.]


The puzzle I got was easy, but in anticipation of more challenging puzzles ahead, I decided to dust of my copy of The Reasoned Schemer by Daniel P. Friedman, William E. Byrd and Oleg Kiselyov. The book teaches the logic programming as a natural extension of functional programming, and the paradigm of logic programming fits this puzzle perfectly. The book is very enjoyable, but be careful it might hurt your weight.

The logic programming system used by The Reasoned Schmer is MiniKanren. It is a much simplified version of Kanren and runs in any R5RS Scheme. Without further ado here is a MiniKanren program to solve the board puzzles from the Da Vinci Quest:

(define distinct
  (lambda (x1 x2 x3 x4)
    (let ([xs (list x1 x2 x3 x4)])
      (all
       (membero 'blade xs)
       (membero 'cross xs)
       (membero 'fleur xs)
       (membero 'omega xs)))))

> (run* (b)
     (fresh (x1 x2 x3 x4 
                x5 x6 x7 x8 
                x9 x10 x11 x12
                x13 x14 x15 x16)
            (alli
             ; the board consists of fields fields
             (== b (list (list x1  x2  x3  x4)
                         (list x5  x6  x7  x8)
                         (list x9  x10 x11 x12)
                         (list x13 x14 x15 x16)))
             (== b (list (list x1  x2     x3  x4)
                         (list x5  x6     x7  'blade)
                         (list x9  'omega x11 x12)
                         (list x13 'fleur x15 'cross)))
             ; symbols in rows are distinct
             (distinct x1  x2  x3  x4)
             (distinct x5  x6  x7  x8)
             (distinct x9  x10 x11 x12)
             (distinct x13 x14 x15 x16)
             ; symbols in columns are distinct
             (distinct x1  x5 x9  x13)
             (distinct x2  x6 x10 x14)
             (distinct x3  x7 x11 x15)
             (distinct x4  x8 x12 x16)
             ; symbols in each colored area are distinct
             (distinct x3 x4  x7  x8)
             (distinct x9 x13 x14 x15)
             )))

(((fleur blade cross omega) 
  (omega cross fleur blade) 
  (cross omega blade fleur) 
  (blade fleur omega cross)))
#<procedure:succeed>