DVA229 Functional Programming with F#, answers to exercises

Latest update Dec. 19, 2022

Answers to Exercises

Functional Programming and F#

let upchar c =
  match c with
  | 'a' -> 'A'
  | 'b' -> 'B'
  | 'c' -> 'C'
  | c   ->  c

let rec upstring s =
  match s with
  | "" -> ""
  | s  -> (upchar (s.[0])).ToString() + upstring (s.[1 .. String.Length s])

let upstring = String.map upchar

let squares n =
  let rec sqlocal i n =
    if i > n
    then []
    else i*i :: squares (i+1) n
  in sqlocal 1 n

let squares n = [ for i in 1 .. n -> i*i ]

let list_match pat l =
  match l with
  | []    -> []
  | x::xs ->
    let rec test pat l =
      match (pat,l) with
      | ([],s)                  -> true
      | (p:pat,x:xs) when p = x -> test pat xs
      | _                       -> false
    in test pat s :: list_match pat xs

match : 'a list -> 'a list -> bool list

let matchall pat = match pat >> List.fold (||) false

let rec foldBack1 f l =
  match l with
  | [] -> failwith "Applying foldBack1 to empty list"
  | [x] -> x
  | x::xs -> f x (foldBack1 f xs)

let rec fold1 f l =
  match l with
  | [] -> failwith "Applying fold1 to empty list"
  | x::xs -> List.fold f x xs

// "Vanilla" recursive function for the sequence
let rec f n = 
  match n with
  | 1                -> 1
  | n when n % 2 = 0 -> f (n/2)
  | _                -> f(3*n+1)

// Version with accumulating argument, returning the number of calls. Call
// with f2 1 n 
let rec f2 count n = 
  match n with
  | 1                -> count
  | n when n % 2 = 0 -> f2 (count + 1) (n/2)
  | _                -> f2 (count + 1) (3*n+1)

// Version with mutable ref cell
let count = ref 1
let rec f3 n = 
  match n with
  | 1                -> !count
  | n when n % 2 = 0 -> count := !count + 1; f3 (n/2)
  | _                -> count := !count + 1; f3 (3*n+1)

// Computing the sequence as a list
let rec f4 n = 
  match n with
  | 1                -> [1]
  | n when n % 2 = 0 -> n :: f4 (n/2)
  | _                -> n :: f4 (3*n+1)

let sroot a eps = 
  let rec new x =
    let newx =  0.5*(x + a/x)
    in if abs (x - newx) < eps then newx else new newx
in new a

let newrap f f' a eps =
  let rec new x =
    let newx =  x - f x/f' x
    in if abs (x - newx) < eps then newx else new newx
in new a : float

let iter f test x =
  let rec new x =
    let xnew = f x
    in if test x xnew then xnew else new xnew
in new x

