all week2's main funs are done

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

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 ()

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

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
+    

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 ()

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 >>

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