dmalikov · May 17, 2020 20:23 · Feb 6, 2013 · Jan 23, 2013
diff --git a/build.sm b/build.sm
@@ -0,0 +1,9 @@
+target hw1
+    sources
+        hw1.mlb
+        hw1.main.sml
+    end
+
+    option compiler = mlton
+    option output = hw1
+end
diff --git a/hw1.main.sml b/hw1.main.sml
@@ -0,0 +1 @@
+run();
diff --git a/hw1.mlb b/hw1.mlb
@@ -0,0 +1,5 @@
+$(SML_LIB)/basis/basis.mlb
+$(SMACKAGE)/qcheck/v1.2.0/qcheck.mlb
+hw1.sml
+hw1.tests.sml
+hw1.qcheck.sml
diff --git a/hw1.qcheck.sml b/hw1.qcheck.sml
@@ -0,0 +1,25 @@
+open QCheck infix ==>;
+
+fun check_method desc func = let
+    val id = fn x => x
+    val pred_all_true = pred (List.all (fn x => x))
+  in
+    checkOne NONE ("check " ^ desc, pred_all_true) func
+  end
+
+fun run () =
+  [ check_method "is_older" is_older_t
+  , check_method "number_in_month" number_in_month_t
+  , check_method "number_in_months" number_in_months_t
+  , check_method "dates_in_month" dates_in_month_t
+  , check_method "dates_in_months" dates_in_months_t
+  , check_method "get_nth" get_nth_t
+  , check_method "date_to_string" date_to_string_t
+  , check_method "number_before_reaching_sum" number_before_reaching_sum_t
+  , check_method "what_month_t" what_month_t
+  , check_method "month_range" month_range_t
+  , check_method "oldest" oldest_t
+  , check_method "number_in_months_challenge" number_in_months_challenge_t
+  , check_method "dates_in_months_challenge_t" dates_in_months_challenge_t
+  , check_method "reasonable_date" reasonalbe_date_t
+  ]
diff --git a/week01.sml → hw1.sml b/week01.sml → hw1.sml
@@ -114,4 +114,4 @@ fun reasonable_date ((y,m,d) : date) : bool =
         val dim = if is_leap_year then days_in_months_leap else days_in_months
       in
         if d > get_nth (dim,m) then false else true