let newrap2 f f' a eps =
  iter (fun x -> x - f x/f' x) (fun x xnew -> abs (x - xnew) < eps) a : float

// A function "isprime" that tests, given a list l of previous primes, whether
// i is prime or not
let rec isprime i l =
  match l with
  | [] -> true
  | head :: tail -> 
      if i % head = 0
      then false
      else isprime i tail

// The prime sieve function. The local function lsieve recursively builds the
// list of discovered primes, and tests the next candidate against this list.
let sieve n =
  let rec lsieve i l n =
    if i = n
    then l
    else if isprime i l
         then lsieve (i+1) (i::l) n
         else lsieve (i+1) l n
  in lsieve 3 [2] n

They have different types, and thus take different arguments. f is in curried form and has type int -> int -> int: it takes an int, and returns a function that takes another int which in turn returns an int. g, on the other hand, has type int * int -> int and takes a tuple of two ints as arguments.

type Vec5 = V2 of float * float | V3 of float * float * float
            | V4 of float * float * float * float
            | V5 of float * float * float * float * float

let vlen vec =
  match vec with
  | V2 (x,y) -> sqrt (x**2 + y**2)
  | V3 (x,y,z) -> sqrt (x**2 + y**2 + z**2)
  | V4 (x,y,z,u) -> sqrt (x**2 + y**2 + z**2 + u**2)
  | V5 (x,y,z,u,v) -> sqrt (x**2 + y**2 + z**2 + u**2 + v**2)

let vadd v1 v2 =
  match (v1,v2) with
  | (V2 (x1,y1),V2 (x2,y2)) -> V2 (x1+x2,y1+ny2)
  | (V3 (x1,y1,z1),V3 (x2,y2,z2)) -> V3 (x1+x2,y1+y2,z1+z2)
  | (V4 (x1,y1,z1,u1),V4 (x2,y2,z2,u2)) -> V4 (x1+x2,y1+y2,z1+z2,u1+u2)
  | (V5 (x1,y1,z1,u1,v1),V5 (x2,y2,z2,u2,v2)) ->
    V5 (x1+x2,y1+y2,z1+z2,u1+u2,v1,v2)
  | _ -> failwith "Attempt to add vectors of different dimensionality"

// We represent internal nodes and leaves by the same kind of node. Leaves
// contain the empty list.
type VarTree<'a> = VNode of 'a * (VarTree<'a> list)

let rec treeMap f (VNode (x,l)) = (VNode (f x),(List.map (treeMap f) l))

let rec fanout_sum (VNode (x,l)) =
  List.length l + List.sum (List.map fanout_sum l)
let rec no_nodes (VNode (x,l)) = 1 + List.sum (List.map no_nodes l)
let average_fanout t = float (fanout_sum t)/float (no_nodes t)

Type Inference

Let us recall the definitions of f and g:
```
let f x y   = x + y
let g (x,y) = x + y
```
Consider f first. We have identifiers f, x, y. First, choose one distinct type variable for each identifier:
```
f : 'a
x : 'b
y : 'c
```
We also have
```
(+) : 'n -> 'n -> 'n, 'n numerical type
```
From the LHS f x y, we obtain
```
'a = 'b -> 'c -> 'd
```
since f is a function applied to x and y, and thus the argument types of f must match with the types of x, y. Furthermore, the type of the LHS is 'd. From the RHS, we have
```
'b = 'n
'c = 'n
'd = 'n
```
since x and y are arguments to +, and the type of x + y must be the same as the type for f x y. There is no more information to guide the choice of 'n: thus, it defaults to int:
```
'n = int
```
This yields
```
'b = int
'c = int
'd = int
```
and since f : 'b -> 'c -> 'd we obtain the answer
```
f : int -> int -> int
```
Now consider g. Similarly to above, we will obtain
```
g : 'b * 'c -> 'd
x : 'b
y : 'c
```
As for f, we obtain
```
'b = int
'c = int
'd = int
```
and the final result is
```
g : int * int -> int
```

Consider the definition of map:
```
let rec map f l =
  match l with
  | []           -> []
  | head :: tail -> f head :: map f tail
```
We know beforehand:
```
[]   : 'a list (first occurrence)
[]   : 'b list (second occurrence)
(::) : 'c -> 'c list -> 'c list (first occurrence)
(::) : 'd -> 'd list -> 'd list (second occurrence)
1    : int
(+)  : 'n -> 'n -> 'n, 'n numerical type
```
Note that we must use different type variables for the different occurrences of [] and (::), since they may assume different typings in different places. As usual, we assign one distinct type variable to each identifier in the function declaration:
```
map  : 'e
f    : 'f
l    : 'g
head : 'h
tail : 'i
```
Lets, start with the LHS, We immediately obtain
```
map : 'f -> 'g -> 'j
map f l : 'j
```
Now consider the RHS (the match expression). Since l is matched with [] (first occurrence), we obtain
```
'g = 'a list
```
Furthermore, well-typedness of head :: tail demands
```
'h = 'c
'i = 'c list
```
Since l can match head :: tail, we also have
```
'c list = 'a list
```
which implies
```
'c  = 'a
```
Summing up so far, we have the following typings (to be further refined):
```
map  : 'f -> 'a list -> 'j
f    : 'f
l    : 'a list
head : 'a
tail : 'a list
```
Now consider the results of the match expression, [] (second occurrence) and f head :: map f tail. From f head we obtain
```
'f = 'a -> 'k
'k = 'd
```
For map f tail, the types for f and tail already match the argument types of map. We have map f tail : 'j, which yields
```
'j = 'd list
```
Finally, since the types of [] and f head :: map f tail must match the type of map f l, we have
```
'b list = 'd list
'd list = 'd list
```
which is satisfied exactly when 'b = 'd. Now all expressions have been checked for correct typings, and we obtain the following typing for map:
```
map  : ('a -> 'd) -> 'a list -> 'd list
```
Since we were careful in each step not to introduce more constraints than necessary on the typings, this is a most general typing for map.

Reconsider the definition of take:

let rec take n l =
  match (n,l) with
  (_,[])    -> failwith "List too short"
  (0,_)     -> []
  (_,x::xs) -> x :: take (n-1) xs

We know beforehand:

[]   : 'a list (first occurrence)
[]   : 'b list (second occurrence)
(::) : 'c -> 'c list -> 'c list (first occurrence)
(::) : 'd -> 'd list -> 'd list (second occurrence)
failwith : string -> 'e
"List too short" : string
0    : int
(-)  : 'n -> 'n -> 'n, 'n numerical type
1    : int

We assign unique type variables as typings for the different identifiers:

take : 'f
n : 'g
l : 'h
x : 'i
xs : 'j

from LHS (take n l) we have

'f = 'g -> 'h -> 'k
take n l : 'k

From the RHS (match expression), we have, from the possible matchings of (n,l):

'g = int (since n can match 0)
'h = 'a list (since l can match first occurrence of [])
'h = 'c list (since l can match x::xs)

The two latter equalities also imply

'c = 'a

From well-typing of x::xs we obtain

'i = 'c
'j = 'c list

Summing up, we now have

take : int -> 'a list -> 'k
n : int
l : 'a list
x : 'a
xs : 'a list

Now consider the results of the match: failwith "List too short", [] (second occurrence), and x :: take (n-1) xs. They must be well-typed, and their types must all match 'k, the type of take n l. We have:

failwith "List too short" : 'e
[] : 'b list (second occurrence)
x :: take (n-1) xs : 'd list

from which we obtain

'k = 'e = 'b list = 'd list

Well-typing of x :: take (n-1) xs demands

'd = 'a (x first argument to ::)
'd list = 'd list (take (n-1) xs second argument to ::)
'n = int (n-1 first argument to take)
'a list = 'a list (xs second argument to take)
'n = int (n first argument to -)
int = int (1 second argument to -)

Summing up, we now have the typing

take : int -> 'a list -> 'a list

Since we now have checked that all subexpressions are well-typed, this is a correct typing of take, and it is also its most general type (by a similar argument as for map).

Björn Lisper
bjorn.lisper (at) mdu.se