integer-riddle.clj

(comment
  "The riddle is as follows:
   
   Two numbers are chosen randomly, both are positive integers smaller than 100. 
   Sandy is told the sum of the numbers, while Peter is told the product of the numbers.

   Then, this dialog occurs between Sandy and Peter:
   Peter: I don't know the numbers.
   Sandy: I don't know the numbers.
   Peter: I don't know the numbers.
   Sandy: I don't know the numbers.
   Peter: I don't know the numbers.
   Sandy: I don't know the numbers.
   Peter: I don't know the numbers.
   Sandy: I don't know the numbers.
   Peter: I don't know the numbers.
   Sandy: I don't know the numbers.
   Peter: I don't know the numbers.
   Sandy: I don't know the numbers.
   Peter: I don't know the numbers.
   Sandy: I don't know the numbers.
   Peter: I do know the numbers.

   What are the numbers?")

(comment
  "To solve the riddle, construct a table of possible options available to guess
   at each 'round' for each player.
   Then, iterate for the specified number of rounds and return the single valid result.")

(def numbers (range 1 100))

(def players
  {:peter *
   :sandy +})

(defn map-vals [f xs]
  (into {} (map (fn [[k v]] [k (f v)]) xs)))

(defn filter-vals [f xs]
  (into {} (filter (comp f second) xs)))

(defn construct-table [players xs]
  (into {}
        (for [x1 xs
              x2 xs]
          [(set [x1 x2]) (map-vals #(% x1 x2) players)])))

(defn unique-values [key table]
  (->> table 
       vals 
       (map key)
       frequencies
       (filter-vals #(= 1 %))
       (map first)
       (into #{})))

(defn eliminate-unique [key table]
  (let [singles (unique-values key table)]
    (filter-vals #(not (singles (key %))) table)))

(defn keep-unique [key table]
  (let [singles (unique-values key table)]
    (filter-vals #(singles (key %)) table)))

(defn get-next [coll item]
  (let [to-next (zipmap coll (rest (cycle coll)))]
    (to-next item)))

(defn dialog [players numbers max-n]
  (loop [key   (->> players keys first)
         table (construct-table players numbers)
         n     0]
    (if (>= n max-n)
      table
      (recur 
       (get-next (keys players) key) 
       (eliminate-unique key table)
       (inc n)))))

(defn solve [players numbers max-n]
  (->> (dialog players numbers max-n)
       (keep-unique :peter)))

(solve players (range 1 100) 14)
;; {#{77 84} {:peter 6468, :sandy 161}}