377 - PurelyFunctional.tv Newsletter - https://purelyfunctional.tv/issues/purelyfunctional-tv-newsletter-377-three-states-of-key-value-pairs/

00 Sudoku validator.md

Sudoku Validator

Write a function that validates a finished sudoku board. It should take a vector of vectors. The inner vectors represent rows from the sudoku board. The rows should contain nine integers. If the board is well-played, the function should return true, otherwise, false.

(sudoku-valid? [[ 1 5 2 4 8 9 3 7 6 ]
                [ 7 3 9 2 5 6 8 4 1 ]
                [ 4 6 8 3 7 1 2 9 5 ]
                [ 3 8 7 1 2 4 6 5 9 ]
                [ 5 9 1 7 6 3 4 2 8 ]
                [ 2 4 6 8 9 5 7 1 3 ]
                [ 9 1 4 6 3 7 5 8 2 ]
                [ 6 2 5 9 4 8 1 3 7 ]
                [ 8 7 3 5 1 2 9 6 4 ]]) ;=> true

(sudoku-valid? [[ 1 1 2 4 8 9 3 7 6 ]
                [ 7 3 9 2 5 6 8 4 1 ]
                [ 4 6 8 3 7 1 2 9 5 ]
                [ 3 8 7 1 2 4 6 5 9 ]
                [ 5 9 1 7 6 3 4 2 8 ]
                [ 2 4 6 8 9 5 7 1 3 ]
                [ 9 1 4 6 3 7 5 8 2 ]
                [ 6 2 5 9 4 8 1 3 7 ]
                [ 8 7 3 5 1 2 9 6 4 ]]) ;=> false

Notes:

• A sudoku puzzle is successfully solved if all rows contain the numbers 1-9, all columns contain 1-9, and the nine 3x3 boxes contain 1-9. See the Wikipedia page for more information.

Thanks to this site for the challenge idea where it is considered Expert level in JavaScript.

Daniel Gaspani.clj

