Below are the commands demonstrated during the lecture session (plus some additional commands).
Remember:
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.
type list_of_int = Nil | Cons of int * list_of_int ;;
Cons (1,Cons(2,Cons(3,Nil))) ;; (* Parentheses are mandatory *)
let l1 = Cons (1,Cons(2,Cons(3,Nil))) ;;
let l2 = Cons (-1, Cons (0, l1)) ;;
Cons (1, Cons (0,Nil)) = Cons (0, Cons (1,Nil)) ;; (* order matters *)
let suc (x:int):int = x+1 ;;
let l1prime = Cons (suc 0, Cons (suc 1, Cons (suc 2, Nil)));;
(* Expressions are evaluated and since lists are values they can be compared *)
l1 = l1prime;;
(* elements of the list should be of the same type *)
Cons (1, Cons ("two", Nil));;
type list_of_booleans = Nil | Cons of bool * list_of_booleans ;;
let lbool1=Cons (true, Cons (false,Nil)) ;;
(* Note that the current construct, in addition to being painful to write, has some disadvantages -> See the later example of list_of_int to remedy to this*)
Cons (1, Cons (2,Nil)) ;;
let lbool2 = Cons(true, Cons (2>3,Nil));;
lbool1 = lbool2 ;;
(* Previous typing rules in constructs apply *)
let abool = (Random.int 2 = 1) ;;
if abool then Nil else Cons (true, Nil) ;;
type list_of_int = NilInt | ConsInt of int * list_of_int ;;
let list_of_first_integers (n:int):list_of_int =
match n with
0 -> NilInt
| 1 -> ConsInt (1,NilInt)
| 2 -> ConsInt (2,ConsInt (1,NilInt))
| _ -> failwith "argument to big (I'm tired!)" ;;
(* List of functions from int to int *)
type int2int = int -> int ;;
type list_of_int2int = Nil | Cons of int2int * list_of_int2int ;;
type list_of_int2int = Nil | Cons of (int -> int) * list_of_int2int ;;
Cons ((fun x -> x+1),Cons ((fun x -> x-1), Cons((fun x -> x+2), Nil))) ;;
Two remarks: what is below can be
type intlist = Nil | Cons of int * intlist ;;
(* A function, given an int, returns the singleton list containing the int *)
let putAsList (n:int):intlist=
Cons (n,Nil) ;;
putAsList 2;;
(*Function head, the head is the first element of the list *)
let head (l:intlist):int=
match l with
Nil -> failwith "Empty list given as a parameter"
| Cons (a,lprime) -> a ;;
(*Equivalently, since lprime is useless in the second case *)
let head (l:intlist):int=
match l with
Nil -> failwith "Empty list given as a parameter"
| Cons (a,_) -> a ;;
head Nil ;;
head (Cons(2,Nil));;
(* Function remainder, the remainder of a list is the list without the first element *)
let remainder (l:intlist):intlist=
match l with
Nil -> failwith "Empty list given as argument"
| Cons (_, l) -> l ;;
remainder (Cons(2,Cons(4,Nil)));;
remainder Nil ;;
(* Is zero as a first element, i.e., the head *)
let is_zero_the_head (l:intlist):bool=
match l with
Nil -> false
| Cons (x,lprime) -> x=0 ;;
(* We do not care about lprime *)
let is_zero_the_head (l:intlist):bool=
match l with
Nil -> false
| Cons (x,_) -> x=0 ;;
(* First case can be avoided *)
let is_zero_the_head (l:intlist):bool=
match l with
| Cons (x,_) -> x=0
| _ -> false ;;
(* We can directly indicate values in the pattern matching *)
let is_zero_the_head (l:intlist):bool=
match l with
|Cons (0,_) -> true
| _ -> false ;;
is_zero_the_head Nil ;;
is_zero_the_head (Cons (1,Nil)) ;;
is_zero_the_head (Cons (0,Nil)) ;;
let is_zero_the_head2 (l:intlist):bool=
head l = 0 ;;
is_zero_the_head2 Nil ;;
is_zero_the_head Nil ;;
(* Function second element *)
let second (l:intlist):int =
match l with
Cons (_,Cons (a,lprime)) -> a
| _ -> failwith "The list does not have more than 1 element" ;;
second Nil ;;
second (Cons (1,Nil)) ;;
second (Cons (4,Cons (1,Nil))) ;;
(* Alternative implementation *)
let second2 (l:intlist):int= head (remainder l) ;;
second2 (Cons(1, Nil)) ;; (* Observe that error messages are less precise *)
(* We can actually make a more detailled pattern matching *)
let second3 (l:intlist):int =
match l with
Nil -> failwith "second3: the argument list is empty"
| Cons (_,Nil) -> failwith "second3: the argument has only one element"
| Cons (_, Cons(a,lprime)) -> a ;;
second3 (Cons (1,Nil)) ;;
type nonempty_intlist = Elt of int | Cons of int * nonempty_intlist ;;
let head (l:nonempty_intlist):int=
match l with
Elt x -> x
| Cons (a,_) -> a ;;
type intlist = Nil | Cons of int * intlist;;
let head (l:intlist):(int*bool)=
match l with
Nil -> 42,false
| Cons (a,_) -> a,true ;;
let head (l:intlist):int=
match l with
Cons (a,_) -> a ;;
(* First let's define some lists to play with *)
let l0 = Nil ;;
let l1 = Cons (1,l0) ;;
let l21 = Cons (2,l1) ;;
let l12 = Cons (1,Cons(2,l0)) ;;
let rec length (l:intlist):int=
match l with
| Nil -> 0
| Cons (_,l) -> 1+length l ;;
(* Sum of elements of the list *)
let rec sum (l:intlist):int=
match l with
Nil -> 0
| Cons (x,l) -> x + sum l ;;
sum l21 ;;
sum l12 ;;
(* Belongs to *)
let rec belongsto_incorrect (l:intlist) (e:int):bool =
match l with
Nil -> false
| Cons (e,_) -> true
| _ -> false ;;
(* Two problems:
1- the last match case is useless
2- worse, this will not return true on lists containing e, but it will return true on any non-empty list. Remember that in filters, we are dealing with "shapes".
*)
let rec belongsto (l:intlist) (e:int):bool=
match l with
Nil -> false
| Cons (x,lprime) -> x = e || belongsto lprime e ;;
belongsto l21 2 ;;
belongsto l21 4 ;;
(* Last element of a list *)
let rec last (l:intlist):int=
match l with
Nil -> failwith "function last: argument list cannot be empty"
| Cons (x,Nil) -> x
| Cons (_,l) -> last l ;;
last l21;;
last l12;;
last Nil;;
(* Minimum element of a list *)
let rec minimum (l:intlist):int=
match l with
Nil -> failwith "function minimum: argument list cannot be empty"
| Cons (x,Nil) -> x
| Cons (x,l) -> min x (minimum l) ;;
(* Interval between integers i and j - Be careful with the spec *)
let rec interval (i:int) (j:int):intlist=
if i = j then Cons (i,Nil)
else Cons (i, interval (i+1) j) ;;
(* Extracting the even integers of a list *)
let rec evens (l:intlist):intlist =
match l with
Nil -> Nil
| Cons (x,l) -> if (x mod 2 = 0) then Cons (x,evens l) else evens l ;;
evens l21;;
let l54321 = Cons (5, Cons (4, Cons (3, l21)));;
evens l54321;;
(* Similarly we can be interested in positive integers *)
let rec positives (l:intlist):intlist =
match l with
Nil -> Nil
| Cons (x,l) -> if (x>0) then Cons (x,positives l) else positives l ;;
(* Actually we could even pass a function as argument and apply this function. Such function is called a higher-order function. It will be the subject of a subsequent chapter *)
(* Replacing elements of a list *)
let rec replace (l:intlist) (before:int) (after:int) =
match l with
Nil -> Nil
| Cons (x,l) -> if (x=before) then Cons (after,replace l before after) else Cons(x,replace l before after) ;;
(* Note here that in the second case we have used l, although it is the argument name. We could have chosen some other name *)
(* Concatenate two lists *)
let rec concat (l1:intlist) (l2:intlist):intlist=
match l1 with
Nil -> l2
| Cons (x,l) -> Cons (x, concat l l2);;
(* Splitting a list of pairs into a pair of lists *)
let rec split (l:(int*int) list):(intlist * intlist)=
match l with
Nil -> (Nil,Nil)
| Cons ((a,b),l) -> let (l1,l2) = split l in (Cons (a,l1),Cons (b,l2)) ;;
(* Is a list in increasing order? *)
let rec is_increasing (l:intlist):bool=
match l with
Nil | Cons (_,Nil) -> true
| Cons (a,Cons(b,l)) -> a<=b && is_increasing (Cons(b,l)) ;;
is_increasing l54321;;
is_increasing l12;;
(* Reversing a list, i.e., produce the list which is as the input list is read from right to left *)
let reverse (l:intlist):intlist=
let rec reverse_aux (l:intlist) (res:intlist):intlist=
match l with
Nil -> res
| Cons (elt,rem) -> reverse_aux rem (Cons (elt,res))
in
reverse_aux l Nil
;;
reverse (Cons (1,Cons (2,Cons(3,Nil))));;
(* Recursive functions on lists of cards *)
type card = Value of int | Jack | Queen | King | Ace ;;
type hand = Nil | Cons of card * hand ;;
let value_card (c:card):int=
match c with
| Value n-> n
| Jack -> 11
| Queen -> 12
| King -> 12
| Ace -> 14 ;;
let rec value_hand (l:main):int=
match l with
Nil -> 0
| Cons (c, lprime) -> (value_hand c) + value_hand lprime ;;
Note here that, in the functions below, equivalent filters can be used sometimes (see the lecture).
let l12 = [1;2] and l21 = [2;1];;
(* Belongs to *)
let rec belongsto (l:int list) (e:int):bool=
match l with
[] -> false
| x::lprime -> x = e || belongsto lprime e ;;
belongsto l21 2;;
belongsto l21 4;;
(* Last element of a list *)
let rec last (l:int list):int=
match l with
[] -> failwith "function last: argument list cannot be empty"
| [x] -> x
| _::l -> last l;;
last l21;;
last l12;;
last [];;
(* Minimum element of a list *)
let rec minimum (l:int list):int=
match l with
[] -> failwith "function minimum: argument list cannot be empty"
| [x] -> x
| x::l -> min x (minimum l) ;;
(* Interval between integers i and j - Be careful with the spec *)
let rec interval (i:int) (j:int):int list=
if i = j then [i]
else i::(interval (i+1) j) ;;
interval 4 9;;
(* Extracting the even integrers of a list *)
let rec evens (l:int list):int list =
match l with
[] -> []
| x::l -> if (x mod 2 = 0) then x::(evens l) else evens l;;
evens l21;;
let l54321 = 5::4::3::l21;;
let l54321 = [5;4;3]@l21;;
evens l54321;;
(* Similarly we can be interested in positive integers *)
let rec positives (l:int list):int list =
match l with
[] -> []
| x::l -> if (x>0) then x::(positives l) else positives l ;;
(* Actually we could even pass a function as argument and apply this function. Such a function is called a higher-order function. It will be the subject of a subsequent chapter *)
(* Replacing elements of a list *)
let rec replace (l:int list) (before:int) (after:int) =
match l with
[] -> []
| x::l -> if (x=before) then after::(replace l before after) else x::(replace l before after);;
(* Note here that in the second case we have used l, although it is the argument name. We could have chosen some other name *)
(* Concatenate two lists *)
let rec concat (l1:int list) (l2:int list):int list=
match l1 with
[] -> l2
| x::l -> x::(concat l l2);;
(* Splitting a list of pairs into a pair of lists *)
let rec split (l:(int*int) list):(int list * int list)=
match l with
[] -> ([],[])
| (a,b)::l -> let (l1,l2) = split l in (a::l1,b::l2);;
(* Is a list in increasing order *)
let rec is_increasing (l:int list):bool=
match l with
[] | [_] -> true
| a::b::l -> a<=b && is_increasing (b::l);;
is_increasing l54321;;
is_increasing l12;;
let rec belongstosortedlist (e:int) (l:int list):bool=
match l with
| [] -> false
| x::lp -> e=x || (e > x) && belongstosortedlist e lp ;;
let rec insert (e:int) (l:int list):int list=
match l with
| [] -> [e]
| x::lp -> if e<x then e::l else x::(insert e lp);;
let rec insertion_sort (l:int list):int list=
match l with
[] -> []
| e::lp -> insert e (insertion_sort lp);;
let rec suppress (e:int) (l:int list):(int list)=
match l with
[] -> []
| x::lp -> if e=x then lp else x::(suppress e lp) ;;
(* only one occurrence suppressed! *)
let rec min_list (l:int list):int=
match l with
[] -> failwith "min_list: error empty list"
| [e] -> e
| x::lp -> min x (min_list lp) ;;
let rec selection_sort (l:int list):int list =
match l with
[] -> []
| _ -> let m = min_list l in let lp = suppress m l in m::(selection_sort lp);;
let l1 = [1;2] and l2 = [4;6;1;3;5;2;7];;
let rec sublist (l1:int list) (l2:int list):bool=
match l1,l2 with
| [],_ -> true
| _,[] -> false
| e1::l1p,e2::l2p -> (e1 = e2 && sublist l1p l2p) || (sublist l1 l2p);;
#trace sublist;;
sublist l1 l2;;