scopes version of sudoku solver

sudoku/sudoku.rkt

@@ -0,0 +1,102 @@
+#lang racket/base
+
+(define C
+ (for*/vector ([i 9] [j 9] [k 9])
+ (vector
+ (+ j (* 9 i))
+ (+ 81 k (* 9 (+ (quotient j 3) (* 3 (quotient i 3)))))
+ (+ 162 k (* 9 i))
+ (+ 243 k (* 9 j)))))
+
+(define R (build-vector 324 (lambda (x) (make-vector 9 0))))
+(let ([nr (make-vector 324 0)])
+ (for ([r 729])
+ (for ([k (vector-ref C r)])
+ (vector-set! (vector-ref R k) (vector-ref nr k) r)
+ (vector-set! nr k (add1 (vector-ref nr k))))))
+
+(define (update! sr sc r v)
+ (let ([v7 (arithmetic-shift v 7)])
+ (for ([c2 4])
+ (let ([i (vector-ref (vector-ref C r) c2)])
+ (vector-set! sc i (+ v7 (vector-ref sc i))))))
+ (let ([min 10] [min-c 0])
+ (for ([c (vector-ref C r)])
+ (if (> v 0)
+ (for ([rr (vector-ref R c)])
+ (let* ([sr-rr (vector-ref sr rr)] [sr-rr+1 (add1 sr-rr)])
+ (vector-set! sr rr sr-rr+1)
+ (when (= 0 sr-rr)
+ (for ([cc (vector-ref C rr)]) 
+ (let ([sc-cc-1 (sub1 (vector-ref sc cc))])
+ (vector-set! sc cc sc-cc-1)
+ (when (< sc-cc-1 min)
+ (set! min sc-cc-1)
+ (set! min-c cc)))))))
+ (for ([rr (vector-ref R c)])
+ (let ([sr-rr-1 (sub1 (vector-ref sr rr))])
+ (vector-set! sr rr sr-rr-1)
+ (when (= 0 sr-rr-1)
+ (for ([p (vector-ref C rr)])
+ (vector-set! sc p (add1 (vector-ref sc p)))))))))
+ (bitwise-ior (arithmetic-shift min 16) min-c)))
+
+(define (solve input-string)
+ (let ([sr (make-vector 729 0)] ; times the row is forbidden by others
+ [sc (make-vector 324 9)] ; bit 1-7 = allowed choices, bit 8 set if constraint has been used
+ [hints 0] 
+ [cr (make-vector 81 -1)] ; row chosen at step i
+ [cc (make-vector 81 -1)] ; column chosen at step i
+ [out (make-string 81 #\.)]) ; output string
+ (for ([i 81] [c input-string])
+ (let ([a 
+ (if (and (char>=? c #\1) (char<=? c #\9))
+ (- (char->integer c) (char->integer #\1))
+ -1)])
+ (when (>= a 0) 
+ (update! sr sc (+ a (* 9 i)) 1)
+ (set! hints (add1 hints)))
+ (string-set! out i c)))
+ (let solve-loop ([n 0] [i 0] [dir 1] [cand 655360])
+ (do () ([or (< i 0) (>= i (- 81 hints))])
+ (when (= dir 1)
+ (vector-set! cc i (bitwise-and cand #xffff))
+ (let ([min (arithmetic-shift cand -16)])
+ (for ([c 324]) #:break (<= min 1)
+ (when (< (vector-ref sc c) min)
+ (set! min (vector-ref sc c))
+ (vector-set! cc i c))) 
+ (when (or (= min 0) (= min 10))
+ (vector-set! cr i -1)
+ (set! dir -1)
+ (set! i (sub1 i)))))
+ (let ([c (vector-ref cc i)])
+ (when (and (= dir -1) (>= (vector-ref cr i) 0))
+ (update! sr sc (vector-ref (vector-ref R c) (vector-ref cr i)) -1))
+ (let find-r2 ([r2 (add1 (vector-ref cr i))])
+ (if (< r2 9)
+ (if (= 0 (vector-ref sr (vector-ref (vector-ref R c) r2)))
+ (begin
+ (set! cand (update! sr sc (vector-ref (vector-ref R c) r2) 1))
+ (vector-set! cr i r2)
+ (set! i (add1 i))
+ (set! dir 1))
+ (find-r2 (add1 r2)))
+ (begin
+ (vector-set! cr i -1)
+ (set! dir -1)
+ (set! i (sub1 i)))))))
+ (when (>= i 0)
+ (for ([j i])
+ (let ([r (vector-ref (vector-ref R (vector-ref cc j)) (vector-ref cr j))])
+ (string-set! out (quotient r 9) (integer->char (+ (char->integer #\1) (remainder r 9))))))
+ (displayln out)
+ (solve-loop (add1 n) (sub1 i) -1 cand))
+ n)))
+
+(define (read-line-stdin) (read-line (current-input-port) 'any))
+(let read-input ([input (read-line-stdin)])
+ (when (not (eof-object? input))
+ (when (>= (string-length input) 81)
+ (solve input))
+ (read-input (read-line-stdin))))

sudoku/sudoku_v1.sc

@@ -0,0 +1,186 @@
+# install scopes (http://scopes.rocks)
+# compile with: scopes sudoku_v1.sc && gcc sudoku_v1.sc.o sudoku_v1.sc.c.o -o sudoku_v1.sc.exe
+# run with: ./sudoku_v1.sc.exe < sudoku.txt
+
+let libC = 
+ include 
+ options "-c" "sudoku_v1.sc.c.o"
+ """"#include <stdio.h>
+ #include <string.h>
+ typeof(stdin) get_stdin() { return stdin; }
+
+let libC =
+ do
+ using libC.extern
+ using libC.typedef
+ locals;
+
+global R : (array (array u16 9) 324)
+global C : (array (array u16 4) 729)
+
+fn genmat ()
+ local r = 0
+ for i in (range 9)
+ for j in (range 9)
+ for k in (range 9)
+ let cr = (C @ r)
+ cr @ 0 = (9 * i + j) as u16
+ cr @ 1 = ((i // 3 * 3 + j // 3) * 9 + k + 81) as u16
+ cr @ 2 = (9 * i + k + 162) as u16
+ cr @ 3 = (9 * j + k + 243) as u16
+ r = r + 1
+
+ local nr : (array i8 324)
+ for c in (range 324)
+ nr @ c = 0
+
+ for r in (range 729)
+ for c2 in (range 4)
+ let k = (C @ r @ c2)
+ (R @ k) @ (nr @ k) = r as u16
+ nr @ k = nr @ k + 1:u16
+
+fn update (sr sc r v)
+ let v7 = (v << 7)
+ for c2 in (range 4)
+ let x = (sc @ (C @ r @ c2))
+ x = (x + v7) as u8
+ local min = 10
+ local min_c = 0
+ for c2 in (range 4)
+ let c = (C @ r @ c2)
+ if (v > 0)
+ for r2 in (range 9)
+ let rr = (R @ c @ r2)
+ local srrr = (sr @ rr)
+ sr @ rr = srrr + 1
+ if (srrr != 0)
+ continue;
+ for cc2 in (range 4)
+ let cc = (C @ rr @ cc2)
+ sc @ cc = sc @ cc - 1
+ if (sc @ cc < min)
+ min = sc @ cc
+ min_c = cc
+ else
+ for r2 in (range 9)
+ let rr = (R @ c @ r2)
+ sr @ rr = sr @ rr - 1
+ if (sr @ rr != 0)
+ continue;
+ let p = (C @ rr)
+ sc @ (p @ 0) = sc @ (p @ 0) + 1
+ sc @ (p @ 1) = sc @ (p @ 1) + 1
+ sc @ (p @ 2) = sc @ (p @ 2) + 1
+ sc @ (p @ 3) = sc @ (p @ 3) + 1
+ min << 16 | min_c
+
+fn solve (_s)
+ local sr : (array i8 729)
+ for r in (range 729)
+ sr @ r = 0
+
+ local sc : (array u8 324)
+ for c in (range 324)
+ sc @ c = 0 << 7 | 9
+
+ let nine = 57:i8
+ let one = 49:i8
+ local hints = 0
+ local cr : (array i8 81)
+ local cc : (array i16 81)
+ local out : (array i8 82)
+ for i in (range 81)
+ let c = (_s @ i)
+ let a = 
+ if (c >= one and c <= nine)
+ c - one
+ else
+ -1:i8
+ if (a >= 0)
+ update sr sc (i * 9 + a) 1
+ hints = hints + 1
+ cr @ i = -1
+ cc @ i = -1
+ out @ i = c
+ out @ 81 = 0
+
+ local n = 0
+ local min : i32
+ local i = 0
+ local dir = 1
+ local cand = (10 << 16 | 0)
+ loop ()
+ while (i >= 0 and i < 81 - hints)
+ if (dir == 1)
+ min = (cand >> 16) as i32
+ cc @ i = (cand & 0xFFFF) as i16
+ if (min > 1)
+ for c in (range 324)
+ if (sc @ c < min)
+ min = sc @ c
+ cc @ i = c as i16
+ if (min <= 1)
+ break;
+ if (min == 0 or min == 10)
+ cr @ i = -1
+ dir = -1
+ i = i - 1
+ let c = (cc @ i)
+ if (dir == -1 and cr @ i >= 0)
+ update sr sc (R @ c @ (cr @ i)) -1
+ let r2 = 
+ loop (r2 = (cr @ i + 1))
+ if (r2 >= 9)
+ break r2
+ if (sr @ (R @ c @ r2) == 0)
+ break r2
+ repeat (r2 + 1)
+ if (r2 < 9)
+ cand = (update sr sc (R @ c @ r2) 1)
+ cr @ i = r2
+ i = i + 1
+ dir = 1
+ else
+ cr @ i = -1
+ i = i - 1
+ dir = -1
+ if (i < 0)
+ break;
+ for j in (range i)
+ let r = (R @ (cc @ j) @ (cr @ j))
+ out @ (r // 9) = (r % 9 + one) as i8
+ libC.puts out
+ n = n + 1
+ i = i - 1
+ dir = -1
+ repeat;
+ n
+
+fn sudoku_solver ()
+ genmat;
+ let stdin = (libC.get_stdin)
+ local buf : (array i8 1024)
+ libC.fgets buf 1024 stdin
+ let newline = 10:i8
+ while ((libC.fgets buf 1024 stdin) != null)
+ if ((libC.strlen buf) < 81)
+ continue;
+ solve buf
+ libC.putchar newline
+
+fn main (argc argv)
+ sudoku_solver;
+ 0
+
+#sudoku_solver;
+
+compile-object
+ default-target-triple
+ compiler-file-kind-object
+ module-dir .. "/sudoku_v1.sc.o"
+ do
+ let main =
+ static-typify main i32 (pointer rawstring)
+ locals;
+ 'O3