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)
|
(9 nil 2 3 4 5 nil nil 8)
|
||||||
(3 4 5 6 7 8 nil 1 2)))
|
(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)
|
(defun amount (x y)
|
||||||
(foldr (lambda (z q) (if (eq x z) (+ q 1) q)) 0 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)))
|
(matrixToList (getSubMatrix m sr er sc ec)))
|
||||||
'error))
|
'error))
|
||||||
|
|
||||||
|
(defun printSudoku (m) (loopforeach i m (print i)))
|
||||||
|
|
||||||
(defun solve (grid)
|
(defun solve (grid)
|
||||||
(let ((empties (findEmpty grid))
|
(let ((empties (findEmpty grid))
|
||||||
(size1 (foldr
|
(size1 (foldr
|
||||||
(lambda (x ys)
|
(lambda (x ys)
|
||||||
(let ((e (match x
|
(let ((e (match x
|
||||||
(((?r) (?c)) (notPresent r c)))))
|
(((?r) . (?c)) (notPresent grid r c)))))
|
||||||
(if (= 1 (length e))
|
(if (= 1 (length e))
|
||||||
(cons (append e x) ys)
|
(cons (list (car e) (car x) (cdr x)) ys)
|
||||||
ys)))
|
ys)))
|
||||||
nil
|
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)))
|
empties)))
|
||||||
(if (eq empties nil)
|
(if (eq empties nil)
|
||||||
grid
|
(if (valid grid)
|
||||||
|
grid
|
||||||
|
'not-valid)
|
||||||
(if (eq size1 nil)
|
(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)
|
(solve (foldr (lambda (x gs)
|
||||||
(match x
|
(match x
|
||||||
((?e) (?r) (?c)) (place g r c e)))
|
(((?e) (?r) (?c)) (place gs r c e))))
|
||||||
grid size1))
|
grid size1))))))
|
||||||
))))
|
|
||||||
|
|||||||
Reference in New Issue
Block a user