Using core.logic to solve a puzzle in a game

puzzle.clj

(ns puzzle
  (:require [clojure.core.logic :as l]))
;; At the dinner party were Lady Winslow, Doctor Marcolla, Countess Contee, Madam
;; Natsiou, and Baroness Finch.

;; The women sat in a row. They all wore different colors and [Doctor Marcolla] wore a
;; jaunty [white] hat. [Natsiou] was at the far left, next to the guest wearing
;; a [red] jacket. The lady in [blue] sat left of someone in [purple]. I remember
;; that [blue] outfit because the woman spilled her [rum] all over it. The
;; traveler from [dabrovka] was dressed entirely in [green]. When one of the dinner
;; guests bragged about her [snuff tin], the woman next to her said they were finer
;; in [dabrovka], where she lived.

;; So [Countess Contee] showed off a prized [diamond], at which the lady from [baelon]
;; scoffed, saying it was no match for her [bird pendant]. Someone else carried a
;; valuable [ring] and when she saw it, the visitor from [karnaca] next to her
;; almost spilled her neighbor's [wine]. [Baroness Finch] raised her [absinthe] in toast.
;; The lady from [fraeport], full of [whiskey], jumped up onto the table falling onto the
;; guest in the center seat, spilling the poor woman's [beer]. Then [Lady Winslow]
;; captivated them all with a story about her wild youth in [dunwall].

;; In the morning there were four heirlooms under the
;; table: [war medal], [diamond], [ring], and [tin].

;; But who owned each?

(def positions [:far-left :left :center :right :far-right])
(def colors    [:green :white :red :blue :purple])
(def drinks    [:rum :beer :wine :whiskey :absinthe])
(def origins   [:karnaca :dabrovka :dunwall :fraeport :baelon])
(def items     [:medal :bird :ring :tin :diamond])
(def names     [:m :w :c :n  :f])

