170 lines
4.8 KiB
Plaintext
170 lines
4.8 KiB
Plaintext
(define nums '(1 2 3 4 5 6 7 8 9))
|
|
|
|
(define exampleGrid
|
|
'(
|
|
(1 2 3 4 5 6 7 8 9)
|
|
(2 3 4 5 6 7 8 9 1)
|
|
(3 4 5 6 7 8 9 1 2)
|
|
(4 5 6 7 8 9 1 2 3)
|
|
(5 6 7 8 9 1 2 3 4)
|
|
(6 7 8 9 1 2 3 4 5)
|
|
(7 8 9 1 2 3 4 5 6)
|
|
(8 9 1 2 3 4 5 6 7)
|
|
(9 1 2 3 4 5 6 7 8)))
|
|
|
|
(define toSolve
|
|
'(
|
|
(1 2 3 4 5 nil 7 8 9)
|
|
(4 5 6 7 nil 9 1 2 3)
|
|
(7 8 nil 1 2 nil 4 5 6)
|
|
(2 nil 4 5 6 7 nil 9 1)
|
|
(5 6 nil 8 9 nil 2 3 4)
|
|
(8 9 nil 2 nil 4 5 6 7)
|
|
(6 7 nil 9 1 2 nil 4 5)
|
|
(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))
|
|
|
|
(defun in (x xs) (foldr (lambda (y z) (if (eq x y) t z)) nil xs))
|
|
|
|
(defun intersection (xs ys) (filter (lambda (x) (in x ys)) xs))
|
|
|
|
(defun repeat (x e)
|
|
(if (number? x)
|
|
(match x
|
|
(0 nil)
|
|
(_ (cons e (repeat (- x 1) e))))
|
|
'error))
|
|
|
|
(defun replace (lst i e)
|
|
(match lst
|
|
(((?x) . (?xs)) (match i
|
|
(0 (cons e xs))
|
|
(_ (cons x (replace xs (- i 1) e)))))
|
|
(nil nil)))
|
|
|
|
|
|
(defun valid (x)
|
|
(if (= 9 (length x))
|
|
(foldr
|
|
(lambda (y z) (if (<= y 1) z nil))
|
|
t
|
|
(map (lambda (y) (amount y x)) nums))
|
|
nil))
|
|
|
|
(defun notPresentRow (xs)
|
|
(foldr
|
|
(lambda (x ys) (if (in x xs) ys (cons x ys)))
|
|
nil
|
|
nums))
|
|
|
|
(defun notPresent (grid row col)
|
|
(intersection (notPresentRow (getRow grid row))
|
|
(notPresentRow (getCol grid col))))
|
|
|
|
(defun getRow (grid x) (ix grid x))
|
|
|
|
(defun findEmpty (grid)
|
|
(foldr (lambda (zs ys)
|
|
(match zs
|
|
(((?row) . (?rowVal))
|
|
(append
|
|
(zip
|
|
(repeat 9 row)
|
|
(foldr (lambda (x qs)
|
|
(match x
|
|
(((?col) . (?val)) (if (eq val nil) (cons col qs) qs))
|
|
(_ 'error)))
|
|
nil
|
|
(zip (iota 9) rowVal)))
|
|
ys))
|
|
(_ 'error)))
|
|
nil
|
|
(zip (iota 9) grid)))
|
|
|
|
(defun transpose (grid)
|
|
(match grid
|
|
(nil nil)
|
|
(((? x))
|
|
(map (lambda (y) (list y)) x))
|
|
(((? x) . (? xs))
|
|
(if (list? x)
|
|
(zipWith
|
|
cons
|
|
x
|
|
(transpose xs))
|
|
('error)))
|
|
(_ 'error)))
|
|
|
|
(defun place (m r c e)
|
|
(let ((row (getRow m r)) (updatedRow (replace row c e)))
|
|
(replace m r updatedRow)))
|
|
|
|
(defun getCol (grid x) (getRow (transpose grid) x))
|
|
|
|
(defun MatrixToList (m) (foldr append nil m))
|
|
|
|
(defun getSubMatrix (m startcol stopcol startrow stoprow)
|
|
(let ((f (lambda (x start stop) (take (drop x start) (- (+ 1 stop) start)))))
|
|
(map (lambda (x) (f x startcol stopcol)) (f m startrow stoprow))))
|
|
|
|
(defun getSubGridAsList (m x)
|
|
(if (and (>= x 0) (< x 9))
|
|
(let ((sr (* (// x 3) 3))
|
|
(er (+ sr 2))
|
|
(sc (* (mod x 3) 3))
|
|
(ec (+ sc 2)))
|
|
(matrixToList (getSubMatrix m sr er sc ec)))
|
|
'error))
|
|
|
|
(defun printSudoku (m) (loopforeach i m (print i)))
|
|
|
|
(defun solve (grid)
|
|
(let ((solverHelper (lambda (grid grids) (let ((empties (findEmpty grid))
|
|
(size1 (foldr
|
|
(lambda (x ys)
|
|
(let ((e (match x
|
|
(((?r) . (?c)) (notPresent grid r c)))))
|
|
(if (= 1 (length e))
|
|
(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)
|
|
(if (valid grid)
|
|
grid
|
|
(solverHelper (car grids) (cdr grids)))
|
|
(if (eq size1 nil)
|
|
(match (car others)
|
|
(((? es) (?r) (?c))
|
|
(let ((new (map (lambda (e) (place grid r c e)) es)))
|
|
(solverHelper (car new) (append grids (new))))))
|
|
(solverHelper
|
|
(foldr (lambda (x gs)
|
|
(match x
|
|
(((?e) (?r) (?c)) (place gs r c e))))
|
|
grid size1)
|
|
grids)))))))
|
|
(solverHelper grid '())))
|