summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorThomas White <taw@physics.org>2022-04-03 17:14:29 +0200
committerThomas White <taw@physics.org>2022-04-03 17:14:29 +0200
commitd2b9eb7bb32cf69f57eb32d4ed39ebd3aa705ff5 (patch)
tree8cf6eed8bc2a271cf13293e109cc1bb4176c7377
parentd7f6da737335aaf87ac1d5c5ff283bb0d7a5507f (diff)
Specialise to board size 9
Generalising makes the code very convoluted, and doesn't even work properly.
-rw-r--r--sudoku.scm84
1 files changed, 36 insertions, 48 deletions
diff --git a/sudoku.scm b/sudoku.scm
index 5d9306b..8637e36 100644
--- a/sudoku.scm
+++ b/sudoku.scm
@@ -11,7 +11,7 @@
(lambda (possible-value)
(array-ref vals
(array-ref board col row possible-value)))
- (iota (biggest-value board)))))
+ (iota 9))))
(define (set-initial-value board col row val)
@@ -23,63 +23,52 @@
(1- val)))))
-(define (map-for-0-to n f)
- (map f (iota n)))
+(define (make-row row)
+ (map
+ (cut cons <> row)
+ (iota 9)))
-(define (make-row row board-size)
- (map-for-0-to
- board-size
- (cut cons <> row)))
+(define (make-col col)
+ (map
+ (cut cons col <>)
+ (iota 9)))
-(define (make-col col board-size)
- (map-for-0-to
- board-size
- (cut cons col <>)))
+(define (rows)
+ (map
+ (cut make-row <>)
+ (iota 9)))
-(define (rows board-size)
- (map-for-0-to
- board-size
- (cut make-row <> board-size)))
+(define (cols)
+ (map
+ (cut make-col <>)
+ (iota 9)))
-(define (cols board-size)
- (map-for-0-to
- board-size
- (cut make-col <> board-size)))
-
-
-(define (make-box bcol brow box-size)
+(define (make-box bcol brow)
(let ((l '()))
- (do ((icol 0 (1+ icol))) ((= icol box-size))
- (do ((irow 0 (1+ irow))) ((= irow box-size))
+ (do ((icol 0 (1+ icol))) ((= icol 3))
+ (do ((irow 0 (1+ irow))) ((= irow 3))
(set! l (cons
- (cons (+ (* box-size bcol) icol)
- (+ (* box-size brow) irow))
+ (cons (+ (* 3 bcol) icol)
+ (+ (* 3 brow) irow))
l))))
l))
-(define (boxes board-size box-size)
+(define (boxes)
(let ((l '()))
(do ((bcol 0 (1+ bcol))) ((= bcol 3))
(do ((brow 0 (1+ brow))) ((= brow 3))
(set! l (cons
- (make-box bcol brow box-size)
+ (make-box bcol brow)
l))
))
l))
-(define (biggest-value board)
- (1+ (match
- (array-shape board)
- (((_ _) (_ _) (_ max-value))
- max-value))))
-
-
(define (unique-values board coords-list)
(for-each
(lambda (n)
@@ -88,7 +77,7 @@
(lambda (coord)
(array-ref board (car coord) (cdr coord) n))
coords-list)))
- (iota (biggest-value board))))
+ (iota 9)))
(define (all-unique-values board coord-lists)
@@ -97,8 +86,8 @@
coord-lists))
-(define (make-board size)
- (let ((board (make-array #f size size size)))
+(define (make-board)
+ (let ((board (make-array #f 9 9 9)))
(array-map! board make-sat-variable)
board))
@@ -108,20 +97,19 @@
(map
(lambda (value)
(array-ref board col row value))
- (iota (biggest-value board)))))
+ (iota 9))))
-(let* ((board-size 9)
- (board (make-board board-size)))
+(let* ((board (make-board)))
;; The standard Sudoku rules
- (all-unique-values board (rows board-size))
- (all-unique-values board (cols board-size))
- (all-unique-values board (boxes board-size 3))
+ (all-unique-values board (rows))
+ (all-unique-values board (cols))
+ (all-unique-values board (boxes))
;; Each position contains exactly one number
- (do ((col 0 (1+ col))) ((= col board-size))
- (do ((row 0 (1+ row))) ((= row board-size))
+ (do ((col 0 (1+ col))) ((= col 9))
+ (do ((row 0 (1+ row))) ((= row 9))
(all-one-number board col row)))
;; Initially specified values
@@ -152,7 +140,7 @@
(set-initial-value board 8 0 5)
(let ((vals (solve-sat)))
- (do ((row 0 (1+ row))) ((= row board-size))
- (do ((col 0 (1+ col))) ((= col board-size))
+ (do ((row 0 (1+ row))) ((= row 9))
+ (do ((col 0 (1+ col))) ((= col 9))
(format #t "~a" (get-value board vals col row)))
(newline))))