142 lines
3.7 KiB
Plaintext
142 lines
3.7 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)))
|
|
|
|
(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 solve (grid)
|
|
(let ((empties (findEmpty grid))
|
|
(size1 (foldr
|
|
(lambda (x ys)
|
|
(let ((e (match x
|
|
(((?r) (?c)) (notPresent r c)))))
|
|
(if (= 1 (length e))
|
|
(cons (append e x) ys)
|
|
ys)))
|
|
nil
|
|
empties)))
|
|
(if (eq empties nil)
|
|
grid
|
|
(if (eq size1 nil)
|
|
() ; TODO: Empty
|
|
(solve (foldr (lambda (x gs)
|
|
(match x
|
|
((?e) (?r) (?c)) (place g r c e)))
|
|
grid size1))
|
|
))))
|