Thursday, January 25, 2007

EOPL - 1.2.4 - Exercise 1.18

Exercise 1.18 takes advantage of Scheme's uniform treatment of code and data, so the functions proposed should return lists that can be evaluated to get some effect. Furthermore, there are typing issues, so adaptations are needed. The first function, compose, is easy enough:

let compose p1 p2 = fun x -> p1 (p2 x)

Next, I defined a data type to represent list operations:

type ListOp = Car | Cdr | Compose of ListOp * ListOp | Error

So it's easy to define car_cdr, but it doesn't return a list to evaluate, rather a ListOp object. Also, because of typing it was easier to include a variant Error of type ListOp and eliminate parameter errval.

let rec car_cdr s slist =
match slist with
[] -> Error
| s1 :: rslist when s1 = s -> Car
| _ :: rslist -> Compose (car_cdr s rslist, Cdr)

Thus we get

> car_cdr "c" ["a"; "b"; "c"];;
val it : ListOp = Compose (Compose (Car,Cdr),Cdr)

So we have a description of the necessary list operations, but it's not directly executable as in Scheme. So we need a function to execute the list operations returned on a list, and this is run_listop

let rec run_listop op lst =
match op with
Car -> List.hd lst
| Compose (c1, Cdr) -> run_listop c1 (List.tl lst)
| _ -> failwith "can't do"

The case that leads to an exception is to find a single Cdr without a previous Car. This is a good indication that the type was not designed properly, but we will not bother with this here. Function car_cdr2 doesn't need explicit Compose operations, and returns a list of list operations that must be applied in succession.

let car_cdr2 s slist errval =
let rec loop lst =
match lst with
[] -> []
| l :: rlst when s = l -> [Car]
| _ :: rlst -> Cdr :: (loop rlst) in
List.rev (loop slist)

It's quite easy to define a function to execute these ListOp lists, but not that interesting at this point.

Monday, January 15, 2007

EOPL - 1.2.4 - Exercise 1.17, sorting

Another exercise. This one involves binary trees and sorting. For the bintrees and finding a path through them to an element, we define two types:

type BinTree = Empty | Node of int * BinTree * BinTree
type direction = Left | Right

Then we can define function path, returning a list of directions:

let rec path n bst =
match bst with
Empty -> failwith ("number " + (string_of_int n) + " not found in tree")
| (Node (x, left, right)) when n = x -> []
| (Node (x, left, right)) when n < x -> Left :: path n left
| (Node (_, left, right)) -> Right :: path n right

For sorting, I chose to implement a rudimentary quicksort (with the first element as pivot). As with previous functions, beware of the value restriction.

let rec sort lst =
let left_part x (lp, rp) = (x :: lp, rp) in
let right_part x (lp, rp) = (lp, x :: rp) in
let rec partition p lst =
match lst with
[] -> ([], [])
| (x :: rlst) when x < p -> left_part x (partition p rlst)
| (x :: rlst) when x > p -> right_part x (partition p rlst)
| (x :: rlst) -> partition p rlst in
match lst with
[] -> []
| (x :: rlst) -> let lp, rp = partition x lst in
(sort lp) @ [x] @ (sort rp)

I wrote the internal function partition because it was part of the exercise, but it is already there in the standard library. Using this fact, we can get a much shorter version of quicksort:

let rec sort lst =
match lst with
[] -> []
| (x :: rlst) -> let lp, rp = List.partition (fun n -> n < x) rlst in
(sort lp) @ [x] @ (sort rp)

To sort with a different predicate is a straightforward change in either version. Here is the longer version working with a predicate:

let rec sort pred lst =
let left_part x (lp, rp) = (x :: lp, rp) in
let right_part x (lp, rp) = (lp, x :: rp) in
let rec partition p lst =
match lst with
[] -> ([], [])
| (x :: rlst) when x = p -> partition p rlst
| (x :: rlst) when (pred x p) -> left_part x (partition p rlst)
| (x :: rlst) -> right_part x (partition p rlst) in
match lst with
[] -> []
| (x :: rlst) -> let lp, rp = partition x lst in
(sort pred lp) @ [x] @ (sort pred rp)

Finally, just for fun, I wrote a merge sort function too.

