1 Initiation au langage Ocaml.

2 Premiers pas en Ocaml.

unit	()	pas d'opération!
bool	true   false	&&   ||   not
char	'a'   '\n'   '\097'	code   chr
int	1   2   3	+   -   *   /   max_int
float	1.0   2.   3.14	+.   -.   *.   /.   cos
string	"a\tb\010c\n"	^   s.[i]   s.[i]
Polymorphes
tableaux	- c[| 0; 1; 2; 3 |]	t.(i)   t.(i)
tuples	(1, 2)   (1, 2, 3, 4)	fst   snd

Exercice 1  [Commade echo]   Corriger le programme ci-dessus pour que comme la commande Unix, pour reconnaître comme premier argument l'option "-n" qui qui a pour effet de ne pas imprime de fin de ligne.

Exercice 2  [Commandes true et false]   Écrire les commandes Unix true et false qui ne font rien la première retourne le code 0, la seconde le code 1.

exit 0;;

exit 1;;

ocaml -c true true.ml ocaml -c false false.ml

p₁ -> e₁ | ... | p_n -> e_n

Exercice 3  [Listes à double entrée]   Définir le type double des listes à ``double entrée'', ie. ayant un constructeur supplémentaire permettant d'ajouter un élément en fin de liste.

type 'a double =     Gauche of 'a * 'a double | Droite of 'a double * 'a | Vide;; let d = Droite (Gauche (1, Droite (Gauche (2, Vide), 3)), 4);;

Écrire une fonction list_of_double qui transforme une liste double en une liste simple (de la librairie).

let rec dédouble l = function   | Vide -> l   | Gauche (h,t) -> h::dédouble l t   | Droite (t, h) -> dédouble (h::l) t;;          let list_of_double l = dédouble [] l;; list_of_double d;;

Exercice 4  [Jeu de cartes]   Deux cartes sont incompatibles si aucune n'est le Joker et si elles sont différentes. Elles sont compatibles sinon. Un ensemble de cartes dont toutes les paires de cartes sont compatibles est compatible. Les ensemble de cartes sont representé par des listes, mais considérés à permutation près.

Écrire une fonction compatibles qui prend un ensemble de cartes et retourne l'ensemble de toutes les sous-parties compatibles les plus larges possibles. La seule difficulté provient de la carte Joker, qui peut remplacer n'importe quelle autre carte. Un joker est compatibles avec deux cartes qui ne sont pas compatibles entre elles. La relation de compatibilité n'est donc pas une relation d'équivalence.

On définit la relation asymétrique binaire meilleure: la carte Joker est meilleure que la carte Roi, mais pas l'inverse.

let meilleure x y =    match x, y with     Carte u, Carte v -> u.figure = v.figure   | _, Joker -> true   | Joker, Carte _ -> false  let pas_meilleure x y = not (meilleure y x);;

La fonction compatibles est définie pas induction. Si la main est vide, l'ensemble des parties compatibles est vide. Si le premier élément de la main est un joker, alors les parties compatibles sont celles du reste de la main dans chacune desquelles il faut ajouter un jojer. Sinon, le premier élément est une carte ordinaire: les parties compatibles sont d'une part l'ensemble des cartes compatibles avec celle-ci, et l'ensemble des parties compatibles avec les cartes qui ne sont pas compatibles avec celle-ci.

let rec compatibles = function   | Joker :: t ->       List.map (fun p -> Joker::p) (compatibles t)   | h :: t ->       let found = h :: List.find_all (meilleure h) t in       let rest = compatibles (List.find_all (pas_meilleure h) t) in       found :: rest   | [] -> [];;

Voici un exemple de recherche:

compatibles  [ roi Trèfle; Joker; roi Carreau; Joker; roi Coeur;    roi Pic; carte Reine Trèfle; carte Reine Pic; valet_de_pic ];; - : carte list list = [[Carte {couleur=Trèfle; figure=Roi}; Joker;   Carte {couleur=Carreau; figure=Roi}; Joker;   Carte {couleur=Coeur; figure=Roi}; Carte {couleur=Pic; figure=Roi}];  [Joker; Joker; Carte {couleur=Trèfle; figure=Reine};   Carte {couleur=Pic; figure=Reine}];  [Joker; Joker; Carte {couleur=Pic; figure=Valet}]]

En déduire une fonction testant si une main contient un carré.

let carré main =   List.exists (fun x -> List.length x >= 4) (compatibles main);;

Exercice 5  [La fonction Sigma]  

1. Écrire une fonction sigma : ('a -> int) -> 'a list -> int telle que l'expression sigma f l calcule la formule å_{x Î l} f(x).
   Réponse

   let rec sigma f = function   | [] -> 0     | x :: rest -> f x + sigma f rest;;

2. Écrire la fonction pi : 'a list -> ('a -> int) -> int analogue mais en remplaçant la somme par le produit.
   Réponse

   let rec pi f = function   | [] -> 1   | x :: rest -> f x * pi f rest;;

3. Comment généraliser la fonction en une fonction

   fold : (int -> int -> int) ->         int -> 'a list -> ('a -> int) ->  int

   pour ne pas dupliquer le code? Donner deux versions de fold, d'abord une seule fonction globale récursives, puis utiliser une fonction locale récursive auxilliaire en lui passant le minimum d'argument(s).
   Réponse

   let rec fold (oper : int -> int -> int) (x0 : int) f = function    | [] -> x0   | x :: rest -> oper (f x) (fold oper x0 f rest);; let fold (oper : int -> int -> int) (x0 : int) f =    let rec aux = function     | [] -> x0     | x :: rest -> oper (f x) (aux rest) in   aux;; let sigma f l = fold ( + ) 0 f l;; let pi f l = fold ( * ) 1 f l;;

   
   
   
4. Réécrire la fonction sigma en utilisant une fonction de librairie.
   Réponse

   let sigma f l = List.fold_right (fun x r -> (f x) + r) l 0;;

Exercice 6  [Exceptions]   Ecrire un programme analogue sans utiliser d'exception.

type 'a valeur = Trouve of 'a | Perdu let rec cherche_la_clé f = function     (h, k) :: t -> if f h then Trouve k else cherche f t   | [] -> Perdu let k =   match cherche_la_clé "Georges" [ "Louis", 14; "Georges", 5;] with   | Trouve x -> x   | Perdu -> 10

Exception	Usage	gravité
Invalid_argument of string	accès en dehors des bornes	forte
Failure of string	liste vide, retourne le nom de la fonction	moyenne
Not_found of unit	fonctions de recherche	nulle
Match_failure of ...	Échec de filtrage	fatale
End_of_file	Fin de fichier	nulle

Exercice 7  [La commande cat]   Écrire la version complète, qui concatène l'ensemble des fichiers dont les noms sont passés en argument ou bien reproduit le flux d'entrée lorsque la commande est appelée sans argument.

let echo chan =    try while true do print_string (input_line chan); print_newline() done   with End_of_file -> ();; if Array.length Sys.argv <= 1 then echo stdin else   for i = 1 to Array.length Sys.argv - 1    do     let chan = open_in Sys.argv.(i) in     echo chan;     close_in chan   done;;

Exercice 8  [La calculette]  

- Écrire une fonction sigma qui prend une fonction f, un tableau et un indice et qui calcule å_{i = j}^k f (t.(i))

- En déduire le calcul de la somme des éléments, des carrés ou la moyenne des éléments d'un sous-tableau.

- Faire un exécutable à partir de l'exercise précédent. Les arguments sont reçus sur la ligne de commande.

- Par défaut le programme calcule la somme. Si le premier argument est la chaîne -carre ou -moyenne, alors il calcule la somme ou la moyenne des éléments restants.

let sigma f t j k =   let y = ref 0 in   for i = j to k do y := !y + f t.(i) done;   !y;; let k = Array.length Sys.argv - 1;; match Sys.argv.(1) with | "-carre" ->     let f x = let n = int_of_string x in n * n in     print_int (sigma f Sys.argv 2 k) | "-moyenne" ->     let r = sigma int_of_string Sys.argv 2 k in     print_float (float r /. float (Array.length Sys.argv - 2)) | _ ->     print_int (sigma int_of_string Sys.argv 1 k) ;; print_newline();;

% ocamlc -o calculette calculette.ml % calculette -carre 1 2 3 4 5 6  91

Exercice 9  [La commande Unix wc]   compte l'ensemble des caractères, mots et lignes de chacun des fichiers passés en arguments ainsi que les totaux respectifs et les imprimes dans la sortie standard.

