Skip to content

Instantly share code, notes, and snippets.

@swannodette
Last active December 15, 2018 04:33
Show Gist options
  • Star 4 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save swannodette/5127144 to your computer and use it in GitHub Desktop.
Save swannodette/5127144 to your computer and use it in GitHub Desktop.
(ns logic-play.puzzle
(:refer-clojure :exclude [==])
(:use [clojure.core.logic])
(:require [clojure.tools.macro :as mu]
[clojure.set :as set]
[clojure.core.logic.fd :as fd]))
;; -----
;; CLP(Set) Boilerplate
(defn index [xs] (->> xs (map-indexed (fn [i x] [x (inc i)])) (into {})))
(def p->i
{:name (index [:amaya :bailey :jamari :jason :landon])
:cheese (index [:asiago :blue :mascarpone :mozzarella :muenster])
:mag (index [:fortune :time :cosmopolitan :us-weekly :vogue])
:reserv (index [:5pm :6pm :7pm :730pm :830pm])})
(def i->p (into {} (map (fn [[k v]] [k (set/map-invert v)]) p->i)))
(defn ->answer [m] (into {} (map (fn [[k v]] [k (get-in i->p [k v])]) m)))
(defn ->answers [ms] (map ->answer ms))
;; -----
(defn existso [q ps] (fresh [x] (featurec x ps) (membero x q)))
(defn ruleo [q p v tp tv]
(let [v (if-not (lvar? v) (-> p->i p v) v)
tv (if-not (lvar? tv) (-> p->i tp tv) tv)]
(existso q {p v tp tv})))
(defn neg-ruleo [q p v tp tv]
(let [tv (if-not (lvar? tv) (-> p->i tp tv) tv)]
(fresh [x] (!= x tv) (ruleo q p v tp x))))
(defn earliero [q p v op ov]
(let [v (-> p->i p v)
ov (-> p->i op ov)]
(fresh [x y t0 t1]
(fd/< t0 t1)
(existso q {p v :reserv t0})
(existso q {op ov :reserv t1}))))
(defne peopleo [q ps]
([() _])
([[h . t] _]
(let [[k :as kv] (first ps)]
(featurec h {k (get-in p->i kv)}))
(peopleo t (next ps))))
(defn puzzle []
(let [vs (take 20 (repeatedly lvar))
ps (->> (partition 4 vs)
(map #(into {} (map vector [:name :cheese :mag :reserv] %)))
(into []))]
(run* [q]
(== q ps)
(everyg #(fd/in % (fd/interval 1 5)) vs)
(everyg fd/distinct (apply map vector (map vals ps)))
(conde
[(ruleo q :name :landon :reserv :730pm) (ruleo q :name :jason :cheese :mozzarella)]
[(ruleo q :name :landon :cheese :mozzarella) (ruleo q :name :jason :reserv :730pm)]) ;; 1
(ruleo q :cheese :blue :mag :fortune) ;; 2
(neg-ruleo q :cheese :muenster :mag :vogue) ;; 3
(peopleo q [[:mag :fortune] [:name :landon] [:reserv :5pm]
[:cheese :mascarpone] [:mag :vogue]]) ;; 4
(neg-ruleo q :reserv :5pm :mag :time) ;; 5
(earliero q :mag :cosmopolitan :cheese :mascarpone) ;; 6
(earliero q :cheese :blue :name :bailey) ;; 7
(conde
[(ruleo q :reserv :7pm :mag :fortune)]
[(ruleo q :reserv :730pm :mag :fortune)]) ;; 8
(earliero q :mag :time :name :landon) ;; 9
(neg-ruleo q :name :jamari :mag :fortune) ;; 10
(ruleo q :reserv :5pm :cheese :mozzarella)))) ;; 11
(comment
(time (->answers (first (puzzle))))
;; ~84ms for 1
(dotimes [_ 5] (time (dotimes [_ 10] (->answers (first (puzzle))))))
)
@swannodette
Copy link
Author

@Engleberg, just a typo, fixed thanks!

@danielpcox
Copy link

When I run this I get

java.lang.ClassCastException: java.lang.Long cannot be cast to clojure.lang.IPersistentMap
logic.clj:2450 clojure.core.logic/eval9091[fn]
logic.clj:2472 clojure.core.logic/partial-map
logic.clj:2491 clojure.core.logic/-featurec[fn]
...

I'm using clojure 1.6.0, core.logic 0.8.6, and tools.macro 0.1.2. Are those versions incompatible?

@dkwgit
Copy link

dkwgit commented Sep 3, 2014

@danielpcox, I was getting the same exception. Tried it with core.logic 0.8.1. No exception and it gave the solution.

@dl1ely
Copy link

dl1ely commented May 13, 2015

@dkwgit @danielpcox Same for me, exception with 0.8.10, works fine with 0.8.1
@swannodette Is that some regression in core.logic/featurec, or is the example not supposed to work with recent versions?

@NightMachinery
Copy link

@swannodette Any updates on this regression?

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment