User Tools

Site Tools


ex-lists-sol

LiP assignment #4: solutions

1. Fibonacci sequence

The function reverse reverts the elements of a list.

# let rec reverse = function
	[] -> []
  |	x::xl -> (reverse xl) @ [x];;
 
val reverse : 'a list -> 'a list = <fun>

The function uncurry uncurries the function passed as input.

# let uncurry f = fun (x,y) -> f x y;;
 
val uncurry : ('a -> 'b -> 'c) -> 'a * 'b -> 'c = <fun>

The function lastpair evaluates to the pair of the last two elements of a list (if the list if long enough).

# let rec lastpair l = match reverse l with
    [] | [_] -> failwith "list too short"
  | x::(y::l') -> (y,x);;
 
val lastpair : 'a list -> 'a * 'a = <fun>

The function fib constructs the list of the first n Fibonacci numbers.

# let rec fib = function 
  	0 -> []
  |	1 -> [0]
  |	2 -> [0;1]
  |	n -> let l = fib (n-1) in l @ [uncurry (+) (lastpair l)]
;;
val fib : int -> int list = <fun>
 
# fib 10;;
- : int list = [0; 1; 1; 2; 3; 5; 8; 13; 21; 34]


2. Prime numbers sequence

Naïve solution, using the primality test implemented here:

# let primes n = 
    map (fun (x,y) -> x) 
	  (filter (fun (x,y) -> y) 
	     (map (fun x -> (x,prime x)) 
	  	  (range 1 n)));;
 
val primes : int -> int list = <fun>
 
# primes 20;;
- : int list = [2; 3; 5; 7; 11; 13; 17; 19]

Alternative solution, using the Sieve of Eratosthenes:

# let rec sieve n = function
	[] -> []
  |	x::xl -> x::(sieve (n+1) (filter (fun y -> y mod n != 0) xl));;
 
val sieve : int -> int list -> int list = <fun>
 
# let primes n = sieve 2 (range 2 n);;
val primes : int -> int list = <fun>
 
# primes 100;;
- : int list = [2; 3; 5; 7; 11; 13; 17; 19; 23; 29; 31; 
37; 41; 43; 47; 53; 59; 61; 67; 71; 73; 79; 83; 89; 97]


3. Palindromes

Evaluating pal_list l yields true if the list l is palindrome, false otherwise.

# let rec last = function
	[] -> failwith "last on empty list"
  |	[x] -> x
  |	x::xl -> last xl;;
 
val last : 'a list -> 'a = <fun>
 
# let rec trunclast = function
	[] -> failwith "trunc on empty list"
  |	[x] -> []
  |	x::xl -> x::(trunclast xl);;
 
val trunclast : 'a list -> 'a list = <fun>
 
# (fun x -> (last x,trunclast x)) [1;2;3;4;5];;
- : int * int list = (5, [1; 2; 3; 4])
# let rec pal_list = function
	[] -> true
  |	[_] -> true
  |	x::xl -> let (z,l') = (last xl,trunclast xl) in x=z && pal_list l';;
 
val pal_list : 'a list -> bool = <fun>
# let rec list_of_string s = 
    if s="" then [] 
    else let s' = (String.sub s 1 ((String.length s)-1)) 
         in  (String.get s 0)::(list_of_string s');;
 
val list_of_string : string -> char list = <fun>
# let pal_int n = pal_list (list_of_string (string_of_int n));;
 
val pal_int : int -> bool = <fun>
# let rec nextpal n = if pal_int n then n else nextpal (n+1);;
 
val nextpal : int -> int = <fun>
# let rec palseq x = function
	0 -> []
  |	n -> let p = nextpal x in p :: (palseq (p+1) (n-1));;
val palse : int -> int -> int list = <fun>
 
# palseq 150 10;;
- : int list = [151; 161; 171; 181; 191; 202; 212; 222; 232; 242]


4. Merge sort

The expression length l computes the length of the list l

# let rec length = function
    [] -> 0
  | x::xl -> 1 + length xl;;
 
val length : 'a list -> int

The expression split n l splits the list l in two sub-lists. For instance, split 3 [2;3;5;7;9] evaluates to ([2;3;5],[7;9])

# let rec split n l = if n=0 then ([],l) else match l with
    [] -> ([],[])
  | x::xl -> let (l1,l2) = split (n-1) xl in (x::l1,l2);;
 
val split : int -> 'a list -> 'a list * 'a list

The expression merge (l1,l2) cmp takes two lists l1 and l2 ordered according to the comparison function cmp, and merges them. The comparison function cmp must return 0 if its arguments compare as equal, a positive integer if the first is greater, and a negative integer if the first is smaller. For instance, merge ([1;5;7],[2;4;6;7;9]) compare evaluates to [1; 2; 4; 5; 6; 7; 7; 9].

# let rec merge (l1,l2) cmp = match (l1,l2) with
    ([],l2) -> l2
  | (l1,[]) -> l1
  | (x::x1,y::y2) -> 
      if (cmp x y < 0) 
      then x::(merge(x1,l2) cmp) 
      else y::(merge(l1,y2) cmp);;
 
val merge : 'a list * 'a list -> ('a -> 'a -> int) -> 'a list

The expression sort l cmp sorts the elements of the list l according to the comparison function cmp.

# let rec sort l cmp = match l with
    [] -> []
  | [x] -> [x]
  | _ -> let (l1,l2) = (split ((length l) / 2) l) 
         in merge (sort l1 cmp,sort l2 cmp) cmp;;
 
val sort : 'a list -> ('a -> 'a -> int) -> 'a list


5. Permutations

The function shuffle x l inserts the element x at each position inside the list l.

# let rec shuffle y l = match l with
    [] -> [[y]]
  | x::xl -> (y::x::xl) :: (map (fun l -> x::l) (shuffle y xl));;
 
val shuffle : 'a -> 'a list -> 'a list list
 
# shuffle 1 [2;3];;
- : int list list = [[1; 2; 3]; [2; 1; 3]; [2; 3; 1]]

The function flatten l transforms a list of lists of elements of type T into a list of elements of type T.

# let rec flatten ll = match ll with
    [] -> []
  | x::xll -> x @ (flatten xll);;
 
val flatten : 'a list list -> 'a list
 
# flatten [ [1;2]; [3;4;5] ];;
- : int list = [1; 2; 3; 4; 5]

The function perm l evaluates to the list of all the permutations of the elements of the list l.

# let rec perm l = match l with
    [] -> [[]]
  | x::xl -> flatten (map (shuffle x) (perm xl));;
 
val perm : 'a list -> 'a list list
 
# perm [1;2;3];;
- : int list list = [[1; 2; 3]; [2; 1; 3]; [2; 3; 1]; [1; 3; 2]; [3; 1; 2]; [3; 2; 1]]


6. Letter frequency

Some utility functions.

# let is_char a = (a>='a' && a<='z') || (a>='A' && a<='Z');;
 
# let rec list_of_string s = 
    if s="" then [] 
    else let s' = (String.sub s 1 ((String.length s)-1)) 
         in  (String.get s 0)::(list_of_string s');;

The expression count a l increments the counter associated to a in the list l.

#let rec count a = function
      [] -> [(a,1)]
    | (x,n)::l' -> if x=a then (a,n+1)::l' else (x,n)::(count a l');;
 
val count : 'a -> ('a * int) list -> ('a * int) list

The expression count_line s l increments the counters associated to each character occurring in the string s.

# let count_line s l = 
    let l' = List.filter is_char (list_of_string (String.lowercase s)) in
    List.fold_right count l' l;;
 
val count_line : string -> (char * int) list -> (char * int) list

The expression count_to_freq l transforms each pair (x,d) in l, by replacing the number of occurrences of letter x with the frequency of x.

# let count_to_freq l = 
    let total_char = List.fold_right (fun (a,n) k -> n + k) l 0
    in let k = float_of_int total_char in
      List.map (fun (a,n) -> (a,(float_of_int n /. k))) l;;
 
val count_to_freq : ('a * int) list -> ('a * float) list

The expression freq f outputs the list of letter frequency for the text contained in file f.

# let freq f = 
    let rec freq' ch l = (
      try freq' ch (count_line (input_line ch) l)
      with End_of_file -> close_in ch; l)
    in count_to_freq (sort (freq' (open_in f) []) (fun (a,n) (b,m) -> compare m n));;
 
val freq : string -> (char * float) list


7. Random permutation

Random.self_init ();;
 
let rec remove_nth n = function
    [] -> failwith "empty list"
  | x::l -> if n=0 then (x,l) else let (y,l') = remove_nth (n-1) l in (y,x::l');;
 
remove_nth 2 [1;2;3;4;5];;
 
let rec range a b = 
  if b<a then []
  else a::(range (a+1) b);;
 
let reduce (l,r) = match l with 
  [] -> ([],r)
| _ -> let (x,l') = remove_nth (Random.int (List.length l)) l in (l',x::r);;
 
let rec loop p f x = if p x then x else loop p f (f x);;
 
let genperm n = snd (loop (fun (l,r) -> l=[]) reduce ((range 1 n),[]));;
 
genperm 26;;


9. LFSR keystream

let xor x y = (x+y) mod 2;;
 
let next c l = 
  if List.length l <> List.length c then failwith "length mismatch"
  else let s = List.fold_left2 (fun r a b -> xor r (a*b)) 0 l c
  in match l with
    [] -> failwith "empty list"
  | x::l' -> l'@[s];;
 
let rec iter n f = fun x -> if n=0 then x else f (iter (n-1) f x);;
 
let nextblock c l = (iter (List.length l) (next c)) l;;
 
let rec take n = function 
    [] -> if n=0 then [] else failwith "list too short"
  | x::l -> if n=0 then [] else x::(take (n-1) l);;
 
let rec tail n l = List.rev (take n (List.rev l));;
 
let prec n m = if n<m then 0 else ((n-1)/m)*m;;
 
let rec keystream n k c = 
  if List.length k <> List.length c then failwith "length mismatch"
  else let m = List.length k in 
  if n<=m then take n k
  else let l = keystream (prec n m) k c in l@(take (n - (prec n m)) (nextblock c (tail m l)));;


11. Number of occurrences in a list

let fsearch x l = List.fold_right (fun (y,n) b -> if x=y then true else b) l false;;
 
let fadd x l = List.fold_right (fun (y,n) l' -> if x=y then (x,n+1)::l' else (y,n)::l') l [];;
 
let fcount l = List.fold_right (fun x l -> if fsearch x l then fadd x l else (x,1)::l)  l [];;


ex-lists-sol.txt · Last modified: 2015/10/08 15:20 (external edit)