Skip to content

Instantly share code, notes, and snippets.

@dmalikov
Last active May 17, 2020 20:23
Show Gist options
  • Save dmalikov/4615885 to your computer and use it in GitHub Desktop.
Save dmalikov/4615885 to your computer and use it in GitHub Desktop.
Programming Languages assignment 1 (with smbt and qcheck)
target hw1
sources
hw1.mlb
hw1.main.sml
end
option compiler = mlton
option output = hw1
end
$(SML_LIB)/basis/basis.mlb
$(SMACKAGE)/qcheck/v1.2.0/qcheck.mlb
hw1.sml
hw1.tests.sml
hw1.qcheck.sml
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
]
(* 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
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
]
@dmalikov
Copy link
Author

dmalikov commented Feb 6, 2013

Compile module with smbt:

$> smbt hw1
smbt 0.3.1
 - Build file: build.sm
 - Target: hw1
 - Running pre-hooks
 - Invoking MLton
 - Output: hw1 (543562 bytes)
 - Running post-hooks

Run tests:

$> ./hw1 
check is_older.........ok      (1 passed)          
check number_in_month..ok      (1 passed)          
check number_in_months.ok      (1 passed)          
check dates_in_month...ok      (1 passed)          
check dates_in_months..ok      (1 passed)          
check get_nth..........ok      (1 passed)          
check date_to_string...ok      (1 passed)          
check number_before_reaching_sum.ok      (1 passed)          
check what_month_t.....ok      (1 passed)          
check month_range......ok      (1 passed)          
check oldest...........ok      (1 passed)          
check number_in_months_challenge.ok      (1 passed)          
check dates_in_months_challenge_t.ok      (1 passed)          
check reasonable_date..ok      (1 passed)    

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment