Skip to content

Instantly share code, notes, and snippets.

@aharisu
Created October 16, 2010 05:43
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save aharisu/629486 to your computer and use it in GitHub Desktop.
Save aharisu/629486 to your computer and use it in GitHub Desktop.
(define panel #(5 3 0 0 7 0 0 0 0
6 0 0 1 9 5 0 0 0
0 9 8 0 0 0 0 6 0
8 0 0 0 6 0 0 0 3
4 0 0 8 0 3 0 0 1
7 0 0 0 2 0 0 0 6
0 6 0 0 0 0 2 8 0
0 0 0 4 1 9 0 0 5
0 0 0 0 8 0 0 7 9))
(define make-init-list (lambda (panel)
(define l '())
(let loop ((i (- (vector-length panel) 1)))
(if (> i -1)
(begin
(set! l (cons
(if (zero? (vector-ref panel i))
(list (remainder i 9) (quotient i 9) '(1 2 3 4 5 6 7 8 9))
(vector-ref panel i))
l))
(loop (- i 1)))))
l))
(define show-panel (lambda (panel)
(let loop ((y 0))
(if (< y 9)
(begin
(if (zero? (remainder y 3)) (newline))
(let inner-loop ((x 0))
(if (< x 9)
(begin
(if (zero? (remainder x 3)) (display " "))
(display (number-with-xy panel x y))
(display " ")
(inner-loop (+ x 1)))))
(newline)
(loop (+ y 1)))))))
(define xy-to-index (lambda (x y)
(+ (* y 9) x)))
(define number-with-xy
(lambda (vec x y) (vector-ref vec (xy-to-index x y))))
(define in-box-number-list (lambda (vec x y)
(let ((offset-x (* (quotient x 3) 3))
(offset-y (* (quotient y 3) 3))
(number-list '()))
(let loop ((i 0))
(if (< i 3)
(begin
(let inner-loop ((j 0))
(if (< j 3)
(begin
(if (not (zero? (number-with-xy vec (+ offset-x j) (+ offset-x i))))
(set! number-list (cons (number-with-xy vec (+ offset-x j) (+ offset-y i)) number-list)))
(inner-loop (+ j 1)))))
(loop (+ i 1)))))
number-list)))
(define vline-number-list (lambda (vec x)
(define number-list '())
(let loop ((i 0))
(if (< i 9)
(begin
(if (not (zero? (number-with-xy vec x i)))
(set! number-list (cons (number-with-xy vec x i) number-list)))
(loop (+ i 1)))))
number-list))
(define hline-number-list (lambda (vec y)
(define number-list '())
(let loop ((i 0))
(if (< i 9)
(begin
(if (not (zero? (number-with-xy vec i y)))
(set! number-list (cons (number-with-xy vec i y) number-list)))
(loop (+ i 1)))))
number-list))
(define contains? (lambda (l v)
(let loop ((l l))
(if (null? l)
#f
(if (= v (car l))
#t
(loop (cdr l)))))))
(define check-number? (lambda (vec x y v)
(not (or
(contains? (in-box-number-list vec x y) v)
(contains? (vline-number-list vec x) v)
(contains? (hline-number-list vec y) v)))))
(define vector-set (lambda (vec k v)
(set! vec (vector-copy vec))
(vector-set! vec k v)
vec))
(define suudok-slove (lambda (panel)
(let/cc esc-cont
(define continuation-slove (lambda (cont panel l)
(cond
((null? l) (esc-cont panel))
((number? (car l)) (continuation-slove cont panel (cdr l)))
(else
(let ((x (car (car l)))
(y (car (cdr (car l)))))
(let loop ((candidate (car (cdr (cdr (car l))))))
(cond
((null? candidate) (cont '()))
((check-number? panel x y (car candidate))
(call/cc (lambda (c)
(continuation-slove c (vector-set panel (xy-to-index x y) (car candidate)) (cdr l))))))
(loop (cdr candidate))))))))
(call/cc (lambda (c) (continuation-slove c panel (make-init-list panel)))))))
(show-panel (suudok-slove panel))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment