From d2b9eb7bb32cf69f57eb32d4ed39ebd3aa705ff5 Mon Sep 17 00:00:00 2001
From: Thomas White <taw@physics.org>
Date: Sun, 3 Apr 2022 17:14:29 +0200
Subject: Specialise to board size 9

Generalising makes the code very convoluted, and doesn't even work
properly.
---
 sudoku.scm | 84 +++++++++++++++++++++++++++-----------------------------------
 1 file 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))))
-- 
cgit v1.2.3