;;; Mastermind solver

(defparameter *default-colors*
  '(red green blue yellow cyan magenta))

(defvar *colors*)
(defvar *constraints*)
(defvar *places*)

(defun generate-all (&optional (places *places*))
  (if (= places 0)
      (iter (with rest = (generate-all (1- places)))
            (for c in *colors*)
            (appending (mapcar (lambda (s) (cons c s)) rest)))))

(defun init-game (colors places)
  (setf *colors* colors)
  (setf *places* places)
  (setf *constraints* (generate-all)))

(defun score (secret guess)
  (iter (for color in *colors*)
        (for s-color = (funcall #'count color secret))
        (for g-color = (funcall #'count color guess))
        (for same = (iter (for s in secret)
                          (for g in guess)
                          (count (and (eq s color) (eq s g)))))
        (sum (- (min s-color g-color) same) into white)
        (sum same into black)
        (finally (return (list black white)))))

(defun analyze (guess score)
  (setf *constraints*
        (remove-if-not (lambda (x) (equal (score x guess) score))

(defun guess ()
  (elt *constraints* (random (length *constraints*))))

(defun read-number (str)
  (format t (concatenate 'string "~&" str " "))

(defun start-game (&key (colors *default-colors*) (places 4))
  (format t "There are ~a colors:~%~
             ~{~a~^, ~}~%~
             Choose ~a (you can select a color twice).~%~%~
             Now I will try to guess...~%~%"
          (length colors) colors places)
  (init-game colors places)
  (iter (for guess = (guess))
        (format t "My guess: ~a~%" guess)
        (for guesses upfrom 1)
        (for black = (read-number "How many colors were matched exactly?"))
        (while (< black places))
        (for white = (read-number "How many were on the wrong position?"))
        (analyze guess (list black white))
        (finally (format t "I have guessed it in ~d steps.~%" guesses))))

(defun automatic-game (&key (colors *default-colors*) (places 4) quiet)
  (init-game colors places)
  (let ((secret (guess)))
    (unless quiet
      (format t "There are ~a colors:~%~
             ~{~a~^, ~}~%~
             I have chosen the colors: ~a~%~%~
             Now I will try to guess...~%~%"
              (length colors) colors secret))
    (iter (for guess = (guess))
          (for (black white) = (score secret guess))
          (unless quiet
            (format t "My guess: ~a [~d / ~d]~%" guess black white))
          (for guesses upfrom 1)
          (while (< black places))
          (analyze guess (list black white))
           (if quiet
               (return guesses)
               (format t "I have guessed it in ~d steps.~%" guesses))))))

;;; Gives an average of ~4.6
(defun test-average (games)
  (+ (/ (iter (repeat games)
              (sum (automatic-game :quiet t)))