(defn valid? [xs]
  (every? #(= (range 1 10) (sort %)) xs))

(defn cols [xs]
  (apply mapv vector xs))

(defn get-block [xs x-offset y-offeset]
  (->> (drop (* y-offeset 3) xs)
       (take 3)
       (mapcat #(->> (drop (* x-offset 3) %)
                     (take 3)))))

(defn blocks [xs]
  (for [x [0 1 2] y [0 1 2]] (get-block xs x y)))

(defn sudoku-valid? [xs]
  (every? #(-> (% xs) (valid?)) [identity cols blocks]))

Enzzo Cavallo.clj

(letfn [(xf-box->line
          [idx]
          (let [i (* 3 (mod idx 3))
                j (* 3 (int (/ idx 3)))]
            (comp (map #(take
                          3 (drop i %)))
                  (drop j)
                  (take 3)
                  cat)))
        (sudoku-valid? [sudoku]
          (transduce (comp (map-indexed (fn [idx _]
                                          [(get sudoku idx)
                                           (map #(get % idx)
                                                sudoku)
                                           (sequence
                                             (xf-box->line idx)
                                             sudoku)]))
                           cat
                           (map (partial apply distinct?)))
                     (fn
                       ([coll] coll)
                       ([coll el]
                        (if el
                          coll
                          (reduced false))))
                     true
                     sudoku))]
  (let [sudokus {:valid   [[1 5 2 4 8 9 3 7 6]
                           [7 3 9 2 5 6 8 4 1]
                           [4 6 8 3 7 1 2 9 5]
                           [3 8 7 1 2 4 6 5 9]
                           [5 9 1 7 6 3 4 2 8]
                           [2 4 6 8 9 5 7 1 3]
                           [9 1 4 6 3 7 5 8 2]
                           [6 2 5 9 4 8 1 3 7]
                           [8 7 3 5 1 2 9 6 4]]
                 :invalid [[1 1 2 4 8 9 3 7 6]
                           [7 3 9 2 5 6 8 4 1]
                           [4 6 8 3 7 1 2 9 5]
                           [3 8 7 1 2 4 6 5 9]
                           [5 9 1 7 6 3 4 2 8]
                           [2 4 6 8 9 5 7 1 3]
                           [9 1 4 6 3 7 5 8 2]
                           [6 2 5 9 4 8 1 3 7]
                           [8 7 3 5 1 2 9 6 4]]}]
    (into {}
          (map (fn [[k v]]
                 [k (sudoku-valid? v)]))
          sudokus)))

Eric Normand.clj

(def group-coords
  (concat
   ;; rows
   (for [y (range 9)]
     (for [x (range 9)]
       [x y]))
   ;; cols
   (for [x (range 9)]
     (for [y (range 9)]
       [x y]))
   ;; squares
   (for [xo (range 0 9 3)
         yo (range 0 9 3)]
     (for [x (range 3)
           y (range 3)]
       [(+ x xo) (+ y yo)]))))

(defn lookup [board [x y]]
  (-> board
      (get y)
      (get x)))

(defn lookup-group [board group]
  (map #(lookup board %) group))

(defn sudoku-valid? [board]
  (->> group-coords
       (map #(lookup-group board %))
       (map set)
       (every? #{(set (range 1 10))})))

J.-F. Rompre.clj

(ns functional-tv-puzzles.-2020.sudoku-377-golf)

(defn row [i] (quot i 9))
(defn column [i] (rem i 9))
(defn box [i] [(quot (row i) 3), (quot (column i) 3)])
(def allowed? (set (range 1 10)))

(defn sudoku-valid? [rows]
  (->> rows 
       (transduce (comp cat (keep-indexed vector))
                  (completing
                   (fn [acc [i v]]
                     (let [paths (->> [row column box] 
                                      (map #(% i))
                                      (map vector [:rows :cols :boxes]))]
                       (if (or (not (allowed? v)) 
                               (->> paths (map #(get-in acc % #{}))
                                    (some #(% v))))
                         (reduced false)
                         (reduce (fn [acc path] 
                                   (update-in acc path #(conj (or % #{}) v)))
                                 acc 
                                 paths)))))
                  {})
       (#(and % true)))) 

James Elliott.clj

(defn extract-row
  "Returns a sequence with the values found in a single row of a sudoku
  grid."
  [grid row]
  (nth grid row))

(defn extract-column
  "Returns a sequence with the values found in a single column of a
  sudoku grid."
  [grid column]
  (map first (map (partial drop column) grid)))

(defn extract-sub-grid
  "Returns a sequence with the values found in the 3x3 section of a
  sudoku grid whose top-left corner is the specified row and column."
  [grid row column]
  (let [rows (map (partial extract-row grid) (range row (+ row 3)))]
    (mapcat (partial take 3) (map (partial drop column) rows))))

(defn valid-nine?
  "Checks whether the supplied sequence of numbers conforms to the
  sudoku rules of containing each integer from 1 to 9. Assumes that
  only nine values have been supplied, as per the problem statement."
  [values]
  (= (set values) #{1 2 3 4 5 6 7 8 9}))

(defn sudoku-valid?
  "Checks whether the supplied sudoku grid, which must consist of nine
  sequences of nine sequences of integers, meets the win condition of
  having each digit from 1 to 9 in every row, column, and 3x3 sub-grid."
  [grid]
  (every? valid-nine?
          (concat (for [row (range 9)] (extract-row grid row))
                  (for [column (range 9)] (extract-column grid column))
                  (for [row (range 0 9 3)
                        column (range 0 9 3)] (extract-sub-grid grid row column)))))

Juan Monetta.clj

(defn sudoku-valid? [sudoku]
  (let [valid-set (set (range 1 10))
        rows-sets (map set sudoku)
        columns-sets (apply (partial map hash-set) sudoku)
        quadrant (fn [x y] [(quot x 3) (quot y 3)]) ;; given a coord return the quadrant
        boxes-sets (->> (for [x (range 9) y (range 9)] [x y])
                        (reduce (fn [r [x y]] ;;  add the num to its quadrant set
                                  (update r (quadrant x y) (fnil conj #{}) (get-in sudoku [x y])))
                                {})
                        vals)]

    (->> (concat rows-sets columns-sets boxes-sets)
         (map #(= % valid-set))
         (reduce #(and %1 %2) true))))

Mark Champine.clj

;; transpose matrix
(defn xp [mx] (apply (partial map vector) mx))

;; collection contains all digits
(defn alldigits? [c] (= (set c) (set (range 1 10))))

;; get 3x3 boxes
(defn boxes [p]
  (->> (partition 3 p)
       (map xp)
       (map (partial partition 3))
       (apply concat)
       (map flatten)))

(defn sudoku-valid? [p]
  (every? true?
          (map alldigits?
               (concat p (xp p) (boxes p)))))

Nathan Donolli.clj

(defn valid-set? [s]
  (= (sort s) (range 1 10)))

(defn rotate [matrix]
  (apply map list matrix))

(defn rows [matrix] matrix)

(defn cols [matrix] (rotate matrix))

(defn boxes [matrix]
  (->> (map (partial partition 3) matrix)
       rotate flatten
       (partition 9)))

(defn cell-sets [matrix]
  (concat (rows matrix)
          (cols matrix)
          (boxes matrix)))

(defn sudoku-valid? [sudoku]
  (->> (cell-sets sudoku)
       (every? valid-set?)))

ninjure.clj

(defn sudoku-valid? [rows]
  (let [columns (apply map vector rows)
        boxes (->> rows
                   (map #(partition 3 %))
                   (partition 3)
                   (mapcat #(apply map concat %)))]
    (every? #(= 9 (count (set %)))
            (concat rows columns boxes))))

Paul Roush.clj

(def rows
  (let [row (fn [r] (for [c (range 9)] [r c]))]
    (for [r (range 9)]
      (row r))))

(def cols
  (let [col (fn [c] (for [r (range 9)] [r c]))]
    (for [c (range 9)]
      (col c))))

(def squares
  (let [origins (for [r (range 0 9 3)
                      c (range 0 9 3)]
                  [r c])
        sq (fn [[r0 c0]]
             (for [r (range 3)
                   c (range 3)]
               [(+ r0 r) (+ c0 c)]))]
    (for [o origins]
      (sq o))))

(defn solved? [bd]
  (let [paths     (concat rows cols squares)
        valset    (fn [path] (set (map #(get-in bd %) path)))
        val-sets  (map valset paths)
        valid?    (fn [vs] (= 9 (count vs)))]
    (every? valid? val-sets)))

Romain Patrelle.clj

(defn sudoku-valid? [s]
  (->> s
       (apply map vector)
       (apply merge s)
       (map sort)
       (map #(= [1 2 3 4 5 6 7 8 9] %))
       (reduce #(and %1 %2) true)))

Slava Istomin.clj

(ns pfsudoku.core)

(defn contains-all-digits?
  "Does a collection contain all the digits from 1 to 9?"
  [x]
  (= (sort x) (range 1 10)))

(defn row
  "Get a row of a matrix"
  [x n]
  (get x n))

(defn column
  "Get a column of a matrix"
  [x n]
  (map #(get % n) x))

(defn submatrix
  "Get a 3x3 submatrix"
  [m [s1 e1] [s2 e2]]
  (let
    [rows (subvec m s1 e1)]
  (map #(subvec % s2 e2) rows)))

(def cutmap
  "A list of cuts to make all 3x3s of a 9x9 matrix.
  The first pair is rows to get, the second is columns."
  [[[0 3] [0 3]] [[3 6] [0 3]] [[6 9] [0 3]]
   [[0 3] [3 6]] [[3 6] [3 6]] [[6 9] [3 6]]
   [[0 3] [6 9]] [[3 6] [6 9]] [[6 9] [6 9]]])

(defn squares3x3
  "Get all 3x3 matrixes of a 9x9 matrix"
  [x]
  (map #(apply submatrix (cons x %))
       cutmap))

(defn sudoku?
  "Checks if a matrix is a valid sudoku solution."
  [x]
  (let [columns (map #(column x %) (range 0 9))
        rows    (map #(row    x %) (range 0 9))
        squares (map flatten (squares3x3 x))]
    (every? contains-all-digits? (concat columns rows squares))))

Steffan Westcott.clj

(defn transpose [mat]
  (apply mapv vector mat))

(defn blocks3 [mat]
  (->> mat (map #(partition 3 %)) transpose flatten (partition 9)))

(defn segment-valid? [xs]
  (= (set xs) (set (range 1 10))))

(defn sudoku-valid? [mat]
  (every? segment-valid? (concat mat (transpose mat) (blocks3 mat))))

Stuart Campbell.clj

(ns sudoku)

(def numbers (set (range 1 10)))

(defn has-all-numbers? [xs]
  (= numbers (set xs)))

(defn cols [board]
  (apply map list board))

(defn boxes [board]
  (for [i (range 3)
        j (range 3)]
    (mapcat #(nth (partition 3 %) j)
            (nth (partition 3 board) i))))

(defn valid? [board]
  (and
   (every? has-all-numbers? board)
   (every? has-all-numbers? (cols board))
   (every? has-all-numbers? (boxes board))))

Viktor P.clj

(ns purelyfunctional-newsletters.issue-377
  (:require [clojure.test :refer :all]))

(defn rows [board] board)
(defn cols [board] (apply map vector board))

(defn boxes [board]
  (for [i [0 3 6]
        j [0 3 6]]
    (for [x (range i (+ i 3))
          y (range j (+ j 3))]
      (get-in board [x y]))))

(defn valid? [xs]
  (= #{1 2 3 4 5 6 7 8 9}
     (set xs)))

(defn sudoku-valid? [board]
  (every? valid? (concat (rows board)
                         (cols board)
                         (boxes board))))


(deftest sudoku-validation-test
  (is (true? (sudoku-valid? [[ 1 5 2 4 8 9 3 7 6 ]
                             [ 7 3 9 2 5 6 8 4 1 ]
                             [ 4 6 8 3 7 1 2 9 5 ]
                             [ 3 8 7 1 2 4 6 5 9 ]
                             [ 5 9 1 7 6 3 4 2 8 ]
                             [ 2 4 6 8 9 5 7 1 3 ]
                             [ 9 1 4 6 3 7 5 8 2 ]
                             [ 6 2 5 9 4 8 1 3 7 ]
                             [ 8 7 3 5 1 2 9 6 4 ]])))
  
  (is (false? (sudoku-valid? [[ 1 1 2 4 8 9 3 7 6 ]
                              [ 7 3 9 2 5 6 8 4 1 ]
                              [ 4 6 8 3 7 1 2 9 5 ]
                              [ 3 8 7 1 2 4 6 5 9 ]
                              [ 5 9 1 7 6 3 4 2 8 ]
                              [ 2 4 6 8 9 5 7 1 3 ]
                              [ 9 1 4 6 3 7 5 8 2 ]
                              [ 6 2 5 9 4 8 1 3 7 ]
                              [ 8 7 3 5 1 2 9 6 4 ]]))))

Sorry, I hope I am not beating a dead horse!...but to follow-up to my previous post, I did perform a basic experiment using the zzz function, but sleeping for 20 milliseconds. I made a version of the same inputs to be wrapped by calling zzz, then ran one of the golfing versions (g7s above) against both modified and modified inputs, and likewise using a transducing version (mine above). I modified both of the tested versions to invoke the thunk to extract the value if needed. So if the modified version sees a function instead of a value, it invokes it and is forced to slow down.

The golfing version is 2-3 times faster as the transducer one on the unmodified input. However when comparing on modified sleeping inputs, the reverse happened:

;; other setup code and inputs omitted
;;...
(defmacro elapsed [expr]
 `(let [start# (. System (nanoTime))]
    ~expr
    (/ (double (- (. System (nanoTime)) start#)) 1000000.0)))

(def SLEEP-TIME 20)

(defn zzz [x]
  (fn []
    (Thread/sleep SLEEP-TIME) x)) 

(defn scaffold [rows]
  (->> rows (mapv (fn [xs]
                    (mapv zzz xs)))))

(def good-ones-bm (mapv scaffold good-ones)) ;; 3 valid grids
(def bad-ones-bm (mapv scaffold bad-ones)) ;; 4 invalid grids

(defn compare-bms 
  ([xs]
   (compare-bms xs nil))
  ([xs repl?]
   (let [sum (fn [bm] (reduce (fn [acc xs]
                                (+ acc (elapsed (bm xs))))
                              0 
                              xs))]

;; bm1 is using transduce
;; bm2 is golf

     (if repl? 
       [(sum bm1), (sum bm2)]
       (compare (sum bm1) (sum bm2))))))


(deftest valid-sudoku?-benchmark-test
  (is (neg? (compare-bms good-ones-bm)))
  (is (neg? (compare-bms bad-ones-bm)))
  (is (pos? (compare-bms good-ones)))
  (is (pos? (compare-bms bad-ones))))

And at the repl:

(compare-bms good-ones :repl)
;;=> [2.473994 0.790286] ;;unmodified input, golf is much faster
(compare-bms good-ones-bm :repl)
;;=> [5578.041905 16874.487328] ;;modified input, performance is reversed
(compare-bms bad-ones :repl)
;;=> [0.6143310000000001 0.12401000000000001]
(compare-bms bad-ones-bm :repl)
;;=> [1467.8639990000001 2066.33711]

Another fast solution

(def init-tracker  (into [] (repeat 9 (vector-of :long 0 0 0))))

(defn sudoku-valid?
  [rows]
  (let [tracker
        (persistent!
         (reduce
          (fn [tracker [^long row-idx ^long col-idx]]
            (let [tr-idx        (dec ^long (nth (nth rows row-idx) col-idx))
                  box-idx       (+ (quot col-idx 3)
                                   (* (quot row-idx 3) 3))
                  [row col box] (get tracker tr-idx)]
              (if (or (bit-test row row-idx)
                      (bit-test col col-idx)
                      (bit-test box box-idx))
                (reduced (conj! tracker false))
                (assoc! tracker
                        tr-idx
                        (vector-of :long
                                   (bit-set row row-idx)
                                   (bit-set col col-idx)
                                   (bit-set box box-idx))))))
          (transient init-tracker)
          (for [row-idx (range 0 9) col-idx (range 0 9)]
            [row-idx col-idx])))]
    (boolean (peek tracker))))

@g7s Wow, nice way to track collections using bitsets! That is the same basic strategy as the one I used (each element is part of three collections, all deduced with index arithmetic, with fail-fast), but yours seems much more efficient and definitely imaginative. (I tried replacing the very last statement (= valid-tracker..) with 'true for even more speed and this also passed my tests).

I tried my experiment again with this very fast version against my own transducing version - although quite close, the results are tilted towards your version being fastest. Here is a look from the repl:

;; Sleep Time = 5 milliseconds per modified (..xx-bm) value in a vector of grids
(compare-bms good-ones-bm :repl)
;;=> [1440.8899139999999 1428.345147] ;; [ <transducing elapsed time>, <bare metal primitives + transient elapsed time> ]
(compare-bms bad-ones-bm :repl)
;;=> [370.305164 375.833551]
(compare-bms good-ones :repl)
;;=> [2.2728789999999996 0.449945]
(compare-bms bad-ones :repl)
;;=> [0.5856220000000001 0.334401]

@KingCode Yes it is an interesting approach. I use a vector of nine 3-element vectors. Each of these 3-element vectors is used to track the occurrence of a valid integer (that's why there are nine) in a row, column and box (that's why their dimension is 3). This is done in a single pass over the board. I check if the number I read, say n, has occurred already in a row, column or box and if it has I terminate the loop. I do that by testing the nth bit on the element of the 3-vector that corresponds to the row (first), column (second) and box (third). If the bit is off I turn it on and continue. If it terminates without error I last check that the every 3-vector is actually [511 511 511] i.e. every integer 1-9 has been seen for every row, column and box 2^0+...+2^8=511 so the last check is not to be removed.

@g7s Thanks for clarifying - that's what I understood as well, except the need for the very last check...

"If it terminates without error,.." as you say, implies that no violation has occurred, including that of the last number correct? Then all constraints are satisfied: in other words, if a number is missing or redundant in one row/box/column (which is required to fail the 511 value test) we wouldn't get to that point without an earlier violation, a contradiction.

Of course if a digit is invalid or out of range then some kind of additional checking would be required - but that is already prevented by indexing, which requires valid digits to prevent a NPE after (get tracker tr-idx). I totally get the astute positioning of compliant bits to amount to the value 511 though, but it would be required only if no other check were performed, e.g. you could simply build all the bit sets and then only use the 511 check at the end (granted, that might be slower on bad input grids).

Sorry if I missed something - do you have a failing test when using 'true as the last expression? I am curious.

In any case, I enjoy studying your solutions and learn from them everytime ! Thanks again...

@KingCode you are correct! The last check can be safely removed because it will throw an NPE if it encounters a number other than 1-9. It was a leftover from previous iterations I did that used a map instead.

So there are two options: Either live with an NPE or perform a check for validity inside the loop and fail properly.. What's your opinion?

@g7s I think it's perfect - I wouldn't change a thing other than 'true at the end :)

Your choice of course....but as Seinfeld's soup nazi would say, "You dare give me a bad digit???? No soup for you, no sudoku validation for you! Here's a NPE for you and get out."

@KingCode haha I remember this episode! I will leave it for now as it is but it can easily be modified for the sanity check. Thanks for the feedback!

@g7s I like the bit-testing solution. Definitely, fast. You could be condense your three elements into one long by offsetting the bits for rows, cols, and boxes. For example, the cols could be (+ col-idx 9) and the boxes could be at (+ 18 box-idx). In any case, I think it's clever to turn the bookkeeping inside out and to index by the value. Thanks for sharing.

@miner good point! TBH my first try was with 3 shorts but bit-set was returning a long so I abandoned shorts but kept the implementation the same..

Here's a variation on the @g7s bit testing approach. I use reduce-kv to drive it so I have the row and col already. The bit twiddling stores the seen bits in a long. The offsets are not critical as long as the bit fields don't overlap. Using shifts for the mask was slightly faster than bit-set on my machine. [Updated to refactor the offsets]

(defn sudoku-valid-bits? [board]
  (boolean (reduce-kv
            (fn [res ^long r row]
              (let [boxoff (+ 32 (* (quot r 3) 3))
                    rbit (bit-shift-left 1 (+ r 16))]
                (reduce-kv (fn [res ^long c x]
                             (let [mask ^long (bit-or rbit
                                                      (bit-shift-left 1 c)
                                                      (bit-shift-left 1 (+ (quot c 3) boxoff)))
                                   bits ^long (nth res x)]
                               (if (zero? (bit-and mask bits))
                                 (assoc! res x (bit-or mask bits))
                                 (reduced (reduced false)))))
                           res
                           row)))
            (transient (vec (repeat 10 0)))
            board)))  

Well done. I like this more than my solution! Definitely more concise