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