gistfile1.clj

(ns monstero.core)

;; Basically this is a change calculator that returns all possible combinations of change for a given 
;; total. Instead of being about money its about monsters for tabletop RPGs. 

(require '[clojure.core.logic :as l]
         '[clojure.core.logic.fd :as fd])


;; Andrew's definition
(defn allocate-monsterso [points monsters out]
  "This relation finds all the allocations of monsters for the given points.
  "
  (l/conde
   ;; if we have no points left, then we get an empty list
   [(fd/<= points 0) 
    (l/== out [])]
   
   [(l/fresh [head 
              cost 
              tail 
              remaining-points 
              rest]
             
             ;; find the current monster and the tail list.
             (l/conso [head cost] tail monsters)

             (l/conde 
              ;; branch one: add one of the current monsters to the list
              ;; subtracting its cost from the points
              [(fd/- points cost remaining-points)
               (fd/<= 0 remaining-points)
               (allocate-monsterso remaining-points monsters rest)
               (l/conso head rest out)]

              ;; branch two: move on to the next monster in the list
              [(allocate-monsterso points tail out)]

              ;; branch three: skip the next monster in the list
              [(l/fresh [_ ttail]
                (l/conso _ ttail tail)
                (allocate-monsterso points ttail out))]))]))

(l/run* [q] 
        (allocate-monsterso
         3 
         [[:a 1] [:b 2] [:c 1]] 
         q))
;; =>
;; ((:a :a :a)
;;  (:a :b)
;;  (:c :c :c)
;;  (:a :a :a)
;;  (:b :c)
;;  (:a :c :c)
;;  (:c :c :c)
;;  (:a :a :a)
;;  (:a :a :c)
;;  (:b :c)
;;  (:c :c :c)
;;  (:a :b)
;;  (:c :c :c)
;;  (:a :c :c)
;;  (:a :a :a)
;;  (:a :b)
;;  (:a :a :c)
;;  (:a :a :a)
;;  (:a :c :c)
;;  (:a :b)
;;  (:a :a :a)
;;  (:a :a :c)
;;  (:a :c :c)
;;  (:a :a :a)
;;  (:a :a :c))



;; Will's version (wallocate-monsterso rather than allocate-monsterso)
(defn pick-monstero [monsters monster cost]
  (l/fresh [m c tail]
    (fd/in cost (fd/interval 0 1000))
    (fd/in c (fd/interval 0 1000))
    (l/conso [m c] tail monsters)
    (fd/< 0 c)
    (l/conde
      [(l/== m monster)
       (l/== c cost)]
      [(l/!= m monster)
       (pick-monstero tail monster cost)])))

(defn wallocate-monsterso [points monsters out]
  (l/fresh []
    (fd/in points (fd/interval 0 1000))
    (l/conde

     [(fd/== points 0) 
      (l/== out [])]
   
     [(l/fresh [monster
                cost
                remaining-points
                res]

               (fd/< 0 points)
               
               (fd/in cost (fd/interval 0 1000))
               (fd/in remaining-points (fd/interval 0 1000))
               
               (l/conso monster res out)
               (fd/- points cost remaining-points)
               (pick-monstero monsters monster cost)
               (wallocate-monsterso remaining-points monsters res))])))

(l/run* [q] 
        (wallocate-monsterso
         3 
         [[:a 1] [:b 2] [:c 1]] 
         q))
;; =>
;; ((:a :b)
;;  (:b :a)
;;  (:a :a :a)
;;  (:b :c)
;;  (:a :a :c)
;;  (:a :c :a)
;;  (:c :b)
;;  (:c :a :a)
;;  (:a :c :c)
;;  (:c :a :c)
;;  (:c :c :a)
;;  (:c :c :c))


(l/run 10 [monsters]
       (l/fresh [out a b]
                (l/== [a b] out)
                (l/membero :a out)
                (l/membero :b out)
                (wallocate-monsterso
                 3
                 monsters
                 out)))
;; =>
;;
;; (([:a 1] [:b 2] . _0)
;;  ([:a 2] [:b 1] . _0)
;;  ([:b 1] [:a 2] . _0)
;;  ([:b 2] [:a 1] . _0)
;;  (([:a 1] [_0 1] [:b 2] . _1) :- (!= (_0 :b)))
;;  (([:a 2] [_0 1] [:b 1] . _1) :- (!= (_0 :b)))
;;  ([:b 1] [:a 2] . _0)
;;  ([:b 2] [:a 1] . _0)
;;  (([:b 1] [_0 1] [:a 2] . _1) :- (!= (_0 :a)))
;;  (([:b 2] [_0 1] [:a 1] . _1) :- (!= (_0 :a))))


(l/run* [q]
            (l/fresh [monsters out a b c d]
              (l/== [monsters out] q)
              (l/== [a b] out)
              (l/== [c d] monsters)
              (l/membero :a out)
              (l/membero :b out)
              (wallocate-monsterso
               3
               monsters
               out)))
;; =>
;; ([[[:a 1] [:b 2]] [:a :b]]
;;  [[[:a 2] [:b 1]] [:a :b]]
;;  [[[:b 1] [:a 2]] [:a :b]]
;;  [[[:b 2] [:a 1]] [:a :b]]
;;  [[[:b 1] [:a 2]] [:b :a]]
;;  [[[:b 2] [:a 1]] [:b :a]]
;;  [[[:a 1] [:b 2]] [:b :a]]
;;  [[[:a 2] [:b 1]] [:b :a]])

(l/run* [q]
            (l/fresh [monsters out a b c d]
               (l/== [monsters out] q)
               (l/== [:a :b] out)
               (l/== [c d] monsters)
               (l/membero :a out)
               (l/membero :b out)
               (wallocate-monsterso
                3
                monsters
                out)))
;; =>
;; ([[[:a 1] [:b 2]] [:a :b]]
;;  [[[:a 2] [:b 1]] [:a :b]]
;;  [[[:b 1] [:a 2]] [:a :b]]
;;  [[[:b 2] [:a 1]] [:a :b]])