#|  example1  this example takes about 1s to get result.

3 0 0 0 0 0 0 0 0
0 0 0 3 5 0 0 0 2
0 1 2 9 6 0 4 3 5
2 0 0 1 4 5 3 9 8
1 9 8 0 3 0 5 4 6
5 3 4 8 9 6 2 1 7
0 8 5 4 0 0 9 6 0
9 2 1 6 8 3 7 5 4
6 4 0 5 0 9 8 2 0

|#

#|  example2 this example takes about 30s to get result.

0 4 0 0 0 0 0 0 0 
0 0 0 5 6 0 0 0 9
0 0 7 8 0 0 1 0 0
2 0 3 0 0 0 0 5 0
0 0 5 0 8 0 0 3 1
6 0 0 0 0 0 8 0 0
3 0 6 9 0 0 7 0 0
0 5 4 0 3 0 0 0 0
0 0 0 0 5 1 0 0 0

|#

#|  example3 this example takes about 2s to get result.

0 2 7 1 0 0 3 9 0
0 0 1 6 0 9 0 0 0
0 6 3 0 0 0 0 5 0
0 0 2 0 0 0 0 0 0
5 0 9 0 0 0 8 0 4
0 0 0 0 0 0 9 0 0
0 3 0 0 0 0 7 8 0
0 0 0 8 0 7 1 0 0
0 8 4 0 0 2 5 6 0
|#
#|  example4 this example takes about 20min to get result.
0 0 0 9 4 0 0 0 0
1 0 0 0 0 0 0 0 5
0 0 0 0 0 0 0 0 3
0 0 0 0 1 0 4 0 0
5 0 0 0 0 7 9 0 0
0 0 0 0 0 0 0 8 0
0 0 0 0 0 1 2 0 7
0 0 2 0 0 0 0 0 0
0 4 8 0 0 0 0 0 0
|#
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;input task sudoku below
(setf task_sudoku (list
	3 0 0 0 0 0 0 0 0
	0 0 0 3 5 0 0 0 2
	0 1 2 9 6 0 4 3 5
	2 0 0 1 4 5 3 9 8
	1 9 8 0 3 0 5 4 6
	5 3 4 8 9 6 2 1 7
	0 8 5 4 0 0 9 6 0
	9 2 1 6 8 3 7 5 4
	6 4 0 5 0 9 8 2 0
))
;input task sudoku above
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(multiple-value-bind (second minute hour date month year day daylight-p zone)
      (get-decoded-time)
      (progn
		  (setf time (format nil "~A:~A:~A" hour minute second))
		  (setf Datum (format nil "~A.~A.~A" date month year ))))
(display time)

; (setq s (open "e:/sudoku.txt" :direction :input ))
; (setq task_sudoku (loop for i from 1 to 81 collect (read s)))
; (close s)

(setf t-dim 9) ;total dimemsion
(setf s-dim 3) ;sub dimension



(setf sudoku9x9 task_sudoku)

;转成9x9列表 turn to 9x9 list
(setf sudoku9x9  (loop for i from 1 to t-dim  collect (let ((l (butlast sudoku9x9 (- (length sudoku9x9) t-dim))))   (setf sudoku9x9 (nthcdr t-dim sudoku9x9)) l))) 

