(defparameter *default-colors*
'(red green blue yellow cyan magenta))
(defvar *colors*)
(defvar *constraints*)
(defvar *places*)
(defun generate-all (&optional (places *places*))
(if (= places 0)
'(nil)
(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))
*constraints*)))
(defun guess ()
(elt *constraints* (random (length *constraints*))))
(defun read-number (str)
(format t (concatenate 'string "~&" str " "))
(read))
(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))
(finally
(if quiet
(return guesses)
(format t "I have guessed it in ~d steps.~%" guesses))))))
(defun test-average (games)
(+ (/ (iter (repeat games)
(sum (automatic-game :quiet t)))
games)
0.0d0))