zebra

Language: R5RS Scheme + AMK

Purpose: Solve the Zebra puzzle using Another Micro KANREN (AMK).

Implementation:

(require "amk.scm")

(define (lefto x y l)
  (fresh (h t ht)
    (any (all (caro l h)
              (cdro l t)
              (caro t ht)  ; ht = head of tail
              (== h x)
              (== ht y))
         (all (cdro l t)
              (lefto x y t)))))

(define (nexto x y l)
  (any (lefto x y l)
       (lefto y x l)))

(define (zebra)
  (fresh (h)
    (run* (h)
      (all
        (== h (list (list 'norwegian (_) (_) (_) (_))
                    (_)
                    (list (_) (_) 'milk (_) (_))
                    (_)
                    (_)))
        (memo (list 'englishman (_) (_) (_) 'red) h)
        (lefto (list (_) (_) (_) (_) 'green)
                 (list (_) (_) (_) (_) 'ivory) h)
        (nexto (list 'norwegian (_) (_) (_) (_))
                 (list (_) (_) (_) (_) 'blue) h)
        (memo (list (_) 'kools (_) (_) 'yellow) h)
        (memo (list 'spaniard (_) (_) 'dog (_)) h)
        (memo (list (_) (_) 'coffee (_) 'green) h) 
        (memo (list 'ukrainian (_) 'tea (_) (_)) h)
        (memo (list (_) 'luckystrikes 'orangejuice (_) (_)) h)
        (memo (list 'japanese 'parliaments (_) (_) (_)) h)
        (memo (list (_) 'oldgolds (_) 'snails (_)) h)
        (nexto (list (_) (_) (_) 'horse (_))
                 (list (_) 'kools (_) (_) (_)) h)
        (nexto (list (_) (_) (_) 'fox (_))
                 (list (_) 'chesterfields (_) (_) (_)) h)
;        (memo (list (_) (_) 'water (_) (_)) h)
        (memo (list (_) (_) (_) 'zebra (_)) h)))))