Data commit

Task/Zebra-puzzle/Clojure/zebra-puzzle-1.clj

@@ -0,0 +1,42 @@
+(ns zebra.core
+  (:refer-clojure :exclude [==])
+  (:use [clojure.core.logic]
+        [clojure.tools.macro :as macro]))
+
+(defne lefto [x y l]
+       ([_ _ [x y . ?r]])
+       ([_ _ [_ . ?r]] (lefto x y ?r)))
+
+(defn nexto [x y l]
+  (conde
+    ((lefto x y l))
+    ((lefto y x l))))
+
+(defn zebrao [hs]
+  (macro/symbol-macrolet [_ (lvar)]
+    (all
+      (== [_ _ _ _ _] hs)
+      (membero ['englishman _ _ _ 'red] hs)
+      (membero ['swede _ _ 'dog _] hs)
+      (membero ['dane _ 'tea _ _] hs)
+      (lefto [_ _ _ _ 'green] [_ _ _ _ 'white] hs)
+      (membero [_ _ 'coffee _ 'green] hs)
+      (membero [_ 'pallmall _ 'birds _] hs)
+      (membero [_ 'dunhill _ _ 'yellow] hs)
+      (== [_ _ [_ _ 'milk _ _] _ _ ] hs)
+      (firsto hs ['norwegian _ _ _ _])
+      (nexto [_ 'blend _ _ _] [_ _ _ 'cats _ ] hs)
+      (nexto [_ _ _ 'horse _] [_ 'dunhill _ _ _] hs)
+      (membero [_ 'bluemaster 'beer _ _] hs)
+      (membero ['german 'prince _ _ _] hs)
+      (nexto ['norwegian _ _ _ _] [_ _ _ _ 'blue] hs)
+      (nexto [_ _ 'water _ _] [_ 'blend _ _ _] hs)
+      (membero [_ _ _ 'zebra _] hs))))
+
+(let [solns (run* [q] (zebrao q))
+      soln (first solns)
+      zebra-owner (->> soln (filter #(= 'zebra (% 3))) first (#(% 0)))]
+  (println "solution count:" (count solns))
+  (println "zebra owner is the" zebra-owner)
+  (println "full solution (in house order):")
+  (doseq [h soln] (println " " h)))

Task/Zebra-puzzle/Clojure/zebra-puzzle-2.clj

@@ -0,0 +1,47 @@
+(ns zebra
+  (:require [clojure.math.combinatorics :as c]))
+
+(defn solve []
+  (let [arrangements (c/permutations (range 5))
+        before? #(= (inc %1) %2)
+        after? #(= (dec %1) %2)
+        next-to? #(or (before? %1 %2) (after? %1 %2))]
+    (for [[english swede dane norwegian german :as persons] arrangements
+          :when (zero? norwegian)
+          [red green white yellow blue :as colors] arrangements
+          :when (before? green white)
+          :when (= english red)
+          :when (after? blue norwegian)
+          [tea coffee milk beer water :as drinks] arrangements
+          :when (= 2 milk)
+          :when (= dane tea)
+          :when (= coffee green)
+          [pall-mall dunhill blend blue-master prince :as cigs] arrangements
+          :when (= german prince)
+          :when (= yellow dunhill)
+          :when (= blue-master beer)
+          :when (after? blend water)
+          [dog birds cats horse zebra :as pets] arrangements
+          :when (= swede dog)
+          :when (= pall-mall birds)
+          :when (next-to? blend cats)
+          :when (after? horse dunhill)]
+      (->> [[:english :swede :dane :norwegian :german]
+            [:red :green :white :yellow :blue]
+            [:tea :coffee :milk :beer :water]
+            [:pall-mall :dunhill :blend :blue-master :prince]
+            [:dog :birds :cats :horse :zebra]]
+           (map zipmap [persons colors drinks cigs pets])))))
+
+
+(defn -main [& _]
+  (doseq [[[persons _ _ _ pets :as solution] i]
+          (map vector (solve) (iterate inc 1))
+          :let [zebra-house (some #(when (= :zebra (val %)) (key %)) pets)]]
+    (println "solution" i)
+    (println "The" (persons zebra-house) "owns the zebra.")
+    (println "house nationality color   drink   cig          pet")
+    (println "----- ----------- ------- ------- ------------ ------")
+    (dotimes [i 5]
+      (println (apply format "%5s %-11s %-7s %-7s %-12s %-6s"
+                      (map #(% i) (cons inc solution)))))))