Cheryl's Birthday

cheryl.clj

;; http://www.theguardian.com/science/alexs-adventures-in-numberland/2015/apr/13/can-you-solve-the-singapore-primary-maths-question-that-went-viral

(def possible-dates
  (sorted-set
    [5 15] [5 16] [5 19]
    [6 17] [6 18]
    [7 14] [7 16]
    [8 14] [8 15] [8 17]))

;; Albert was told the month. Bernard was told the day of month.

(def dates-by-month
  (group-by first possible-dates))

(def day-occurences
  (sort (map second possible-dates)))

(def day-freq
  (frequencies day-occurences))

;; First elimination:
;; Albert: "I don't know Cheryl's birthday, and neither does Bernard."
;; Eliminate all dates in the same month where the day of month only appears once in the list.


(def unique-days
  (set (map first
            (filter (fn [[day freq]]
                      (= freq 1)) day-freq))))

(defn month-has-unique-days? [month]
  (let [dates-in-month (dates-by-month month)
        days-in-dates-in-month (set (map second dates-in-month))]
    (not (empty? (clojure.set/intersection unique-days
                                           days-in-dates-in-month)))))


(def months-with-non-unique-days
  (set
    (for [[m dates-in-month] dates-by-month
          :when (not (month-has-unique-days? m))]
      m)))


(def possible-dates-after-first-elimination
  (apply sorted-set
         (filter (fn [[m d]]
                   (contains? months-with-non-unique-days m))
                 possible-dates)))


;; Second elimination:
;; Bernard: "At first I didn't know when Cheryl's birthdate is, but now I know."
;; Eliminate dates with the same day.

(def day-freq-after-first-elimination
  (frequencies (map second possible-dates-after-first-elimination)))

(def dupes-days
  (set (for [[d f] day-freq-after-first-elimination
             :when (> f 1)]
         d)))

(def possible-dates-after-second-elimination
  (apply sorted-set (filter (fn [[m d]]
                              (not (contains? dupes-days d)))
                            possible-dates-after-first-elimination)))


;; Third elimination:
;; Albert: "Then I also know when Cheryl's birthday is."
;; Eliminate dates where the month has more than one date.

(def month-freq
  (frequencies (map first possible-dates-after-second-elimination)))

(def the-month
  (first (for [[m f] month-freq
               :when (= f 1)]
           m)))


(def cheryls-birthdate
  (filter (fn [[m d]]
            (= m the-month))
          possible-dates-after-second-elimination))