unpack.clj

(ns chal209.unpack
  (:require [clojure.string :refer [split]]
            [clojure.set :refer [difference]]))

(def input1
  "6 1 1
T H T L E D 
P E N U R G
I G S D I S
Y G A W S I 
W H L Y N T
I T A R G I")

(def input2
  "5 1 1
I E E H E
T K P T L
O Y S F I 
U E C F N
R N K O E")

(defn parse
  [input]
  (let [[header & grid] (split input #"\n")
        [_ start-row start-col] (->> header
                                     (re-seq #"\d+")
                                     (map #(Integer/parseInt %)))
        grid (mapv (fn [row] (vec (remove #(= % \space) row))) grid)]
    {:start-row (dec start-row)
     :start-col (dec start-col)
     :rows (count grid)
     :cols (count (first grid))
     :grid grid}))

(def pair-freq-table
  "Source: http://homepages.math.uic.edu/~leon/mcs425-s08/handouts/char_freq2.pdf"
  ;;  a   b   c   d   e   f   g   h   i   j   k   l   m   n   o   p   q   r   s   t   u   v   w   x   y   z
  [[  1  20  33  52   0  12  18   5  39   1  12  57  26 181   1  20   1  75  95 104   9  20  13   1  26   1] ; a
   [ 11   1   0   0  47   0   0   0   6   1   0  17   0   0  19   0   0  11   2   1  21   0   0   0  11   0] ; b
   [ 31   0   4   0  38   0   0  38  10   0  18   9   0   0  45   0   1  11   1  15   7   0   0   0   1   0] ; c
   [ 48  20   9  13  57  11   7  25  50   3   1  11  14  16  41   6   0  14  35  56  10   2  19   0  10   0] ; d
   [110  23  45 126  48  30  15  33  41   3   5  55  47 111  33  28   2 169 115  83   6  24  50   9  26   0] ; e
   [ 25   2   3   2  20  11   1   8  23   1   0   8   5   1  40   2   0  16   5  37   8   0   3   0   2   0] ; f
   [ 24   3   2   2  28   3   4  35  18   1   0   7   3   4  23   1   0  12   9  16   7   0   5   0   1   0] ; g
   [114   2   2   1 302   2   1   6  97   9   9   2   3   1  49   1   0   8   5  32   3   0   4   0   4   0] ; h
   [ 10   5  32  33  23  17  25   6   1   1   8  37  37 179  24   6   0  27  86  93   1  14   7   2   0   2] ; i
   [  2   0   0   0   2   0   0   0   3   0   0   0   0   0   3   0   0   0   0   0   8   0   0   0   0   0] ; j
   [  6   1   1   1  29   1   0   2  14   0   0   3   1   9   4   0   0   0   5   4   1   0   2   0   2   0] ; k
   [ 40   3   2  36  64  10   1   4  47   0   3  56   4   2  41   3   0   2  11  16   8   3   5   0  31   0] ; l
   [ 44   7   1   1  68   2   1   3  25   0   0   1   5   2  29  11   0   3  10   9   8   0   4   0  18   0] ; m
   [ 40   7  25 146  66   8  92  16  33   2   8   9   7   8  60   4   1   3  33 106   6   2  12   0  11   0] ; n
   [ 16  12  13  18   5  80   7  11  12   1  13  26  48 106  36  15   0  84  28  57 115  12  46   0   5   1] ; o
   [ 23   1   0   0  30   1   0   3  12   0   0  15   1   0  21  10   0  18   5  11   6   0   1   0   1   0] ; p
   [  0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   9   0   0   0   0   0] ; q
   [ 50   7  10  20 133   8  10  12  50   1   8  10  14  16  55   6   0  14  37  42  12   4  11   0  21   0] ; r
   [ 67  11  17   7  74  11   4  50  49   2   6  13  12  10  57  20   2   4  43 109  20   2  24   0   4   0] ; s
   [ 59  10  11   7  75   9   3 330  76   1   2  17  11   7 115   4   0  28  34  56  17   1  31   0  16   0] ; t
   [  7   5  12   7   7   2  14   2   8   0   1  34   8  36   1  16   0  44  35  48   0   0   2   0   1   0] ; u
   [  5   0   0   0  65   0   0   0  11   0   0   0   0   0   4   0   0   0   0   0   0   0   0   0   1   0] ; v
   [ 66   1   1   2  39   1   0  44  39   0   0   2   1  12  29   0   0   3   4   4   1   0   2   0   1   0] ; w
   [  1   0   2   0   1   0   0   0   2   0   0   0   0   0   0   3   0   0   0   3   0   0   0   0   0   0] ; x
   [ 18   7   6   6  14   7   3  10  11   1   1   4   6   3  36   4   0   3  19  20   1   1  12   0   2   0] ; y
   [  1   0   0   0   3   0   0   0   1   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0] ; z
   ])

(defn chr->i
  [chr]
  (- (int chr) (int \A)))

(defn pair-freq
  [chr1 chr2]
  (get-in pair-freq-table [(chr->i chr1) (chr->i chr2)]))

(defn initial-path
  [{:keys [start-row start-col]}]
  {:steps [[start-row start-col]]
   :visited #{[start-row start-col]}
   :score 0})

(defn neighbours
  [{:keys [rows cols]} [row col]]
  (->> [(when (< 0 row) [(dec row) col])
        (when (< (inc row) rows) [(inc row) col])
        (when (< 0 col) [row (dec col)])
        (when (< (inc col) cols) [row (inc col)])]
       (remove nil?)
       set))

(defn extend-path
  [{:keys [rows cols grid] :as challenge} {:keys [steps visited] :as path}]
  (let [curr-pos (last steps)
        options (difference (neighbours challenge curr-pos) visited)]
    (map
     (fn [next-pos]
       (-> path
           (update-in [:steps] conj next-pos)
           (update-in [:visited] conj next-pos)
           (update-in [:score] + (pair-freq (get-in grid curr-pos)
                                            (get-in grid next-pos)))))
     options)))

(defn pr-paths
  [{:keys [grid]} n paths]
  (doseq [{:keys [score steps]} (take n paths)]
    (println score (apply str (map #(get-in grid %) steps)))))

(defn find-paths
  [{:keys [rows cols] :as challenge}]
  (reduce
   (fn [paths step]
     ;; (println "**" step (count paths))
     (->> paths
          (sort-by :score >)
          (take 50000)
          (mapcat (partial extend-path challenge))))
   [(initial-path challenge)]
   (range (dec (* rows cols)))))

(defn pr-top40
  [input]
  (let [challenge (parse input)
        paths (time (find-paths challenge))]
    (println "Top 40 out of" (count paths) "paths:")
    (pr-paths challenge 40 paths)))

(comment
  (pr-top40 input1)
  (pr-top40 input2))

Partial solution for https://www.reddit.com/r/dailyprogrammer/comments/322hh0/20150410_challenge_209_hard_unpacking_a_sentence/