ex-lists-sol

# Differences

This shows you the differences between two versions of the page.

 — ex-lists-sol [2015/10/08 15:20] (current) Line 1: Line 1: + ====== 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 = + ​ + + 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 = + ​ + + 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 = + ​ + + 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 = + + # 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 [[ex-rec|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 = + + # primes 20;; + - : int list = [2; 3; 5; 7; 11; 13; 17; 19] + ​ + + Alternative solution, using the [[wp>​Sieve_of_Eratosthenes|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 = + + # let primes n = sieve 2 (range 2 n);; + val primes : int -> int list = + + # 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 = + + # let rec trunclast = function + [] -> failwith "trunc on empty list" + | [x] -> [] + | x::xl -> x::​(trunclast xl);; + + val trunclast : 'a list -> 'a list = + + # (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 = + ​ + + + # 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 = + ​ + + + # let pal_int n = pal_list (list_of_string (string_of_int n));; + + val pal_int : int -> bool = + ​ + + + # let rec nextpal n = if pal_int n then n else nextpal (n+1);; + + val nextpal : int -> int = + ​ + + + # let rec palseq x = function + 0 -> [] + | n -> let p = nextpal x in p :: (palseq (p+1) (n-1));; + val palse : int -> int -> int list = + + # 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 ([],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 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 [];; + ​ + + \\