hw2/WashingtonPLMOOC

hw2provided.sml

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

(* put your solutions for problem 1 here *)

fun all_except_option(str : string, strlist : string list) = 
    case strlist of
	[] => NONE
      | str1 :: strlist' => case same_string(str, str1) of
				false => (case  all_except_option(str, strlist') of
					     NONE => NONE
					   | SOME lst => SOME(str1 :: lst))
			      | true => SOME(strlist')
				

fun get_substitutions1(substitutions : string list list, s : string) = 
    case substitutions of 
	[] => []
      | strlist1 :: sllist' =>  case all_except_option(s, strlist1) of
					  NONE => get_substitutions1(sllist', s)
				       |  SOME list => list @ get_substitutions1(sllist', s)
				  
fun get_substitutions2(substitutions : string list list, s: string) =
    let fun aux(substitutions, s, l) =
	    case substitutions of
		[] => []
		   | strlist1 :: sllist' => case all_except_option(s, strlist1) of
					       NONE => aux(sllist', s, l)
					     | SOME lst => aux(sllist', s, l @ lst)
    in
	aux(substitutions, s, [])
    end

fun similar_names(substitutions : string list list, fullname : {first:string, middle:string, last:string}) =
    let fun aux(lst : string list, fullname) =
	    case fullname of 
		{first, middle, last} => case lst of
					    [] => []
					  | str :: strlist => [{first = str, last = last, middle = middle}] @  aux(strlist, fullname)
    in
	case fullname of
	    {first, middle, last} => let val l = get_substitutions1(substitutions, first)
				     in
					 [{first = first, last = last, middle = middle}] @ aux(l, fullname)
				     end
    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

(* put your solutions for problem 2 here *)

fun card_color(c : card) = 
    case c of
	(Clubs, _) => Black
      | (Spades, _) => Black
      | _ => Red

fun card_value(c : card) =
    case c of
	(_, Ace) => 11
     | (_, Num i) => i
     | _ => 10

fun remove_card(cs : card list, c : card, e) = 
    case cs of
	[] => raise e
      | c1 :: cs' => case c1 = c of
			 true => cs'
		       | false => c1 :: remove_card(cs', c, e)
						  

fun all_same_color(cs : card list) =
    case cs of
	[] => true
     | c :: cs1' => case cs1' of
			     [] => true
			   | c' :: cs2' => case card_color(c) = card_color(c') of
						     true => all_same_color(cs1')
						   | false => false

fun sum_cards(cs :card list) =
    let fun aux(cs, sum) = 
	    case cs of
		[] => sum
	      | c :: cs' => aux(cs', sum + card_value(c))
    in
	aux(cs, 0)
    end

fun score(heldc : card list, goal : int) =
    let
	val sum = sum_cards(heldc)
	val same = all_same_color(heldc)
	val bigger = sum > goal
    in
	if bigger 
	then case same of
		 true => 3 * (sum - goal) div 2
	       | false =>  3 * (sum - goal)
	else case same of
		 true => (goal - sum) div 2
	       | false => goal - sum

    end

fun officiate(cs : card list, ms : move list, goal : int) = 
    let fun aux(heldc : card list, cs, ms, goal) = 
	    case ms of
		[] => score(heldc, goal)
	      | m :: ms' => case m of
				Discard c' =>  aux(remove_card(heldc, c',  IllegalMove), cs, ms', goal)
			      | draw => case cs of
					    [] => score(heldc, goal)
					  | c :: cs' => aux(c :: heldc, cs', ms', goal)			
    in
	aux([], cs, ms, goal)
    end