cheryls.ml

(*
 * Copyright (c) 2015 Moritz Bitsch <moritzbitsch@gmail.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *
 * OCaml solution to the "Cheryl's birthday" quiz
 *)

#load "str.cma";;

let dates = ["May 15"; "May 16"; "May 19";
             "June 17"; "June 18";
             "July 14"; "July 16";
             "August 14"; "August 15"; "August 17"] |>
            List.map (fun el -> match Str.split (Str.regexp " ") el with | [month; day] -> (month, day) | _ -> raise (Invalid_argument "Can't parse data") ) in
let tell v = 
  List.filter ( fun (month, day) -> v = month || v = day ) in
let know lst =
  (List.length lst) == 1 in
let all =
  List.fold_left (fun all el -> all && el) true in
let rule3 =
  List.filter (fun (month, _) -> let possible = tell month dates in
                if know possible then
                  false
                else
                  List.map (fun (_, day) -> tell day dates |> know |> not) possible |> all) in
let rule4 =
  List.filter (fun (_, day) -> let at_first = tell day dates in
                if know at_first then
                  false
                else
                  rule3 at_first |> know) in
let rule5 =
  List.filter (fun (month, _) -> tell month dates |> rule4 |> know) in

(* actual rule execution *)
dates |> rule3 |> rule4 |> rule5 |>

(* dump results *)
(fun res -> match res with
   | [month,day] -> Printf.printf "Cheryl's birthday is: %s %s\n" month day
   | _ -> raise (Failure "More than one date found, sorry")
);;