let rec merge_sort (lst:'a list) =
let merge_pairs (ll1, rl1) (ll2, rl2) =
(ll1 @ ll2, rl1 @ rl2) in
let split_pairs i x =
if i < (lst.Length / 2) then ([x], []) else ([], [x]) in
let split l =
List.fold_right merge_pairs (List.mapi split_pairs l) ([], []) in
let rec merge lon1 lon2 =
match (lon1, lon2) with
([], _) -> lon2
| (_, []) -> lon1
| (x :: rlon1, y :: rlon2) when x <= y -> x :: (merge rlon1 lon2)
| (x :: rlon1, y :: rlon2) -> y :: (merge lon1 rlon2) in
match lst with
[] -> []
| [x] -> [x]
| _ -> let l, r = split lst in merge (merge_sort l) (merge_sort r)

It's quite long, but I didn't bother trying to get a shorter version.

Sunday, January 14, 2007

EOPL - 1.2.4 - Exercise 1.16

And now back to business, nothing really exciting yet: the next batch of exercises. The first is function up that in F# ends up being the same as concat, unless we define some new type.

// if not defining a new type that may be a list or a single element,
// up will work like concat, on lists of lists
let rec up lst =
match lst with
[] -> []
| (l :: rlst) -> l @ (up rlst)

This is the Scheme version of up, for comparison:

(define up
(lambda (lst)
(if (null? lst)
'()
(if (list? (car lst)
(append (car lst) (up (cdr lst)))
(cons (car lst) (up (cdr lst)))))))

The next functions work on lists of symbols, so we repeat here the necessary type definition for symbol expressions.

type SymbolExp = Symbol of string | SList of SymbolExp list

And the functions can thus be written:

let rec swapper s1 s2 slist =
match slist with
[] -> []
| (s :: rslist) -> swapper_in_symbol_exp s1 s2 s ::
(swapper s1 s2 rslist)
and swapper_in_symbol_exp s1 s2 sexp =
match sexp with
(Symbol s) when s = s1 -> Symbol s2
| (Symbol s) when s = s2 -> Symbol s1
| (SList sl) -> SList (swapper s1 s2 sl)
| _ -> sexp

let rec count_occurrences sym slist =
match slist with
[] -> 0
| (s :: rsl) -> (count_occurrences_sexp sym s) +
(count_occurrences sym rsl)
and count_occurrences_sexp sym sexp =
match sexp with
(Symbol s) when s = sym -> 1
| (SList sl) -> count_occurrences sym sl
| _ -> 0

let rec flatten slist =
match slist with
[] -> []
| ((Symbol s) :: rsl) -> (Symbol s) :: (flatten rsl)
| ((SList sl) :: rsl) -> (flatten sl) @ (flatten rsl)

// lon1 and lon2 are sorted lists of numbers
let rec merge lon1 lon2 =
match (lon1, lon2) with
([], _) -> lon2
| (_, []) -> lon1
| (x :: rlon1, y :: rlon2) when x <= y -> x :: (merge rlon1 lon2)
| (x :: rlon1, y :: rlon2) -> y :: (merge lon1 rlon2)

Tuesday, January 2, 2007

EOPL - 1.2.3 - Other Patterns of Recursion

Forgot to post the code for this section. Simple stuff, and only three functions.

let rec list_sum l =
match l with
[] -> 0
| (x :: rl) -> x + list_sum rl

let rec partial_vector_sum von n =
if n = 0 then 0
else von.(n - 1) + partial_vector_sum von (n - 1)

let vector_sum von =
partial_vector_sum von von.Length

EOPL - 1.2.4 - Some Exercises - 1.15

These are F# solutions to Exercise 1.15. In some places the functions proposed in the exercise are not completely suited to a ML language, so I made notes in the comments, but otherwise there is little that is exciting about these functions. I did alternative versions in some cases, even though the whole point of this exercise (and the rest from Section 1.2) is to write recursive functions to get a feel for them.

The function product once again runs into troubles with the value restriction. If one of the parameters is an empty list, the F# system won't recognize the result as a simple data value, so it will complain. The only way around it is to use type annotations, as noted in the comments after both versions of the function.

let rec duple n x =
if n = 0 then [] else x :: (duple (n - 1) x)

// invert would probably accept a list of real pairs in F#
let invert lp =
let invpair p =
match p with
[] -> []
| (a :: b :: []) -> [b; a]
| _ -> failwith "invalid list" in
List.map invpair lp

let rec filter_in p lst =
match lst with
[] -> []
| (x :: rl) when p x -> x :: (filter_in p rl)
| (_ :: rl) -> filter_in p rl

let rec every p lst =
match lst with
[] -> true
| (x :: rl) when p x -> every p rl
| _ -> false

let every2 p lst =
List.fold_left (fun b x -> b && p x) true lst

let rec exists p lst =
match lst with
[] -> false
| (x :: rl) when p x -> true
| (_ :: rl) -> exists p rl

// It's not possible to return numbers and booleans, so we could
// use an algebraic data type, or int option, which seems better
let vector_index p (v:'a array) =
let rec search i =
if i = v.Length then None
elif p v.(i) then Some i
else search (i + 1) in
search 0

// the test given can't be easily expressed in F#
// also: fragile for negative n
let rec list_set lst n x =
match (lst, n) with
([], _) -> []
| (elt :: rl, 0) -> x :: rl
| (elt :: rl, i) -> elt :: (list_set rl (n - 1) x)

// value restriction troubles: any empty list gives an error
let rec product l1 l2 =
match (l1, l2) with
(_, []) -> []
| ([], _) -> []
| (x :: rl1, _) -> (List.map (fun e -> (x, e)) l2) @ (product rl1 l2)

// value restriction troubles: any empty list gives an error
let product2 l1 l2 =
List.concat (List.map (fun x -> List.map (fun e -> (x, e)) l2) l1)

(*
To call product with an empty list as argument, you must annotate its type:
> product [1; 2; 3] ([] : int list);;
val it : (int * int) list = []
*)

// once again, this function makes less sense in F# than in Scheme
let down lst =
List.map (fun x -> [x]) lst

// explicitly recursive version:
let rec down2 lst =
match lst with [] -> [] | (x::rl) -> [x] :: (down2 rl)

// scheme version
(*
(define down
(lambda (lst)
(if (null? lst)
'()
(cons (list (car lst))
(down (cdr lst))))))
*)

// more type inference nuances: these types must be written down
let vector_append_list (v:'a array) (lst:'a list) =
let rec copy src dst i =
if i = 0 then ()
else (dst.(i-1) <- src.(i-1); copy src dst (i-1)) in
let rec copy_list_to_vector ls vc i =
match ls with
[] -> ()
| (x :: rls) -> (vc.(i) <- x;
copy_list_to_vector rls vc (i + 1)) in
let newv = Array.create (v.Length + lst.Length) 0 in
(copy v newv v.Length;
copy_list_to_vector lst newv v.Length;
newv)