Below are the commands demonstrated during the lecture session (plus some additional commands).
Remember:
Try them yourself.
Tweak them: modify them and try variants of those commands.
Your curiosity is your best pedagogical tool.
Disclaimer: the functions in the code below are defined most of the times without SPECIFICATION. Remember that defining a function always consists in giving its specification and then implementation.
So far, several definition of the identity function, depending on the type of the argurment. If we want to have several identities for several types, we have to define each type a function and give it a new name.
let identity_int (n:int):int = n ;;
let identity_float (f:float):float = f ;;
let identity_char (c:char):char = c ;;
(* Length of a list. Note how the implementation of the two functions below do not depend on int or chars. *)
let rec length_int (l: int list):int=
match l with
| [] -> 0
| _::l -> 1+ length_int l ;;
let rec length_char (l: char list):int=
match l with
| [] -> 0
| _::l -> 1+ length_char l ;;
(* Polymorphic identity -- observe the type inferred by OCaml*)
let id x = x ;;
let id (x:'a):'a = x ;;
let id (x:'b):'b = x ;;
let id (x:'toto):'toto = x ;;
id 2 ;;
id 2.3 ;;
let suc (x:int):int = x+1 in (id suc) 4;;
id (fun x -> x+1);;
let suc (x:int):int = x+1 ;;
id suc;;
(* Polymporphic lists *)
type 't llist = Nil | Cons of 't * 't llist ;;
let il4 = Cons(1,Cons (2,Cons (3,Cons (4,Nil))));;
let sl4 = Cons('a',Cons('r',Cons ('d',Cons ('c',Nil))));;
Cons ((fun x -> x), Cons ((fun x -> 3*x+2), Nil)) ;;
fun x y -> x::y;;
let rec lengthconsnil (l:'a llist):int=
match l with
| Nil -> 0
| Cons (_, l) -> 1 + lengthconsnil l;;
let rec append (l1: 'a llist) (l2:'a llist):'a llist=
match l1 with
| Nil -> l2
| Cons (x,l) -> Cons(x,append l l2);;
let rec length (l: 'a list):int =
match l with
| [] -> 0
| _::l -> 1+ length l;;
(* Polymorphic functions on polymorphic lists *)
let rec reverse (x : 'a llist) : 'a llist =
match x with
| Nil-> Nil
| Cons (h, t) -> append (reverse t) (Cons (h, Nil));;
(* apply the function f to each element of x
* map f [a; b; c] = [f a; f b; f c] *)
let rec map (f : 'a -> 'b) (x : 'a llist) : 'b llist =
match x with
| Nil-> Nil
| Cons (h, t) -> Cons (f h, map f t);;
let mil4 = map string_of_int il4 ;;
(* insert sep between each element of x:
* separate s [a; b; c; d] = [a; s; b; s; c; s; d] *)
let rec separate (sep : 'a) (x : 'a llist) : 'a llist =
match x with
| Nil-> Nil
| Cons (h, Nil) -> x
| Cons (h, t) -> Cons (h, Cons (sep, separate sep t)) ;;
(* Motivation, a function to test *)
let max2_v1 (a:int) (b:int): int =
if a > b then a else b ;;
let max2_v2 (a:int) (b:int): int =
if a <= b then b else a ;;
(* How can I test that those functions return correct values ? *)
max2_v1 2 3 = 3 ;;
max2_v2 5 6 = 6 ;;
let test (f:int -> int -> int) (arg1:int) (arg2:int) (res:int):bool =
f arg1 arg2 = res ;;
test max2_v1 5 6 6;;
test max2_v2 7 11 11;;
(* How can I test that those implementations return the same value *)
let v1 = max2_v1 3 12 and v2 = max2_v2 3 12 in v1 = v2 ;;
max2_v1 3 12 = max2_v2 3 12 ;;
let test2 (f:int -> int -> int) (g:int -> int -> int) (arg1:int) (arg2:int):bool =
f arg1 arg2 = g arg1 arg2 ;;
test2 max2_v1 max2_v2 3 12 ;;
(* A function returning an affine function *)
let affinegen a b = (fun x -> a *x + b) ;;
let plustwo = affinegen 1 2 ;;
plustwo 3;;
(* Slope in 0 *)
let slope_in_0 (f:float->float):float =
let h = 0.001 in
(f h -. f 0.) /. h ;;
(* Derivative of a function *)
let derivative (f:float-> float):(float->float) =
fun x -> let h = 0.0001 in (f(x+.h) -. f(x))/. h ;;
let square (x:float):float = x*.x ;;
(*Directly using the derivative and the square functions together *)
(derivative square) 3. ;;
(* Defining the intermediate function *)
let twox = derivative square ;; (* observe the type of the result *)
twox 3.;;
(* Using anonymous function *)
derivative (fun x -> x*.x) 3.;;
(* Finding the zeros of a continuous function using dichotomy *)
let sign (x:float):bool = x >=0. ;;
let rec zero (f:float -> float) (a:float) (b:float) (eps:float):float =
let sa = sign (f a) and sb = sign (f b) in assert (sa <> sb);
if f a=0. then a
else
if f b=0. then b
else (
let c = (a +. b) /. 2. in
if (f c=0. || b -. a < eps) then c
else (
if (sign (f a) = sign (f c))
then zero f c b eps
else
zero f a c eps
)
);;
let id = fun (x:float) -> x ;;
zero id (-.(1.)) 1. 0.1 ;;
let threexminustwo (x:float) = 3.*.x-.2.;;
zero threexminustwo 0. 1. 0.1;;
(* We can deduce an algorithm to compute the square root of a float
Based on the remark that x s.t. x²=a belongs to (0,(1+a)/2) and x->x²-a monotonous
*)
(* Experiment with several values of the precision and observe how it influences the results *)
let square_root (a:float) =
zero (fun x -> x*.x -. a) 0. ((1.+.a)/.2.) 0.0001 ;;
let root = square_root 2.;;
root *. root;;
let double (x:int):int = 2*x;;
let square (x:int):int = x * x;;
let quad (x:int):int = double (double x);;
let power4 (x:int):int = square (square x);;
let applyTwice (f:int -> int) (x:int) = f (f x) ;;
let compose (g:'a -> 'b) (f:'c -> 'a):('c -> 'b)=
fun x -> g (f x);;
(* Composing functions *)
let rec nthterm (n:int) (f:'a->'a) (x:'a):'a =
if (n=0) then x else f (nthterm (n-1) f x) ;;
(* n-th iteration of a function *)
let rec iterate (n:int) (f:'a->'a) = fun (x:'a) ->
match n with
0 -> x
| 1 -> f x
| 2 -> (compose f f) x
| _ -> (compose (iterate (n-1) f) f) x;;
let f = fun x -> x+2;;
let f3 = iterate 3 f ;;
f3 3 ;;
(* Generalizing the sum of the first n integers *)
let rec sum_integers (n:int) =
if n=0 then 0
else sum_integers (n-1) + n ;;
sum_integers 10;;
10*11/2;;
let rec sum_squares (n:int) =
if n=0 then 0
else sum_squares (n-1) + (n*n);;
sum_squares 10;;
let rec sigma (n:int) (f:int -> int):int=
if n=0 then 0 (* implicitely we assume that f 0 = 0 *)
else (f n) + sigma (n-1) f ;;
let sum_integers2 (n:int):int = sigma n (fun x -> x) ;;
sum_integers2 10;;
let sum_squares2 (n:int):int = sigma n (fun x -> x*x);;
sum_squares2 10;;
(* Applying a function to each element of a list *)
let rec my_map (f:'a-> 'b) (l:'a list):'b list =
match l with
[] -> []
| e::r -> (f e)::(my_map f r);;
let rec my_map f l =
match l with
[] -> []
| e::r -> (f e)::(my_map f r);;
let vectorize (l:'a list):'a list list = my_map (fun x -> [x]) l;;
let toSquare (l:int list):(int list)=
my_map (fun x -> x*x) l ;;
let toAscii (l:char list):int list=
my_map (fun x -> Char.code x) l;;
let toAscii (l:char list):int list=
my_map Char.code l;;
(* Later we will see that we can even write it like that *)
let toAscii = my_map Char.code;;
let toUpperCase (l:char list):char list =
my_map (fun c -> Char.chr ((Char.code c) - 32)) l;;
Char.code ('a');;
Char.code ('A');;
Char.chr 97;;
Char.chr 98;;
97-65;;
let l = ['a';'b';'c';'d';'e';'f'];;
toUpperCase l;;
(* The function can be improved *)
let l2 = ['a';'B';'c';'D';'e';'f'];;
toUpperCase l2;;
Char.code ('Z');;
Char.chr 91;;
(* The function below is safer *)
let toUpperCase2 (l:char list):char list =
let conversion =
fun c -> let cc = (Char.code c) in
if (cc <= 122 && cc >=97) then Char.chr ((Char.code c) - 32)
else c
in my_map conversion l;;
toUpperCase2 l2;;
(* Powerset *)
let rec powerset = function
| [] -> [[]]
| h :: r -> let rp = powerset r in
rp@(my_map ( function l -> h :: l ) rp ) ;;
powerset [1;2;3] ;;
Observe the similarities and differences between the following functions.
let rec sum l =
match l with
[ ] -> 0
| elt::remainder -> elt + (sum remainder);;
let rec product l =
match l with
[ ] -> 1
| elt::remainder -> elt * (product remainder);;
let rec concatenate l =
match l with
[ ] -> " "
| elt::remainder -> elt ^ (concatenate remainder);;
let l1 = [1;2;3;4;5];;
let l2 = [1;0;8;10];;
(* Generalizing: function fold_right *)
let rec my_fold_right (f:'a -> 'b -> 'b) (l:'a list) (b0:'b):'b =
match l with
[] -> b0
| elt::remainder -> f elt (my_fold_right f remainder b0);;
let sum2 l = my_fold_right (+) l 0 ;;
let product2 l = my_fold_right ( * ) l 1 ;;
let concatenate2 l = my_fold_right (^) l "" ;;
sum l1 = sum2 l1 && sum l2 = sum2 l2;;
(* Humm, let's generalize our test function *)
let test2equal (f:'a -> 'b) (g:'a -> 'b) (l:'a) =
f l = g l;;
test2equal sum sum2 l1 && test2equal sum sum2 l2;;
test2equal product product2 l1 && test2equal product product2 l2;;
(* Hummm, we can tweak a bit this function in order to generalize our first test function which performed test cases and now it will perform a test suite, that is a list of test cases
For a test suite to succeed, it has to succeed on all test cases. The inputs will be provided by the list.*)
let testsuite (f:'a -> 'b) (g:'a -> 'b) (l:'a list) =
my_fold_right (fun current previous -> previous && f current = g current) l true;;
let plus1 = fun x -> x+1;;
let plus1dummy = fun x -> if (x mod 2 = 0) then x -2 + 3 else 2*x;;
testsuite plus1 plus1dummy [8;2;4;6];;
testsuite plus1 plus1dummy [8;1;4;6];;
#trace testsuite;;
testsuite plus1 plus1dummy [8;3;4;6];;
let rec my_fold_left (f: 'b -> 'a -> 'a) (a:'a) (l:'b list):'b=
match l with
[] -> a
| elt::remainder -> let new_a = f elt a in my_fold_left f new_a remainder ;;
let rec remove_odd (l:int list) =
match l with
[ ] -> [ ]
| elt::remainder ->
if elt mod 2 = 0
then elt::(remove_odd remainder)
else (remove_odd remainder) ;;
(* Some functions parameterized by a predicate *)
let rec filter (l:'a list) (p:'a -> bool):'a list=
match l with
[] -> []
| elt::remainder ->
if p elt then elt::(filter remainder p)
else filter remainder p ;;
let rec forall (l:'a list) (p:'a -> bool):bool=
match l with
[] -> true
| elt::remainder -> p elt && forall remainder p ;;
let rec forall2 (l:'a list) (p:'a -> bool):bool =
my_fold_left (fun elt res -> p elt && res) true l ;;
let rec exists (l:'a list) (p:'a -> bool):bool=
match l with
[] -> false
| elt::remainder -> p elt || exists remainder p ;;
let rec exists2 (l:'a list) (p:'a -> bool):bool =
my_fold_left (fun elt res -> p elt || res) false l ;;
(* Back to testing *)
let testsuite2 (f:'a -> 'b) (g:'a -> 'b) (l:'a list) =
forall l (fun x -> f x = g x) ;;
(* Map with fold_left *)
let my_map_left (l:'a list) (f:'a -> 'b):'b list =
List.fold_left (fun acc x-> acc @ [f x]) [] l ;;
(* Map with fold_right *)
let my_map_right (l:'a list) (f:'a -> 'b):'b list=
List.fold_right (fun x acc -> (f x)::acc) l [] ;;
(* Minimum and maximum -- with one line of code *)
let l1 = [12;1;2;3;4;8;5;37;1;81];;
let minright (l:'a list):'a = List.fold_right min l (List.hd l);;
let minleft (l:'a list)= List.fold_left min (List.hd l) l;;
minleft l1;;
minright l1;;
let maxright (l:'a list):'a = List.fold_right max l (List.hd l);;
let maxleft (l:'a list)= List.fold_left max (List.hd l) l;;
(* Currying the function applyTwice: we apply the function without the second argument (e.g., appllyTwice f. We obtain the function x -> f f (x) *)
let applyTwice (f:int -> int) (x:int):int = f (f x);;
let ninexpluseight = applyTwice (fun x -> 3*x + 2);;
ninexpluseight 1 = 9*1 + 8;;
ninexpluseight 2 = 9*2 + 8;;
(* So let's write a test function *)
let test (f:'a -> 'b) (g:'a -> 'b) (l:'a list)=
List.fold_left (fun acc x -> acc && (f x = g x)) true l ;;
test ninexpluseight (fun x -> 9*x+8) [1;2;3;4;5;6;7] ;;
(* Currying allows for some flexibility *)
let add1 ((x,y):int*int):int = x+y;;
let add2 (x:int) (y:int):int = x+y;;
add1 2;;
add2 2;;
(+);;
let increment (x:int):int = (+) 1 x;;
let increment = (+) 1;;