I'm trying to write a program in SML for the following problem:
A game is played with a card-list and a goal. The player has a list of held-cards, initially empty. The player
makes a move by either drawing, which means removing the first card in the card-list from the card-list and
adding it to the held-cards, or discarding, which means choosing one of the held-cards to remove. The game
ends either when the player chooses to make no more moves or when the sum of the values of the held-cards
is greater than the goal. Write a function officiate, which “runs a game.” It takes a card list (the card-list) a move list
(what the player “does” at each point), and an int (the goal) and returns the score at the end of the
game after processing (some or all of) the moves in the move list in order. Use a locally defined recursive
helper function that takes several arguments that together represent the current state of the game. As
described above:
The game starts with the held-cards being the empty list.
The game ends if there are no more moves. (The player chose to stop since the move list is empty.)
If the player discards some card c, play continues (i.e., make a recursive call) with the held-cards
not having c and the card-list unchanged. If c is not in the held-cards, raise the IllegalMove
exception.
If the player draws and the card-list is (already) empty, the game is over. Else if drawing causes
the sum of the held-cards to exceed the goal, the game is over (after drawing). Else play continues
with a larger held-cards and a smaller card-list.
And this is my solution:
datatype suit = Clubs | Diamonds | Hearts | Spades
datatype rank = Jack | Queen | King | Ace | Num of int
type card = suit * rank
datatype move = Discard of card | Draw
exception IllegalMove
fun remove_card (cs, c, e) =
let
fun delete_it (cs, c, e, count, acs) =
case cs of
[] => if count = 0 then raise e else acs
| cp::cs' => if cp = c andalso count = 0
then delete_it (cs', c, e, count + 1, acs)
else
if cp = c then delete_it (cs', c, e, count + 1, [cp] # acs) else delete_it (cs', c, e, count, [cp] # acs)
in
delete_it (cs, c, e, 0, [])
end
fun sum_cards (loc) =
let
fun sum_it (loc, sum) =
case loc of
[] => sum
| c::loc' => sum_it (loc', sum + card_value (c))
in
sum_it (loc, 0)
end
fun score (loc, goal) =
let
val sum = sum_cards (loc)
val all_same = all_same_color (loc)
in
let
fun prem_score (sum, goal) =
if sum > goal
then 3 * (sum - goal)
else goal - sum
in
let
val pre_score = prem_score (sum, goal)
fun final_score (all, pre) =
if all
then pre div 2
else pre
in
final_score (all_same, pre_score)
end
end
end
fun officiate (loc, lom, goal) =
let
fun get_score (lcards, lohc, lmoves, goal, e) =
case lmoves of
[] => score (lcards, goal)
| Draw::lmoves' => case lcards of
[] => score (lcards, goal)
| c::loc' => if sum_cards (c) > goal
then score (lcards, goal)
else get_score (loc', c::lohc, lmoves', goal, e)
| d::lmoves' => case d of
Discard c => get_score (loc, remove_card (lohc, c, e), lmoves', goal, e)
in
get_score (loc, [], lom, goal, IllegalMove)
end
Ihe function sum_cards returns the values sum of the given card lists. score function returns the score of the game, while remove_card returns a list of cards minus the card provided. All these functions are working perfectly, but the problem is in the officiate function as I tried to use another two helper functions but without luck. This is the error log:
hw2.sml:196.17-196.60 Error: operator and operand don't agree [tycon mismatch]
operator domain: (suit * rank) list * (suit * rank) list list * 'Z * int *
'Y
operand: (suit * rank) list list * (suit * rank) list list *
move list * int * 'Y
in expression:
get_score (loc',c :: lohc,lmoves',goal,e)
hw2.sml:198.29-198.78 Error: operator and operand don't agree [tycon mismatch]
operator domain: (suit * rank) list list * (suit * rank) list * exn
operand: (suit * rank) list list * card * 'Z
in expression:
remove_card (lohc,c,e)
hw2.sml:192.27-198.78 Error: types of rules don't agree [tycon mismatch]
earlier rule(s): (suit * rank) list list -> int
this rule: move list -> 'Z
in rule:
:: (d,lmoves') =>
(case d
of Discard c => get_score (<exp>,<exp>,<exp>,<exp>,<exp>))
hw2.sml:192.27-198.78 Error: case object and rules don't agree [tycon mismatch]
rule domain: (suit * rank) list list
object: (suit * rank) list
in expression:
(case lcards
of nil => score (lcards,goal)
| :: (c,loc') =>
if sum_cards <exp> > goal
then score (<exp>,<exp>)
else get_score (<exp>,<exp>,<exp>,<exp>,<exp>)
| :: (d,lmoves') =>
(case d
of Discard <pat> => get_score <exp>))
val it = () : unit
I think this is because I used multiple case expressions.
Any help will be appreciated!
Related
I have the following question "Given a list of integer pairs, write a function to return a list of even numbers in that list in sml".
this is what I've achieved so far
val x = [(6, 2), (3, 4), (5, 6), (7, 8), (9, 10)];
fun isEven(num : int) =
if num mod 2 = 0 then num else 0;
fun evenNumbers(list : (int * int) list) =
if null list then [] else
if isEven(#1 (hd list)) <> 0
then if isEven(#2 (hd list)) <> 0
then #1 (hd list) :: #1 (hd list) :: evenNumbers(tl list)
else []
else if isEven(#2 (hd list)) <> 0
then #1 (hd list) :: evenNumbers(tl list)
else [];
evenNumbers(x);
the result should be like this [6,2,4,6,8,10]
any help would be appreciated.
I see two obvious problems.
If both the first and second number are even, you do
#1 (hd list) :: #1 (hd list) :: evenNumbers(tl list)
which adds the first number twice and ignores the second.
If the first number is odd and the second even, you do
#1 (hd list) :: evenNumbers(tl list)
which adds the number that you know is odd and ignores the one you know is even.
Programming with selectors and conditionals gets complicated very quickly (as you've noticed).
With pattern matching, you could write
fun evenNumbers [] = []
| evenNumber ((x,y)::xys) = ...
and reduce the risk of using the wrong selector.
However, this still makes for complicated logic, and there is a better way.
Consider the simpler problem of filtering the odd numbers out of a list of numbers, not pairs.
If you transform the input into such a list, you only need to solve that simpler problem (and there's a fair chance that you've already solved something very similar in a previous exercise).
Exercise: implement this transformation. Its type will be ('a * 'a) list -> 'a list.
Also, your isEven is more useful if it produces a truth value (if you ask someone, "is 36 even?", "36" is a very strange answer).
fun isEven x = x mod 2 = 0
Now, evenNumbers can be implemented as "just" a combination of other, more general, functions.
So running your current code,
- evenNumbers [(6, 2), (3, 4), (5, 6), (7, 8), (9, 10)];
val it = [6,6,3,5,7,9] : int list
suggests that you're not catching all even numbers, and that you're catching some odd numbers.
The function isEven sounds very much like you want to have the type int -> bool like so:
fun isEven n =
n mod 2 = 0
Instead of addressing the logic error of your current solution, I would like to propose a syntactically much simpler approach which is to use pattern matching and fewer explicit type annotations. One basis for such a solution could look like:
fun evenNumbers [] = ...
| evenNumbers ((x,y)::pairs) = ...
Using pattern matching is an alternative to if-then-else: the [] pattern is equivalent to if null list ... and the (x,y)::pairs pattern matches when the input list is non-empty (holds at least one element, being (x,y). At the same time, it deconstructs this one element into its parts, x and y. So in the second function body you can express isEven x and isEven y.
As there is a total of four combinations of whether x and y are even or not, this could easily end up with a similarly complicated nest of if-then-else's. For this I might do either one of two things:
Use case-of (and call evenNumbers recursively on pairs):
fun evenNumbers [] = ...
| evenNumbers ((x,y)::pairs) =
case (isEven x, isEven y) of
... => ...
| ... => ...
Flatten the list of pairs into a list of integers and filter it:
fun flatten [] = ...
| flatten ((x,y)::pairs) = ...
val evenNumbers pairs = ...
I have a tree type:
type tree = Vertex of int * tree list;;
My recursive equality definition is that two trees are equal if their ints are equal and all of their children are equal.
How do I build the function
topo: tree -> tree list
that creates a list of all of the trees in depth first search order with each tree appearing once and only once (according to the equality definition)? I want to do this in a computationally efficient way. Maybe use lazy or a hashmap?
Here is my attempt, the code blows up when the length is too large:
type tree = Vertex of int * (tree list)
let rec base = function
| 0 -> Vertex (0, [])
| i -> Vertex (i, [base (i - 1)])
let rec range = function
| 0 -> [0]
| i -> i :: range (i - 1)
let agg i = Vertex (-1, List.map base (range i))
let rec equals (a: tree) (b: tree) : bool =
let rec deep_match a_dep b_dep = match a_dep, b_dep with
| [], [] -> true
| [], _
| _, [] -> false
| x::xs, y::ys -> equals x y && deep_match xs ys
in
let Vertex (ai, al) = a in
let Vertex (bi, bl) = b in
ai = bi && deep_match al bl
let rec in_list (a: tree) (l: tree list) : bool = match l with
| [] -> false
| hd::tl -> equals a hd || in_list a tl
let rec topological (pool: tree list) (t: tree) : tree list =
if in_list t pool then pool else
t::match t with
| Vertex(_, []) -> pool
| Vertex(_, deps) -> List.fold_left topological pool deps
let big_agg = agg 100_000
let topo_ordered = topological [] big_agg;;
Printf.printf "len %i\n" (List.length topo_ordered)
To make it efficient you need to implement ordering and hash-consing. With total ordering, you can store your trees in a balanced tree or even a hashtable, thus turning your in_list into O(logN) or even O(1). Adding hash-consing will enable O(1) comparison of your trees (at the cost of less efficient tree construction).
Instead of having both, depending on your design constraints, you can have only one. For the didactic purposes, let's implement hash-consing for your particular representation
To implement hash-consing you need to make your constructor private and hide data constructors behind an abstraction wall (to prevent users from breaking you hash-consing properties):
module Tree : sig
type t = private Vertex of int * t list
val create : int -> t list -> t
val equal : t -> t -> bool
end = struct
type t = Vertex of int * t list
let repository = Hashtbl.create 64
let create n children =
let node = Vertex (n,children) in
try Hashtbl.find repository node
with Not_found -> Hashtbl.add repository node node; node
let equal x y = x == y
end
Since we guaranteed that structurally equal trees are physically equal during the tree creation (i.e., if there exists an equal tree in our repository then we return it), we are now able to substitute structural equality with physical equality, i.e., with pointer comparison.
We got a fast comparison with the price - we now leaking memory, since we need to store all ever created trees and the create function is now O(N). We can alleviate the first problem by using ephemerons, but the latter problem will persist, of course.
Another issue, is that we're not able to put our trees into ordered structure, like a map or a set. We can of course use regular polymorphic compare, but since it will be O(N), inserting to such structure will become quadratic. Not an option for us. Therefore we need to add total ordering on our trees. We can theoretically do this without changing the representation (using ephemerons), but it is easier just to add an order parameter to our tree representation, e.g.,
module Tree : sig
type order (* = private int *) (* add this for debuggin *)
type t = private Vertex of order * int * t list
val create : int -> t list -> t
val equal : t -> t -> bool
val compare : t -> t -> int
end = struct
type order = int
type t = Vertex of order * int * t list
type tree = t
module Repository = Hashtbl.Make(struct
type t = tree
let max_hash = 16
let rec equal (Vertex (_,p1,x)) (Vertex (_,p2,y)) =
match compare p1 p2 with
| 0 -> equal_trees x y
| n -> false
and equal_trees xs ys = match xs, ys with
| [],[] -> true
| [],_ | _,[] -> false
| x :: xs, y::ys -> equal x y && equal_trees xs ys
let rec hash (Vertex (_,p,xs)) =
hash_trees (Hashtbl.hash p) max_hash xs
and hash_trees hash depth = function
| x :: xs when depth > 0 ->
hash_trees (Hashtbl.hash x) (depth-1) xs
| _ -> hash
end)
let repository = Repository.create 64
let create n children =
try Repository.find repository (Vertex (0,n,children))
with Not_found ->
let order = Repository.length repository + 1 in
let node = Vertex (order,n,children) in
Repository.add repository node node; node
let equal x y = x == y
let order (Vertex (order,_,_)) = order
let compare x y = compare (order x) (order y)
end
We had to manually implement the structural variants of equal and hash for our trees because we need to ignore the order in comparison, when we store a new tree in the repository. It looks like a bit of work, but in the real-life you can do this using derivers.
Anyways, now we got a comparable version of a tree with a comparison function which is O(1), so we can put our trees in sets and maps, and implement your topo efficiently.
A nice feature of both implementations is a tight representation of a tree, since sharing is guaranteed by the create function. E.g.,
# let t1 = Tree.create 42 [];;
val t1 : Tree.t = Tree.Vertex (1, 42, [])
# let t3 = Tree.create 42 [t1; t1];;
val t3 : Tree.t =
Tree.Vertex (2, 42, [Tree.Vertex (1, 42, []); Tree.Vertex (1, 42, [])])
# let t5 = Tree.create 42 [t1; t3; t1];;
val t5 : Tree.t =
Tree.Vertex (3, 42,
[Tree.Vertex (1, 42, []);
Tree.Vertex (2, 42, [Tree.Vertex (1, 42, []); Tree.Vertex (1, 42, [])]);
Tree.Vertex (1, 42, [])])
#
In this example, t1 in t5 and t3 will be the same pointer.
For optimal performance, one possibility would be to use hashconsing. However, in your current example, both the generation and the unicity test are quadratic in n. Fixing both points seems to already improve performance a lot.
First, we can avoid the quadratic tree generation by adding a lot of sharing:
let range max =
let rec range elt l n =
if n > max then elt::l
else
let next = Vertex(n,[elt]) in
range next (elt::l) (n+1) in
range (Vertex(0,[])) [] 1
let agg i = Vertex (-1, range i)
With this change, it is become reasonable to generate a tree with 1010 elements (but only 105 unique elements).
Then, the unicity test can be done with a set (or a hashtable):
module S = Set.Make(struct type t = tree let compare = compare end)
let rec topological (set, pool) t =
if S.mem t set then (set, pool) else
let set = S.add t set in
let set, pool =
match t with
| Vertex(_, []) -> set, pool
| Vertex(_, deps) -> List.fold_left topological (set,pool) deps in
set, t::pool
Can someone please explain the: "description of g"? How can f1 takes unit and returns an int & the rest i'm confused about too!!
(* Description of g:
* g takes f1: unit -> int, f2: string -> int and p: pattern, and returns
* an int. f1 and f2 are used to specify what number to be returned for
* each Wildcard and Variable in p respectively. The return value is the
* sum of all those numbers for all the patterns wrapped in p.
*)
datatype pattern = Wildcard
| Variable of string
| UnitP
| ConstP of int
| TupleP of pattern list
| ConstructorP of string * pattern
datatype valu = Const of int
| Unit
| Tuple of valu list
| Constructor of string * valu
fun g f1 f2 p =
let
val r = g f1 f2
in
case p of
Wildcard => f1 ()
| Variable x => f2 x
| TupleP ps => List.foldl (fn (p,i) => (r p) + i) 0 ps
| ConstructorP (_,p) => r p
| _ => 0
end
Wildcard matches everything and produces the empty list of bindings.
Variable s matches any value v and produces the one-element list holding (s,v).
UnitP matches only Unit and produces the empty list of bindings.
ConstP 17 matches only Const 17 and produces the empty list of bindings (and similarly for other integers).
TupleP ps matches a value of the form Tuple vs if ps and vs have the same length and for all i, the i-th element of ps matches the i-th element of vs. The list of bindings produced is all the lists from the nested pattern matches appended together.
ConstructorP(s1,p) matches Constructor(s2,v) if s1 and s2 are the same string (you can compare them with =) and p matches v. The list of bindings produced is the list from the nested pattern match. We call the strings s1 and s2 the constructor name.
Nothing else matches.
Can someone please explain the: "description of g"? How can f1 takes unit and returns an int & the rest i'm confused about too!!
The function g has type (unit → int) → (string → int) → pattern → int, so it takes three (curried) parameters of which two are functions and one is a pattern.
The parameters f1 and f2 must either be deterministic functions that always return the same constant, or functions with side-effects that can return an arbitrary integer / string, respectively, determined by external sources.
Since the comment speaks of "what number to be returned for each Wildcard and Variable", it sounds more likely that the f1 should return different numbers at different times (and I'm not sure what number refers to in the case of f2!). One definition might be this:
local
val counter = ref 0
in
fun uniqueInt () = !counter before counter := !counter + 1
fun uniqueString () = "s" ^ Int.toString (uniqueInt ())
end
Although this is just a guess. This definition only works up to Int.maxInt.
The comment describes g's return value as
[...] the sum of all those numbers for all the patterns wrapped in p.
Since the numbers are not ascribed any meaning, it doesn't seem like g serves any practical purpose but to compare the output of an arbitrarily given set of f1 and f2 against an arbitrary test that isn't given.
Catch-all patterns are often bad:
...
| _ => 0
Nothing else matches.
The reason is that if you extend pattern with additional types of patterns, the compiler will not notify you of a missing pattern in the function g; the catch-all will erroneously imply meaning for cases that are possibly yet undefined.
for example the following code
fun swap (pr : int*bool) =
(#2 pr, #1 pr)
fun div_mod (x : int, y : int) =
(x div y, x mod y)
the above code has taking pair(Tuple) as an argument in the first swap function , and taking two integers as an argument in function div_mod ..so my doubt is how does ML know that am calling it with a pair(Tuple) and not calling it with two arguments ?
please help me . am beginner in ML programming
Thank you :)
In terms of the types themselves, both functions take one argument, which is a pair.
These two definitions are equivalent to yours:
fun swap (i: int, b: bool) = (b, i)
fun div_mod (xy: int * int) = ((#1 xy) div (#2 xy), (#1 xy) mod (#2 xy))
The only difference is whether you do pattern matching against the elements of the tuple or not.
There's a slight difference in whether you would say that a function takes one or two arguments, though.
If the pair is just "incidental" – used for grouping like in these functions – you often say that the function takes two arguments.
If the pair represents some kind of abstraction like, say, a rational number, you would probably say that it takes one argument.
I suggest you check it in your preferred SML:
str#s132-intel:~> poly
Poly/ML 5.5.2 Release
>fun swap (pr : int*bool) = (#2 pr, #1 pr);;
val swap = fn: int * bool -> bool * int
>
> fun div_mod (x : int, y : int) = (x div y, x mod y);;
val div_mod = fn: int * int -> int * int
The first takes type int * bool, the second takes int * int, both are pairs.
In contrast, multiple arguments which are not tuples:
> fun maketriple a b c = (a, b, c);;
val maketriple = fn: 'a -> 'b -> 'c -> 'a * 'b * 'c
And how does SML tell the types of arguments apart? Tuples are written inside parens and separated by commata.
I am working on some exercises to help my understanding of SML and find I am having a hard time understanding how generic/polymorphic types are passed into functions.
I am given the following initial information:
datatype 'a tree = Leaf | Node of 'a tree * 'a * 'a tree
val testTree = Node (Node (Node (Leaf, ("a", 107), Leaf), ("c", 417), Node (Leaf, ("e", ~151), Node (Leaf, ("o", ~499), Leaf))), ("s", 35), Node (Leaf, ("u", ~387), Node (Leaf, ("y", 263), Leaf)))
fun nameCompare (n1: name, n2: name) : order = String.compare (n1, n2)
fun treeLookup cmp =
let
fun lkup (x, btree) =
case tree of
Leaf => NONE
| Node (lt, y, rt) =>
(case cmp (x, y) of
LESS => lkup (x, lt)
| EQUAL => SOME y
| GREATER => lkup (x, rt))
in
lkup
end
When I try to call treeLookup I continue to get type matching errors.
For example this is what I may be calling
treeLookup nameCompare ("a", testTree)
and Ill get an error like this
treeLookup nameCompare ("a", testTree);
^^^^^^^^
Type clash: expression of type
(string * int) tree
cannot have type
string tree
What do I need to do in order to satisfy the type of the tree when passing it to treeLookup?
In your tree
a' : ("a", 107)
treeLookup calls the cmp on every element and the one you passed. You passed in nameCompare which takes two strings and a string, and "a" which is a string. That means your tree should only have strings in it.
To solve that you'll probably want to make your tree be a map, effectively comparing only on the first value of the pair:
| Node (lt, (k,v), rt) =>
(case cmp (x, k)
Possibly changing the definition as well:
datatype 'k 'v tree = Leaf | Node of 'k 'v tree * ('k * 'v) * 'k 'v tree
Alternatively, you can change your comparison function to take ('a * 'b), but that means that e.g. you'd need to do treeLookup with an element ("a", 107) which would try to match both fields.
You're comparing a string against an item in the tree, which is a string * int.
You could always change your comparison function; something like
fun nameCompare (n, (k,v)) = String.compare (n1, k)
should do.