#lang debug br
(require sugar/debug "hacs.rkt")

(define names (for/list ([i (in-range 81)])
                        (string->symbol (format "c~a" i))))

(define (make-sudoku)
  (define sudoku (make-csp))
  (add-vars! sudoku names (range 1 10))

  (define (not= . xs) (= (length xs) (length (remove-duplicates xs =)))) 

  (for ([i (in-range 9)])
       (define row-cells (for/list ([(name idx) (in-indexed names)]
                                    #:when (= (quotient idx 9) i))
                                   name))
       (add-pairwise-constraint! sudoku not= row-cells)
       (define col-cells (for/list ([(name idx) (in-indexed names)]
                                    #:when (= (remainder idx 9) i))
                                   name))
       (add-pairwise-constraint! sudoku not= col-cells))
  
  (for ([i '(0 3 6 27 30 33 54 57 60)])
       (define box-cells (for/list ([j '(0 1 2 9 10 11 18 19 20)])
                                   (string->symbol (format "c~a" (+ i j)))))
       (add-pairwise-constraint! sudoku not= box-cells))
  
  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")))

(define (board . strs)
  (define sudoku (make-sudoku))
  (define vals
    (for*/list ([str strs]
                [c (in-port read-char (open-input-string str))]
                #:unless (memv c '(#\- #\|)))
               (string->number (string c))))
  (for ([name names]
        [val vals]
        #:when val)
       (add-constraint! sudoku (curry = val) (list name) (string->symbol (format "is-~a" val))))
  sudoku)

;; http://jeapostrophe.github.io/2013-10-23-sudoku-post.html

(define b1
  (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
  (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
  (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-random #true)
(current-node-consistency #t)
(current-arity-reduction #t)
#;(time-avg 10 (solve b1 #:finish-proc print-grid))
#;(time-avg 10 (solve b2 #:finish-proc print-grid))
#;(time-avg 10 (solve b3 #:finish-proc print-grid))

;; https://projecteuler.net/problem=96
;; todo: parsing of these is wrong
(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))))

(car bstrs)
(define bboard (apply board (car bstrs)))
(solve bboard #:finish-proc print-grid)

#;(for/fold ([sum 0])
          ([(bstr idx) (in-indexed bstrs)])    
  (define sol (solve (apply board bstr)))
  (+ sum #R (+ (* 100 (cdr (assq 'c0 sol)))
            (* 10 (cdr (assq 'c1 sol)))
            (* 1 (cdr (assq 'c2 sol))))))