this little cutie essentially solves the Valid Sudoku problem from LeetCode
#lang racket
(define input
'((5 3 _ _ 7 _ _ _ _)
(6 _ _ 1 9 5 _ _ _)
(_ 9 8 _ _ _ _ 6 _)
(8 _ _ _ 6 _ _ _ 3)
(4 _ _ 8 _ 3 _ _ 1)
(7 _ _ _ 2 _ _ _ 6)
(_ 6 _ _ _ _ 2 8 _)
(_ _ _ 4 1 9 _ _ 5)
(_ _ _ _ 8 _ _ 7 9)))
(define (unique? item collection)
(let loop ([lst collection] [count 0])
(cond
[(> count 1)
false]
[(null? lst)
(= count 1)]
[(eq? item (car lst))
(loop (cdr lst) (+ count 1))]
[else
(loop (cdr lst) count)])))
(define (valid-collection? collection)
(andmap (lambda (cell)
(or (eq? '_ cell) (unique? cell collection)))
collection))
(define (get-square n board)
(let ([init-x (* 3 (modulo n 3))] [init-y (* 3 (floor (/ n 3)))])
(let loop ([x init-x] [y init-y])
(let ([cell (list-ref (list-ref board y) x)])
(cond
[(and (= x (+ 2 init-x)) (= y (+ 2 init-y)))
(cons cell null)]
[(= x (+ 2 init-x))
(cons cell (loop init-x (+ y 1)))]
[else
(cons cell (loop (+ x 1) y))])))))
; more functional style implementation by LCOLONQ
; (define (get-square n board)
; (apply
; append
; (map
; (lambda (row)
; (take (drop row (* 3 (modulo n 3))) 3))
; (take (drop board (* 3 (floor (/ n 3)))) 3))))
; initial implementation
; (define (get-squares board)
; (let loop ([n 0])
; (cond
; [(= n 8)
; (cons (get-square n board) null)]
; [else
; (cons (get-square n board) (loop (+ n 1)))])))
; improved implementation
(define (get-squares board)
(append
(map
(lambda (n)
(get-square n board))
(range 9))))
(define (valid-sudoku? board)
(and
(andmap valid-collection? board)
(andmap valid-collection? (apply map list board))
(andmap valid-collection? (get-squares board))))
(valid-sudoku? input)
partially inspired by Better Motherfucking Website and Even Better Motherfucking Website with my own spin on thingamajigs
the few silly subdomains that redirect here are hosted on Free DNS