;; lib/minikanren/tests/classics.sx — small classic-style puzzles that ;; exercise the full system end to end (relations + conde + matche + ;; fresh + run*). Each test is a self-contained miniKanren program. ;; ----------------------------------------------------------------------- ;; Pet puzzle (3 friends, 3 pets, 1-each). ;; ----------------------------------------------------------------------- (mk-test "classics-pet-puzzle" (run* q (fresh (a b c) (== q (list a b c)) (permuteo (list :dog :cat :fish) (list a b c)) (== b :fish) (conde ((== a :cat)) ((== a :fish))))) (list (list :cat :fish :dog))) ;; ----------------------------------------------------------------------- ;; Family-relations puzzle (uses membero on a fact list). ;; ----------------------------------------------------------------------- (define parent-facts (list (list "alice" "bob") (list "alice" "carol") (list "bob" "dave") (list "carol" "eve") (list "dave" "frank"))) (define parento (fn (x y) (membero (list x y) parent-facts))) (define grandparento (fn (x z) (fresh (y) (parento x y) (parento y z)))) (mk-test "classics-grandparents-of-frank" (run* q (grandparento q "frank")) (list "bob")) (mk-test "classics-grandchildren-of-alice" (run* q (grandparento "alice" q)) (list "dave" "eve")) ;; ----------------------------------------------------------------------- ;; Symbolic differentiation, matche-driven. ;; Variable :x: d/dx x = 1 ;; Sum (:+ a b): d/dx (a+b) = (da + db) ;; Product (:* a b): d/dx (a*b) = (da*b + a*db) ;; ----------------------------------------------------------------------- (define diffo (fn (expr var d) (matche expr (:x (== d 1)) ((:+ a b) (fresh (da db) (== d (list :+ da db)) (diffo a var da) (diffo b var db))) ((:* a b) (fresh (da db) (== d (list :+ (list :* da b) (list :* a db))) (diffo a var da) (diffo b var db)))))) (mk-test "classics-diff-of-x" (run* q (diffo :x :x q)) (list 1)) (mk-test "classics-diff-of-x-plus-x" (run* q (diffo (list :+ :x :x) :x q)) (list (list :+ 1 1))) (mk-test "classics-diff-of-x-times-x" (run* q (diffo (list :* :x :x) :x q)) (list (list :+ (list :* 1 :x) (list :* :x 1)))) (mk-tests-run!)