-      end
+      end
diff --git a/hw1.tests.sml b/hw1.tests.sml
@@ -0,0 +1,119 @@
+val d1 = (1983,5,28)
+val d2 = (1983,9,12)
+val d3 = (1983,9,10)
+val d4 = (1980,10,1)
+val ds = [d1,d2,d3,d4]
+val ms1 = [5,9]
+val ms2 = [9,11,6]
+val ms3 = [1,2,3,4,6,7,8]
+val ms4 = [10,5]
+
+val is_older_t =
+  [ is_older (d1,d2) = true
+  , is_older (d2,d1) = false
+  , is_older (d1,d1) = false
+  , is_older (d3,d2) = true
+  , is_older (d2,d3) = false
+  , is_older (d4,d1) = true
+  ]
+
+
+val number_in_month_t =
+  [ number_in_month (ds,5) = 1
+  , number_in_month (ds,9) = 2
+  , number_in_month (ds,7) = 0
+  ]
+
+
+val number_in_months_t =
+  [ number_in_months (ds,ms1) = 3
+  , number_in_months (ds,ms2) = 2
+  , number_in_months (ds,ms3) = 0
+  ]
+
+val dates_in_month_t =
+  [ dates_in_month (ds,5) = [d1]
+  , dates_in_month (ds,9) = [d2,d3]
+  , dates_in_month (ds,7) = []
+  ]
+
+val dates_in_months_t =
+  [ dates_in_months (ds,ms1) = [d1,d2,d3]
+  , dates_in_months (ds,ms2) = [d2,d3]
+  , dates_in_months (ds,ms3) = []
+  , dates_in_months (ds,ms4) = [d4,d1]
+  ]
+
+val ss1 = ["one","two","three","four","five"]
+
+val get_nth_t =
+  [ get_nth (ss1,2) = "two"
+  , get_nth (ss1,1) = "one"
+  ]
+
+val date_to_string_t =
+  [ date_to_string d1 = "May 28, 1983"
+  , date_to_string d2 = "September 12, 1983"
+  , date_to_string d3 = "September 10, 1983"
+  , date_to_string d4 = "October 1, 1980"
+  ]
+
+val numbers = [1, 6, 9, 4, 2, 19]
+
+val number_before_reaching_sum_t =
+  [ number_before_reaching_sum (8, numbers) = 2
+  , number_before_reaching_sum (17, numbers) = 3
+  , number_before_reaching_sum (21, numbers) = 4
+  , number_before_reaching_sum (1, numbers) = 0
+  ]
+
+val what_month_t =
+  [ what_month 10 = 1
+  , what_month 360 = 12
+  , what_month 150 = 5
+  , what_month 290 = 10
+  , what_month 60 = 3 (* no leap years *)
+  ]
+
+val month_range_t =
+  [ month_range (29,34) = [1,1,1,2,2,2]
+  , month_range (20,19) = []
+  , month_range (101,101) = [4]
+  , month_range (304,305) = [10,11]
+  ]
+
+val oldest_t =
+  [ oldest [] = NONE
+  , oldest [d2] = SOME d2
+  , oldest ds = SOME d4
+  ]
+
+val number_in_months_challenge_t =
+  [ number_in_months_challenge (ds,ms1) = number_in_months (ds,ms1)
+  , number_in_months_challenge (ds,ms2) = number_in_months (ds,ms2)
+  , number_in_months_challenge (ds,ms3) = number_in_months (ds,ms3)
+  , number_in_months_challenge (ds,ms1@ms1) = number_in_months (ds,ms1)
+  , number_in_months_challenge (ds,ms2@ms2) = number_in_months (ds,ms2)
+  , number_in_months_challenge (ds,ms3@ms3) = number_in_months (ds,ms3)
+  ]
+
+val dates_in_months_challenge_t =
+  [ dates_in_months_challenge (ds,ms1) = dates_in_months (ds,ms1)
+  , dates_in_months_challenge (ds,ms2) = dates_in_months (ds,ms2)
+  , dates_in_months_challenge (ds,ms3) = dates_in_months (ds,ms3)
+  , dates_in_months_challenge (ds,ms4) = dates_in_months (ds,ms4)
+  , dates_in_months_challenge (ds,ms1@ms1) = dates_in_months (ds,ms1)
+  , dates_in_months_challenge (ds,ms2@ms2) = dates_in_months (ds,ms2)
+  , dates_in_months_challenge (ds,ms3@ms3) = dates_in_months (ds,ms3)
+  , dates_in_months_challenge (ds,ms4@ms4) = dates_in_months (ds,ms4)
+  ]
+
+val reasonalbe_date_t =
+  [ reasonable_date d1 = true
+  , reasonable_date d2 = true
+  , reasonable_date d3 = true
+  , reasonable_date d4 = true
+  , reasonable_date (~10,1,1) = false
+  , reasonable_date (1900,2,29) = false
+  , reasonable_date (1904,2,29) = true
+  ]
diff --git a/week01.sml b/week01.sml
@@ -0,0 +1,117 @@
+(* TYPE INITIALIZING *)
+type year = int
+type month = int
+type day = int
+type date = (year * month * day)
+
+(* BORING ROUTINES *)
+fun filter p l =
+  if null l then [] else
+  let
+    val x = hd l
+    val xs = tl l
+  in
+    if p x
+      then x :: filter p xs
+      else filter p xs
+  end
+
+fun map f l =
+  if null l then [] else
+    f (hd l) :: map f (tl l)
+
+fun sum l =
+  if null l then 0 else
+    hd l + sum (tl l)
+
+fun concat l =
+  if null l then [] else
+    (hd l) @ concat (tl l)
+
+fun concatMap f l =
+  concat (map f l)
+
+fun range a b =
+  if a > b then [] else a :: range (a+1) b
+
+fun member x l =
+  if null l then false else
+    (x = hd l) orelse member x (tl l)
+
+fun uniq l =
+  if null l then [] else
+    let
+      val x = hd l
+      val xs = tl l
+    in
+      if member x xs then uniq xs else x :: uniq xs
+    end
+
+
+(* ACTUAL SOLUTIONS *)
+val days_in_months = [31,28,31,30,31,30,31,31,30,31,30,31]
+val days_in_months_leap = [31,29,31,30,31,30,31,31,30,31,30,31]
+val string_months = [ "January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December" ]
+
+fun is_older ((y1,m1,d1):date, (y2,m2,d2):date) =
+  if (y1 > y2) then false else
+    if (y1 = y2) andalso (m1 > m2) then false else
+      if (y1 = y2) andalso (m1 = m2) andalso (d1 >= d2) then false else
+        true
+
+fun number_in_month (dates : date list, m : month) : int =
+  length (filter (fn x => #2 x = m) dates)
+
+fun number_in_months (dates : date list, months : month list) : int =
+  sum (map (fn m => number_in_month (dates,m)) months)
+
+fun dates_in_month (dates : date list, m : month) : date list =
+  filter (fn x => #2 x = m) dates
+
+fun dates_in_months (dates : date list, months : month list) : date list =
+  concatMap (fn m => dates_in_month (dates,m)) months
+
+fun get_nth (l, n) =
+  if n <= 1 then hd l else
+    get_nth (tl l, n-1)
+
+fun date_to_string ((y,m,d) : date) : string =
+  get_nth (string_months, m) ^ " " ^ Int.toString d ^ ", " ^ Int.toString y
+
+exception EmptyList
+fun number_before_reaching_sum (sum : int, l : int list) : int =
+  if null l then raise EmptyList else
+    if hd l >= sum then 0 else
+      1 + number_before_reaching_sum (sum - hd l, tl l)
+
+fun what_month (d : int) : int =
+  1 + number_before_reaching_sum (d, days_in_months)
+
+fun month_range (day1 : int, day2 : int) : month list =
+  map what_month (range day1 day2)
+
+fun oldest (l : date list) : date option =
+  if null l then NONE else
+    let
+      fun foldl f z [] = z
+        | foldl f z l = foldl f (f z (hd l)) (tl l)
+      fun min a b = if is_older (a,b) then a else b
+    in
+      SOME (foldl min (hd l) (tl l))
+    end
+
+fun number_in_months_challenge (l,months) =
+  number_in_months (l, uniq months)
+
+fun dates_in_months_challenge (l,months) =
+  dates_in_months (l, uniq months)
+
+fun reasonable_date ((y,m,d) : date) : bool =
+  if y <= 0 then false else
+    if m < 1 orelse m > 12 then false else
+      let
+        val is_leap_year = y mod 400 = 0 orelse (y mod 4 = 0 andalso y mod 100 <> 0)
+        val dim = if is_leap_year then days_in_months_leap else days_in_months
+      in
+        if d > get_nth (dim,m) then false else true
+      end