type counts = {  mutable chars : int;  mutable lines : int;  mutable words : int; };; let wc_count = {chars = 0; lines = 0; words = 0};; let wc_count_total = {chars = 0; lines = 0; words = 0};; let reset_count () =  wc_count.chars <- 0;  wc_count.lines <- 0;  wc_count.words <- 0;; let cumulate () =  wc_count_total.chars <- wc_count_total.chars + wc_count.chars;  wc_count_total.lines <- wc_count_total.lines + wc_count.lines;  wc_count_total.words <- wc_count_total.words + wc_count.words;; let rec counter ic iw =  let c = input_char ic in  wc_count.chars <- wc_count.chars + 1;  match c with  | ' ' | '\t' ->     if iw then wc_count.words <- wc_count.words + 1 else ();     counter ic false  | '\n' ->     wc_count.lines <- wc_count.lines + 1;     if iw then wc_count.words <- wc_count.words + 1 else ();     counter ic false  | c ->     counter ic true;; let count_channel ic =  reset_count ();  try counter ic false with  | End_of_file -> cumulate (); close_in ic;; let output_results s wc =   Printf.printf "%7d%8d%9d %s\n" wc.lines  wc.words wc.chars  s ;; let count_file file_name =  try   let ic = open_in file_name in   count_channel ic;   output_results file_name wc_count;  with Sys_error s -> print_string s; print_newline(); exit 2 ;; let main () =   let nb_files = Array.length Sys.argv - 1 in   if nb_files > 0 then     begin        for i = 1 to nb_files do         count_file Sys.argv.(i)       done;       if nb_files > 1 then output_results "total" wc_count_total;     end   else     begin       count_channel stdin;       output_results "" wc_count;     end;   exit 0;; main();;

Exercice 10  [Gelé les calculs]   On considère le programme:

let ifzéro n sioui sinon = if n = 0 then sioui else sinon;; ifzéro 3 (print_string "oui") (print_string "non");;

Expliquer l'anomalie.

Corriger cette anomalie en redéfinissant la fonction ifzéro avec le type int -> (unit -> 'a) -> (unit -> 'a) -> 'a. On donnera le programme corrigé complet. La fonction ifzéro évalue ses deux arguments (de plus l'ordre d'évaluation n'est pas déterminé).

Il faudrait que ses arguments soient systématiquement gelés, donc passés comme des fonctions de type unit -> 'a.

let ifzéro n yes no = if n = 0 then yes() else no();; ifzéro 3 (fun() -> print_string "oui") (fun() -> print_string "non");;

Exercice 11  [Calculs paresseux]   Un stream est une liste potentiellement infinie. Elle doit bien sûr être représentée de façon finie, les calculs des s'effectuant paresseusement au fur et à mesure des besoin. On peut le représenter par le type concret suivant:

type 'a stream = 'a status ref and 'a status =      Nil   | Cons of 'a * 'a stream   | Exception of exn   | Frozen of (unit -> ('a * 'a stream));;

Un stream dont le statut est une excepetion est un stream dont l'évaluatinon à lancé (et donc doit relancer cette exception).

Définir les fonction hd, tl et nth sur les streams qui retourne le premier élément, le reste du stream, et le nième élément.

let hd x =   match !x with   | Nil -> failwith "hd"   | Cons (h,t) -> h   | Exception x -> raise x   | Frozen f ->       try let h,t = f() in x := Cons (h, t); h       with exn -> x := Exception exn; raise exn;; let tl x =   match !x with   | Nil -> failwith "tl"   | Cons (h,t) -> t   | Exception x -> raise x   | Frozen f ->       try let h,t = f() in x := Cons (h, t); t       with exn -> x := Exception exn; raise exn;; let rec nth l n =   if n < 0 then failwith "nth"   else if n = 0 then hd l   else nth (tl l) (pred n);;

Donnez également des fonctions de construction nil, cons : 'a -> 'a stream -> 'a stream et une fonction freeze : (unit -> ('a * 'a stream)) -> 'a stream, qui retourne le stream vide, ajoute un élément explicite en tête d'un stream et construit un stream à partir d'une fonction génératrice.

let nil = ref Nil let cons x t : 'a stream = ref (Cons (x, t)) let freeze f : 'a stream = ref (Frozen f);;

Construire le stream des entiers pairs.

let entiers_pair = let rec s n = freeze (fun () -> n, s (n + 2)) in s 0;; nth entiers_pair 3;;

Définir une fonction filter : ('a -> bool) -> 'a stream -> 'a stream qui prend un prédicat un stream et retourne le stream des éléments qui satisfont les prédicat. En déduire le stream des entiers pairs à partir du stream des entiers.

let rec filter f s =   let rec first s =     let h, t = hd s, tl s in     if f h then h, filter f t else first t in   freeze (fun () -> first s);; let entiers = let rec s n = freeze (fun () -> n, s (n + 1)) in s 0;; let entiers_pairs = filter (fun x -> x mod 2 = 0) entiers;; nth entiers 3;; nth entiers_pairs 3;;

spécification de valeurs	val x : s
spécification de types abstraits	type t
spécification de types manifestes	type t = t
spécification d'exceptions	exception E