Direct port of Norvig's "When is Cheryl's birthday?"

cheryls-birthday.reb

Rebol [
    Title: {Direct port of Norvig's "When is Cheryl's birthday?"}
    see: http://nbviewer.ipython.org/url/norvig.com/ipython/Cheryl.ipynb
    version: 1.0.0   ;  short & sweet version (no function docs or optional dates)
]

filter: function [f s] [
    collect [foreach n s [if f n [keep n]]]
]

DATES: ["May 15"    "May 16"    "May 19"
        "June 17"   "June 18"
        "July 14"   "July 16"
        "August 14" "August 15" "August 17"]

month: func [date] [first split date space]
day:   func [date] [second split date space]

tell: function [part] [filter func [date] [find date part] DATES]

know?: func [possible-dates] [1 == length? possible-dates]

cheryl's-birthday: does [filter :statements3to5? DATES]

statements3to5?: func [date] [all [statement3? date  statement4? date  statement5? date]]

statement3?: function [date] [
    possible-dates: tell month date
    all [
        not know? possible-dates
        all map-each d possible-dates [not know? tell day d]
    ]
]

statement4?: function [date] [
    at-first: tell day date
    all [
        not know? at-first
        know? filter :statement3? at-first
    ]
]

statement5?: function [date] [
    know? filter :statement4? tell month date
]

probe cheryl's-birthday

cheryls_birthday.pl

use 5.020;
use warnings;
use feature 'signatures';
no warnings 'experimental::signatures';
use List::Util qw(all);

our @DATES = ('May 15',    'May 16',    'May 19',
              'June 17',   'June 18',
              'July 14',   'July 16',
              'August 14', 'August 15', 'August 17');

sub month ($date) { (split /\s/, $date)[0] }  
sub day   ($date) { (split /\s/, $date)[1] }  

sub tells ($part) { grep { m/$part/ } @DATES }

sub knows (@possible_dates) { 1 == @possible_dates }

sub cheryls_birthday { grep { statements3to5($_) } @DATES }

sub statements3to5 ($date) { statement3($date) and statement4($date) and statement5($date) }

sub statement3 ($date) {
    my @possible_dates = tells(month($date));
    not knows(@possible_dates)
    and all { not knows(tells(day($_))) } @possible_dates;
}

sub statement4 ($date) {
    my @at_first = tells(day($date));
    not knows(@at_first)
    and knows(grep { statement3($_) } @at_first);
}

sub statement5 ($date) {
    knows(grep { statement4($_) } tells(month($date)));
}

say cheryls_birthday;

more-cheryl.reb

Rebol [
    Title: {Direct port of Norvig's "When is Cheryl's birthday?"}
    see: http://nbviewer.ipython.org/url/norvig.com/ipython/Cheryl.ipynb
    version: 2.0.0   ; alt version without filter + function specs (docs/types)
                     ; and /with optional dates
]

DATES: ["May 15"    "May 16"    "May 19"
        "June 17"   "June 18"
        "July 14"   "July 16"
      "August 14" "August 15" "August 17"]

month: func [date [string!]] [first split date space]
day:   func [date [string!]] [second split date space]

tell: function [
    "Cheryl tells a part of her birthdate to someone; return a new list of possible dates that match the part."
    part [string!]
    /with possible-dates [block!]
  ][
    unless with [possible-dates: copy DATES]
    remove-each date possible-dates [not find date part]
    possible-dates
]

know?: func [
    "A person knows the birthdate if they have exactly one possible date."
    possible-dates [block!]
  ][1 == length? possible-dates]

cheryl's-birthday: function [
    "Return a list of the possible dates for which statements 3 to 5 are true."
    /with possible-dates [block!]
  ][
    unless with [possible-dates: copy DATES]
    remove-each date possible-dates [not statements3to5? date]
    possible-dates
]

statements3to5?: func [date] [all [statement3? date  statement4? date  statement5? date]]

statement3?: function [
    "Albert: I don't know when Cheryl's birthday is, but I know that Bernard does not know too."
    date [string!]
  ][
    possible-dates: tell month date
    all [
        not know? possible-dates
        all map-each d possible-dates [not know? tell day d]
    ]
]

statement4?: function [
    "Bernard: At first I don't know when Cheryl's birthday is, but I know now."
    date [string!]
  ][
    at-first: tell day date
    all [
        not know? at-first
        know? collect [foreach d at-first [if statement3? d [keep d]]]
    ]
]

statement5?: function [
    "Albert: Then I also know when Cheryl's birthday is."
    date [string!]
  ][
    remove-each d possible-dates: tell month date [not statement4? d]
    know? possible-dates
]

probe cheryl's-birthday