(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 validSudoku (grid) (and (foldr (lambda (x b) (and (valid x) b)) 't grid) (foldr (lambda (x b) (and (valid x) b)) 't (transpose grid)) (foldr (lambda (x b) (and (valid (getSubgridAsList grid x)) b)) 't (iota 9)))) (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 (validSudoku 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 (cdr new) grids))))) (solverHelper (foldr (lambda (x gs) (match x (((?e) (?r) (?c)) (place gs r c e)))) grid size1) grids))))))) (solverHelper grid '())))