Programming Languages Homework 2

week02.sml

(* routines *)
fun map f (x::xs) = f x :: map f xs
  | map _ [] = []

fun concat (x::xs) = x @ concat xs
  | concat [] = []

fun mapPartial _ [] = []
  | mapPartial f (x::xs) = case f x
      of SOME v => v :: (mapPartial f xs)
       | NONE   => mapPartial f xs

fun elem e (x::xs) = (e = x) orelse elem e xs
  | elem _ [] = false

fun delete s (x::xs) = if (s = x) then xs else x :: (delete s xs)
  | delete _ [] = []

fun all_same (x::(xs as y::_)) = x = y andalso all_same xs
  | all_same _ = true


(* problem 1, task a *)
fun all_except_option (s: string, l: string list): string list option =
  if (elem s l) then SOME (delete s l) else NONE


(* problem 1, task b *)
fun get_substitutions0 (l: string list list, s: string): string list =
  concat (mapPartial (fn x => all_except_option(s,x)) l)

fun get_substitutions1 ([],_) = []
  | get_substitutions1 ((x::xs),s) = case all_except_option (s,x)
    of SOME v => v @ get_substitutions1 (xs,s)
     | NONE   => get_substitutions1 (xs,s)


(* problem 1, task c *)
fun get_substitutions2 (l,s) = let
    fun go [] s' acc = acc
      | go (x::xs) s' acc = case all_except_option (s',x)
        of SOME v => go xs s' (acc @ v)
         | NONE   => go xs s' acc
  in
    go l s []
  end


(* problem 1, task d *)
fun similar_names (xs, n as {first=f, middle=m, last=l}) =
  n :: map (fn name => {first=name, middle=m, last=l}) (get_substitutions1 (xs,f))


(* problem 2 *)
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


(* problem 2, task a *)
fun card_color (c,_) = case c
  of (Clubs | Spades) => Black
   | _ => Red


(* problem 2, task b *)
fun card_value (_,r) = case r
  of Num(v) => v
   | (Jack | Queen | King) => 10
   | Ace => 11


(* problem 2, task c *)
fun remove_card ((x::xs),c,e) = if (x = c) then xs else x :: (remove_card (xs,c,e))
  | remove_card ([],_,e) = raise e


(* problem 2, task d *)
fun all_same_color cs = all_same (map card_color cs)


(* problem 2, task e *)
fun sum_cards cs = let
    fun f [] acc = acc
      | f (x::xs) acc = f xs (acc + card_value x)
  in
    f cs 0
  end


(* problem 2, task f *)
fun score (cards, goal) = let
    val sum = sum_cards cards
    val ps = if (sum > goal) then 3 * (sum - goal) else (goal - sum)
  in
    if (all_same_color cards) then ps div 2 else ps
  end


(* problem 2, task g *)
fun officiate (cards, moves, goal) = let
    fun go _ held_cards [] g = score (held_cards, g)
      | go [] hcs _ g = score (hcs, g)
      | go (cards' as c::cs) hcs (moves' as m::ms) g = case m
        of Discard d => go cards' (remove_card (hcs, d, IllegalMove)) ms g
         | Draw => case cards'
           of [] => score (hcs, g)
            | _ =>
               let
                 val hcs' = c :: hcs
                 val held_cards_sum = sum_cards hcs'
               in
                 if (held_cards_sum > goal)
                   then score (hcs', g)
                   else go cs hcs' ms g
               end
  in
    go cards [] moves goal
  end