diff --git a/sml/week2/assignment.pdf b/sml/week2/assignment.pdf new file mode 100644 index 0000000..9cf177f Binary files /dev/null and b/sml/week2/assignment.pdf differ diff --git a/sml/week2/card.sml b/sml/week2/card.sml new file mode 100644 index 0000000..947b4f1 --- /dev/null +++ b/sml/week2/card.sml @@ -0,0 +1,83 @@ +use "list.sml"; + +datatype color = Black | Red +datatype rank = Ace | Queen | King | Jack | Num of int +datatype suit = Club | Diamond | Heart | Spade +type card = suit * rank +datatype move = Draw | Discard of card + +exception IllegalMove + +type card_color = card -> color +val card_color: card_color = fn card => + case card of + (Club, _) => Black + | (Spade, _) => Black + | (Diamond, _) => Red + | (Heart, _) => Red + +type card_value = card -> int +val card_value: card_value = fn (_, rank) => + case rank of + Num num => num + | Ace => 11 + | _ => 10 + +type remove_card = card list * card * exn -> card list +val remove_card: remove_card = fn (cards, to_remove, exp) => + let + fun filter card (found, acc) = + if card <> to_remove orelse found + then (found, card :: acc) + else (true orelse found, acc) + in + case fold filter (false, []) cards of + (true, filtered) => filtered + | (false, _) => raise exp + end + +type all_same_color = card list -> bool +val rec all_same_color: all_same_color = fn cards => + case cards of + [] => true + | one :: [] => true + | first :: second :: rest => + card_color first = card_color second andalso all_same_color rest + +type sum_cards = card list -> int +val sum_cards: sum_cards = fn cards => + cards |> fold (fn card => fn sum => card_value card + sum) 0 + +type score = card list * int -> int +val score: score = fn (cards, goal) => + let + val sum = sum_cards cards + val preliminary_score = + if sum < goal + then goal - sum + else 3 * (sum - goal) + val same_color = all_same_color cards + in + if same_color then preliminary_score div 2 else preliminary_score + end + +type officiate = card list * move list * int -> int +val officiate: officiate = fn (deck, moves, goal) => + let + fun draw (deck, hand) = + case deck of + [] => (deck, hand) + | head :: tail => + if sum_cards hand > goal + then (deck, hand) + else (tail, head :: hand) + + fun play move (deck, hand) = + case move of + Draw => draw (deck, hand) + | Discard card => (deck, remove_card (hand, card, IllegalMove)) + + fun round hand = score (hand, goal) + in + moves |> fold play (deck, []) |> #2 |> round + end \ No newline at end of file diff --git a/sml/week2/card_tests.sml b/sml/week2/card_tests.sml new file mode 100644 index 0000000..42da0f1 --- /dev/null +++ b/sml/week2/card_tests.sml @@ -0,0 +1,212 @@ +use "test.sml"; +use "card.sml"; + +val () = + assert (card_color (Spade, King) = Black) + "card_color: returns right color" + +val () = + assert (card_color (Heart, King) = Red) + "card_color: returns right color x2" + +val () = + assert (card_value (Heart, Num 5) = 5) + "card_value: number card" + +val () = + assert (card_value (Heart, Ace) = 11) + "card_value: ace is 11" + +val () = + assert (card_value (Heart, Jack) = 10) + "card_value: jack is 10" + +val () = + assert (remove_card ([(Heart, Jack)], (Heart, Jack), IllegalMove) = []) + "remove_card: removes card" + +val () = + let + val deck = [(Heart, Jack), (Heart, Jack)] + val card = (Heart, Jack) + val expected = [(Heart, Jack)] + val exp = IllegalMove + in + assert + (remove_card (deck, card, exp) = expected) + "remove_card: leaves duplicates" + end + +val _ = + let + val deck = [] + val card = (Heart, Jack) + val expected = IllegalMove + val exp = IllegalMove + in + remove_card (deck, card, exp) + handle IllegalMove => + let + val () = assert true "remove_card: raises exception" + in + [] + end + end + +val () = + let + val deck = [] + val expected = true + in + assert + $ all_same_color deck = expected + $ "all_same_color: true on empty list" + end + +val () = + let + val deck = [(Club, Jack)] + val expected = true + in + assert + $ all_same_color deck = expected + $ "all_same_color: true on one value" + end + +val () = + let + val deck = [(Club, Jack), (Diamond, Jack)] + val expected = false + in + assert + $ all_same_color deck = expected + $ "all_same_color: false on two different colors" + end + +val () = + let + val deck = [] + val expected = 0 + in + assert + $ sum_cards deck = expected + $ "sum_cards: zero on empty list" + end + +val () = + let + val deck = [(Club, Jack), (Diamond, Ace)] + val expected = 21 + in + assert + $ sum_cards deck = expected + $ "sum_cards: correct sum" + end + +val () = + let + val deck = [] + val goal = 20 + val expected = 10 + in + assert + $ score (deck, goal) = expected + $ "score: empty list returns goal / 2 because empty deck = same color" + end + +val () = + let + val deck = [(Club, Jack), (Diamond, Jack)] + val goal = 21 + val expected = 1 + in + assert + $ score (deck, goal) = expected + $ "score: when sum < goal then score = goal - sum" + end + +val () = + let + val deck = [(Club, Jack), (Diamond, Jack)] + val goal = 9 + val expected = 33 + in + assert + $ score (deck, goal) = expected + $ "score: when sum > goal then score = 3 * (sum - goal)" + end + +val () = + let + val deck = [(Club, Jack), (Club, Ace)] + val goal = 18 + val expected = 4 + in + assert + $ score (deck, goal) = expected + $ "score: when all cards are the same color score is divied by 2" + end + +val () = + let + val deck = [(Club, Jack), (Club, Ace)] + val moves = [Draw, Draw] + val goal = 18 + val expected = 4 + in + assert + $ officiate (deck, moves, goal) = expected + $ "officiate: player draw all deck, get correct result" + end + + +val () = + let + val deck = [(Club, Jack)] + val moves = [Draw, Draw] + val goal = 21 + val expected = 5 + in + assert + $ officiate (deck, moves, goal) = expected + $ "officiate: game stops on empty deck even if there are moves" + end + +val () = + let + val deck = [(Club, Jack), (Club, Num 3), (Club, Num 10), (Club, Jack)] + val moves = [Draw, Draw, Draw, Draw] + val goal = 19 + val expected = 6 + in + assert + $ officiate (deck, moves, goal) = expected + $ "officiate: game stops on sum > goal" + end + +val () = + let + val deck = [(Club, Jack), (Club, Num 3), (Heart, Num 10), (Club, Jack)] + val moves = [Draw, Discard (Club, Jack), Draw, Draw] + val goal = 19 + val expected = 6 + in + assert + $ officiate (deck, moves, goal) = expected + $ "officiate: player can discard cards" + end + +val 0 = + let + val deck = [(Club, Jack), (Club, Num 3), (Heart, Num 10), (Club, Jack)] + val moves = [Discard (Club, Jack), Draw, Draw, Draw] + val goal = 19 + val expected = 6 + in + officiate (deck, moves, goal) + handle IllegalMove => + assert true "officiate: raises exception on missing card" + |> (fn _ => 0) + end + +val () = complete () \ No newline at end of file diff --git a/sml/week2/list.sml b/sml/week2/list.sml new file mode 100644 index 0000000..d13eb34 --- /dev/null +++ b/sml/week2/list.sml @@ -0,0 +1,31 @@ +use "operators.sml"; + +fun cons head tail = head :: tail + +fun fold f acc lst = + case lst of + [] => acc + | head :: tail => fold f (f head acc) tail + +fun reverse lst = + let + fun f elm acc = elm :: acc + in + fold f [] lst + end + +fun filter predicate lst = + let + fun f elm acc = if predicate elm then elm :: acc else acc + in + lst |> fold f [] |> reverse + end + +fun empty lst = lst = [] + +(* not efficient but works *) +fun exists elem lst = + lst + |> filter (fn needle => elem = needle) + |> empty + |> not \ No newline at end of file diff --git a/sml/week2/name.sml b/sml/week2/name.sml new file mode 100644 index 0000000..879612a --- /dev/null +++ b/sml/week2/name.sml @@ -0,0 +1,70 @@ +use "operators.sml"; +use "list.sml"; + +type FullName = {first: string, middle: string, last: string} + +(* too complex *) +fun all_except_option (str, lst) = + if exists str lst + then SOME $ filter (fn elem => elem <> str) lst + else NONE + +(* more straightforward *) +fun all_except_option (str, lst) = + let + val filtered = filter (fn elem => elem <> str) lst + in + if lst = filtered then NONE else SOME filtered + end + +(* maybe it's what assigment requires us to do but I don't like it *) +(* how to get it in 8 lines?! *) +fun all_except_option (str, lst) = + let + fun filter (same_lst, acc) lst = + case lst of + [] => (same_lst, acc) + | head :: tail => + if head = str + then filter (false andalso same_lst, acc) tail + else filter (same_lst, head :: acc) tail + in + case filter (true, []) lst of + (false, lst) => SOME $ reverse lst + | (true, _) => NONE + end + +fun get_substitutions1 ( + substitutions: string list list, + name: string +): string list = + let + fun collect lst acc = + case all_except_option (name, lst) of + NONE => acc + | SOME names => acc @ names + in + fold collect [] substitutions + end + +(* lol, previous function is already tail recursive 😎 *) +fun get_substitutions2 ( + substitutions: string list list, + name: string +): string list = get_substitutions1(substitutions, name) + + +fun similar_names ( + substitutions: string list list, + {first=first, middle=middle, last=last}: FullName +): FullName list = + let + fun full_substitution name acc = + {first=name, middle=middle, last=last} :: acc + in + get_substitutions1 (substitutions, first) + |> fold full_substitution [] + |> reverse + |> cons {first=first, middle=middle, last=last} + end + \ No newline at end of file diff --git a/sml/week2/name_tests.sml b/sml/week2/name_tests.sml new file mode 100644 index 0000000..e54eef2 --- /dev/null +++ b/sml/week2/name_tests.sml @@ -0,0 +1,96 @@ +use "name.sml"; +use "test.sml"; + +val () = + assert + (all_except_option ("str", []) = NONE) + "all_except_option: NONE on empty list" + +val () = + assert + (all_except_option ("str", ["str"]) = SOME []) + "all_except_option: filters out matched string" + +val () = + assert + (all_except_option ("str", ["str", "bar"]) = SOME ["bar"]) + "all_except_option: filters only necessary elements" + +val () = + assert + (all_except_option ("str", ["str", "bar", "str"]) = SOME ["bar"]) + "all_except_option: filters all matches" + +val () = + assert + (all_except_option ("str", ["str", "bar", "baz"]) = SOME ["bar", "baz"]) + "all_except_option: preserve order" + +val () = + let + val substitutions = [ + ["Fred","Fredrick"], + ["Elizabeth","Betty"], + ["Freddie","Fred","F"] + ] + val name = "Fred" + val expect = ["Fredrick","Freddie","F"] + in + assert + (get_substitutions1 (substitutions, name) = expect) + "get_substitutions1: collects substitutions" + end + +val () = + let + val substitutions = [ + ["Fred","Fredrick"], + ["Jeff","Jeffrey"], + ["Geoff","Jeff","Jeffrey"] + ] + val name = "Jeff" + val expect = ["Jeffrey","Geoff","Jeffrey"] + in + assert + (get_substitutions1 (substitutions, name) = expect) + "get_substitutions1: collect duplicates" + end + +val () = + let + val substitutions = [ + ["Fred","Fredrick"], + ["Jeff","Jeffrey"], + ["Geoff","Jeff","Jeffrey"] + ] + val name = "Jeff" + val expect = ["Jeffrey","Geoff","Jeffrey"] + val res1 = get_substitutions1 (substitutions, name) + val res2 = get_substitutions2 (substitutions, name) + in + assert + (res1 = res2) + "get_substitutions2: works as previous one" + end + +val () = + let + val substitutions = [ + ["Fred","Fredrick"], + ["Elizabeth","Betty"], + ["Freddie","Fred","F"] + ] + val full_name = {first="Fred", middle="W", last="Smith"} + val expect = [ + {first="Fred", last="Smith", middle="W"}, + {first="Fredrick", last="Smith", middle="W"}, + {first="Freddie", last="Smith", middle="W"}, + {first="F", last="Smith", middle="W"} + ] + in + assert + (similar_names (substitutions, full_name) = expect) + "similar_names: creates correct list" + end + +val () = complete () \ No newline at end of file diff --git a/sml/week2/operators.sml b/sml/week2/operators.sml new file mode 100644 index 0000000..0d3e6b1 --- /dev/null +++ b/sml/week2/operators.sml @@ -0,0 +1,21 @@ +(* + Pipe operator. + Simply to write code like "data |> fun" instead "fun data". + Then you can "pipe" results to functions via partial application: + + fun square a b = a * b + fun sum a b = a + b + + 10 |> sum 10 |> square 2 // 40 +*) +fun |> (x, f) = f x + +(* apply operator *) +fun $ (f, x) = f x + +(* composition operator *) +fun >> (f, g) x = g(f(x)) + +infix |> +infix $ +infix >> \ No newline at end of file diff --git a/sml/week2/test.sml b/sml/week2/test.sml new file mode 100644 index 0000000..8a4f8d4 --- /dev/null +++ b/sml/week2/test.sml @@ -0,0 +1,17 @@ +fun assert condition message = + if condition + then + print (message ^ "\n") + else + let + val () = print ("Assert error: " ^ message ^ "\n") + in + OS.Process.exit OS.Process.failure + end + +fun complete () = + let + val () = print "All tests passed!" + in + OS.Process.exit OS.Process.success + end \ No newline at end of file