Skip to content

Instantly share code, notes, and snippets.

@lazyval
Last active December 12, 2015 03:38
Show Gist options
  • Save lazyval/4708007 to your computer and use it in GitHub Desktop.
Save lazyval/4708007 to your computer and use it in GitHub Desktop.
SML sandbox. I place here most of the stuff, I've done during coursera course. If you don't like **SPOILERS**, please, move along, don't look inside.
[submodule "SMLTest"]
path = SMLTest
url = git://github.com/Yankovsky/SMLTest.git
(* Disclamer.
Please, do not complain that most of the stuff here could be rewritten easily
using pattern matching: the rules of this assignment prohibits use of some of the
SML features, including pattern matching *)
type day = int
type month = int
type year = int
type date = day * month * year
fun is_older(a: date, b: date) =
let
val year_before = #3 a < #3 b;
val month_before = #2 a < #2 b;
val day_before = #1 a < #1 b;
in
year_before orelse month_before orelse day_before
end;
(* how many dates in the list are in the given month *)
fun number_in_month(dates: date list, m: month) =
if(null dates) then 0
else let
val d = hd dates
val month_matches_inc = if(#2 d = m) then 1 else 0
in
month_matches_inc + number_in_month(tl dates, m)
end;
(* returns the number of dates in the list of dates that are in any
of the months in the list of months *)
fun number_in_months(dates: date list, ms: month list) =
if(null ms) then 0
else number_in_month(dates, hd ms) + number_in_months(dates, tl ms)
(* returns a list holding the dates from the argument list of dates that are in the month *)
fun dates_in_month(dates: date list, m: month) =
if(null dates) then []
else let
val d = hd dates
val curr_m = #2 d
val matches = curr_m = m
in
if(matches) then d::dates_in_month(tl dates, m)
else dates_in_month(tl dates, m)
end;
(* returns a list holding the dates that are in any of the months *)
fun dates_in_months(dates: date list, months: month list) =
if(null months) then []
else dates_in_month(dates, hd months) @ dates_in_months(dates, tl months)
fun get_nth(xs: string list, n: int) =
if(n = 1) then hd xs
else get_nth(tl xs, n-1)
fun date_to_string(x: date) =
let
val months = [
"January", "February", "March",
"April", "May", "June",
"July", "August", "September",
"October", "November", "December"
]
val m = get_nth(months, #2 x)
in
m ^ " " ^ Int.toString(#3 x) ^ ", " ^ Int.toString(#1 x)
end
fun number_before_reaching_sum(sum: int, xs: int list) =
let
val h = hd xs
val diff = sum - h
in
if(diff > 0) then 1 + number_before_reaching_sum(diff, tl xs) else 0
end
fun what_month(d: day) = 1 + number_before_reaching_sum(d, [
31,28,31, (* J, F, M *)
30,31,30, (* A, M, J *)
31,31,30, (* J, A, S *)
31,30,31 (* O, N, D *)
])
fun month_range(day1: day, day2: day) =
if(day1 > day2) then []
else let
val m = what_month(day1)
val tail = month_range(day1+1, day2)
in
m::tail
end;
fun oldest(dates: date list) =
if(null dates) then NONE
else let
val the_oldest = oldest(tl dates)
val h = hd dates
in
if(isSome the_oldest andalso is_older(valOf the_oldest, h))
then the_oldest
else SOME h
end;
(* Dan Grossman, Coursera PL, HW2 Provided Code *)
(* if you use this function to compare two strings (returns true if the same
string), then you avoid several of the functions in problem 1 having
polymorphic types that may be confusing *)
fun same_string(s1 : string, s2 : string) =
s1 = s2
(* 1a *)
(* NONE if the string is not in the list, else return SOME lst where lst is identical to the argument list except the string is not in it *)
fun all_except_option (str: string, strings: string list) =
let fun recursive_helper(to_process: string list, acc: string list) = case to_process of
[] => NONE
| h::tail => if(same_string(h, str))
then SOME(acc @ tail)
else recursive_helper(tail, h::acc)
in recursive_helper(strings, []) end;
(* 1 b
takes a string list list (a list of list of strings, the
substitutions) and a string s and returns a string list. The result has all the strings that are in
some list in substitutions that also has s, but s itself should not be in the result
*)
fun get_substitutions1 (xss: (string list) list, s: string) = case xss of
[] => []
| substitution::tail => case all_except_option(s, substitution) of
NONE => get_substitutions1(tail,s)
| SOME(lst: string list) => lst @ get_substitutions1(tail,s)
(* 1c. Same as 1b, but with tail-recursive helper inside *)
fun get_substitutions2 (xss: (string list) list, s: string) =
let fun subs(xss: string list list, acc: string list) = case xss of
[] => acc
| substitution::tail => case all_except_option(s, substitution) of
NONE => subs(tail, acc)
| SOME(lst: string list) => subs(tail, lst@acc)
in subs(xss, []) end;
(* 1d.
The result is all the full names you
can produce by substituting for the frst name (and only the frst name) using substitutions and parts (b)
or (c). The answer should begin with the original name (then have 0 or more other names).
*)
fun similar_names(substitutions: string list list,
full_name : {first: string, middle: string, last: string}) =
let
val {first = first, middle = middle, last = last} = full_name (* deconstructed record, so we call access all parts directly*)
fun produce_names_foreach(subs: string list) = case subs of
[] => []
| h::tail => {first = h, middle = middle, last = last} :: produce_names_foreach(tail)
in
full_name::produce_names_foreach(get_substitutions2(substitutions, first))
end;
(* you may assume that Num is always used with values 2, 3, ..., 10
though it will not really come up *)
datatype suit = Clubs | Diamonds | Hearts | Spades
datatype rank = Jack | Queen | King | Ace | Num of int
type card = suit * rank
datatype color = Red | Black
datatype move = Discard of card | Draw
exception IllegalMove
(* 2a *)
fun card_color (s: suit, _: rank) = case s of
Spades => Black
| Clubs => Black
| Hearts => Red
| Diamonds => Red
(* 2b *)
fun card_value(_: suit, r: rank) = case r of
Ace => 11
| Jack => 10
| Queen => 10
| King => 10
| Num i => i
(* 2c *)
fun remove_card(cs: card list, c: card, e) = case cs of
[] => raise e (* went through the whole list and haven't found c *)
| hd::tail => if(hd = c) then tail else remove_card(tail, c, e)
(* 2d *)
fun all_same_color(cs: card list) = case cs of
[] => true
| x::[] => true
| a::b::c => card_color(a) = card_color(b) andalso all_same_color(c)
(* 2e *)
fun sum_cards(cs: card list) = let
fun sum_helper(cs: card list, acc: int) = case cs of
[] => acc
| h::tail => sum_helper(tail, acc+card_value(h))
in sum_helper(cs, 0) end;
(* 2f *)
fun score(cs: card list, goal: int) = let
val sum = sum_cards(cs)
val prelimenary = if(sum > goal)
then 3 * (sum - goal)
else goal - sum
in
if(all_same_color(cs)) then prelimenary div 2 else prelimenary
end;
(* 2g *)
fun officiate(cs: card list, mv: move list, goal: int) = let
fun play(held: card list, cs: card list, mv: move list) = case (cs, mv) of
(_, []) => score(held, goal)
| ([], _) => score(held, goal)
| (c::ctail, m::move_tail) => case (cs, m) of
(_, Discard d) => play(remove_card(held, d, IllegalMove), cs, move_tail)
| ([], Draw) => score(held, goal)
| (_, Draw) => if (sum_cards(held) > goal) then score(held, goal)
else play(c::held,ctail, move_tail)
in play([], cs, mv) end;
source 'http://rubygems.org'
group :development do
gem 'guard-process'
gem 'rb-fsevent', :require => false if RUBY_PLATFORM =~ /darwin/i
end
guard 'process', :name => 'Execute tests', :command => 'sml hw3-tests.sml', :stop_signal => "KILL" do
watch('hw3.sml')
end
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment