Why to replace `in` with `let` in sml? - sml

I have a local block with few helper methods. After that, comes a main function (between the in and end block):
datatype color = BLACK | RED;
datatype 'a RBTree = Nil
| Br of (int * 'a * color) * 'a RBTree * 'a RBTree;
datatype Balance = RR | LR | LL | RL;
exception NotFound;
local
fun max (num1, num2) ...
fun get_hight ...
fun get_balance_factor ...
fun LL_rotate ...
fun LR_rotate ...
fun RR_rotate ...
fun RL_rotate ...
fun balance_tree (Nil) = (Nil)
| balance_tree (Br(node, Nil, Nil)) = (Br(node, Nil, Nil))
| balance_tree (Br(node, left, right)) =
if (get_balance_factor (Br(node, left, right))) = 2 then
if (get_balance_factor left) = ~1 then (* LR *)
LR_rotate (Br(node, left, right))
else if (get_balance_factor left) > ~1 then (* LL *)
LL_rotate (Br(node, left, right))
else if (get_balance_factor Br(node, left, right)) = ~2 then
if (get_balance_factor right) = 1 then (* RL *)
RL_rotate (Br(node, left, right))
else if (get_balance_factor right) < 1 then (* RR *)
RR_rotate (Br(node, left, right))
else (Br(node, left, right))
in
fun insert ((Nil), item) = Br(item, (Nil), (Nil) )
| insert ( (Br(node, left, right)), item) =
if (#1(node) = #1(node)) then
(Br(item, left, right))
else if (#1(node) < #1(node)) then
balance_tree (Br(node, insert(left, item), right))
else
balance_tree (Br(node, left, insert(right, item)))
end;
where the ... stands for the implementation.
And insert is the 'main' function.
SML gives me this output:
- use "ex4.sml";
[opening ex4.sml]
datatype color = BLACK | RED
datatype 'a RBTree = Br of (int * 'a * color) * 'a RBTree * 'a RBTree | Nil
datatype Balance = LL | LR | RL | RR
exception NotFound
ex4.sml:58.1-58.3 Error: syntax error: replacing IN with LET
ex4.sml:69.1 Error: syntax error found at END
uncaught exception Compile [Compile: "syntax error"]
raised at: ../compiler/Parse/main/smlfile.sml:15.24-15.46
../compiler/TopLevel/interact/evalloop.sml:44.55
../compiler/TopLevel/interact/evalloop.sml:296.17-296.20
I don't understand why I should be replacing in with let?

SML/NJ's parser errors are a little strange. What it means when it says "repacing IN with LET" is that it saw the token "IN" (i.e., the keyword "in") at the beginning of line 58, but it got stuck parsing there because it had no way to resolve what the IN goes with. In situations like this it performs error recovery by pretending that you wrote something different, I think based on some hard-coded rules. The rules aren't designed to fix your program, just to allow parsing to continue so that you can see multiple parse errors in one compilation attempt. In this case, it's just saying that it pretended to see "LET" (i.e., the keyword "let") instead of "IN", and then continued trying to parse. In my experience, the right way to proceed is just to look at the location of the first parse error, fix it, and recompile. The later errors can be very confusing, and its message about how it tried to recover is usually useless.

Related

Issue with a tycon mismatch

Working on a homework assignment that essentially takes a tree, the declaration of which is:
datatype a BinTree =
Leaf of a
| Node of a BinTree * a BinTree;
and returns a tuple of an int height of tree and a list of values which were stored at that deepest portion of the tree.
fun deepest tree =
case tree of
Leaf(n) => [n]
| Node(l, r) => if #1(deepest l) > #1(deepest r) then ((#1(deepest l) + 1), #2(deepest l)) else
if #1(deepest l) < #1(deepest r) then ((#1(deepest r) + 1), #2(deepest r)) else
(1, #2(deepest l) # #2(deepest r));
Trying to test this code, I come up with the following error message:
stdIn:43.1-47.35 Error: types of rules don't agree [tycon mismatch]
earlier rule(s): 'Z BinTree -> 'Z list
this rule: 'Z BinTree -> [+ ty] * 'Y list
in rule:
Node (l,r) =>
if (fn <rule>) (deepest <exp>) > (fn <rule>) (deepest <exp>)
then (<exp> <exp> + 1,(fn <rule>) (deepest <exp>))
else if <exp> <exp> < <exp> <exp>
then (<exp> + <exp>,<exp> <exp>)
else (1,<exp> # <exp>)
stdIn:21.2-47.35 Error: right-hand-side of clause doesn't agree with
function result type [type mismatch]
expression: 'Z list
result type: {1:[+ ty], 2:'X list; 'Y}
in declaration:
deepest =
(fn tree =>
(case tree
of <pat> => <exp>
| <pat> => <exp>))
stdIn:1.2-47.35 Error: unresolved flex record (need to know the names of ALL
the fields
in this context)
type: {1:[+ ty], 2:'Y list; 'Z}
While I do understand that its a type conflict, I can't find what the conflict is, nor how to fix it. Any help would be appreciated.
This
earlier rule(s): 'Z BinTree -> 'Z list
comes from the leaf case ([n]), which makes it a function from trees to lists.
And this:
this rule: 'Z BinTree -> [+ ty] * 'Y list
comes from the node case, making it a function from trees to pairs of "a type that supports addition" and lists.
The remaining errors are caused by SML not being able to deduce what #1 and #2 mean in the presence of that conflict.
Your base case is wrong – it should be a pair, not a list.
The depth in that pair should be 1, and the depth should not be 1 in the case where both subtrees are equally deep.
You're also computing the deepest values three times for each subtree in the worst case, and two in the best case.
It's better to recurse only once for each subtree.
Something like this:
fun deepest (Leaf n) = (1, [n])
| deepest (Node (l, r)) =
case deepest l of (dl, ll) =>
case deepest r of (dr, lr) =>
if dl > dr then (dl + 1, ll)
else if dr > dl then (dr + 1, lr)
else (dl + 1, ll # lr)
While I also prefer case-of like molbdnilo for writing this function, here is an example of using let-in-end to demonstrate that they can both be used when the result is a product (tuple). Since there are three cases in the if-then-else with three distinct outcomes (dl > dr, dr > dl and dl = dr), using Int-compare may be preferable:
fun deepest (Leaf n) = (1, [n])
| deepest (Node (l, r)) =
let val (lcount, ls) = deepest l
val (rcount, rs) = deepest r
in case Int.compare (lcount, rcount) of
GT => (lcount + 1, ls)
| LT => (rcount + 1, rs)
| EQ => (lcount + 1, ls # rs)
end

SML with lazy list function

I'm trying to make a function which can return the specific nth element of lazylist.
Here is what I made:
datatype 'a lazyList = nullList
| cons of 'a * (unit -> 'a lazyList)
fun Nth(lazyListVal, n) = (* lazyList * int -> 'a option *)
let fun iterator (laztListVal, cur, target) =
case lazyListVal of
nullList => NONE
| cons(value, tail) => if cur = target
then SOME value
else iterator (tail(), cur+1, target)
in
iterator(lazyListVal,1,n)
end
I expected the result that as recusing proceeds, eventually the variable cur gets same as the variable target, and then the function iterator returns SOME value so it will return the final nth element.
But when I compile it and run, it only returns the very first element however I test with the lazylist objects.
Please figure what is the problem. I have no idea...
cf) I made another function which is relevant to this problem, the function that transforms lazylist into SML original list containing the first N values. Codes above:
fun firstN (lazyListVal, n) = (* lazyList * int -> 'a list *)
let fun iterator (lazyListVal, cur, last) =
case lazyListVal of
nullList => []
| cons(value, tail) => if cur = last
then []
else value::iterator(tail(),cur+1,last)
in
iterator(lazyListVal,0,n)
end
The strange thing is the function firstN is properly working.
The problem is that your iterator function does case lazyListVal of ..., but the recursive tail is called laztListVal, so for every iteration, it keeps looking at the first list. Use better variable names to avoid this kind of "invisible" bug.
For a simpler definition of nth:
datatype 'a lazyList = NullList | Cons of 'a * (unit -> 'a lazyList)
fun nth (NullList, _) = NONE
| nth (Cons (x, xs), 0) = SOME x
| nth (Cons (_, xs), n) = nth (xs (), n-1)
val nats = let fun nat n = Cons (n, fn () => nat (n+1)) in nat 0 end
val ten = nth (nats, 10)
Edit: While function pattern matching is ideal here, you could also have used a case ... of ... here. A helper function seems unnecessary, though, since you can simply use the input argument n as the iterator:
fun nth (L, n) =
case (L, n) of
(NullList, _) => NONE
| (Cons (x, xs), 0) => SOME x
| (Cons (_, xs), n) => nth (xs (), n-1)
You may however want to make the function more robust:
fun nth (L, n) =
let fun nth' (NullList, _) = NONE
| nth' (Cons (x, xs), 0) = SOME x
| nth' (Cons (_, xs), n) = nth' (xs (), n-1)
in if n < 0 then NONE else nth' (L, n) end
Here having a helper function ensures that n < 0 is only checked once.
(You could also raise Domain, since negative indices are not well-defined.)

I want to make function maptree with standard ML

I want to make function maptree with standard ML.
If function f(x) = x + 1;
then
maptree(f, NODE(NODE(LEAF 1,LEAF 2),LEAF 3));
should make result
NODE(NODE(LEAF 2,LEAF 3),LEAF 4))
I write the code like below.
datatype 'a tree = LEAF of 'a | NODE of 'a tree * 'a tree;
fun f(x) = x + 1;
fun maptree(f, NODE(X, Y)) = NODE(maptree(f, X), maptree(f, Y))
| maptree(f, LEAF(X)) = LEAF(f X);
but when I execute this code like this
maptree(f, (NODE(NODE(LEAF 1,LEAF 2),LEAF 3)));
result is not I want to
(NODE(NODE(LEAF 2,LEAF 3),LEAF 4)))
but
NODE(NODE(LEAF #,LEAF #),LEAF 4)).
Why this happened(not a number but #)?
# is used by the REPL when the data structure it prints is deeper than a pre-set value. If you increase that value, you'll get the result you excepted. I assume you're using SML/NJ, which calls that setting print.depth:
sml -Cprint.depth=20
- maptree(f, (NODE(NODE(LEAF 1,LEAF 2),LEAF 3)));
val it = NODE (NODE (LEAF 2,LEAF 3),LEAF 4) : int tree
You can find more options like these by executing sml -H. Look them up under the "compiler print settings" section:
compiler print settings:
print.depth (max print depth)
print.length (max print length)
print.string-depth (max string print depth)
print.intinf-depth (max IntInf.int print depth)
print.loop (print loop)
print.signatures (max signature expansion depth)
print.opens (print `open')
print.linewidth (line-width hint for pretty printer)
Some comments:
I would probably go with the definition
datatype 'a tree = Leaf | Node of 'a tree * 'a * 'a tree
so that trees with zero or two elements can also be expressed.
I would probably curry the tree map function
fun treemap f Leaf = Leaf
| treemap f (Node (l, x, r)) = Node (treemap f l, x, treemap f r)
since you can then partially apply it, e.g. like:
(* 'abstree t' returns t where all numbers are made positive *)
val abstree = treemap Int.abs
(* 'makeFullTree n' returns a full binary tree of size n *)
fun makeFullTree 0 = Leaf
| makeFullTree n =
let val subtree = makeFullTree (n-1)
in Node (subtree, n, subtree)
end
(* 'treetree t' makes an int tree into a tree of full trees! *)
val treetree = treemap makeFullTree
You may at some point want to fold a tree, too.

How to write iterative inorder traversal for BST in OCaml

It is easy enough to write recursive inorder traversal in OCaml, but how to write iterative one? with for loop or while?
Asking for someone to write something without recursive calls is stupid, but I'll still do it because it's an interesting exercise. Going from recursive to iterative is always the same process.
type tree = Leaf | Node of int * tree * tree
let rec in_order = function
| Leaf -> []
| Node(i,l,r) -> in_order l # (i :: in_order r);;
Alright, now we have our recursive function. The first step is to transform it to tail recursive. This is actually the hardest step since it requires a real logical and algorithmic change.
We are going to add a new parameter to the function that is going to contain the result of the computation :
let rec ino res = function
| Leaf -> ()
| Node(i,l,r) ->
begin
ino res r ;
res := i :: !res ;
ino res l
end
At the end, the result is !res.
Now that we have this, removing the recursive call is very easy, we just have to think about what does the compiler does when he has a recursive call. Well, it just does a while loop, after putting the parameters of the function and the next work to do in a stack. Let's just do it.
open Stack
type work = Value of int | NextNode of tree ref
let ino t : int list =
let res = ref [] in
let stack = Stack.create () in
push (NextNode (ref t)) stack;
try
while true do
let current = pop stack in
match current with
Value i -> res := i :: !res
| NextNode n ->
begin
match !n with
Leaf -> ()
| Node(i,l,r) ->
begin
push (NextNode (ref l)) stack;
push (Value i) stack;
push (NextNode (ref r)) stack
end
end
done;
assert false
with
| Empty -> !res
Here we just remember the next thing to do. We know that when we reach a node we have to treat its right child, then the value of the node, then its left child, so we just put all this in the stack (in reverse order of course), and we keep going to the next element of the stack. When the stack is empty, we have visited the whole tree, and we can return.
I hope that this post manages to convince some people of the power of recursion over iterative programming. 3 lines Vs 26 lines. QED.
Here's another take on iterative in-order traversals:
type 'a node = {mutable data: 'a;
mutable left : 'a node option;
mutable right: 'a node option; }
let new_node data = {data; left = None; right = None;}
let insert tree new_data =
let module Wrapper = struct exception Stop_loop end in
let iter = ref tree in
try
while true do
if new_data < !iter.data
then match !iter.left with
| None ->
!iter.left <- Some (new_node new_data);
raise Wrapper.Stop_loop
| Some left_tree -> iter := left_tree
else if new_data > !iter.data
then match !iter.right with
| None ->
!iter.right <- Some (new_node new_data);
raise Wrapper.Stop_loop
| Some right_tree -> iter := right_tree
done
with Wrapper.Stop_loop -> ()
let in_order_traversal tree =
let module W = struct exception Stop_loop end in
let visited_stack = Stack.create () in
let iter_node = ref (Some tree) in
try while true do
(* Inner loop, we keep trying to go left *)
(try while true do
match !iter_node with
| None -> raise W.Stop_loop
| Some left ->
Stack.push left visited_stack;
iter_node := left.left
done;
with W.Stop_loop -> ());
(* If we have no more to process in the stack, then we're
done *)
if Stack.length visited_stack = 0
then raise W.Stop_loop
else
(* Here we're forced to start moving rightward *)
let temp = Stack.pop visited_stack in
Printf.sprintf "%s " temp.data |> print_string;
iter_node := temp.right
done
with W.Stop_loop -> ()
let () =
let root = new_node "F" in
["B";"G";"A";"D";"I";"C";"E";"H"] |> List.iter (insert root);
in_order_traversal root;
print_newline ();

huffman coding for a text file

This is only part of my huffman tree generated using ocaml. The tree is represented as (char*int list) list:
[(' ', [0]); ('e', [1; 0]); ('t', [1; 1; 0]); ('a', [1; 1; 1; 0]);
('o', [1; 1; 1; 1; 0]); ('n', [1; 1; 1; 1; 1; 0]).....].
The (char*int list) is the code and the corresponding encoded bitstream. I'm wondering if this is a correct tree or I understood something wrong. In this way, the longest encoded ASC II code will be 255 bits. The original file is 213.3k and after encoding, it becomes 227k while in the instructions, I was told it should generate a file around 119k. I don't know where my problem is because I did everything following the instructions. Can someone tell me what is wrong in here?
My biggest problem is that: if I use huffman coding, only the 8 most frequent chars can save me space while the other 247 chars will cost extra space, is that true? If it isn't, why?
The codes I wrote was following the instructions in this link:
http://www.cs.cornell.edu/Courses/cs3110/2012sp/hw/ps3/ps3.html
This is my code of encoding function:
type huffmantree = Node of huffmantree*(int*int)*huffmantree
| Leaf of char*int | Nil
type encoding = char * (int list)
let look_up (chr: char) (encl : encoding list) : int list =
let rec look_up_rec encl =
match encl with
| [] -> raise (Failure "Not found")
| (ch,theL)::tl -> if ch = chr then theL
else look_up_rec tl
in
look_up_rec encl
;;
let get_codes (hm : huffmantree): encoding list =
let rec get_codes_rec aTree word=
match aTree with
| Nil -> []
| Node (Leaf(lKey,lFreq),value,Nil) -> [(lKey,[0])]
| Node (Leaf(lKey,lFreq),value,Leaf(rKey,rFreq)) ->
[(lKey,List.append word [0]);(rKey,List.append word [1])]
| Node (Leaf(lKey,lFreq),value,rNode) ->
(lKey,List.append word [0])::(get_codes_rec rNode (List.append word [1]))
in
get_codes_rec hm []
;;
let encode (text : char list) : huffmantree * int list =
let sortedT = List.fast_sort (fun ch1 ch2->
if (int_of_char ch1)>=(int_of_char) ch2 then 1 else -1) text
in
let rec cre_freq_list aList m =
match aList with
| [] -> []
| hd::[] -> [(hd,m+1)]
| hd1::hd2::tl -> if hd1=hd2 then cre_freq_list (hd2::tl) (m+1)
else (hd1,(m+1))::(cre_freq_list (hd2::tl) 0)
in
let sortedF = List.fast_sort (fun (ch1,fr1) (ch2,fr2) ->
if fr1>=fr2 then 1 else -1) (cre_freq_list sortedT 0)
in
let rec createHuff sortedF=
match sortedF with
| [] -> Nil
| (ch,va)::[] -> Node (Leaf (ch,va),(256,va),Nil)
| (ach,aval)::tl ->
let rec creH_rec the_tl sib n freq=
match the_tl with
| (bch,bval)::[] -> Node(Leaf (bch,bval),(n,bval+freq),sib)
| (bch,bval)::btl -> creH_rec btl
(Node (Leaf (bch,bval),(n,bval+freq),sib)) (n+1)
(freq+bval)
in creH_rec tl (Leaf(ach,aval)) 256 aval
in
let huff = createHuff sortedF
in
let rec make_codes text =
match text with
| [] -> []
| hd::tl -> List.append (look_up hd (get_codes huff))
(make_codes tl)
in
(huff,(make_codes text))
Looking at the resulting tree, it appears that you don't implement the Huffman's algorithm. I doubt the 'e' is more frequent in your text than any other letter. Without your code I can only guess but maybe when merging the two lightest trees you inserted the resulting tree at the end of the list of trees to merge instead of inserting it at the right place according to its weight.
In your code createHuff is declared recursive but there is no recursive call.
Your function createHuff never compares the values inside the sortedF list don't you think this is a problem? It means that createHuff will always yield the same tree (with different labels but with the same structure).