(in-package :cl-user)


;;;Mickeys Riddle, see generic.lisp
;;;Mickey Mouse loves Gouda
;;;Mighty Mouse's favorite TV show is Emergency Room
;;;The mouse that lives in the left hole never misses an episode of Seinfeld
;;;Mickey Mouse and Mighty Mouse have one mouse hole between them 
;;;The Simpsons fan does not live on the left of the Brie lover

;;;To get a solution, try (test-mickey)
;;;Run tests at least twice to get clos prepared

(eval-when
    (:compile-toplevel :execute :load-toplevel)
  (proclaim '(optimize (speed 0) (safety 3) (space 0)(debug 3)(compilation-speed 0)))
  )

(defclass MICKEY-RIDDLE-SOLVER (riddle-solver)
  ()
  )


(defmethod all-domains-extended ((me mickey-riddle-solver))
  '((:names (:mickey :mighty :minny))
    (:tv (:emergency-room :seinfield :simpsons))
    (:cheese (:gouda :brie :emmental))
    )
  )

(defclass mickey-house ()
  (
   (name :accessor riddle-house-name :initform nil)
   (tv :accessor riddle-house-tv :initform nil)
   (cheese :accessor riddle-house-cheese :initform nil)
   )
  )

(defclass mickey-partial-solution (RIDDLE-PARTIAL-SOLUTION)
  ()
  )

(defconstant +mickey-setf-mapper+ 
    (list 0 #'(setf riddle-house-name)
          1 #'(setf riddle-house-tv)
          2 #'(setf riddle-house-cheese)
          ))

(defmethod element-mapper ((me mickey-partial-solution))
  +mickey-setf-mapper+)

(defconstant +mickey-property-mapper+ 
    (list :name #'riddle-house-name
          :tv #'riddle-house-tv
          :cheese #'riddle-house-cheese))

(defmethod element-property-mapper ((me mickey-partial-solution))
  +mickey-property-mapper+)

(defmethod partial-solution-class ((solver MICKEY-RIDDLE-SOLVER))
  (find-class 'mickey-partial-solution))

(defmethod solution-element-class ((me MICKEY-RIDDLE-SOLVER))
  (find-class 'mickey-house))

(defmethod show-result ((me mickey-house) tries)
  (declare (ignore tries))
  (format t "A house with ")
  (format t "Name ~10a " (riddle-house-name me))
  (format t "Soap ~10a " (riddle-house-tv me))
  (format t "Cheese ~10a~%"(riddle-house-cheese me))
  )

(defmethod initialize-instance :after ((me MICKEY-RIDDLE-SOLVER) &rest initargs)
  (declare (ignore initargs))
  (setf (my-constraints me)
    (list 
     (make-instance 'TWO-VALUES-IN-HOUSE-CONSTRAINT
       :SELECTOR-ONE :name
       :value-one :mickey
       :SELECTOR-two :cheese
       :value-two :gouda)
     
     (make-instance 'TWO-VALUES-IN-HOUSE-CONSTRAINT
       :SELECTOR-ONE :name
       :value-one :MIGHTY
       :SELECTOR-two :tv
       :value-two :emergency-room)
     (make-instance 'POSITION-AND-PROPERTY-CONSTRAINT
       :SELECTOR-ONE :tv
       :VALUE-ONE :seinfield
       :POSITION 0)
     (make-instance 'ABS-DISTANCE-NEIGHBOUR-CONSTRAINT
       :SELECTOR-ONE :NAME
       :VALUE-ONE :MICKEY
       :SELECTOR-TWO :NAME
       :VALUE-TWO :MIGHTY
       :DISTANCE 2)
     (make-instance 'NEGATED-DIRECTED-DISTANCE-NEIGHBOUR-CONSTRAINT
       :SELECTOR-ONE :tv
       :VALUE-ONE :SIMPSONS
       :SELECTOR-TWO :CHEESE
       :VALUE-TWO :brie
       :DISTANCE 1)   
     )))

;;; Test for Mickeys Riddle
(defun test-mickey (&optional (print t))
  (let ((solver (make-instance 'mickey-riddle-solver))
        (solution nil)
        )
    (time (setq solution (solve-it solver)))
    (when print
      (show-result solution (solution-tried solver))
      ))
  (values)
  )


  
  
#|
(test-mickey)
|#

#|

(defparameter *solver* (make-instance 'mickey-riddle-solver))
(defparameter *test* (GENERATE-EMPTY-SOLUTION *solver*))
(PARTIAL-SOLUTION-CORRECT *solver* *test*)

|#

#|
(#(MICKEY GOUDA SEINFELD) #(MINNY BRIE SIMPSONS) #(MIGHTY EMMENTAL ER))

(defparameter *solver* (make-instance 'mickey-riddle-solver))
(defparameter *test* (GENERATE-EMPTY-SOLUTION *solver*))
(EXPAND-PARTIAL-SOLUTION *test* '(:mickey :MINNY :mighty)  0)
(PARTIAL-SOLUTION-CORRECT *solver* *test*)
(EXPAND-PARTIAL-SOLUTION *test* '(:SEINFIELD :SIMPSONS :EMERGENCY-ROOM)  1)
(PARTIAL-SOLUTION-CORRECT *solver* *test*)
(EXPAND-PARTIAL-SOLUTION *test* '(:gouda :brie :emmental)  2)
(PARTIAL-SOLUTION-CORRECT *solver* *test*)

|#