Skip to content

Instantly share code, notes, and snippets.

Created December 11, 2020 23:40
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
What would you like to do?
Nondeterministic sudoku solver
#lang racket
(module amb racket/base
(provide amb assert!)
(define-syntax-rule (pop! stack)
(begin0 (car stack) (set! stack (cdr stack))))
(define-syntax-rule (push! v stack)
(set! stack (cons v stack)))
(define (U f) (f f))
(define fail-stack '())
(define (fail!)
(if (null? fail-stack)
(error 'amb "Back-tracking stack exhausted!")
(U (pop! fail-stack))))
(define (amb choices)
(let ((cc (call-with-current-continuation values)))
(cond ((null? choices) (fail!))
(else (push! cc fail-stack)
(pop! choices)))))
(define (assert! condition)
(unless condition (fail!))))
(require 'amb)
(define (split-into lst n)
(define-values (head tail) (split-at lst n))
(if (null? tail)
(list head)
(cons head (split-into tail n))))
(define (split-up lst)
(split-into lst (sqrt (length lst))))
(define (get-rows matrix)
(define (get-columns matrix)
(apply map list matrix))
(define (get-grids matrix)
(apply append (map (curry apply map append) (split-up (map split-up matrix)))))
(define (get-digit-set lst)
(apply set (range 1 (add1 (length lst)))))
(define (valid? lst)
(set=? (apply set lst) (get-digit-set lst)))
(define (matrix-valid? matrix)
(let ((rows (get-rows matrix))
(columns (get-columns matrix))
(grids (get-grids matrix)))
(= (length rows)
(length columns)
(length grids))
(andmap valid? rows)
(andmap valid? columns)
(andmap valid? grids))))
(module+ main
;; Replace `x' with `amb' for aesthetics.
(define-syntax x
(syntax-id-rules ()
(x (amb (range 1 10)))))
;;; Warning: This implementation is very inefficient and unoptimised.
;;; This is the price to pay for succint and high-level code.
(let ((puzzle
(list 5 x x 4 6 7 3 x 9)
(list 9 x 3 8 1 x 4 2 7)
(list 1 7 4 2 x 3 x x x)
(list 2 3 1 9 6 7 8 5 4)
(list 8 5 7 1 2 4 x 9 x)
(list 4 6 9 3 x 8 1 7 2)
(list x x x x 8 9 2 6 x)
(list 7 8 2 6 4 1 x x 5)
(list x 1 x x x x 7 x 8))))
(assert! (matrix-valid? puzzle))
(pretty-print puzzle))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment