;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Author: Steve Lombardi
;	http://www.stephenlombardi.com/
; Date: July 23rd, 2008
; Description: 
;	Generates the possible configurations
; 	of mines in a minesweeper game, given
;	the current state of the game
;
; To make it work:
;	See the example at the bottom
;
; MIT license
; I make no garuntees that this software
; doesn't become self aware and take over
; the world.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;; Combination generating functions ;;;;;
; useful outside the scope of this project
; (and took me the longest to code)

(defun Combo-OK (groupset maxsizes)
	"Checks to make sure the size of each group is equal to the cooresponding size in the maxsizes array"
	(every '= (map 'list 'length groupset) maxsizes) 
)

(defun GenCombosR (set pos groupset maxsizes)
	"Recursive function to generate combination for a particular set and grouping"
	(push (car set) (nth pos groupset))
	(if (not (null (cdr set)))
		(loop for i from 0 below (length groupset) append
			(GenCombosR (cdr set) i (copy-list groupset) maxsizes)
		)
		(when (Combo-OK groupset maxsizes)
			(list groupset)
		)
	)
)

; GenCombos takes a set of elements and a list of maxsizes
; and returns a list of all unique combinations of every
; set element within a number of groups. This is best
; explained with an example: If I have a set of 3 elements
; (set=(a b c)) and want to pack them into two groups of
; sizes two and one (maxsizes=(2 1)) there are three 
; possible ways to do that:
; 1) (a b) in one group, (c) in the other
; 2) (a c) in one group, (b) in the other
; 3) (b c) in one group, (a) in the other
; A call to GenCombos with that data would look like this:
;	(GenCombos '(a b c) '(2 1))
; and would return this:
;	(((a b)(c)) ((a c)(b)) ((b c)(a)))
(defun GenCombos (set maxsizes)
	(loop for i from 0 below (length maxsizes) append
		(GenCombosR set i (make-list (length maxsizes)) maxsizes)
	)
)

;;;;; Matrix manipulating functions ;;;;;
; somewhat useful outside the scope of minesweeper

