You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
119 lines
2.9 KiB
Racket
119 lines
2.9 KiB
Racket
#lang debug br
|
|
(require sugar/debug "hacs.rkt")
|
|
|
|
(define (make-base-sudoku)
|
|
(define sudoku (make-csp))
|
|
|
|
(define cells (range 81))
|
|
(add-vars! sudoku cells (range 1 10))
|
|
|
|
(for ([i 9])
|
|
(define row-cells (filter (λ (cell) (= (quotient cell 9) i)) cells))
|
|
(add-all-diff-constraint! sudoku row-cells)
|
|
|
|
(define col-cells (filter (λ (cell) (= (remainder cell 9) i)) cells))
|
|
(add-all-diff-constraint! sudoku col-cells))
|
|
|
|
(define box-starts '(0 3 6 27 30 33 54 57 60))
|
|
(define box-offsets '(0 1 2 9 10 11 18 19 20))
|
|
(for ([start box-starts])
|
|
(add-all-diff-constraint! sudoku (map (curry + start) box-offsets)))
|
|
|
|
sudoku)
|
|
|
|
(define (make-sudoku-board . strs)
|
|
(define sudoku (make-base-sudoku))
|
|
(define vals (for*/list ([str (in-list strs)]
|
|
[c (in-string str)]
|
|
#:unless (memv c '(#\- #\|)))
|
|
(string->number (string c))))
|
|
(for ([(val vidx) (in-indexed vals)]
|
|
#:when val)
|
|
(add-constraint! sudoku (curry = val) (list vidx)))
|
|
sudoku)
|
|
|
|
(require racket/sequence)
|
|
(define (print-grid sol)
|
|
(displayln (string-join (map ~a (for/list ([row (in-slice 9 (csp->assocs sol))])
|
|
(map cdr row))) "\n")))
|
|
|
|
;; http://jeapostrophe.github.io/2013-10-23-sudoku-post.html
|
|
|
|
(define b1
|
|
(make-sudoku-board
|
|
"53 | 7 | "
|
|
"6 |195| "
|
|
" 98| | 6 "
|
|
"-----------"
|
|
"8 | 6 | 3"
|
|
"4 |8 3| 1"
|
|
"7 | 2 | 6"
|
|
"-----------"
|
|
" 6 | |28 "
|
|
" |419| 5"
|
|
" | 8 | 79"))
|
|
|
|
;; "Hard" example
|
|
(define b2
|
|
(make-sudoku-board
|
|
" 7 | 2 | 5"
|
|
" 9| 87| 3"
|
|
" 6 | | 4 "
|
|
"-----------"
|
|
" | 6 | 17"
|
|
"9 4| |8 6"
|
|
"71 | 5 | "
|
|
"-----------"
|
|
" 9 | | 8 "
|
|
"5 |21 |4 "
|
|
"4 | 9 | 6 "))
|
|
|
|
;; "Evil" example
|
|
(define b3
|
|
(make-sudoku-board
|
|
" 8| | 45"
|
|
" | 8 |9 "
|
|
" 2|4 | "
|
|
"-----------"
|
|
"5 | 1|76 "
|
|
" 1 | 7 | 8 "
|
|
" 79|5 | 1"
|
|
"-----------"
|
|
" | 7|4 "
|
|
" 7| 6 | "
|
|
"65 | |3 "))
|
|
|
|
(current-inference forward-check)
|
|
(current-select-variable mrv-degree-hybrid)
|
|
(current-order-values shuffle)
|
|
(current-node-consistency #t)
|
|
(current-arity-reduction #t)
|
|
(define trials 5)
|
|
(time-avg trials (void (solve b1)))
|
|
(print-debug-info)
|
|
(time-avg trials (void (solve b2)))
|
|
(print-debug-info)
|
|
(time-avg trials (void (solve b3)))
|
|
(print-debug-info)
|
|
|
|
|
|
(define (euler-value sol)
|
|
(match sol
|
|
[(list (cons 0 h) (cons 1 t) (cons 2 d) _ ...)
|
|
(+ (* 100 h) (* 10 t) d)]))
|
|
|
|
|
|
(require rackunit)
|
|
(check-equal? (euler-value (solve b1)) 534)
|
|
(check-equal? (euler-value (solve b2)) 378)
|
|
(check-equal? (euler-value (solve b3)) 938)
|
|
|
|
;; https://projecteuler.net/problem=96
|
|
;; answer 24702
|
|
(define (do-euler)
|
|
(define bstrs
|
|
(for/list ([puz (in-slice 10 (string-split (port->string (open-input-file "euler-sudoku-grids.txt")) "\n"))])
|
|
(map (λ (str) (string-replace str "0" " ")) (cdr puz))))
|
|
(for/sum ([bstr bstrs])
|
|
(euler-value (solve (apply make-sudoku-board bstr)))))
|