20131014:TP:OCaml:imperative

Introduction

L'objectif de ce TP est de faire un peu plus le tour des possibilités impératives d'OCaml. Le TP est volontairement long: vous allez y voir pleins d'aspects différents à la difficulté relative où le code n'est pas forcément long ou compliqué mais l'idée n'ests pas forcément évidente du premier coup.

Variables Statiques

On l'a vu en cours, on peut jouer la cloture d'une fonction pour créer une forme de variable locale statique (variable visible uniquement à l'intérieur d'une fonction mais dont la valeur persiste d'appel en appel.) La fonction vu en cours était la suivante:

let next =
  let r = ref 0 in
    fun () ->
      incr r;
      !r

• Reprendre le principe de la fonction next pour écrire la fonction suivante:

(* next_fact () renvoie à chaque appel la prochaine valeur de factoriel *)
(* en commencant par 1!                                                 *)
val next_fact: unit -> int

On veut maintenant généraliser le principe de la question précédante. On peut définir les valeurs d'une suite à l'aide d'une fonction qui prend le rang désiré et le terme précédant ce qui donne quelque chose de la forme (avec $f(n,u)$ la fonction en question):

$u_n = f(n, u_{n-1})$

• En utilisant les principes vus précédement, écrire la fonction suivante:

(* build_next_seq u0 f  construit une fonction "next" comme les *)
(* précédantes à partir de son terme initial u0 et de sa        *)
(* génératrice f                                                *)
val build_next_seq: int -> (int -> int -> int) -> unit -> int

Voici un example d'utilisation:

let gen_fact n u_n_1 = n * u_n_1
let next_fact = build_next_seq 1 gen_fact

Maintenant nous désirons construire plusieurs fonction partageant la même variable statique. Il est tout à fait possible et simple de construire simultanément (dans le même contexte) plusieurs fonctions, voici un exemple jouet:

let (f,g,h) = (
  (fun x -> x + 1),
  (fun x -> x - 1),
  (fun x y -> x + y)
)

• Appliquer ce principe pour construire un triplet de fonctions avec une fonction next (qui fait la même chose que celle vu en cours), une fonction reset (qui remet le compteur à 0) et une fonction get (qui renvoie la valeur actuelle du compteur sans l'incrémenter.)

val next: unit -> int
val reset : unit -> unit
val get : unit -> int

Vecteurs

Pour la suite nous travaillerons dans un fichier vector.ml.

Nous allons maintenant construire des listes statiques ou vecteurs. Globalement il s'agit simplement d'associer un tableau avec un indicateur de taille. Voici donc le type dont nous avons besoin:

type 'a t = {
  mutable size : int;
  tab  : 'a array;
}

On ajoute deux exceptions utiles pour nos opérations:

(* vector is full *)
exception Vector_full
(* index provided is out of range                  *)
(* exception parameters are: index and vector size *)
exception Vector_out_of_range of int * int

• Vous devez implémenter les fonctions suivantes:

(* make max: build a new vector of maximal size max *)
val make : int -> 'a -> 'a t
 
(* add x v : add x at the end of vector v   *)
(* if v is full raise exception Vector_full *)
val add : 'a -> 'a t -> unit
 
 
(* get i v: return stored value at position i *)
(* raise Vector_out_of_range (i, v.size) if i *)
(* is out-of-range                            *)
val get : int -> 'a t -> 'a
 
(* insert_at i x v : insert x at position i in v *)
(* no element are replaced, they are shifted to  *)
(* right                                         *)
val insert_at : int -> 'a -> 'a t -> unit
 
 
(* iteri f v : apply f i v.tab.(i) for all i in *)
(* the array.                                   *)
val iteri : (int -> 'a -> 'b) -> 'a t -> unit
 
(* iter f v : apply f v.tab.(i) for all i in    *)
(* the array                                    *)
val iter : ('a -> 'b) -> 'a t -> unit
 
(* mapi f v : apply f i v.tab.(i) for all i in  *)
(* the array and return a new vector containing *)
(* the result.                                  *)
val mapi : (int -> 'a -> 'b) -> 'a t -> 'b t
 
(* map f v : apply f v.tab.(i) for all i in     *)
(* the array and return a new vector containing *)
(* the result.                                  *)
val map : ('a -> 'b) -> 'a t -> 'b t
 
(* fold f a v : return f (...(f a v.tab.(0))...) *)
val fold : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a

Listes modifiables

On va maintenant implémenter des listes chainées modifiables à l'aide de records.

Voici le type complet:

(* inner node of the list *)
type 'a _t = {
  mutable content : 'a;
  mutable next : 'a _t option;
}
 