(defmacro GetMatrixElement (matrix width height x y)
	"Checks bounds and returns the element at position y * width + x"
	`(if (and (>= ,x 0) (< ,x ,width) (>= ,y 0) (< ,y ,height))
		(nth (+ ,x (* ,y ,width)) ,matrix)
		nil
	)
)

(defun GetSurroundingElement (matrix width height x y elem)
	"Returns a list of coordinates where a particular element is found in matrix adjacent to (x y)"
	(remove nil 
		(loop for offsety from -1 to 1 append
			(loop for offsetx from -1 to 1 collect
				(if (equal (GetMatrixElement matrix width height (+ x offsetx) (+ y offsety)) elem)
					(list (+ x offsetx) (+ y offsety))
					nil
				)
			)
		)
	)
)

; This function goes through the minesweeper grid
; and calculates the possible configurations for
; each individual cell. For example, in this grid:
; 	? 0 0
;	0 1 ?
;	0 ? 0
; The cell at position (1 1) denotes three
; possible scenarios: (0 0) is a mine, (2 1) is
; a mine, or (1 2) is a mine. This is represented
; in the function by arranging each scenario into
; two groups: the 'mine' group, and the 'not mine'
; group. For scenario one, (0 0) is in the mine
; group, while (2 1) and (1 2) are in the not mine
; group, and so on.
(defun GenMatrixCombos (matrix width height)
	"For each cell in the minesweeper grid, generate combinations for individual cells"
	(loop for y from 0 below height append
		(loop for x from 0 below width collect
			(let ((elem (GetMatrixElement matrix width height x y)))
				(if (or (equal elem '?) (equal elem 0) (equal elem 'x))
					nil
					(let* ((?pos (GetSurroundingElement matrix width height x y '?))
						(minepos (GetSurroundingElement matrix width height x y 'x))
						(minenum (- elem (length minepos))))
						(GenCombos ?pos (list minenum (- (length ?pos) minenum)))
					)
				)
			)
		)
	)
)

; Checks to make sure there is only one coordinate pair per group
; If a coordinate pair is placed in the 'mine' group, and the
; 'not mine' group, then it is an impossible configuration. The
; function returns the configuration if it is possible, nil if
; it isn't.
(defun CheckConfig (config)
	"Checks if a generated configuration is possible"
	(when (null (intersection (first config) (second config) :test 'equal ) )
		(list (remove-duplicates (first config) :test 'equal) (remove-duplicates (second config) :test 'equal))
	)
)

;;;;; Configuration Combining functions ;;;;;

; Combine the 'mine' groups, and the 'not mine' groups
; together, and check the result
(defun CombineConfigs (config1 config2)
	"Combine two potential pairings"
	(CheckConfig (mapcar 'append config1 config2))
)

; mapeachpair example:
; (mapeachpair '* '(1 2) '(3 4))
;; expands to ((* 1 3) (* 1 4) (* 2 3) (* 2 4))
;   => (3 4 6 8)
(defun mapeachpair (func list1 list2)
	"Takes two lists and applys func against each possible pairing"
	(loop for i in list1 append
		(loop for j in list2 collect
			(funcall func i j)
		)
	)
)

(defun Combine2Possibilities (poss1 poss2)
	"Combines two possible configurations of mines by canceling out any impossible configurations"
	(remove nil (mapeachpair 'CombineConfigs poss1 poss2))
)

(defun CombineAllPossibilities (posslist)
	(reduce 'Combine2Possibilities (remove nil posslist))
)

;;;;; Miscellaneous ;;;;;

(defun print-minesweeper (matrix width height)
	"Prints out minesweeper grid"
	(loop for y from 0 below height do
		(loop for x from 0 below width do
			(setf elem (GetMatrixElement matrix width height x y))
			(if (equal elem 0)
				(format t "  ")
				(format t "~a " elem)
			)
		)
		(format t "~%")
	)
)

(defun print-minesweeper-outcomes (matrix width height results)
	"Print out grid with all definite mine and not mine positions"
	(setf definite-mines (reduce 'intersection (mapcar 'first results)))
	(setf definite-not-mines (reduce 'intersection (mapcar 'second results)))
	(loop for y from 0 below height do
		(loop for x from 0 below width do
			(setf elem (GetMatrixElement matrix width height x y))
			(cond ((and (equal elem '?) (find (list x y) definite-mines :test 'equal))
					(format t "X ")
				)
				((and (equal elem '?) (find (list x y) definite-not-mines :test 'equal))
					(format t "n ")
				)
				((equal elem 0)
					(format t "  ")
				)
				(t
					(format t "~a " elem)
				)
			)
		)
		(format t "~%")
	)
)

;;;;; Example ;;;;;

; Example minesweeper state:
; I opened a beginner game and clicked
; around a little and got this state:
(setf board '(
 0 0 0 0 1 ? ? ? ?
 0 0 0 0 1 ? ? 3 ?
 0 0 1 1 2 ? ? ? ?
 0 0 1 ? ? ? ? 1 ?
 0 0 1 2 ? 3 ? ? ?
 0 0 0 1 ? ? ? ? ?
 0 0 1 2 2 1 1 1 1
 0 0 1 ? 1 0 0 0 0
 0 0 1 ? 1 0 0 0 0
))
(setf board-width 9)
(setf board-height 9)

; Print out board
(format t "Board before solution:~%")
(print-minesweeper board board-width board-height)

; Run algorithm
(setf result (CombineAllPossibilities (GenMatrixCombos board board-width board-height)))

; Print results
(format t "Possible mine location sets:~%~{~{~a~*~}~%~}~%" result)
(format t "Definite mine locations:~%~a~%~%" (reduce 'intersection (mapcar 'first result)))
(format t "Definite not mine locations:~%~a~%~%" (reduce 'intersection (mapcar 'second result)))

(format t "Board after solution:~%")
(print-minesweeper-outcomes board board-width board-height result)

; Done!