opt on day23

day23.clj

(load-file "aoc.clj")
(ns day23
  (:require aoc
            [clojure.data.int-map :refer [dense-int-set int-map]]))

(set! *unchecked-math* :warn-on-boxed)

(def ^:const S 256)
(def ^:const N (- S))

(def directions
  [[(dec N)  N (inc N)]   ; N
   [(dec S)  S (inc S)]   ; S
   [(dec N) -1 (dec S)]   ; W
   [(inc N)  1 (inc S)]]) ; E

(def adjacent
  (into []  (dedupe) (reduce concat directions)))

;;the adjacent array never escapes the function
;;it's called from, so we can reuse a little mutable
;;buffer and update it arithmetically efficiently.
;;Helps a bit, like 200-300ms.
(let [^longs origin (long-array adjacent)
      ^longs buff   (long-array (count adjacent))]
  (defn get-adjacent! ^longs [^long elf]
    (dotimes [i (alength origin)]
      (aset buff i (+ (aget origin i) elf)))
    buff))

;;invoking the reduce path on the array will
;;end up creating a seq (oddly), so we loop it for now.
;;I think one could extend coll-reduce to the array types
;;if not already done so...
(defn arr-not-any? [pred ^longs arr]
  (let [bound (alength arr)]
    (loop [idx 0
           acc true]
      (if (== bound idx)
        acc
        (if (pred (aget arr idx))
          false
          (recur (unchecked-inc idx) acc))))))

;;unrolling takes off about 200ms, probably in function
;;calls to reduce.
(defn valid-neighbor3 [elves ^long elf dir]
  (let [x   (dir 0)
        rx  (+ elf x)]
    (if (elves rx) nil
        (let [y    (dir 1)
              res  (+  elf y)]
          (if (elves res) nil
              (let [z (dir 2)
                    rz (+ elf z)]
                (if (elves rz) nil
                    res)))))))

;;looping shaves off another 100ms.
(defn propose [elves ^long round proposals elf]
  (let [nbs (get-adjacent! elf)]
    (if (arr-not-any? elves nbs)
      proposals
      (let [prop (loop [i     0
                        acc elf]
                   (if (== i 4)
                     acc
                     (let [n       (mod (+ round i) 4)]
                       (if-let [res (valid-neighbor3 elves elf (directions n))]
                         res
                         (recur (unchecked-inc i) acc)))))]
        (if (proposals prop)
          (dissoc! proposals prop)
          (assoc!  proposals prop elf))))))

;;vals and keys create iterator seqs.  we can just reduce-kv
;;and efficiently get the key/val, disj and conj in one pass.
;;minor improvement (like 100ms or so).
(defn move [elves proposals]
  (as-> elves $
    (transient $)
    (reduce-kv (fn [acc k v]
                 (-> acc
                     (disj! v)
                     (conj! k))) $ proposals)
    (persistent! $)))

(defn play-round [elves round]
  (->> elves
       (reduce (partial propose elves round) (transient (int-map)))
       persistent!
       (#(when (seq %) (move elves %)))))

(defn calc-area [elves]
  (let [xs (sort (map #(mod  % S) elves))
        ys (sort (map #(quot % S) elves))]
    (* (inc (- (last xs) (first xs)))
       (inc (- (last ys) (first ys))))))


(defn part-1 [elves]
  (-> (reduce play-round elves (range 10))
      calc-area
      (- (count elves))))

(defn part-2 [elves]
  (reduce
   (fn [elves round]
     (let [new-elves (play-round elves round)]
       (if (nil? new-elves)
         (reduced (inc round))
         new-elves)))
   elves
   (iterate inc 0)))


(defn parse-input [input]
  (->> input
       aoc/read-input
       (#(for [[y line] (map-indexed vector %)
               [x char] (map-indexed vector line)
               :when (= char \#)]
           (+ (/ S 2) x
              (* S (+ (/ S 2) y)))))
       dense-int-set))

(defn solve
  ([] (solve 23))
  ([input]
   (let [elves (parse-input input)]
     [(part-1 elves)
      (part-2 elves)])))


(solve)

;;various explorations.
;;original gains from eliminating seq generation/traversal overhead.
;;lots of small seqs.  so move to a vector for neighbors, getting
;;better reduce pathway.  only now we are allocating a vector
;;and doing transient/persistent for probably a small collection.

;;slightly more efficient to use eduction (note the direct
;;use of the constructor; by default the clojure.core/eduction
;;function will create a varargs pathway using apply.  We can
;;avoid this just by constructing an eduction directly....I think
;;the API could be improved for this case...)

#_
(defn neighbours> [^long elf direction]
  (clojure.core.Eduction. (map #(+ elf ^long %)) direction))

;;not-any? projected as a reduction, good gains when used on
;;vector or eduction.
#_
(defn not-any?> [pred xs]
  (reduce (fn [acc x]
            (if (pred x)
              (reduced false)
              acc)) true xs))

;;explored a couple of unrolling options
;;for kicks.  This could be macro'd but meh,
;;one-off stuff.  There are only 2 sized collections
;;we are working with, so it's a possible opt.
;;17ns unrolled vs 96ns iterating.
#_
(defn not-any?3 [pred v]
  (and (not (pred (v 0)))
       (not (pred (v 1)))
       (not (pred (v 2)))))
#_
(defn not-any?12 [pred v]
  (and (not (pred (v 0)))
       (not (pred (v 1)))
       (not (pred (v 2)))
       (not (pred (v 3)))
       (not (pred (v 4)))
       (not (pred (v 5)))
       (not (pred (v 6)))
       (not (pred (v 7)))
       (not (pred (v 8)))
       (not (pred (v 9)))
       (not (pred (v 10)))
       (not (pred (v 11)))))

;;original neighbors impl, generates
;;a lazy seq.
#_
(defn neighbours [^long elf direction]
  (map #(+ elf ^long %) direction))

;;slightly better, generates a vector we
;;can more efficiently reduce on with not-any?>
#_
(defn neighbours [^long elf direction]
  (mapv #(+ elf ^long %) direction))

;;similar unrolling variant.
#_
(defn neighbours3 [^long elf direction]
  [(+ ^long (direction 0) ^long elf)
   (+ ^long (direction 1) ^long elf)
   (+ ^long (direction 2) ^long elf)])

;;compute valid neighbor in 1 pass.  Instead of
;;computing the vector, and then iterating over it
;;again, we can simultaneously build the result
;;and detect a violation of the existence criterion.
;;The only really weird bit is where we have to
;;keep only the second result....no idea why.
#_
(defn valid-neighbor [elves ^long elf dir]
  (reduce-kv (fn [acc i  n]
               (let [res (+ elf ^long n)]
                 (cond (elves res) ;;violates not-any
                         (reduced nil)
                       (= i 1) ;;collect the second index for reasons.
                         res
                       :else
                       acc)))
             nil dir))

;;intermediate variant that was around 3.3x.  Final version gets
;;to 4x by unrolling the loop eliminating overhead outside.
#_
(defn propose [elves ^long round proposals elf]
  (let [nbs (get-adjacent! elf #_adjacent)]
    (if (arr-not-any? elves nbs)
      proposals
      (let [prop (reduce
                  (fn [elf ^long i]
                    (let [n       (mod (+ round i) 4)]
                      (if-let [res (valid-neighbor elves elf (directions n))]
                        (reduced res)
                        elf)))
                  elf
                  (range 4))]
        (if (proposals prop)
          (dissoc! proposals prop)
          (assoc!  proposals prop elf))))))