Exploring improvements on the relatively slow HexSpeak demo from https://github.com/ttsiodras/HexSpeak

hexspeakfast.clj

;;performance opts by joinr
;;running openjdk 1.8 because reasons, bumped clojure dep to 1.11.1
(ns thanassis.hexspeakfast
  (:gen-class))

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

(defn slength ^long [^String x] (.length x))

(defn good-words
  "Reads words from a with-open-ed stream and filters them
  to only include the ones that contain the letters passed.
  It also drops words of length 1 and 2, and drops
  3 'words' of length 3 that exist in /usr/share/dict/words"
  [rdr letters]
  (let [matcher (re-pattern (str "^[" letters "]*$"))
        forbidden #{"aaa" "aba" "abc"}]
    (into []
      (filter
        #(and (> (slength %) 2)
              (re-matches matcher %)
              (not (forbidden %)))
        (line-seq rdr)))))

;;This is inconsistent with the hy implementation, which avoids hashing by
;;shoving words into a vector of 0...128.  Let's do the same.
#_
(defn get-words-per-length
  "The algorithm below (in solve) needs to access words of the same
  length, and a vector is much faster than a hashmap (which is what
  is returned by group-by below). This function uses good-words
  to generate the list of valid words, and then arranges them into
  a neat map: 

  1 -> ['a']
  3 -> ['bee', 'fed', ...]
  4 -> ['dead', ...]

  ...etc."
  [dictionary-file letters]
  (let [candidates (with-open [rdr (clojure.java.io/reader dictionary-file)]
                     (good-words rdr letters))]
    (group-by slength (conj candidates "a"))))


;;We now dump our WPL into a vector with fast int lookup.
;;Avoiding hashing altogether and indexing into vector like the hy version
;;shaves off another 25% from the original.
(defn get-words-per-length
  "The algorithm below (in solve) needs to access words of the same
  length, and a vector is much faster than a hashmap (which is what
  is returned by group-by below). This function uses good-words
  to generate the list of valid words, and then arranges them into
  a neat map: 

  1 -> ['a']
  3 -> ['bee', 'fed', ...]
  4 -> ['dead', ...]

  ...etc."
  [dictionary-file letters]
  (let [candidates (with-open [rdr (clojure.java.io/reader dictionary-file)]
                     (good-words rdr letters))]
    (->> (group-by slength (conj candidates "a"))
         (reduce-kv (fn [acc ^long k v]
                      (assoc acc k v)) (vec (repeat 128 []))))))

;;legacy implementation of solve uses imperative and seq-focused
;;constructs for dotimes, doseq, and boxes all arithemtic.
#_
(defn solve
  "Using the list of valid options from our list of words,
  recurse to form complete phrases of the desired target-length,
  and count them all up to see how many there are."

  [words-per-length target-length phrase-len used-words counter]
  (dotimes [i (- target-length phrase-len)]
    (doseq [w (get words-per-length (inc i) [])]
      (if (not (used-words w))
        (if (= target-length (+ i phrase-len 1))
          (vswap! counter inc) ;faster than swap! and atom
          (solve words-per-length target-length (+ phrase-len (inc i))
                 (conj used-words w) counter))))))

;;We move to a functional implementation to enable primitive hinting
;;and unboxed arithmetic without having to hint all callsites.
#_
(defn ->solver [words-per-length ^long target-length]
  (fn solve [^long phrase-len used-words counter]
    (dotimes [i (- target-length phrase-len)]
      (doseq [w (get words-per-length (inc i) [])]
        (if (not (used-words w))
          (if (= target-length (+ i phrase-len 1))
            (vswap! counter (fn [^long n] (inc n))) ;faster than swap! and atom
            (solve (+ phrase-len (inc i)) (conj used-words w) counter)))))))



;;Moving to unboxed arithmetic buys us ~25-30% speedup.
;;just performing vector lookups on wpl vector instead of
;;hashing into a map gets us another 20%.
#_
(defn ->solver [words-per-length ^long target-length]
  (fn solve [^long phrase-len used-words ^long counter]
    (->>  (range (- target-length phrase-len)) ;;0, 1 , ... target-length-1
          (reduce
           (fn [^long acc ^long i]
             (reduce (fn [^long acc w]
                       (if (not (used-words w))
                         (if (== target-length (+ i phrase-len 1))
                           (inc acc)
                           (solve (+ phrase-len (inc i)) (conj used-words w) acc))
                         acc))
                     acc (words-per-length (inc i))))
           counter))))

;;So the hy implementation just uses mutable sets and concatenation for its
;;used word implementation.  This seems odd since you would expect it to be slower
;;in the general case with large dictionaries....but for the empirical benchmark
;;being used here, the used words are only like 5 entries....so linear
;;scans of the list leveraging identical? outpeform hashsets in this
;;narrow case.  We probably would want to let the data (size of the
;;unused words) determine the underlying structure and have a simple
;;api to shift between them, but meh.

(defn in [xs k]
  (reduce (fn [acc x]
            (if (identical? x k)
              (reduced true)
              acc)) false xs))

;;in the worst case, for a 5 element vector we are as fast as a hashset lookup
;;according to criterium. in the best case (first entry is found), we are over 2x faster.
;;Begs the question if we can do better using an array, but meh.

;;using linear scans via `in` instead of hashing gets us another 5% or so.
;;add a primitive return to solve.
(defn ->solver [words-per-length ^long target-length]
  (fn solve ^long [^long phrase-len used-words ^long counter]
    (->>  (range (- target-length phrase-len)) ;;0, 1 , ... target-length-1
          (reduce
           (fn [^long acc ^long i]
             (reduce (fn [^long acc w]
                       (if (not (in used-words w))
                         (if (== target-length (+ i phrase-len 1))
                           (inc acc)
                           (solve (+ phrase-len (inc i)) (conj used-words w) acc))
                         acc))
                     acc (words-per-length (inc i))))
           counter))))

