Works, but for some sudokus it runs out of stack space

This commit is contained in:
2025-10-14 18:20:37 +02:00
parent 6d66ecafac
commit 60fa13d0e2

View File

@ -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))))))