Cheryl's birthday
Albert and Bernard just became friends with Cheryl, and they want to know when her birthday is.
Cheryl gave them a list of 10 possible dates:
May 15, May 16, May 19 June 17, June 18 July 14, July 16 August 14, August 15, August 17
Cheryl then tells Albert and Bernard separately the month and the day of the birthday respectively.
1) Albert: I don't know when Cheryl's birthday is, but I know that Bernard does not know too.
2) Bernard: At first I don't know when Cheryl's birthday is, but I know now.
3) Albert: Then I also know when Cheryl's birthday is.
- Task
Write a program in your language to deduce, by successive elimination, Cheryl's birthday.
See the Wikipedia article of the same name.
- Related task
Common Lisp
<lang lisp> (defparameter *possible-dates*
'((15 . may) (16 . may) (19 . may) (17 . june) (18 . june) (14 . july) (16 . july) (14 . august) (15 . august) (17 . august)))
(defun count-items (list)
"returns a list of (item how-many-of-it)" (mapcar #'(lambda (item) (list item (count item list :test #'equal)))
(remove-duplicates list :test #'equal)))
(defun filter-dates (possible-dates &key (alist-look-at #'car) (alist-r-assoc #'assoc))
(let ((unique-date-parts (remove-if-not #'(lambda (part) (= (cadr part) 1))
(count-items (mapcar alist-look-at possible-dates)))))
(mapcar #'(lambda (part) (funcall alist-r-assoc part possible-dates)) (mapcar #'first unique-date-parts))))
(defun person (person possible-dates)
"Who's turn is it to think?"
(case person
('albert (filter-dates possible-dates :alist-look-at #'cdr :alist-r-assoc #'rassoc))
('bernard (filter-dates possible-dates :alist-look-at #'car :alist-r-assoc #'assoc))))
(defun cheryls-birthday (possible-dates)
(person 'albert ;And this is the final search Albert does in stage 3) and finds the birthday
(person 'bernard ;This is the search Bernard does in stage 2) (set-difference possible-dates (person 'bernard possible-dates) ;This is the search Albert does at first on behalf of Bernard in stage 1) :key #'cdr))))
(cheryls-birthday *possible-dates*) ;; => ((16 . JULY)) </lang>
Go
<lang go>package main
import (
"fmt" "time"
)
type birthday struct{ month, day int }
func (b birthday) String() string {
return fmt.Sprintf("%s %d", time.Month(b.month), b.day)
}
func (b birthday) monthUniqueIn(bds []birthday) bool {
count := 0
for _, bd := range bds {
if bd.month == b.month {
count++
}
}
if count == 1 {
return true
}
return false
}
func (b birthday) dayUniqueIn(bds []birthday) bool {
count := 0
for _, bd := range bds {
if bd.day == b.day {
count++
}
}
if count == 1 {
return true
}
return false
}
func (b birthday) monthWithUniqueDayIn(bds []birthday) bool {
for _, bd := range bds {
if bd.month == b.month && bd.dayUniqueIn(bds) {
return true
}
}
return false
}
func main() {
choices := []birthday{
{5, 15}, {5, 16}, {5, 19}, {6, 17}, {6, 18},
{7, 14}, {7, 16}, {8, 14}, {8, 15}, {8, 17},
}
// Albert knows the month but doesn't know the day.
// So the month can't be unique within the choices.
var filtered []birthday
for _, bd := range choices {
if !bd.monthUniqueIn(choices) {
filtered = append(filtered, bd)
}
}
// Albert also knows that Bernard doesn't know the answer.
// So the month can't have a unique day.
var filtered2 []birthday
for _, bd := range filtered {
if !bd.monthWithUniqueDayIn(filtered) {
filtered2 = append(filtered2, bd)
}
}
// Bernard now knows the answer.
// So the day must be unique within the remaining choices.
var filtered3 []birthday
for _, bd := range filtered2 {
if bd.dayUniqueIn(filtered2) {
filtered3 = append(filtered3, bd)
}
}
// Albert now knows the answer too.
// So the month must be unique within the remaining choices.
var filtered4 []birthday
for _, bd := range filtered3 {
if bd.monthUniqueIn(filtered3) {
filtered4 = append(filtered4, bd)
}
}
if len(filtered4) == 1 {
fmt.Println("Cheryl's birthday is", filtered4[0])
} else {
fmt.Println("Something went wrong!")
}
}</lang>
- Output:
Cheryl's birthday is July 16
Perl 6
<lang perl6>my @dates =
{ :15day, :5month },
{ :16day, :5month },
{ :19day, :5month },
{ :17day, :6month },
{ :18day, :6month },
{ :14day, :7month },
{ :16day, :7month },
{ :14day, :8month },
{ :15day, :8month },
{ :17day, :8month }
- Month can't have a unique day
my @filtered = @dates.grep(*.<month> != one(@dates.grep(*.<day> == one(@dates».<day>))».<month>));
- Day must be unique and unambiguous in remaining months
my $birthday = @filtered.grep(*.<day> == one(@filtered».<day>)).classify({.<month>})\
.first(*.value.elems == 1).value[0];
- convenience hash
my %months = < January February March April May June July
August September October November December>.kv.pairup;
say "Cheryl's birthday is { %months{$birthday<month>} } {$birthday<day>}.";</lang>
Cheryl's birthday is July 16.
zkl
<lang zkl>var D=Time.Date,
bDays=T(T(D.May, 15), T(D.May, 16), T(D.May, 19),
T(D.June, 17), T(D.June, 18),
T(D.July, 14), T(D.July, 16), T(D.August,14), T(D.August,15), T(D.August,17) ),
pDates=bDays.pump(Dictionary().appendKV); // "5":(15,16,19), "6":(17,18) ...
dayCnt:=bDays.pump(Dictionary().incV,T("get",1)); // 15:2, 14:2, 19:1, 18:1 .. udays :=dayCnt.keys.filter('wrap(d){ dayCnt[d]==1 }).apply("toInt"); # (19,18) days :=pDates.keys.apply2('wrap(m) // remove months that have a unique day
{ if(interset(pDates[m],udays)) pDates.del(m) }); // 7:(14,16), 8:(14,15,17)
days :=pDates.values.reduce(intersection); // (16), len>1 --> ambiguous result mons :=pDates.filter(fcn([(m,ds)],d,ms){ // find months that hold day
ms.holds(m) and ds.holds(d) }.fp1(days[0],pDates.keys)); # ((7,(14,16)))
if(days.len()>1 or mons.len()>1) throw(Exception.BadDay); // can't reduce
println("Cheryl's birthday is ",D.monthNames[mons[0][0]]," ",days[0]);
fcn interset(l1,l2){ foreach i in (l1){ if(l2.holds(i)) return(True) } False } fcn intersection(l1,l2){ l1.pump(List,l2.holds,'==(False),Void.Filter) }</lang>
- Output:
Cheryl's birthday is July 16