;;; minesweeper-basics.lisp
;;; Implementation of minesweeper 

;;; Key functions are:
;;;    minesweeper-performance, which measures the success rate of an algorithm
;;;       as a function of mine density
;;;    minesweeper, which applies a given algorithm to play minesweeper once
;;;    human-player, which is a skeleton minesweeper agent using human input


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; The world: an array with some number of mines in it.
;;; Square contents: 0 = empty, 1 = mine
;;; Row 0 and column 0 of the array are not used.

(defvar *x* 8)   ;;; horizontal dimension
(defvar *y* 8)   ;;; vertical dimension
(defvar *n* 10)  ;;; default number of mines

(defvar *probed*) ;;; number of mines

;;; make-world constructs a minesweeper board size x*y, n mines, with
;;; no mine at (cx,cy) since that's the first move.

(defun make-world (&optional (x *x*) (y *y*) (n *n*) cx cy)
  (let ((world (make-array (list (1+ x) (1+ y)) :initial-element 0))
	(m 0))
    (loop until (= m n) do
	  (let ((i (1+ (random x))) (j (1+ (random y))))
	    (when (and (zerop (aref world i j)) (or (not (= i cx)) (not (= j cy))))
	      (setf (aref world i j) 1)
	      (incf m))))
     world))

(defun make-display (&optional (x *x*) (y *y*))
  (make-array (list (1+ x) (1+ y)) :initial-element '-))

(defvar *debugging*)

(defun minesweeper (&optional (x *x*) (y *y*) (n *n*) (player #'human-player))
  "Play one minesweeper game on an x by y board with n mines. 
   Return 1 if player wins, 0 otherwise. Set *debugging* to t
   for full display of boards and moves."
  (let ((display (make-display x y)))
    (setq *probed* 0)
    (when *debugging* (print-display display n))
    (let ((c1 (funcall player display n)))
      (cond ((eq (first c1) '?)
	     (let ((world (make-world x y n (second c1) (third c1))))
	       (update-display-probe (second c1) (third c1) display world)
	       (loop until (or (null *probed*) (= *probed* (- (* x y) n))) do
		 (when *debugging* (print-display display n))
		 (let ((c (funcall player display n)))
		   (cond ((eq (first c) 'm) 
			  (update-display-mine (second c) (third c) display world))
			 ((eq (first c) 'u) 
			  (update-display-undo (second c) (third c) display world))
			 ((eq (first c) '?) 
			  (update-display-probe (second c) (third c) display world)))))))))
    (when *debugging* (print-display display n))
    (cond (*probed* (when *debugging* (format t "~%YOU WIN")) 1)
	  (t (when *debugging* (format t "~%YOU LOSE")) 0))))

(defun minesweeper-performance (&optional (x *x*) (y *y*) (player #'human-player) (trials 100) 
				&aux (performance nil))
  "Return an alist of pairs (n . p) where n is the number of mines and
   p is the fractional success rate of the player. By default 100 trials are used
   for each n."
  (loop for n from (- (* x y) 1) downto 0 do
    (let ((wins 0))
      (loop for trial from 1 to trials do
	(incf wins (minesweeper x y n player)))
      (push (cons n (float (/ wins trials))) performance)))
  performance)


(defun human-player (display n) 
  "Returns a move in (f x y) format from human input.
   f is one of 
       m (mark a mine)
       u (undo previous mark)
       ? (probe a square)"
  (declare (ignore display n)) 
  (format t "~%Enter move ")
  (read))
		
		
(defun update-display-probe (i j display world)
  (when (untouched? i j display)
    (cond ((mine? i j world) (setf (aref display i j) 'L *probed* nil))
	  (t (let ((m (count-mines i j world)))
	       (setf (aref display i j) m)
	       (incf *probed*)
	       (when (zerop m) (propagate i j display world)))))))

(defun update-display-mine (i j display world)
  (setf (aref display i j) 'M))

(defun update-display-undo (i j display world)
  (setf (aref display i j) '-))

(defun propagate (i j display world)
  (loop for i2 from (1- i) to (1+ i) do
	(loop for j2 from (1- j) to (1+ j) do
	      (when (inside? i2 j2 world)
		(update-display-probe i2 j2 display world)))))



;;; World functions

(defun mine? (i j world) (plusp (aref world i j)))

(defun count-mines (i j world)
  (let ((m 0))
    (loop for i2 from (1- i) to (1+ i) do
      (loop for j2 from (1- j) to (1+ j) do
	(when (and (inside? i2 j2 world) (mine? i2 j2 world))
	  (incf m))))
    m))

(defun inside? (i j world)
  (and (>= i 1) (>= j 1) 
       (< i (array-dimension world 0)) (< j (array-dimension world 1))))

;;; Display functions

(defun untouched? (i j display) (eq (aref display i j) '-))

(defun count-squares (p display &aux (x (array-dimension display 0))
			             (y (array-dimension display 1)))
  (let ((count 0))
    (loop for i from 1 to (1- x) do
      (loop for j from 1 to (1- y) do
	(when (funcall p i j display) (incf count))))
    count))

(defun marked-mine? (i j display) (eq (aref display i j) 'm))
(defun unknown? (i j display) (eq (aref display i j) '-))

(defun background? (i j display)
  (let ((contents (aref display i j)))
    (and (not (eq contents 'm))
	 (not (numberp contents))
	 (let ((b t))
	   (loop for i2 from (1- i) to (1+ i) do
	     (loop for j2 from (1- j) to (1+ j) do
	       (when (and (inside? i2 j2 display) (numberp (aref display i2 j2)))
		 (setf b nil))))
	   b))))

(defun background-squares (display &aux (x (array-dimension display 0))
				        (y (array-dimension display 1)))
  (let ((squares nil))
    (loop for i from 1 to (1- x) do
      (loop for j from 1 to (1- y) do
	(when (background? i j display) (push (list i j) squares))))
    squares))

(defun print-display (display n &aux (x (array-dimension display 0))
			             (y (array-dimension display 1)))
  (format t "~%Total mines: ~A  To find: ~A~%" n (- n (count-squares #'marked-mine? display)))
  (loop for j from (1- y) downto 1 do
	(format t "~%~A   " j)
	(loop for i from 1 to (1- x) do
	      (format t "~A " (aref display i j))))
  (format t "~%~%   ")
  (loop for i from 1 to (1- x) do (format t "~A " i)))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; General utility functions


(defun random-element (list)
  "Return some element of the list, chosen at random."
  (nth (random (length list)) list))

(defun the-biggest-random-tie (fn l)
  "Return the element of l with the largest value of fn, breaking ties randomly."
  (random-element
   (let ((biggest (list (first l)))
	 (best-val (funcall fn (first l))))
     (dolist (x (rest l))
       (let ((val (funcall fn x)))
	 (cond ((> val best-val)
		(setq best-val val)
		(setq biggest (list x)))
	       ((= val best-val)
		(push x biggest)))))
     biggest)))

(defun the-smallest-random-tie (fn l)
  "Return the element of l with the smallest value of fn, breaking ties randomly."
  (random-element
   (let ((smallest (list (first l)))
	 (best-val (funcall fn (first l))))
     (dolist (x (rest l))
       (let ((val (funcall fn x)))
	 (cond ((< val best-val)
		(setq best-val val)
		(setq smallest (list x)))
	       ((= val best-val)
		(push x smallest)))))
     smallest)))

(defun choose (n k)
  "Returns C(n,k), the number of ways to choose k objects from n."
  (unless (and (>= k 0) (<= k n)) (error "~%Cannot choose ~A out of ~A" k n))
  (/ (factorial n) (* (factorial k) (factorial (- n k)))))

(defun factorial (n)
  (if (zerop n) 1 (* n (factorial (- n 1)))))

(defun plot-alist (alist file)
  "Plots x-y data in alist to a file in a format readable by gnuplot."
  (with-open-file (stream file :direction :output :if-does-not-exist :create
                     :if-exists :supersede)
     (dolist (x.y alist)
       (format stream "~&~G ~G~%" (coerce (car x.y) 'single-float)
	                          (coerce (cdr x.y) 'single-float)))))