;;using unboxed math gets us down to the 680s
#_
(defn -main
  "Expects as cmd-line arguments:

  - Desired length of phrases (e.g. 8)
  - Letters to search for     (e.g. abcdef)
  - Dictionary file to use    (e.g. /usr/share/dict/words)

  Prints the number of such HexSpeak phrases
  (e.g. 0xADEADBEE - a dead bee - is one of them)"
  [& args]
  (let [phrase-length (Integer. ^String (re-find #"\d+" (nth args 0 4)))
        letters (nth args 1 "abcdef")
        dictionary-file (nth args 2 "/usr/share/dict/words")
        counter (volatile! 0) ; faster than atom
        words-per-length (get-words-per-length dictionary-file letters)
        solve (->solver words-per-length phrase-length)]
    (dotimes [n 10]
      (let [_ (vreset! counter 0)
            _ (time (solve 0 #{} counter))]
        (printf "Total: %d\n" @counter)))
    (flush)))

;;eliminating volatile usage, reducing on a long,
;;and using vector words-per-length instead of map (like hy
;;version did) gets us down to 500's
#_
(defn -main
  "Expects as cmd-line arguments:

  - Desired length of phrases (e.g. 8)
  - Letters to search for     (e.g. abcdef)
  - Dictionary file to use    (e.g. /usr/share/dict/words)

  Prints the number of such HexSpeak phrases
  (e.g. 0xADEADBEE - a dead bee - is one of them)"
  [& args]
  (let [phrase-length (Integer. ^String (re-find #"\d+" (nth args 0 4)))
        letters (nth args 1 "abcdef")
        dictionary-file (nth args 2 "/usr/share/dict/words")
        counter 0 #_(volatile! 0) ; faster than atom
        words-per-length (get-words-per-length dictionary-file letters)
        solve (->solver words-per-length phrase-length)]
    (dotimes [n 10]
      (let [n (time (solve 0 #{} counter))]
        (printf "Total: %d\n" n)))
    (flush)))

;;using linear scans instead of hashset...
;;gets us to 470's at the low end.
#_
(defn -main
  "Expects as cmd-line arguments:

  - Desired length of phrases (e.g. 8)
  - Letters to search for     (e.g. abcdef)
  - Dictionary file to use    (e.g. /usr/share/dict/words)

  Prints the number of such HexSpeak phrases
  (e.g. 0xADEADBEE - a dead bee - is one of them)"
  [& args]
  (let [phrase-length (Integer. ^String (re-find #"\d+" (nth args 0 4)))
        letters (nth args 1 "abcdef")
        dictionary-file (nth args 2 "/usr/share/dict/words")
        counter 0
        words-per-length (get-words-per-length dictionary-file letters)
        solve (->solver words-per-length phrase-length)]
    (dotimes [n 10]
      (let [n (time (solve 0 [] counter))]
        (printf "Total: %d\n" n)))
    (flush)))

;;use a word list instead of vector for cheap conj.
;;420's
;;adding a return hint on solve gets us to 380's
(defn -main
  "Expects as cmd-line arguments:

  - Desired length of phrases (e.g. 8)
  - Letters to search for     (e.g. abcdef)
  - Dictionary file to use    (e.g. /usr/share/dict/words)

  Prints the number of such HexSpeak phrases
  (e.g. 0xADEADBEE - a dead bee - is one of them)"
  [& args]
  (let [phrase-length (Integer. ^String (re-find #"\d+" (nth args 0 4)))
        letters (nth args 1 "abcdef")
        dictionary-file (nth args 2 "/usr/share/dict/words")
        counter 0
        words-per-length (get-words-per-length dictionary-file letters)
        solve (->solver words-per-length phrase-length)]
    (dotimes [n 10]
      (let [n (time (solve 0 '() counter))]
        (printf "Total: %d\n" n)))
    (flush)))

;; thanassis.hexspeakfast> (-main "14" "abcdef" "contrib/words")
;; "Elapsed time: 430.6477 msecs"
;; Total: 3020796
;; "Elapsed time: 389.3113 msecs"
;; Total: 3020796
;; "Elapsed time: 390.8865 msecs"
;; Total: 3020796
;; "Elapsed time: 430.753 msecs"
;; Total: 3020796
;; "Elapsed time: 388.195 msecs"
;; Total: 3020796
;; "Elapsed time: 394.8848 msecs"
;; Total: 3020796
;; "Elapsed time: 401.641 msecs"
;; Total: 3020796
;; "Elapsed time: 418.998 msecs"
;; Total: 3020796
;; "Elapsed time: 383.9683 msecs"
;; Total: 3020796
;; "Elapsed time: 391.5956 msecs"
;; Total: 3020796

;;baseline, warm jit
;; thanassis.hexspeakfast> (#'thanassis.hexspeak/-main "14" "abcdef" "contrib/words")
;; "Elapsed time: 1024.986 msecs"
;; Total: 3020796
;; "Elapsed time: 1065.0907 msecs"
;; Total: 3020796
;; "Elapsed time: 1075.3926 msecs"
;; Total: 3020796
;; "Elapsed time: 1016.9033 msecs"
;; Total: 3020796
;; "Elapsed time: 1015.9312 msecs"
;; Total: 3020796
;; "Elapsed time: 1015.3411 msecs"
;; Total: 3020796
;; "Elapsed time: 1005.0903 msecs"
;; Total: 3020796
;; "Elapsed time: 1003.8628 msecs"
;; Total: 3020796
;; "Elapsed time: 967.1175 msecs"
;; Total: 3020796
;; "Elapsed time: 968.3548 msecs"
;; Total: 3020796