logic.clj

(ns megalogic.core
  (:require [clojure.core.logic :as cl])
  (:gen-class))

(defn parteqo [p1 p2]
  (cl/conde
    [(cl/== p1 :fox-top) (cl/== p2 :fox-bottom)]
    [(cl/== p1 :deer-top) (cl/== p2 :deer-bottom)]
    [(cl/== p1 :racoon-top) (cl/== p2 :racoon-bottom)]
    [(cl/== p2 :fox-top) (cl/== p1 :fox-bottom)]
    [(cl/== p2 :deer-top) (cl/== p1 :deer-bottom)]
    [(cl/== p2 :racoon-top) (cl/== p1 :racoon-bottom)]))

(defn distincto [parts]
  (cl/and*
      (for [a (range (count parts)) b (range (count parts)) :when (> b a)]
        (cl/!= (nth parts a) (nth parts b)))))

(defn memberso [parts pieces]
    (cl/and* (for [a (range (count parts))] (cl/membero (nth parts a) pieces))))

(defn match-sideo [p1 s1 p2 s2]
  (cl/fresh [a b]
    (cond
        (and (= s1 0) (= s2 0)) (cl/all (cl/firsto p1 a) (cl/firsto p2 b) (parteqo a b))
        (and (> s1 0) (> s2 0)) (cl/all (cl/resto p1 a) (cl/resto p2 b) (match-sideo a (dec s1) b (dec s2)))
        (> s1 0) (cl/all (cl/resto p1 a) (match-sideo a (dec s1) p2 s2))
        (> s2 0) (cl/all (cl/resto p2 b) (match-sideo p1 s1 b (dec s2))))))

(defn rotate [piece n] (into [] (take (count piece) (drop n (cycle piece)))))

; Simpler one to test the behaviour
(let [pieces [[:fox-top :deer-top :racoon-top] [:racoon-top :deer-bottom :deer-top] [:racoon-bottom :fox-bottom :fox-top]]
      all-pieces (apply concat (for [i (range 3)] (mapv #(rotate % i) pieces)))
      parts (repeatedly 3 cl/lvar)
      equations [[[0 1] [1 1]]
                 [[1 0] [2 2]]
                 [[0 0] [2 0]]]]
  (cl/run 1 [q]
    (distincto parts)
    (memberso parts all-pieces)
    (cl/and*
      (->> equations
           (map (fn [[[p1 s1] [p2 s2]]] (match-sideo (nth parts p1) s1 (nth parts p2) s2)))
           flatten))
    (cl/== q parts)))


(let [puzzle-pieces { :piece-1 [:fox-top :fox-bottom :deer-top] :piece-2 [:deer-top :fox-bottom :racoon-bottom]
             :piece-3 [:deer-top :fox-bottom :fox-top] :piece-4 [:deer-top :deer-bottom :fox-bottom]
             :piece-5 [:deer-top :racoon-bottom :deer-bottom] :piece-6 [:racoon-bottom :fox-bottom :racoon-top]
             :piece-7 [:fox-bottom :racoon-top :fox-top] :piece-8 [:racoon-top :deer-top :racoon-bottom]
             :piece-9 [:fox-bottom :deer-bottom :deer-top]}
      inverse-puzzle (clojure.set/map-invert puzzle-pieces)
      equations [[[2 2]  [0 2]] [[2 1]  [1 1]] [[5 2]  [1 2]] [[3 0]  [2 0]]
                 [[7 2]  [3 2]] [[5 1]  [4 1]] [[6 0]  [5 0]] [[7 1]  [6 1]]
                 [[7 0]  [8 0]]]
      pieces (apply concat (for [i (range 3)] (mapv #(rotate % i) (vals puzzle-pieces))))
      parts (repeatedly 9 cl/lvar)]
  (cl/run 1
        [q]
        (distincto parts)
        (memberso parts pieces)
        (cl/and*
          (->> equations
               (map (fn [[[p1 s1] [p2 s2]]] (match-sideo (nth parts p1) s1 (nth parts p2) s2)))
               flatten))
        (cl/== q parts)))