SketchyLISP Stuff | Copyright (C) 2006 Nils M Holm |
[ More Sketchy LISP Stuff ] |
Conformance: R5RS
Purpose: Solve the Zebra puzzle using Another Micro KANREN (AMK).
Implementation:
(require "amk.scm") (define memb membero) (define (left-of x y l) (let ((vh (var 'h)) (vt (var 't)) (vz (var 'z))) (any (all (conso vh vt l) (caro vt vz) (== vz y) (== vh x)) (all (cdro l vt) (left-of x y vt))))) (define (next-to x y l) (any (left-of x y l) (left-of y x l))) (define (zebra) (run* vq (let ((h (var 'h))) (all (== h (list (list 'norwegian (_) (_) (_) (_)) (_) (list (_) (_) 'milk (_) (_)) (_) (_))) (memb (list 'englishman (_) (_) (_) 'red) h) (left-of (list (_) (_) (_) (_) 'green) (list (_) (_) (_) (_) 'ivory) h) (next-to (list 'norwegian (_) (_) (_) (_)) (list (_) (_) (_) (_) 'blue) h) (memb (list (_) 'kools (_) (_) 'yellow) h) (memb (list 'spaniard (_) (_) 'dog (_)) h) (memb (list (_) (_) 'coffee (_) 'green) h) (memb (list 'ukrainian (_) 'tea (_) (_)) h) (memb (list (_) 'luckystrikes 'orangejuice (_) (_)) h) (memb (list 'japanese 'parliaments (_) (_) (_)) h) (memb (list (_) 'oldgolds (_) 'snails (_)) h) (next-to (list (_) (_) (_) 'horse (_)) (list (_) 'kools (_) (_) (_)) h) (next-to (list (_) (_) (_) 'fox (_)) (list (_) 'chesterfields (_) (_) (_)) h) (memb (list (_) (_) 'water (_) (_)) h) (memb (list (_) (_) (_) 'zebra (_)) h) (== vq h)))))
[ More Sketchy LISP Stuff ] |