(defn solve []
  (l/run 1 [p1 p2 p3 p4 p5
           c1 c2 c3 c4 c5
           d1 d2 d3 d4 d5
           o1 o2 o3 o4 o5
           n1 n2 n3 n4 n5
           i1 i2 i3 i4 i5]
    (l/fresh [one two three four five]
      ;;model by seating order.
      (l/== one   [n1 c1 o1 p1 i1 d1]) ;;natsou.
      (l/== two   [n2 c2 o2 p2 i2 d2])
      (l/== three [n3 c3 o3 p3 i3 d3])
      (l/== four  [n4 c4 o4 p4 i4 d4])
      (l/== five  [n5 c5 o5 p5 i5 d5])

      (l/== [p1 p2 p3 p4 p5]
            [:far-left :left :center :right :far-right])

      ;;natsou is on the far left, next to red.
      ;;I think we know by elimination natsou is green,
      ;;but we'll let the solver determine it.
      (l/== [n1 c1 p1] [:n c1 #_:green :far-left]) 
      ;;red is left
      (l/== [c2 p2]    [:red  :left])
      ;;center drinks beer.
      (l/== [p3 d3]    [:center :beer])

      (l/distincto [c1 c2 c3 c4 c5])
      (l/membero c1 colors)
      (l/membero c2 colors)
      (l/membero c3 colors)
      (l/membero c4 colors)
      (l/membero c5 colors)

      (l/distincto [o1 o2 o3 o4 o5])
      (l/membero o1 origins)
      (l/membero o2 origins)
      (l/membero o3 origins)
      (l/membero o4 origins)
      (l/membero o5 origins)

      (l/distincto [i1 i2 i3 i4 i5])
      (l/membero i1 items)
      (l/membero i2 items)
      (l/membero i3 items)
      (l/membero i4 items)
      (l/membero i5 items)

      (l/distincto [d1 d2 d3 d4 d5])
      (l/membero d1 drinks)
      (l/membero d2 drinks)
      (l/membero d3 drinks)
      (l/membero d4 drinks)
      (l/membero d5 drinks)


      (l/fresh [name->color
                name->item
                name->drink
                name->origin
                origin->drink
                origin->item
                color->drink]
        (l/== name->color   [[n1 c1] [n2 c2] [n3 c3] [n4 c4] [n5 c5]])
        (l/== name->item    [[n1 i1] [n2 i2] [n3 i3] [n4 i4] [n5 i5]])
        (l/== name->drink   [[n1 d1] [n2 d2] [n3 d3] [n4 d4] [n5 d5]])
        (l/== name->origin  [[n1 o1] [n2 o2] [n3 o3] [n4 o4] [n5 o5]])
        (l/== origin->drink [[o1 d1] [o2 d2] [o3 d3] [o4 d4] [o5 d5]])
        (l/== origin->item  [[o1 i1] [o2 i2] [o3 i3] [o4 i4] [o5 i5]])
        (l/== color->drink  [[c1 d1] [c2 d2] [c3 d3] [c4 d4] [c5 d5]])

        (l/fresh [mname mc
                  fname fd
                  forigin fdrink
                  wname worigin
                  cname citem
                  borigin item
                  blue bdrink
                  dcolor dorigin db-item]
          ;;we know marcolla is white.
          (l/== [mname mc] [:m :white])
          (l/membero [mname mc] name->color)
          ;;we know finch drinks absinthe
          (l/==  [fname fd] [:f :absinthe])
          (l/membero [fname fd] name->drink)
          ;;we know fraeport drinks whiskey
          (l/== [forigin fdrink] [:fraeport :whiskey])
          (l/membero [forigin fdrink] origin->drink)
          ;;we know winslow is from dunwall
          (l/==  [wname worigin] [:w :dunwall])
          (l/membero [wname worigin] name->origin)
          ;;we know contess has a diamond
          (l/== [cname citem] [:c :diamond])
          (l/membero [cname citem] name->item)
          ;;we know baelon has the bird
          (l/== [borigin item] [:baelon :bird])
          (l/membero [borigin item] origin->item)
          ;;blue drinks rum
          (l/== [blue bdrink] [:blue :rum])
          (l/membero [blue bdrink] color->drink)
          ;;dabovka is in green, dabovka is next to the tin!
          (l/membero db-item [:medal :bird :ring :diamond])
          (l/== [dcolor dorigin] [:green :dabrovka])
          (l/membero [dcolor dorigin db-item]
                     [[c1 o1 i1] [c2 o2 i2] [c3 o3 i3] [c4 o4 i4] [c5 o5 i5]])
          (l/conde
           [(l/== o1 :dabrovka)  ;far-left
            (l/== i2  :tin)]   ;tin left

           [(l/==  o2  :dabrovka) ;;left
            (l/conde [(l/==  i3 :tin)] ;;tin center or far-left
                     [(l/==  i1 :tin)])]

           [(l/==  o3 :dabrovka) ;;center
            (l/conde [(l/== i2 :tin)]  ;;tin left or right
                     [(l/== i4 :tin)])]
           [(l/== o4 :dabrovka)  ;;right
            (l/conde [(l/== i3 :tin)] ;;tin center or far right
                     [(l/== i5 :tin)])]
           [(l/== o5 :dabrovka)  ;;far right, tin right
            (l/conde [(l/== i4 :tin)])])

          ;;karnaca does not have ring, but is next to it.
          (l/conde
           [(l/== o1 :karnaca)  ;far-left
            (l/== i2  :ring)]   ;ring left

           [(l/==  o2  :karnaca) ;;left
            (l/conde [(l/==  i3 :ring)] ;;ring center or far-left
                     [(l/==  i1 :ring)])]

           [(l/==  o3 :karnaca) ;;center
            (l/conde [(l/== i2 :ring)]  ;;ring left or right
                     [(l/== i4 :ring)])]
           [(l/== o4 :karnaca)  ;;right
            (l/conde [(l/== i3 :ring)] ;;ring center or far right
                     [(l/== i5 :ring)])]
           [(l/== o5 :karnaca)  ;;far right, ring right
            (l/conde [(l/== i4 :ring)])])

          ;;karnaca does not have wine, but is next to wine.
          (l/conde
           [(l/== o1 :karnaca)  ;far-left
            (l/== d2  :wine)]   ;ring left

           [(l/==  o2  :karnaca) ;;left
            (l/conde [(l/==  d3 :wine)] ;;ring center or far-left
                     [(l/==  d1 :wine)])]

           [(l/==  o3 :karnaca) ;;center
            (l/conde [(l/== d2 :wine)]  ;;ring left or right
                     [(l/== d4 :wine)])]
           [(l/== o4 :karnaca)  ;;right
            (l/conde [(l/== d3 :wine)] ;;ring center or far right
                     [(l/== d5 :wine)])]
           [(l/== o5 :karnaca)  ;;far right, ring right
            (l/conde [(l/== d4 :wine)])])
        ;;blue left of purple
          (l/conde [(l/== [c1 c2] [:blue :purple])]
                   [(l/== [c2 c3] [:blue :purple])]
                   [(l/== [c3 c4] [:blue :purple])]
                   [(l/== [c4 c5] [:blue :purple])]))))))


(defn readable-result [answer]
  (let [[p1 p2 p3 p4 p5
         c1 c2 c3 c4 c5
         d1 d2 d3 d4 d5
         o1 o2 o3 o4 o5
         n1 n2 n3 n4 n5
         i1 i2 i3 i4 i5]  answer]
    [[p1 c1 d1 o1 n1 i1]
     [p2 c2 d2 o2 n2 i2]
     [p3 c3 d3 o3 n3 i3]
     [p4 c4 d4 o4 n4 i4]
     [p5 c5 d5 o5 n5 i5]]))

;;(->> (solve) readable-result)
;;[[:far-left :green :wine :dabrovka :n :ring]
;; [:left :red :absinthe :karnaca :f :tin]
;; [:center :white :beer :baelon :m :bird]
;; [:right :blue :rum :dunwall :w :medal]
;; [:far-right :purple :whiskey :fraeport :c :diamond]]