(* outside structure containing size and entry point *)
type 'a t = {
  mutable size : int;
  mutable inner : 'a _t option;
}

• Voici la liste des fonctions à réalisée, elles ont le même rôle que pour les fonctions de même nom sur les listes classiques.

val create : unit -> 'a t
val add : 'a -> 'a t -> unit
val length : 'a t -> int
val map : ('a -> 'b) -> 'a t -> 'b t
val iter : ('a -> 'b) -> 'a t -> unit
val fold_left : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a
val fold_right : ('a -> 'b -> 'b) -> 'a t -> 'b -> 'b

• Écrire la fonction suivante:

(* access filter v returns the first node of v for which *)
(* filter returns true                                   *)
val access: ('a _t -> bool) -> 'a t -> 'a _t

La fonction access fourni un accès au nœud interne de la liste et permet ainsi d'implémenter de nombreuse fonction d'accès ou de modification.

Voici un exemple d'utilisation pour implémenter la fonction nth:

let nth i l =
  if i < 0 || i >= l.size then
    invalid_arg "Bad index"
  else
    let r = ref (i+1) in
    (access (fun _ -> decr r; !r = 0 ) l).content

• Vous pouvez maintenant implémenter les fonctions suivantes:

(* replace_at n x l : replace by x the value in n-th cell *)
(* of the list l                                          *)
val replace_at : int -> 'a -> 'a t -> unit
 
(* replace_if filter x l replace by x the first node in l *)
(* for which filter returns true                          *)
val replace_if : ('a -> bool) -> 'a -> 'a t -> bool

Si vous voulez tester vos listes, voici un programme de test qui couvre une bonne partie des fonctions précédantes:

(***************************************************************************)
(*                              Tests                                      *)
(***************************************************************************)
 
(* A Static value if your create/add function is not working *)
let static_list = {
  size = 3;
  inner = Some {
    content = 0;
    next = Some {
      content = 1;
      next = Some {
        content = 2;
        next = None;
      };
    };
  };
}
 
let display l =
  begin
    Format.printf "@[<b 2>[@;";
    iter (Format.printf "%d;@;") l;
    Format.printf "]@]@,";
  end
 
let dyn_list n =
  let l = create () in
  for i = 0 to n-1 do
    add i l;
  done; l
 
let main _ =
  begin
    (* Need working create and add *)
    let l = dyn_list 10 in
    Format.printf "@[<v>";
 
    Format.printf "testing add and iter:@;";
    display l;
 
    Format.printf "@,testing map:@;";
    display (map (fun x -> x*x) l);
 
    Format.printf "@,testing fold_left: %d@," (fold_left (+) 0 l);
 
    Format.printf "@,testing fold_right: %d@," (fold_right (+) l 0);
 
    Format.printf "@,testing fold_right (more):@,@[<b>[";
    List.iter (Format.printf "@;%d;") (fold_right (fun h t -> h::t) l []);
    Format.printf "@;]@]@,";
 
    Format.printf "@,@[<v 2>testing nth:";
    for i = 0 to (length l) - 1 do
      Format.printf "@,@[<h>nth %d l = %d@]" i (nth i l);
    done;
    Format.printf "@]@,";
 
    Format.printf "@,testing replace_at:@,";
    for i = 0 to (length l) - 1 do
      replace_at i i l;
      assert (nth i l = i);
    done;
    display l;
 
    Format.printf "@,@[<b 2>testing replace_if:";
    for i = 0 to (length l) - 1 do
      if replace_if (fun x -> x = i) (i*10) l then
        Format.printf "@;OK"
      else
        Format.printf "@;KO"
    done;
    Format.printf "@]@,";
    display l;
 
    Format.printf "@]@.";
    exit 0
  end
let _ = main ()