Correction de Jill-Jênn

• Sujet

• Retour à la page des TP

(* https://jill-jenn.net/tp/1-recursivite-listes.pdf *)
(* TL;DR Q6 pour faire flatten, on pouvait utiliser fold_left *)
(*       Q9 pour faire nb_occ, on pouvait utiliser filter et list_length *)

(* Question 1. *)

let rec fibo0 n = match n with
	| 0 -> 0
	| 1 -> 1
	| n -> fibo0 (n - 1) + fibo0 (n - 2)
;;

(* La complexité de la fonction est exponentielle. *)

let fibo n = aux 0 1 n where
	rec aux a b c = if c == 0 then a else aux b (b + a) (c - 1)
;;

(* Question 2. *)

let rev1 l = aux l [] where
	rec aux l1 l2 = match l1 with
		| [] -> l2
		| h::t -> aux t (h::l2)
;;

(* Question 3. *)

let map1 f l = aux [] l where
	rec aux r l = match l with
		| [] -> rev r
		| h::t -> aux (f h::r) t
;;

(* Question 4. *)

let filter p l = aux [] l where
	rec aux r l = match l with
		| [] -> r
		| h::t -> if p h then aux (h::r) t else aux r t
;;

(* Question 5. *)

let fold_left f a l = aux a l where
	rec aux r l = match l with
		| [] -> r
		| h::t -> aux (f r h) t
;;

(* Question 6. *)

let rec flatten l = match l with
	| [] -> []
	| h::t -> fold_left (fun x y -> y::x) (flatten t) (rev h)
;;

(* Question 7. *)

let fibogen f0 f1 op n = aux f0 f1 n where
	rec aux a b c = if c == 0 then a else aux b (op b a) (c - 1)
;;

let fibo = fibogen 0 1 prefix +;;

(* Question 8. *)

let fiboword = fibogen "b" "a" prefix ^;;
let fibolist = fibogen [1] [0] prefix @;;

(* Question 9. *)

let nb_occ x0 l = list_length (filter (function x -> x == x0) l);;

(* Question 10. *)

let tronque n l = aux n (rev l) where
	rec aux n l = match n with
		| 0 -> rev l
		| n -> try aux (n - 1) (tl l) with Failure _ -> []
;;

(* Question 11. *)

let rec ajoute l1 l2 = match l1 with
	| [] -> l2
	| h::t -> ajoute t (h::l2)
;;

let remplace x lx l = aux [] l where
	rec aux r l = match l with
		| [] -> rev r
		| h::t -> if h == x then aux (ajoute lx r) t else aux (h::r) t
;;

remplace 2 [0] (remplace 0 [0;1] (remplace 1 [2] [0;1;0]));;

(* Bonus gratuit *)

let remplace_multi subst l = aux [] l where
	rec aux r l = match l with
		| [] -> rev r
		| h::t -> try let remp = assoc h subst in aux (ajoute remp r) t with Not_found -> aux (h::r) t
;;

remplace_multi [0,[0;1];1,[0]] [0;1;0];;

(* Question 12. *)

(* Version récursive non terminale *)

let rec exp1 a n = match n with
	| 0 -> 1
	| n when n mod 2 == 0 -> let u = exp1 a (n / 2) in u * u (* S *)
	| n -> let u = exp1 a (n / 2) in u * u * a (* SM *)
;;

(* Version récursive terminale *)

let exp2 a n = aux 1 a n where
	rec aux p a n = match n with
		| 0 -> p
		| n when n mod 2 == 0 -> aux p (a * a) (n / 2)
		| n -> aux (p * a) (a * a) (n / 2)
;;

(* Question 13. *)

type op = S | M;;

let sm_of_exp n = aux [] n where
	rec aux l n = match n with
		| 0 -> l
		| n when n mod 2 == 0 -> aux (S::l) (n / 2)
		| n -> aux (S::(M::l)) (n / 2)
;;

(* Question 14. *)

let decode l = aux 0 l where
	rec aux n l = match l with
		| [] -> n
		| _::(false::t) -> aux (n * 2 + 1) t
		| _::t -> aux (n * 2) t
;;