Files
Tataru/sudoku.lispbm
2025-10-14 14:39:29 +02:00

111 lines
2.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)))
(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))