Table of Contents
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
