Works, but for some sudokus it runs out of stack space
This commit is contained in:
@ -24,6 +24,18 @@
|
||||
(9 nil 2 3 4 5 nil nil 8)
|
||||
(3 4 5 6 7 8 nil 1 2)))
|
||||
|
||||
(define toSolve2
|
||||
'(
|
||||
(2 4 3 1 6 5 7 9 8)
|
||||
(6 1 9 nil nil nil 2 4 5)
|
||||
(5 8 7 nil 4 nil 1 nil 6)
|
||||
(4 nil 6 nil 1 2 9 8 3)
|
||||
(3 9 nil 8 nil 4 6 nil 2)
|
||||
(7 nil nil 6 nil 3 4 nil 1)
|
||||
(9 nil 2 5 nil 7 8 nil 8)
|
||||
(8 nil nil 4 2 1 3 nil 9)
|
||||
(1 nil nil nil nil 6 5 2 7)))
|
||||
|
||||
(defun amount (x y)
|
||||
(foldr (lambda (z q) (if (eq x z) (+ q 1) q)) 0 y))
|
||||
|
||||
@ -119,23 +131,40 @@
|
||||
(matrixToList (getSubMatrix m sr er sc ec)))
|
||||
'error))
|
||||
|
||||
(defun printSudoku (m) (loopforeach i m (print i)))
|
||||
|
||||
(defun solve (grid)
|
||||
(let ((empties (findEmpty grid))
|
||||
(size1 (foldr
|
||||
(lambda (x ys)
|
||||
(let ((e (match x
|
||||
(((?r) (?c)) (notPresent r c)))))
|
||||
(((?r) . (?c)) (notPresent grid r c)))))
|
||||
(if (= 1 (length e))
|
||||
(cons (append e x) ys)
|
||||
(cons (list (car e) (car x) (cdr x)) ys)
|
||||
ys)))
|
||||
nil
|
||||
empties))
|
||||
(others (foldr
|
||||
(lambda (x ys)
|
||||
(let ((e (match x
|
||||
(((?r) . (?c)) (notPresent grid r c)))))
|
||||
(cons (list e (car x) (cdr x)) ys)))
|
||||
nil
|
||||
empties)))
|
||||
(if (eq empties nil)
|
||||
grid
|
||||
(if (valid grid)
|
||||
grid
|
||||
'not-valid)
|
||||
(if (eq size1 nil)
|
||||
() ; TODO: Empty
|
||||
(match (car others)
|
||||
(((? es) (?r) (?c))
|
||||
(foldr
|
||||
(lambda (e ys) (match (solve (place grid r c e))
|
||||
('not-valid ys)
|
||||
(xs xs)))
|
||||
nil
|
||||
es)))
|
||||
(solve (foldr (lambda (x gs)
|
||||
(match x
|
||||
((?e) (?r) (?c)) (place g r c e)))
|
||||
grid size1))
|
||||
))))
|
||||
(((?e) (?r) (?c)) (place gs r c e))))
|
||||
grid size1))))))
|
||||
|
||||
Reference in New Issue
Block a user