revised brute force day 5-2

brute.clj

(defn some-fast [f xs]
  (reduce (fn [acc x]
            (let [res (f x)]
              (if res (reduced res)
                  acc)))
          false xs))

(defn toDigits [s] (mapv read-string (re-seq #"\d+" s)))

(defn parseInput [d]
  (->> d
       (map toDigits)
       (partition-by empty?)
       (filter (comp not empty? first))
       (map vec)
       ))

(defn withinRange  [^long n ^long start ^long range] (and (>= n start) (< n (+ start range))))

#_
(defn withinRanges2 [n ranges]
  (loop [[src dest range] (first ranges) rem (rest ranges)]
    (if (nil? dest)
      n
      (if (withinRange n src range)
        (+ dest (- n src))
        (recur (first rem) (rest rem))
        ))))

(defn withinRanges2 [n ranges]
  (reduce (fn [acc sdr]
            (let [src   (sdr 0)
                  dest  (sdr 1)
                  range (sdr 2)]
              (if (withinRange n src range)
                (reduced (+ dest (- n src)))
                acc))) n ranges))

(defn runSeed2 [seed maps] (reduce #(withinRanges2 %1 %2) seed maps))

(defn backwardsSearch [[[seeds] & maps]]
  (let [seeds (into [] (map vec (partition 2 seeds)))
        maps  (vec (reverse maps))]
    (loop [n 0]
      (let [result (runSeed2 n maps)]
        (if (some-fast #(withinRange result (nth % 0) (nth % 1)) seeds)
          n
          (recur (inc n)))))))

#_
(backwardsSearch (parseInput data))

;;using arrays more invasively:

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

(defn some-fast [f xs]
  (reduce (fn [acc x]
            (let [res (f x)]
              (if res (reduced res)
                  acc)))
          false xs))

(defn toDigits [s] (long-array (mapv read-string (re-seq #"\d+" s))))

(defn parseInput [d]
  (->> d
       (map toDigits)
       (partition-by empty?)
       (filter (comp not empty? first))
       (map vec)
       ))

(defn withinRange  [^long n ^long start ^long range] (and (>= n start) (< n (+ start range))))

(defn withinRanges2 [n ranges]
  (reduce (fn [acc ^longs sdr]
            (let [src   (aget sdr 0)
                  dest  (aget sdr 1)
                  range (aget sdr 2)]
              (if (withinRange n src range)
                (reduced (+ dest (- n src)))
                acc))) n ranges))

(defn runSeed2 [seed maps] (reduce #(withinRanges2 %1 %2) seed maps))

(defn backwardsSearch [[[seeds] & maps]]
  (let [seeds (into [] (map vec (partition 2 seeds)))
        maps  (vec (reverse maps))]
    (loop [n 0]
      (let [result (runSeed2 n maps)]
        (if (some-fast #(withinRange result (nth % 0) (nth % 1)) seeds)
          n
          (recur (inc n)))))))

(defn withinRanges3 [^long n ^longs ranges-array]
  (let [bnd (alength ranges-array)]
    (loop [idx 0]
      (if (< idx bnd)
        (let [src   (aget ranges-array idx)
              dest  (aget ranges-array (+ idx 1))
              range (aget ranges-array (+ idx 2))]
          (if (withinRange n src range)
            (+ dest (- n src))
            (recur (+ idx 3))))
        n))))

(defn runSeed3 [^long seed maps] (reduce #(withinRanges3 %1 %2) seed maps))
(defn arrayify [xs]
  (->>  (for [maps xs ]
          (long-array (apply concat maps)))
        vec))

(defn backwardsSearch3 [[[seeds] & maps]]
  (let [seeds (into [] (map vec (partition 2 seeds)))
        maps  (arrayify (reverse maps))]
    (loop [n 0]
      (let [result (runSeed3 n maps)]
        (if (some-fast #(withinRange result (nth % 0) (nth % 1)) seeds)
          n
          (recur (inc n)))))))

;;about 87 seconds.

(defn some-fast-longs-by2 [^clojure.lang.IFn$LLO f ^longs xs]
  (let [bnd (alength xs)]
    (loop [idx 0]
      (if (< idx bnd)
        (let [res (.invokePrim f (aget xs idx) (aget xs (inc idx)))]
          (if res
            res
            (recur (+ idx 2))))
        nil))))

(defn backwardsSearch4 [[[seeds] & maps]]
  (let [^longs seeds seeds
        maps  (arrayify (reverse maps))]
    (loop [n 0]
      (let [result (runSeed3 n maps)]
        (if (some-fast-longs-by2 (fn [^long l ^long r] (withinRange result l r)) seeds)
          n
          (recur (inc n)))))))

;;44s


(defn backwardsSearch5 [[[seeds] & maps]]
  (let [^longs seeds seeds
        maps  (arrayify (reverse maps))
        step 1000
        answer (atom nil)]
    (->> (range 0 Long/MAX_VALUE step)
         (pmap (fn [^long init]
                 (let [bound (+ init step)]
                   (loop [n init]
                     (if (and (< n bound) (not @answer))
                       (let [result (runSeed3 n maps)]
                         (if (some-fast-longs-by2 (fn [^long l ^long r] (withinRange result l r)) seeds)
                           (reset! answer n)
                           (recur (inc n))))
                       nil)))))
         (some identity))))

;;~11s, this isn't even work stealing.