Programming Languages Week 1 Assignment in OCaml

hw1.ml

(* Week 1 assignment in Ocaml *)

let is_older d1 d2 = match d1, d2 with
    (y1,m1,d1), (y2,m2,d2) ->
      y1 < y2 || (y1 = y2 && m1 < m2) || (y1 = y2 && m1 = m2 && d1 < d2)

let rec number_in_month ds m = match ds with
    [] -> 0
  | x :: xs ->
    let r = number_in_month xs m in
    match x with
        (yr,mn,dy) -> if m = mn then 1 + r else r

let rec number_in_months ds ms = match ms with
    [] -> 0
  | x :: xs ->
    let r = number_in_month ds x in
    r + number_in_months ds xs

let rec dates_in_month ds m = match ds with
    [] -> []
  | x :: xs ->
    let r = dates_in_month xs m in match x with
      | (yr,mn,dy) ->
        if mn = m
        then x :: r
        else r

let rec dates_in_months ds ms = match ms with
    [] -> []
  | x :: xs -> dates_in_month ds x @ dates_in_months ds xs

let rec get_nth strs n = match strs with
    [] -> ""
  | x :: xs -> if n = 1 then x else get_nth xs (n-1)

let date_to_string date =
  let month_names = ["January";"February";"March";"April";"May";
                     "June";"July";"August";"September";"October";
                     "November";"December"]
  in match date with
      (y,m,d) -> get_nth month_names m ^ " " ^ string_of_int d ^ ", " ^ string_of_int y

let number_before_reaching_sum sum ls = match ls with
    [] -> 0
  | x :: xs ->
      let rec number_before_reaching_sum_it ys i a = match ys with
          [] -> i
        | z :: zs -> if a < sum then number_before_reaching_sum_it zs (i+1) (a + z) else i
      in number_before_reaching_sum_it xs 0 x

let what_month day =
  let day_list = [31;28;31;30;31;30;31;31;30;31;30;31]
  in (number_before_reaching_sum day day_list) + 1

let rec month_range d1 d2 =
  if d1 > d2 then []
  else what_month d1 :: month_range (d1+1) d2

let rec oldest ds = match ds with
    [] -> None
  | x :: y :: [] ->
    if is_older x y then Some x else Some y
  | x :: xs ->
    let ans = oldest xs
    in match ans with
        None -> None
      | Some z -> if is_older x z then Some x else ans

let rec remove_dup l =
  let rec remove x ls = match ls with
      [] -> []
    | y :: ys ->
      if x = y
      then remove x ys
      else y :: remove x ys
  in match l with
      [] -> []
    | z :: zs -> z :: remove z (remove_dup zs)

let number_in_months_challenge ds ms =
  let new_ms = remove_dup ms in
  number_in_months ds new_ms

let dates_in_months_challenge ds ms =
  let new_ms = remove_dup ms in
  dates_in_months ds new_ms

let reasonable_date date = match date with
    (y,m,d) ->
      let is_leap_year = y mod 400 = 0 || (y mod 4 = 0 && y mod 100 <> 0) in
      let day_list = [31;28;31;30;31;30;31;31;30;31;30;31] in
      if y <= 0 then false
      else
        if m < 1 || m > 12 then false
        else
          if is_leap_year && m = 2 && d <= 29 && d > 0 then true
          else
            if d > List.nth day_list (m-1) || d <= 0 then false
            else true

let reasonable_date2 date = match date with
    (y,m,d) when y <= 0 -> false
  | (y,m,d) when m < 1 || m > 12 -> false
  | (y,m,d) when m = 2 && d = 29 ->
    let is_leap_year = y mod 400 = 0 || (y mod 4 = 0 && y mod 100 <> 0)
    in is_leap_year
  | (y,m,d) ->
    let day_list = [31;28;31;30;31;30;31;31;30;31;30;31]
    in d <= List.nth day_list (m-1) && d > 0