Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

* src/main/clojure/clojure/core/logic/bench.clj: simplistic verificat…

…ion of sudoku results
  • Loading branch information...
commit ed614bf2e4b89f2f2eccb171a93dc6b47ebd25fe 1 parent 5db26ee
David Nolen authored

Showing 1 changed file with 30 additions and 5 deletions. Show diff stats Hide diff stats

  1. +30 5 src/main/clojure/clojure/core/logic/bench.clj
35 src/main/clojure/clojure/core/logic/bench.clj
@@ -485,13 +485,22 @@
485 485 (init (next vars) (next hints))))
486 486 succeed))
487 487
  488 +(defn ->rows [xs]
  489 + (->> xs (partition 9) (map vec) (into [])))
  490 +
  491 +(defn ->cols [rows]
  492 + (apply map vector rows))
  493 +
  494 +(defn ->squares [rows]
  495 + (for [x (range 0 9 3)
  496 + y (range 0 9 3)]
  497 + (get-square rows x y)))
  498 +
488 499 (defn sudokufd [hints]
489 500 (let [vars (repeatedly 81 lvar)
490   - rows (->> vars (partition 9) (map vec) (into []))
491   - cols (apply map vector rows)
492   - sqs (for [x (range 0 9 3)
493   - y (range 0 9 3)]
494   - (get-square rows x y))]
  501 + rows (->rows vars)
  502 + cols (->cols rows)
  503 + sqs (->squares rows)]
495 504 (run-nc 1 [q]
496 505 (== q rows)
497 506 (everyo #(infd % (domain 1 2 3 4 5 6 7 8 9)) vars)
@@ -500,6 +509,16 @@
500 509 (everyo distinctfd cols)
501 510 (everyo distinctfd sqs))))
502 511
  512 +(defn verify [rows]
  513 + (let [cols (->cols rows)
  514 + sqs (->squares rows)
  515 + verify-group (fn [group]
  516 + (every? #(= (count (into #{} %)) 9)
  517 + group))]
  518 + (and (verify-group rows)
  519 + (verify-group cols)
  520 + (verify-group sqs))))
  521 +
503 522 (comment
504 523 (def easy0
505 524 [0 0 3 0 2 0 6 0 0
@@ -516,6 +535,8 @@
516 535
517 536 (sudokufd easy0)
518 537
  538 + (-> (sudokufd easy0) first verify)
  539 +
519 540 ;; ~600ms
520 541 ;; 6ms for 1
521 542 (dotimes [_ 5]
@@ -539,6 +560,8 @@
539 560
540 561 (time (sudokufd hard0))
541 562
  563 + (-> (sudokufd hard0) first verify)
  564 +
542 565 ;; ~600ms
543 566 ;; ~60ms for 1
544 567 (dotimes [_ 5]
@@ -562,6 +585,8 @@
562 585
563 586 (time (sudokufd hard1))
564 587
  588 + (-> (sudokufd hard1) first verify)
  589 +
565 590 ;; ~1500ms
566 591 ;; ~150ms for 1
567 592 (dotimes [_ 5]

0 comments on commit ed614bf

Please sign in to comment.
Something went wrong with that request. Please try again.