When is Cheryl's Birthday?

;;; 1. Cheryl gave them a list of 10 possible dates.

(define +dates+ '(("May" 15) ("May" 16) ("May" 19)
                  ("June" 17) ("June" 18)
                  ("July" 14) ("July" 16)
                  ("August" 14) ("August" 15) ("August" 17)))

;; We'll also define accessor functions for the month and day of a
;; date:

(define (month date)
  (car date))

(define (day date)
  (cadr date))

(month '("May" 15))
#| "May" |#

(day '("May" 15))
#| 15 |#

;;; 2. Cheryl then tells Albert and Bernard separately the month and
;;; the day of the birthday respectively.

;; We can define the idea of telling, and while we're at it, the idea
;; of knowing a birth date.

(define (tell part)
  "Cheryl tells a part of her birthdate to someone. Return a new list
of possible dates that match the part."
  (define (contains-part? pair)
    (member part pair))
  (filter contains-part? +dates+))

(define (know possible-dates)
  "A person knows the birthdate if they have exactly one possible
date."
  (= 1 (length possible-dates)))

;; Note that we use a list of dates to represent someone's knowledge
;; of the possible birthdates, and that someone knows the birthdate
;; when they get down to only one possibility.  For example: If Cheryl
;; tells Albert that her birthday is in May, he would have a list of
;; three possible birthdates:

(tell "May")
#| (("May" 15) ("May" 16) ("May" 19)) |#

;; And if she tells Bernard that her birthday is on the 15th, he would
;; end up with two possibilities:

(tell 15)
#| (("May" 15) ("August" 15)) |#

;; With two possibilities, Bernard does not know the birthdate:

(know (tell 15))
#| #f |#

;;; Overall strategy

;; When Cheryl tells Albert 'May' then he knows there are three
;; possibilities, but we (the puzzle solvers) don't, because we
;; don't know what Cheryl said. So what can we do? We will consider
;; all of the possible dates, one at a time. For example, first
;; consider 'May 15'. Cheryl tells Albert 'May' and Bernard
;; '15', giving them the lists of possible birthdates shown above.
;; We can then check whether statements 3 through 5 are true in this
;; scenario.  If they are, then 'May 15' is a solution to the
;; puzzle.  Repeat the process for each of the possible dates. If all
;; goes well, there should be exactly one solution.

;; Here is the main function, cheryls-birthday:

(define (cheryls-birthday)
  (filter statement-3-to-5 +dates+))

(define (statement-3-to-5 date)
  (and (statement3 date) (statement4 date) (statement5 date)))

;;; 3. Albert: I don't know when Cheryl's birthday is, but I know that
;;; Bernard does not know too.

;; The function `statement3` takes as input a possible birthdate and
;; returns true if Albert's statement is true for that birthdate. How
;; do we go from Albert's English statement to a Scheme procedure?
;; Let's paraphrase in a form that is closer to Scheme code:

;;   Albert: After Cheryl told me the month of her birthdate, I didn't
;;   know her birthday.  I don't know which day Cheryl told Bernard,
;;   but I know that for all of the possible dates, if Bernard is told
;;   that day, he wouldn't know the birthdate.

;; That I can translate directly into code:

(define (statement3 date)
  "Albert: I don't know when Cheryl's birthday is, but I know that
Bernard does not know too."
  (define (not-know-day? d)             ; Helper procedure
    (not (know (tell (day d)))))
  (let ((possible-dates (tell (month date)))) ; Statement
    (and (not (know possible-dates))
         (every not-know-day? possible-dates))))

;; We can try the function on a date:

(statement3 '("May" 15))
#| #f |#

(filter statement3 +dates+)
#| (("July" 14) ("July" 16) ("August" 14) ("August" 15) ("August" 17)) |#

;;; 4. Bernard: At first I don't know when Cheryl's birthday is, but I
;;; know now.

;; Again, a paraphrase:

;;   Bernard: At first Cheryl told me the day, and I didn't know.
;;   Then I considered just the dates for which Albert's statement 3
;;   is true, and now I know.

(define (statement4 date)
  "Bernard: At first I don't know when Cheryl's birthday is, but I
know now."
  (let ((at-first (tell (day date))))
    (and (not (know at-first))
         (know (filter statement3 at-first)))))

;; Let's see which dates satisfy both statement 3 and statement 4:

(filter statement4 (filter statement3 +dates+))
#| (("July" 16) ("August" 15) ("August" 17)) |#

;; Wait a minute--I thought that Bernard knew?! Why are there three
;; possible dates remaining? Bernard does indeed know the birthdate,
;; because he knows something we don't know: the day. We won't know the
;; birthdate until after statement 5.

;;; Albert: Then I also know when Cheryl's birthday is.

;; Albert is saying that after hearing the month and Bernard's
;; statement 4, he now knows Cheryl's birthday:

(define (statement5 date)
  "Albert: Then I also know when Cheryl's birthday is."
  (know (filter statement4 (tell (month date)))))

;;; 6. So when is Cheryl's birthday?

;; Let's see:

(cheryls-birthday)
#| (("July" 16)) |#

;; Success! We have deduced that Cheryl's birthday is July 16. It is
;; now true that we know Cheryl's birthday:

(know (cheryls-birthday))
#| #t |#