(mapcar #'display sudoku9x9)

;;找出pos位置上的可能数值 find all possible numbers in position 'pos'
(defun find_avial (pos)  
	(let ( row column possible-list block-row block-column block-list)
		(if (= 0 (nth (- (if (= (mod pos t-dim) 0) t-dim (mod pos t-dim)) 1)  (nth (- (car (last (loop for i from 1 to t-dim when (< (* (- i 1) t-dim) pos) collect i ))) 1) sudoku9x9)))
			(progn
				(setf row (car (last (loop for i from 1 to t-dim when (< (* (- i 1) t-dim) pos) collect i )))) 
				(setf column (if (= (mod pos t-dim) 0) t-dim (mod pos t-dim)))
			
				(setf possible-list (union (nth (- row 1) sudoku9x9) (mapcar #'(lambda (x) (nth (- column 1) x)) sudoku9x9)  ))
				(setf block-row (car (last (loop for i from 1 to s-dim when (< (* (- i 1) s-dim) row) collect i )))) 
				(setf block-column (car (last (loop for i from 1 to s-dim when (< (* (- i 1) s-dim) column) collect i )))) 
				
				(setf block-list (reduce #'append (loop for i from (+ 1 (* s-dim (- block-row 1))) to (* s-dim block-row) collect 
					(loop for j from (+ 1 (* s-dim (- block-column 1))) to (* s-dim block-column) 	
					collect (nth (- j 1) (nth (- i 1) sudoku9x9))))))
				
				(setf possible-list (set-difference (loop for i from 1 to t-dim  collect i) (union possible-list block-list))))
			nil)))
 ;;在可能数值列表中是否有长度1的list,是的话返回t check whether the length of  possible-list equals 1
(defun check_length(x)  
	(reduce #'(lambda (x y) (or x y)) (mapcar #' (lambda (i) (= (length i) 1)) x)))
	
;;找出81个位置的对应可能数值列表 collect possible-list for each pos and make big list.	
(setf avail-value-list (loop for i from 1 to (* t-dim t-dim) collect (find_avial i))) 
																					  
;;如果有长度1的表，迭代更新数独表;运气好直接解出 if there is length=1 sub-list in avail-value-list, make iteration to update avail-value-list
;;if the sudoku is easy, the result will be solved in this iteration.
  
(loop for z from 1 to (* t-dim t-dim)      
	when (check_length avail-value-list)
	do	
		(progn
		(loop for i from 1 to (* t-dim t-dim) when (= 1 (length (nth (- i 1) avail-value-list )))
			do (setf (nth (- (if (= (mod i t-dim) 0) t-dim (mod i t-dim)) 1)  (nth (- (car (last (loop for j from 1 to t-dim when (< (* (- j 1) t-dim) i) collect j ))) 1) sudoku9x9)) 	(car (nth (- i 1) avail-value-list ))))
		(setf avail-value-list (loop for i from 1 to (* t-dim t-dim) collect (find_avial i)))))
	

;(display "*************")
;(mapcar #'display sudoku9x9)

; make index for each pos
(setf index (reduce #'append  (loop for i in sudoku9x9 collect (mapcar #' (lambda (x) (if (equal x 0) t nil)) i))))
;reset avail-value-list nil
(setf avail-value-list (loop for i in task_sudoku collect nil))

;;main solve method, check first avail number in 'pos', if number may fit, goto next downstream 'pos'; if no number fit in this position,
;;goto upstream 'pos', and use the second avial number in this pos.
(defun solve(pos)
	(let ((updown t))           
		(loop (when (null pos) (return-from solve)) 
			(if updown  ;向下找数 if updown t,  solve downstream
			
				(if (= 0 (nth (- (if (= (mod pos t-dim) 0) t-dim (mod pos t-dim)) 1)  (nth (- (car (last (loop for i from 1 to t-dim when (< (* (- i 1) t-dim) pos) collect i ))) 1) sudoku9x9))) 
					;如果Pos是0 if pos value=0, find possible value
					(let ((posvalues (find_avial pos))) 
						;如果在pos没有可填的数，pos的数设为0，pos向上返回一个最近的数
						;if no avial number in 'pos', set pos value 0, find upstream closest 'pos' 
						(if  (null posvalues) 
							(progn 
								(setf (nth (- (if (= (mod pos t-dim) 0) t-dim (mod pos t-dim)) 1)  (nth (- (car (last (loop for i from 1 to t-dim when (< (* (- i 1) t-dim) pos) collect i ))) 1) sudoku9x9)) 0)
									
								(setf pos (car (last (loop for i from 1 to (- pos 1)  when (nth (- i 1) index) collect i))))
								(setf updown nil))
							;如有可填的数，则将Pos设为第1个可填的数，再向下找
							; if there is avail number in 'pos', set pos number (car posvalues), then goto downstream 'pos'
							(progn 
								(setf (nth (- pos 1) avail-value-list) posvalues)
								(setf (nth (- (if (= (mod pos t-dim) 0) t-dim (mod pos t-dim)) 1)  (nth (- (car (last (loop for i from 1 to t-dim when (< (* (- i 1) t-dim) pos) collect i ))) 1) sudoku9x9)) 	(car posvalues))
								(setf updown t)
								(setf pos (car (loop for i from (+ pos 1) to (* t-dim t-dim)  when (nth (- i 1) index) collect i))))))
						
					(progn
						(setf updown t)
						(setf pos (car (loop for i from (+ pos 1) to (* t-dim t-dim)  when (nth (- i 1) index) collect i)))))
						
				(progn  ;向上找数 if updown nil, solve upstram
					;把可用数字列表去掉第1个已试不行，试第2个数
					;remove the first number in avail-value-list, try the second number in avail-value-list
					(setf (nth (- pos 1) avail-value-list) (cdr (nth (- pos 1) avail-value-list))) 
					(if (nth (- pos 1) avail-value-list)
						(progn 
							
							(setf (nth (- (if (= (mod pos t-dim) 0) t-dim (mod pos t-dim)) 1)  (nth (- (car (last (loop for i from 1 to t-dim when (< (* (- i 1) t-dim) pos) collect i ))) 1) sudoku9x9)) 	(car (nth (- pos 1) avail-value-list)))
							(setf updown t)
							(setf pos (car (loop for i from (+ pos 1) to (* t-dim t-dim)  when (nth (- i 1) index) collect i))))
						(progn 
							(setf (nth (- (if (= (mod pos t-dim) 0) t-dim (mod pos t-dim)) 1)  (nth (- (car (last (loop for i from 1 to t-dim when (< (* (- i 1) t-dim) pos) collect i ))) 1) sudoku9x9)) 0)
							(setf pos (car (last (loop for i from 1 to (- pos 1)  when (nth (- i 1) index) collect i))))
							(setf updown nil))))))))
(solve 1)
(display "*************")
(mapcar #'display sudoku9x9)

(multiple-value-bind (second minute hour date month year day daylight-p zone)
    (get-decoded-time)
    (progn   
		(setf time (format nil "~A:~A:~A" hour minute second))
		(setf Datum (format nil "~A.~A.~A" date month year ))))

(display time)