init

BE/README.md

@@ -0,0 +1,221 @@
+# Proposition BE OCaml
+
+Objectif : implémenter un mécanisme de mémoire associative (adresse -> valeur)
+de différentes manières.
+
+## 1. Spécification des mémoires
+
+Une mémoire est spécifiée par l'interface de module `Memory` (dans `mem.ml`).
+Cet objet est associé à plusieurs fonctionnalités :
+ * Le type qui sert à stocker la mémoire
+ * Le nom de l'implémentation (c'est surtout pour le benchmark)
+ * `clear` : permet de créer une mémoire vide en précisant une _taille de bus
+   d'addressage_, autrement dit le nombre de bits sur lesquels une adresse peut
+   être exprimée.
+ * `bussize` : taille du bus d'adressage
+ * `size` : taille maximale de la mémoire (nombre de "cases")
+ * `allocsize` : quantité d'espace que la mémoire prend en RAM (permet de donner
+   une idée de l'efficacité de l'implémentation, c.f. benchmark)
+ * `busyness` : nombre de valeurs stockées dans la mémoire
+ * `read` : permet d'accéder au contenu d'une case mémoire
+ * `write` : permet d'écrire dans une case mémoire
+
+Les contrats détaillés de chacune de ces fonctionnalités sont données dans le
+code de `mem.ml`.
+
+À noter que les adresses sont exprimées en entier (type `int`), ce qui laisse la
+possibilité de définir des tailles de bus d'adressage assez intéressantes
+(jusqu'à 63 car les entiers sont signés). Les valeurs stockées dans la mémoire
+sont des `char`, pour simuler le stockage d'octets.
+
+On considère que la valeur par défaut dans la mémoire est 0 (`_0` dans le code,
+car sinon il faut écrire `'\x000'` partout car la mémoire stocke des caractères).
+
+Typiquement, pour déterminer l'occupation, on compte le nombre de "cases" qui ne
+contiennent pas 0.
+
+
+## 2. Mémoire à base de listes indexées
+
+Une implémentation des mémoires à base de listes est données dans le fichier
+`listmem.ml`.
+
+Une mémoire avec un bus d'adressage _n_ est représentée par une liste de _2^n_
+éléments.
+
+L'adressage se fait en parcourant la liste récursivement (on pourrait utiliser
+la fonction `List.nth` directement mais c'est un peu trop facile !).
+
+
+### Efficacité
+
+Cette implémentation est très simple à mettre en place mais assez peu efficace,
+et surtout a un très mauvais de "taux d'allocation pour le vide" : on a plein de
+cases vides qui ne servent à rien...
+
+Autre petit soucis : toutes les opérations sont en _O(size(mem))_ (pas
+catastrophique en soit mais quand même).
+
+
+## 3. Mémoire à base de listes associatives
+
+Une implémentation des mémoires à base de listes associatives est donnée dans le
+fichier `assocmem.ml`.
+
+Le principe est de stocker directement les couples clef-valeur dans une liste et
+d'utiliser (entres autres) `List.assoc_opt`.
+
+À noter que cette implémentation stocke les valeurs "en vrac", on pourrait sans
+doutes gagner pas mal en complexité amortie en se basant sur des clefs triées.
+
+
+### Efficacité
+
+Cette implémentation est très raisonnable en mémoire (une case par valeur), mais
+pour une mémoire très remplie et un espace d'adressage important, peut s'avérer
+assez inefficace (complexité en _O(2^n) = O(size(mem))_ dans le pire cas, comme
+avec la liste simple).
+
+
+## 4. Mémoire à base de _bit tree_
+
+Une implémentation des mémoires avec bit tree est donnée dans le fichier
+`treemem.ml`.
+
+Un _bit tree_ est un arbre binaire dont les feuilles contiennent des valeurs et les
+noeuds ne contiennent rien. Le chemin d'une racine vers une feuille correspond à
+une séquence de directions (gauche/droite) qui peut être convertie en nombre
+binaire (par ex : gauche = 0, droite = 1).
+
+L'idée est donc de se servir d'un bit tree pour représenter la mémoire : une
+adresse correspond à un chemin, au bout duquel se trouve la valeur
+correspondante.
+
+On considère, en particulier, que le chemin est donné en lisant l'adresse du bit
+de poids faible vers le bit de poids fort (de droite à gauche).
+
+Exemple :
+```
+      |
+      .
+    /   \
+  .       .
+ / \     / \
+0   .   0   .
+   / \     / \
+  5   0   3   1
+```
+
+Dans l'arbre ci-dessus, les valeurs suivantes son stockées :
+ * 5, à l'adresse 010 (gauche puis droite puis gauche)
+ * 3, à l'adresse 011 (droite puis droite puis gauche)
+ * 1, à l'adresse 111 (droite puis droite puis droite)
+
+Partout ailleurs, on a des 0. On remarque qu'il n'y a que trois 0 dans l'arbre,
+mais qu'ils en représentent en réalité 5 !
+
+
+### Efficacité
+
+Les opérations de lecture et d'accès sont généralement _O(n)_ où _n_ est la
+taille du bus d'adressage, et également lié à la profondeur de l'arbre.
+
+Comme la taille maximale de la mémoire est _s = 2^n_, on peut aussi considérer
+que la complexité est en _O(ln(s))_.
+
+L'arbre est assez efficace en mémoire grâce à ce phénomène de "clusterisation",
+mais cela dépend énormément des données qui y sont stockées. Notamment, en cas
+de mémoire saturée (aucune case vide), l'arbre doit normalement contenir _2^n_
+(ou _s_) feuilles, tout en aillant une profondeur de _n_, ce qui donne un poids
+en mémoire de _2^(n + 1) - 1_, soit pratiquement le double par rapport à
+l'utilisation de listes.
+
+Un des pires cas possible pour la mémoire advient lorsqu'on a des valeurs
+stockées à toutes les adresses paires (ou impaires) : on a alors un taux
+d'occupation de 50% mais une taille de l'arbre maximale !
+
+On en déduit que les bit trees sont plutôt adaptés à la mémoire "creuse", avec
+un faible taux d'occupation, et surtout des _clusters_ (des "grappes" de 0).
+
+
+# 5. Module `Util`
+
+Le module `Util` (`util.ml`) contient deux utilitaires simples pour aider
+l'écriture des implémentations :
+ * `pow2 n` : élève le nombre 2 à la puissance _n_ (indispensable pour calculer
+   `size`). On note que, sans cela, OCaml ne dispose que de l'opérateur `**` qui
+   ne marche que sur les float
+ * `_0` : le nombre 0 en type `char` (plus pratique que `'\x000'`)
+
+
+# 6. Module de tests
+
+Le module de tests (`test.ml`) comprend une batterie de tests de spécification,
+qui couvrent une bonne partie des erreurs qu'on peut faire en écrivant les
+divers modules.
+
+À noter qu'il faudrait ajouter des tests d'implémentation (notamment pour
+`allocsize`).
+
+
+# 7. Benchmark
+
+Un petit benchmark est proposé (`bench.ml`). On peut le compiler et l'exécuter
+avec :
+```
+> dune build bench.exe
+> _build/default/bench.exe
+```
+
+Il met un peu de temps à terminer, c'est normal !
+
+Le benchmark, pour chaque implémentation, va :
+ * créer une mémoire
+ * effectuer quelques milliers d'écritures
+ * effectuer quelques milliers de lecture
+ * chronométrer les écritures et les lectures
+ * calculer des taux d'occupation et d'allocation pour le vide
+ * refaire la même chose mais avec une mémoire "saturée" (sans case vide)
+
+
+# Remarques et idées en vrac
+
+ * L'implémentation à base de bit tree est peut être un peu dure, il faudrait
+   peut être la découper, ou alors guider son élaboration dans le sujet (surtout
+   `write`, qui est un peu subtile je trouve)
+ * J'ai décidé de stocker des `char` en mémoire, mais on pourrait très bien
+   stocker des `int` pour simplifier. C'est juste qu'en stockant des `char` on
+   fait bien la différence entre adresses et valeurs
+ * Inversement, on pourrait rendre le module `Memory` beaucoup plus
+   polymorphique, en abstrayant le type pour les adresse et/ou le type pour les
+   valeurs. Ça rajoute peut être de la complexité pour pas grand chose
+   (notamment, gestion d'une valeur par défaut) mais ça permet de voir si les
+   étudiants savent écrire une en-tête de module correctement, par ex:
+```ocaml
+module IntCharListMemory : Memory with type taddr = int and tval = char = ...
+```
+ * Le type dans les modules est toujours `(int * t)` avec `t` le type "support"
+   pour la mémoire; à la base je me disais que ce n'était pas très intuitif et
+   qu'on l'oubliait souvent, mais c'est peut être bien que ça soit l'étudiant
+   qui l'écrive. Dans tous les cas, les modules se basent sur un type synonyme
+   (on pourrait faire un type avec constructeur, mais ça n'apporte pas grand
+   chose, si ce n'est peut être un peu de clarté ?)
+ * Concernant ce qui serait donné aux étudiants, je pense qu'on aurait :
+   - Le module de tests et le benchmark
+   - Le module `Mem` avec l'interface `Memory` tel quel (avec les contrats donc)
+   - Le module `Listmem`, avec l'en-tête, le type et le nom donnés, et qu'il
+     faut compléter
+   - Le module `Treemem`, vide (avec juste les open et `module TreeMemory` pour
+     simplifier les tests)
+ * Petit soucis : le type bit tree est un peu particulier, car on ne stock rien
+   dans les nodes (c'est assez différent de ce qu'on voit en TD/TP, mais d'un
+   autre côté c'est plus simple)
+ * Autre petit soucis : on ne fait pas écrire de fonction auxiliaire (mais on
+   pourrait découper `write` pour les bit tree, peut-être)
+ * Difficile d'estimer le temps; je pense honnêtement que tout le BE sauf `read`
+   et `write` prennent 1h de réflexion/écriture/correction/test, `read` ça doit
+   prendre 30-45 minutes, et `write` peut-être 1h (oui j'exagère un peu mais
+   j'essaye de me caler sur les performances des étudiants sur les BE des années
+   précédentes); sans `read` et `write` pour le bit tree, j'ai peur que ça soit
+   un peu trop simple... D'où l'idée peut être de rajouter l'implémentation à
+   base de listes associatives... À voir.

BE/assocmem.ml

@@ -0,0 +1,111 @@
+open Util
+open Mem
+
+(*
+    get_assoc:
+        int -> (int * char) list -> char -> char
+    Description:
+        Retourne la valeur associée à la clef e dans la liste l,
+        ou la valeur fournie def si la clef n’existe pas.
+    Paramètres:
+        - e : la clé dont on cherche la valeur associée
+        - l : la liste que l'on va chercher
+        - def : élement par défaut si l'on ne trouve rien
+    Renvoie:
+        la valeur associée à la clé, ou def
+    Préconditions:
+        - True
+    Postconditions:
+        - True
+    Exceptions:
+        - None
+*)
+let rec get_assoc e l def =
+    match l with
+    | [] -> def
+    | (k,v)::q -> if k=e then v else (get_assoc e q def)
+
+(* Tests unitaires *)
+let liste_test = [ (0, 'a'); (1, 'b'); (2, 'c') ]
+let%test _ = get_assoc 0 liste_test '0' = 'a'
+let%test _ = get_assoc 1 liste_test '0' = 'b'
+let%test _ = get_assoc 2 liste_test '0' = 'c'
+let%test _ = get_assoc 3 liste_test '0' = '0'
+
+(*
+    set_assoc:
+        int -> (int * char) list -> char -> (int * char) list
+    Description:
+        Remplace la valeur associée à la clef e dans la liste l par x,
+        ou ajoute le couple (e, x) si la clef n’existe pas déjà.
+    Paramètres:
+        - e : la clé dont on veut remplacer la valeur associée
+        - l : la liste que l'on va modifier
+        - x : nouvelle valeur associée à e
+    Renvoie:
+        La nouvelle liste modifiée
+    Préconditions:
+        - True
+    Postconditions:
+        - True
+    Exceptions:
+        - None
+*)
+let rec set_assoc e l x =
+    match l with
+    | [] -> l@[(e,x)]
+    | (k,v)::q -> if k=e then (k,x)::q else (k,v)::(set_assoc e q x)
+
+(* Tests unitaires *)
+let liste_test = [ (0, 'a'); (1, 'b'); (2, 'c') ]
+let%test _ = set_assoc 0 liste_test 'd' = [ (0, 'd'); (1, 'b'); (2, 'c') ]
+let%test _ = set_assoc 1 liste_test 'e' = [ (0, 'a'); (1, 'e'); (2, 'c') ]
+let%test _ = set_assoc 2 liste_test 'f' = [ (0, 'a'); (1, 'b'); (2, 'f') ]
+let%test _ = set_assoc 3 liste_test 'g' = [ (0, 'a'); (1, 'b'); (2, 'c'); (3, 'g') ]
+
+
+module AssocMemory : Memory =
+struct
+    (* Type = liste qui associe des adresses (entiers) à des valeurs (caractères) *)
+    type mem_type = (int * char) list
+
+    (* Un type qui contient la mémoire + la taille de son bus d'adressage *)
+    type mem = int * mem_type
+
+    (* Nom de l'implémentation *)
+    let name = "assoc"
+
+    (* Taille du bus d'adressage *)
+    let bussize (bs, _) = bs
+
+    (* Taille maximale de la mémoire *)
+    let size (bs, _) = pow2 bs
+
+    (* Taille de la mémoire en mémoire *)
+    let allocsize (_, m) =
+        List.fold_right (fun _ res_q -> 1 + res_q) m 0
+
+    (* Nombre de cases utilisées *)
+    let busyness (_, m) =
+        List.fold_right (
+            fun (_,v) res_q -> if v != _0 then 1 + res_q else res_q
+        ) m 0
+
+    (* Construire une mémoire vide *)
+    let clear bs = (bs, [])
+
+    (* Lire une valeur *)
+    let read (bs, m) addr =
+        if addr > (size (bs, m)) then
+            raise OutOfBound
+        else
+            match (get_assoc addr m _0) with
+            | v -> v
+
+    (* Écrire une valeur *)
+    let write (bs, m) addr x =
+        if addr > (size (bs, m)) then
+            raise OutOfBound
+        else
+            (bs, (set_assoc addr m x))
+end

BE/bench.ml

@@ -0,0 +1,127 @@
+open Be
+open Mem
+open Util
+open Listmem
+open Assocmem
+open Treemem
+
+(* Foncteur qui met en place un petit benchmark pour évaluer les performances
+ * d'une implémentation.
+ *)
+module MemoryBench (M : Memory) =
+struct
+    open M
+
+    (* Crée une mémoire avec un bus d'adressage de taille n et la rempli avec
+     * (au plus) nval valeurs aléatoires.
+     *
+     * nval est une borne supérieure car on utilise le module Random pour
+     * générer des adresses, qui peut (statistiquement) générer plusieurs fois
+     * le même nombre.
+     *)
+    let randommem n nval =
+        let rec write1 nval mem sm =
+            if nval = 0 then
+                mem
+            else
+                let raddr = Random.int sm in
+                (* On évite le 0, qui dénote une case vide *)
+                let rchar = Char.chr (1 + Random.int 255) in
+                    write1 (nval - 1) (write mem raddr rchar) sm
+        in let mem = clear n in
+            write1 nval (clear n) (size mem)
+
+    (* Effectue un ensemble de lectures sur une mémoire. *)
+    let readatrandom nval mem =
+        let sm = size mem in
+        let rec read1 nval =
+            let _ = read mem (Random.int sm) in
+                if nval = 0 then () else read1 (nval - 1)
+        in read1 nval
+
+    (* Génère une mémoire saturée, c'est à dire une mémoire où toutes les cases
+     * contiennent quelque chose.
+     *)
+    let saturatemem n =
+        let rec write1 n mem =
+            (* On évite le 0, qui dénote une case libre. *)
+            let mem' = write mem n (Char.chr (1 + Random.int 255)) in
+                if n = 0 then mem' else write1 (n - 1) mem'
+        in write1 ((pow2 n) - 1) (clear n)
+
+    (* Calcul le taux d'occupation de la mémoire (# cases occupées / # cases total) *)
+    let busyrate busyness size =
+        let fbus = float_of_int busyness in
+        let fsiz = float_of_int size in
+        100. *. (fbus /. fsiz)
+
+    (* Calcul l'efficacité d'occupation, c'est à dire la quantité de mémoire
+     * nécessaire en moyenne pour stocker chaque élément de la mémoire.
+     *)
+    let busyeff busyness allocated =
+        let fbus = float_of_int busyness in
+        let fall = float_of_int allocated in
+        fall /. fbus
+
+    (* Calcul l'efficacité à stocker du vide, autrement dit la quantité de
+     * mémoire physique allouée pour stocker des cases vides.
+     *)
+    let emptyeff busyness allocated size =
+        let fbus = float_of_int busyness in
+        let fall = float_of_int allocated in
+        let fsiz = float_of_int size in
+        100. *. ((fall -. fbus) /. (fsiz -. fbus))
+
+    (* Quelques paramètres pour le benchmark :
+     *  - valnum : nombres de valeurs à lire et écrire
+     *  - busiz  : taille du bus d'adressage pour la mémoire random
+     *  - busiz2 : taille du bus d'adressage pour la mémoire saturée
+     *)
+    let valnum = 4000
+    let busiz  = 16
+    let busiz2 = 10
+
+    (* Effectuer le benchmark et afficher les résultats obtenus. *)
+    let dobench =
+        Printf.printf "Implémentation '%s'\n" name;
+        Printf.printf "Génération et lecture aléatoire de mémoire (%d valeurs, adresses sur %d bits)...\n" valnum busiz;
+        (let t = Sys.time () in
+         let mem = randommem busiz valnum in
+         let t' = Sys.time () in
+         let _ = readatrandom valnum mem in
+         let t''= Sys.time () in
+         let siz = size mem in
+         let asi = allocsize mem in
+         let bus = busyness mem in
+         Printf.printf "Création : %fs, Lecture : %fs, Total : %fs\n" (t' -. t) (t'' -. t') (t'' -. t);
+         Printf.printf "Taille max : %d\n" siz;
+         Printf.printf "Taille occupée : %d (taux d'occupation : %.2f%%)\n" bus (busyrate bus siz);
+         Printf.printf "Taille allouée : %d (mémoire moyenne par case : %.4f, taux mémoire allouée au vide : %.2f%%)\n" asi (busyeff bus asi) (emptyeff bus asi siz)
+        );
+        Printf.printf "Génération et lecture de mémoire saturée (%d valeurs, adresses sur %d bits)...\n" (pow2 busiz2) busiz2;
+        (let t = Sys.time () in
+         let mem = saturatemem busiz2 in
+         let t' = Sys.time () in
+         let _ = readatrandom valnum mem in
+         let t''= Sys.time () in
+         let siz = size mem in
+         let asi = allocsize mem in
+         let bus = busyness mem in
+         Printf.printf "Création : %fs, Lecture : %fs, Total : %fs\n" (t' -. t) (t'' -. t') (t'' -. t);
+         Printf.printf "Taille max : %d\n" siz;
+         Printf.printf "Taille occupée : %d (taux d'occupation : %.2f%%)\n" bus (busyrate bus siz);
+         Printf.printf "Taille allouée : %d (mémoire moyenne par case : %.4f)\n" asi (busyeff bus asi)
+        );
+        Printf.printf "==========================\n"
+end
+
+module LMBench = MemoryBench (ListMemory)
+module AMBench = MemoryBench (AssocMemory)
+module TMBench = MemoryBench (TreeMemory)
+
+(* Fonction principales *)
+let main =
+    LMBench.dobench;
+    AMBench.dobench;
+    TMBench.dobench;
+    ()

BE/btree.ml

@@ -0,0 +1,266 @@
+open Util
+
+(* Type de base : arbre binaire avec information dans les feuilles. *)
+type btree = Node of btree * btree | Leaf of char
+
+(* Un exemple pour la suite *)
+let bt1 =
+    Node (
+        Node (
+            Node (
+                Leaf 'a',
+                Leaf 'b'
+            ),
+            Leaf _0
+        ), Node (
+            Leaf _0,
+            Node (
+                Leaf 'c',
+                Leaf 'd'
+            )
+        )
+    )
+
+(* empty_btree : btree
+ * Retourne l'arbre vide (qui ne "contient que des _0")
+ *)
+let empty_btree = Node(Leaf _0, Leaf _0)
+
+(* height : btree -> int
+ * Calcule la hauteur d'un arbre binaire.
+ *
+ * Paramètre :
+ *   tr : btree, arbre dont on veut la hauteur
+ * Retour :
+ *   hauteur de l'arbre
+ *)
+let rec height tr = 
+    match tr with
+    | Node(tr_g, tr_d) ->
+        let height_gauche = (height tr_g) + 1 in
+        let height_droite = (height tr_d) + 1 in
+        if height_gauche > height_droite then
+            height_gauche
+        else
+            height_droite
+    | Leaf(_) -> 0
+
+let%test "height-0" =
+    height (Leaf _0) = 0
+let%test "height-1" =
+    height (Node (Leaf _0, Node (Leaf _0, Leaf _0))) = 2
+let%test "height-2" =
+    height bt1 = 3
+
+(* num_nodes : btree -> int
+ * Calcule le nombre de noeuds de l'arbre passé en paramètre
+ *
+ * Paramètres :
+ *   tr : btree, arbre dont on veut le nombre de noeuds
+ * Retour :
+ *   nombre de noeuds
+ *)
+let rec num_nodes tr = (* failwith "TODO" *)
+    match tr with
+    | Node(tr_g, tr_d) ->
+        let num_gauche = (num_nodes tr_g) in
+        let num_droite = (num_nodes tr_d) in
+            num_gauche + num_droite + 1
+    | Leaf(_) -> 1
+
+let%test "num_nodes-0" = (num_nodes (Leaf _0)) = 1
+let%test "num_nodes-1" = (num_nodes (Node (Leaf 'a', Leaf 'b'))) = 3
+let%test "num_nodes-1" = (num_nodes (Node (Leaf 'a', Leaf _0))) = 3
+let%test "num_nodes-2" = (num_nodes bt1) = 11
+
+(* num_values : btree -> int
+ * Calcule le nombre de valeurs stockées dans l'arbre qui ne sont pas
+ * égales à _0.
+ *
+ * Paramètres :
+ *   tr : btree, arbre dont on veut compter les valeurs
+ * Retour :
+ *   nombre de valeurs non nulles
+ *)
+let rec num_values tr = (* failwith "TODO" *)
+    match tr with
+    | Node(tr_g, tr_d) ->
+        let num_gauche = (num_values tr_g) in
+        let num_droite = (num_values tr_d) in
+            num_gauche + num_droite
+    | Leaf(c) -> if c != _0 then 1 else 0
+
+let%test "num_values-0" = (num_values (Leaf _0)) = 0
+let%test "num_values-1" = (num_values (Leaf 'a')) = 1
+let%test "num_values-2" = (num_values (Node (Leaf 'a', Leaf 'b'))) = 2
+let%test "num_values-2" = (num_values (Node (Leaf 'a', Leaf _0))) = 1
+let%test "num_values-3" = (num_values bt1) = 4
+
+(* bits : int -> int -> int list
+ * Transforme une nombre binaire en liste de 0 et 1 de la taille
+ * désirée, du bit le plus faible (la puissance de deux la plus basse) au
+ * bit le plus fort.
+ *
+ * Paramètres :
+ *   n : int, taille de la liste résultante
+ *   addr : int, adresse
+ * Retour :
+ *   liste de taille n contenant les bits de addr du plus faible au plus fort
+ * Pré-conditions :
+ *   addr peut être codé sur n bits
+ *)
+let rec bits n addr = (* failwith "TODO" *)
+    match n with
+    | 0 -> []
+    | _ ->
+        if addr mod 2 == 0 then
+            0::(bits (n-1) (addr/2))
+        else
+            1::(bits (n-1) (addr/2))
+
+let%test "bits-0" = (bits 0 546) = []
+let%test "bits-1" = (bits 2   3) = [1; 1]
+let%test "bits-2" = (bits 6  11) = [1; 1; 0; 1; 0; 0]
+let%test "bits-3" = (bits 3 121) = [1; 0; 0]
+let%test "bits-4" = (bits 0   6) = []
+let%test "bits-5" = (bits 1   6) = [0]
+let%test "bits-6" = (bits 2   6) = [0;1]
+let%test "bits-7" = (bits 3   6) = [0;1;1]
+let%test "bits-8" = (bits 4   6) = [0;1;1;0]
+let%test "bits-9" = (bits 5   6) = [0;1;1;0;0]
+let%test "bits-10" = (bits 4   12) = [0;0;1;1]
+let%test "bits-11" = (bits 4   13) = [1;0;1;1]
+
+(* search : btree -> int list -> char
+ * Parcours un arbre binaire selon l'adresse donnée et récupère
+ * la valeur au bout du chemin.
+ *
+ * Paramètre :
+ *   tr : btree, arbre à parcourir
+ *   addr : int list, addresse du chemin, sous forme de liste de bits
+ * Retour :
+ *   valeur à la feuille au bout du chemin, ou _0 si le chemin n'existe pas
+ *
+ * Pré-condition
+ *   la taille de l'addresse est supérieure à la profondeur de l'arbre
+ *   => traité avec une exception pour avoir un patter matching exhaustif...
+ *)
+let rec search tr addrl = (* failwith "TODO" *)
+    match tr, addrl with
+    | Leaf(c), [] -> c
+    | Node(tr_g, tr_d), b::bl ->
+        if b == 0 then
+            search tr_g bl
+        else
+            search tr_d bl
+    | _, _ -> _0
+
+let%test "search-0" =
+    search bt1 [0; 0; 0] = 'a'
+let%test "search-1" =
+    search bt1 [0; 1; 0] = _0
+let%test "search-2" =
+    search bt1 [1; 0; 1] = _0
+let%test "search-3" =
+    search bt1 [1; 1; 0] = 'c'
+
+(* sprout : char -> int list -> btree
+ * Crée un arbre contenant le chemin correspondant à l'addresse passée en
+ * paramètre, au bout duquel se trouve la valeur passée en paramètre.
+ * Le reste de l'arbre résultant ne contient que des _0.
+ *
+ * Paramètres :
+ *   x : char, valeur à rajouter
+ *   addrl : int list, adresse de la valeur, sous forme d'une liste de bits
+ * Retour :
+ *   arbre qui contient la valeur x au bout du chemin de addr et des _0 partout
+ *   ailleurs
+ *)
+let rec sprout x addrl =
+    match addrl with
+    | b::bl ->
+        if b == 0 then
+            Node((sprout x bl), Leaf(_0))
+        else
+            Node(Leaf(_0), (sprout x bl))
+    | [] -> Leaf(x)
+
+let%test "sprout-0" =
+    let tr = sprout 'z' [] in
+        height tr = 0 &&
+        search tr [] = 'z'
+let%test "sprout-1" =
+    let tr = sprout 'z' [0] in
+        height tr = 1 &&
+        search tr [0] = 'z' &&
+        search tr [1] = _0
+let%test "sprout-2" =
+    let tr = sprout 'z' [1;0;1] in
+        height tr = 3 &&
+        search tr [0;0;0] = _0  &&
+        search tr [1;0;0] = _0  &&
+        search tr [0;1;0] = _0  &&
+        search tr [1;1;0] = _0  &&
+        search tr [0;0;1] = _0  &&
+        search tr [1;0;1] = 'z' &&
+        search tr [0;1;1] = _0  &&
+        search tr [1;1;1] = _0
+
+(* update : btree -> char -> int list -> btree
+ * Remplace une valeur au chemin donné par la valeur passée en paramètre, le
+ * chemin étant spécifié par une adresses (sous forme de liste de bits).
+ *
+ * Si le chemin n'existe pas complètement, cette fonction le crée.
+ *
+ * Paramètres :
+ *   tr : btree, arbre à mettre à jour
+ *   x : char, valeur à changer
+ *   addrl : int list, adresse à modifier, sous forme de liste de bits
+ * Retour :
+ *   arbre modifié
+ *
+ * Pré-condition :
+ *   la taille de l'adresse est supérieure ou égale à la profondeur de l'arbre
+ *   => assuré par une exception pour avoir le pattern-matching exhaustif, mais ne 
+ *   devrait pas arriver !
+ *)
+let rec update tr x addrl = (* failwith "TODO" *)
+    match tr, addrl with
+    | Leaf(_0), _ -> (sprout x addrl)
+    | Node(tr_g, tr_d), b::bl ->
+        if b == 0 then
+            Node((update tr_g x bl), tr_d)
+        else
+            Node(tr_g, (update tr_d x bl))
+
+let%test "update-0" =
+    let tr = update (Leaf _0) 'a' [] in
+        height tr = 0 &&
+        search tr [] = 'a'
+let%test "update-1" =
+    let tr = update (Node (Leaf _0, Leaf _0)) 'a' [1] in
+        height tr = 1 &&
+        search tr [0] = _0 &&
+        search tr [1] = 'a'
+let%test "update-2" =
+    let tr = update bt1 'z' [0; 0; 0] in
+        height bt1 = 3 &&
+        search tr [0;0;0] = 'z' &&
+        search tr [1;0;0] = _0  &&
+        search tr [0;1;0] = _0  &&
+        search tr [1;1;0] = 'c' &&
+        search tr [0;0;1] = 'b' &&
+        search tr [1;0;1] = _0  &&
+        search tr [0;1;1] = _0  &&
+        search tr [1;1;1] = 'd'
+let%test "update-3" =
+    let tr = update bt1 'z' [0; 1; 1] in
+        height bt1 = 3 &&
+        search tr [0;0;0] = 'a' &&
+        search tr [1;0;0] = _0  &&
+        search tr [0;1;0] = _0  &&
+        search tr [1;1;0] = 'c' &&
+        search tr [0;0;1] = 'b' &&
+        search tr [1;0;1] = _0  &&
+        search tr [0;1;1] = 'z' &&
+        search tr [1;1;1] = 'd'

BE/dune

@@ -0,0 +1,10 @@
+(library
+ (name be)
+ (inline_tests)
+ (modules test util mem listmem assocmem btree treemem)
+ (preprocess
+  (pps ppx_inline_test)))
+(executable
+    (name bench)
+    (modules bench)
+    (libraries be))

BE/dune-project

@@ -0,0 +1 @@
+(lang dune 2.9)

BE/dune-workspace

@@ -0,0 +1,2 @@
+(lang dune 2.9)
+(env (dev (flags (:standard -warn-error -A))))

BE/listmem.ml

@@ -0,0 +1,115 @@
+open Mem
+open Util
+
+(* generate: int -> 'a -> 'a list
+ * Créer une liste de taille fixe qui contient un élément particulier.
+ * Paramètres :
+ *   n : int, taille de la liste
+ *   x : 'a, élément dont la est remplie
+ * Retour :
+ *   liste de taille n et qui contient des x
+ *)
+let rec generate n x =
+    if n <= 0 then []
+    else x::(generate (n - 1) x)
+
+let%test "generate-0" = generate 0 5 = []
+let%test "generate-1" = generate 5 'a' = ['a';'a';'a';'a';'a']
+let%test "generate-2" = generate 3 1 = [1;1;1]
+
+(* get: 'a list -> int -> 'a
+ * Récupère l'élément en n-ième position d'une liste
+ * Paramètres :
+ *   l : 'a list, liste à parcourir
+ *   n : int, position de l'élément à récupérer
+ * Retour :
+ *   élément à la position n de l
+ * Exception :
+ *   OutOfBound si la position souhaitée n'est pas dans la liste
+ *)
+let rec get l n =
+    match l,n with
+    | t::_, 0 -> t
+    | _::q, n -> get q (n - 1)
+    | [], _   -> raise OutOfBound
+
+(* Autre version avec List :
+ * let get l n =
+ *     if n >= List.length l then
+ *         raise OutOfBound
+ *     else
+ *         List.nth l n
+ *)
+
+let%test "get-1" = get [5;7;9] 2 = 9
+let%test "get-2" = get ['o';'c';'a';'m';'l'] 3 = 'm'
+let%test "get-3" =
+    try let _ = get [1;2;3] 5 in false with OutOfBound -> true
+
+(* set: 'a list -> int -> 'a -> 'a list
+ * Modifie l'élement en n-ième position d'une liste
+ * Paramètres :
+ *   l : 'a list, liste à modifier
+ *   n : int, position de l'élément à changer
+ *   x : 'a, nouvelle valeur de l'élément
+ * Retour l
+ *   liste modifiée (telle que l[n] = x)
+ * Exception l
+ *   OutOfBound si la position souhaitée n'est pas dans la liste
+ *)
+let rec set l n x =
+    match l,n with
+    | _::q, 0 -> x::q
+    | t::q, n -> t::(set q (n - 1) x)
+    | [], _ -> raise OutOfBound
+
+let%test "set-1" = set [5;7;9] 2 3 = [5;7;3]
+let%test "set-2" = set ['o';'c';'a';'m';'l'] 3 'b' = ['o';'c';'a';'b';'l']
+let%test "set-3" =
+    try let _ = set [1;2;3] 5 0 in false with OutOfBound -> true
+
+(* Implémentation simpliste et peu efficace d'une mémoire à base de listes.
+ *
+ * En OCaml, on pourrait utiliser des vecteurs (non vu en cours), mais les
+ * listes sont bien pour mettre en évidence les problèmes de complexité
+ * temporelle et surtout spatiale !
+ *)
+module ListMemory : Memory =
+struct
+    (* Le type "support" est une liste *)
+    type mem_type = char list
+
+    (* Un type qui contient la mémoire + la taille de son bus d'adressage *)
+    type mem = int * mem_type
+
+    let name = "list"
+
+    (* Obtenir la taille du bus d'adressage *)
+    let bussize (bs, _) = bs
+
+    (* Obtenir la taille de la mémoire *)
+    let size (bs, _) = pow2 bs
+
+    (* Obtenir la taille effective de la mémoire.
+     * On a alloué une liste de 2^bs éléments...
+     *)
+    let allocsize (_, l) = List.length l
+
+    (* Obtenir le nombre de valeurs stockées en mémoire. *)
+    let busyness (_, l) =
+        List.fold_left (fun acc t -> if t = _0 then acc else acc + 1) 0 l
+        (* List.length (List.filter (fun i -> i <> _0) l) *)
+
+    (* Lire une valeur *)
+    (* Obtenir une mémoire vide avec adressage sur n bits *)
+    (* À essayer : clear 20 => stack overflow ! *)
+    let clear bs = (bs, generate (pow2 bs) _0)
+
+    (* Complexité : O(2^bs) *)
+    let read (_, l) addr = get l addr
+
+    (* Écrire une valeur. *)
+    (* Complexité : O(2^bs) *)
+    let write (bs, l) addr value =
+        (bs, set l addr value)
+end

BE/mem.ml

@@ -0,0 +1,114 @@
+(* Exception qui signifie que l'on essaye d'adresser la mémoire à un endroit
+ * où elle n'est pas définie.
+ *)
+exception OutOfBound
+
+(* Interface Memory, qui représente un système de mémoire avec adressage direct.
+ *
+ * On suppose que la mémoire stocke des octets (on peut le rendre type-generic
+ * ceci dit).
+ *)
+module type Memory =
+sig
+    (* Le type qui contient la mémoire (e.g. list) *)
+    type mem_type
+
+    (* Un type qui contient la mémoire + la taille de son bus d'adressage *)
+    type mem = int * mem_type
+
+    (* Nom de l'implémentation (pour les tests) *)
+    val name : string
+
+    (* bussize : mem -> int
+     * Retourne la taille du bus d'adressage de la mémoire, autrement dit le
+     * nombre de bits sur lesquels les adresses d'accès peuvent être encodées.
+     *
+     * Paramètres :
+     *   m : mem, mémoire à tester
+     * Retour :
+     *   avec m = (clear n), retourne n
+     *)
+    val bussize : mem -> int
+
+    (* size : mem -> int
+     * Calcule la taille de la mémoire, c'est à dire le nombre (potentiel)
+     * d'emplacements accessibles.
+     *
+     * Paramètres :
+     *   m : mem, mémoire à tester
+     * Retour :
+     *   nombre de "cases" exploitables dans la mémoire
+     *)
+    val size : mem -> int
+
+    (* allocsize : mem -> int
+     * Calcule le nombre de cases "physiquement" allouées pour la mémoire,
+     * autrement dit la taille qu'elle prend dans la RAM physique de
+     * l'ordinateur.
+     *
+     * Paramètres :
+     *   m : mem, mémoire à tester
+     * Retour :
+     *   taille effective de la mémoire en mémoire
+     *)
+    val allocsize : mem -> int
+
+    (* busyness : mem -> int
+     * Calcule le nombre de valeurs stockées dans la mémoire. Pour simplifier,
+     * on considère que les cases qui contiennent 0 sont vide.
+     *
+     * Paramètres :
+     *   m : mem, mémoire à tester
+     * Retour :
+     *   nombre de cases non-vide de la mémoire
+     *)
+    val busyness : mem -> int
+
+    (* clear : int -> mem
+     * Initialise une mémoire avec un nombre de *bits d'adressage*, autrement
+     * dit le nombre de bits sur lesquels une adresse d'accès peut être
+     * exprimée.
+     *
+     * Paramètres :
+     *   n : int, nombre de bits d'addressage
+     * Retour :
+     *   mémoire initialisée (contenu aléatoire, des 0 pour simplifier)
+     *
+     * Pré : n > 0, n < 32 (< 64)
+     * Post : si m = clear n, alors toutes les opérations sur m qui se basent
+     * sur une adresse codée sur n bits ne doivent pas lever OutOfBound.
+     *)
+    val clear : int -> mem
+
+    (* read : mem -> int -> char
+     * Réalise la lecture de la mémoire à l'adresse donnée, et retourne la
+     * valeur correspondante.
+     *
+     * Paramètres :
+     *   m : mem, mémoire à lire
+     *   addr : int, adresse de lecture
+     * Retour :
+     *   valeur stockée dans m à l'adresse addr
+     *
+     * Exception : OutOfBound levée si addr n'est pas une adresse valide pour m
+     *)
+    val read : mem -> int -> char
+
+    (* write : mem -> int -> char -> mem
+     * Réalise l'écriture de la mémoire à l'adresse donnée et avec la valeur
+     * donnée, puis retourne la mémoire ainsi modifiée.
+     *
+     * Paramètres :
+     *   m : mem, mémoire à modifier
+     *   addr : int, adresse d'écriture
+     *   value : char, valeur à écrire
+     * Retour :
+     *   mémoire modifiée
+     *
+     * Post : si m' = write m addr c alors read m' addr == c
+     * Excpetion : OutOfBound levée si addr ne rentre pas sur le nombre de bits
+     * d'adressage spécifié dans m
+     *)
+    val write : mem -> int -> char -> mem
+
+end

BE/test.ml

@@ -0,0 +1,107 @@
+open Mem
+open Treemem
+open Listmem
+open Assocmem
+open Util
+
+(* Foncteur pour factoriser les tests.
+ * Les tests sont sommaires et ne se basent que sur la spécification,
+ * pas sur l'implémentation.
+ *)
+module MemoryTest (M : Memory) =
+struct
+    open M
+
+    (* writeall : mem -> (int * char) list -> mem
+     * Écrit un ensemble de valeurs dans une mémoire, aux addresses données.
+     *
+     * Paramètres :
+     *   mem : M.mem, mémoire à impacter
+     *   l : (int * char) list, liste de couples (adresse, valeur) à écrire
+     * Retour :
+     *   mémoire mise à jour
+     *
+     * Exceptions : OutOfBound si une des adresses est en dehors de la zone
+     * autorisée.
+     *)
+    let rec writeall mem l =
+        match l with
+        | [] -> mem
+        | (addr,v)::q -> writeall (write mem addr v) q
+
+    (* Une mémoire de taille raisonnable avec des choses dedans *)
+    let mem1 =
+        writeall (clear 10) [
+            (   0, 'a');
+            (  12, 'b');
+            ( 131, 'r');
+            (1001, 'a');
+            ( 981, 'c');
+            (  15, 'a');
+            (  19, 'd');
+            ( 451, 'a');
+            ( 222, 'b');
+            ( 223, 'r');
+            ( 682, 'a')
+        ]
+
+    (* Tester le stockage correct de la taille du bus d'adressage. *)
+    let%test "bussize-1" =
+        bussize (clear 5) = 5
+    let%test "bussize-2" =
+        bussize mem1 = 10
+
+    (* Tester le calcul correct de la taille de la mémoire. *)
+    let%test "size-1" =
+        size (clear 5) = 32
+    let%test "size-2" =
+        size mem1 = 1024
+
+    (* Tester la cohérence du retour de allocsize.
+     * Note : on ne peut pas tester la valeur exacte car cela dépend complètement
+     * de l'implémentation !
+     *)
+    let%test "allocsize-consistency-1" =
+        allocsize (clear 5) <= 32 &&
+        allocsize (clear 5) >=  0
+
+    (* Tester le retour de busyness. *)
+    let%test "busyness-0" =
+        busyness (clear 2) = 0
+    let%test "busyness-1" =
+        busyness mem1 = 11
+
+    (* Tester la validité de read *)
+    let%test "read-0" =
+        read mem1 0 = 'a'
+    let%test "read-1" =
+        read mem1 451 = 'a'
+    let%test "read-2" =
+        read mem1 221 = _0
+
+    (* Tester la validité de read et write.
+     * On est obligé de procéder ainsi (read ET write) car formellement, write
+     * n'a pas de résultat que l'on peu examiner, puisque les types sont
+     * abstraits (= effets de bord).
+     *)
+    let%test "read-write-0" =
+        let m' = write mem1 0 'z' in
+            read m' 0 = 'z'
+    let%test "read-write-1" =
+        let m' = write mem1 31 'a' in
+            read m' 31 = 'a'
+    let%test "read-write-2" =
+        let m' = write mem1 27 'a' in
+        let m''= write m' 27 'b' in
+            read m'' 27 = 'b'
+
+    (* Tester la bonne levée d'exception. *)
+    let%test "read-except" =
+        try let _ = read mem1 10000 in false with OutOfBound -> true
+    let%test "write-except" =
+        try let _ = write mem1 10000 '0' in false with OutOfBound -> true
+end
+
+module ListMemoryTest = MemoryTest (ListMemory)
+module AssocMemoryTest = MemoryTest (AssocMemory)
+module TreeMemoryTest = MemoryTest (TreeMemory)

BE/treemem.ml

@@ -0,0 +1,69 @@
+open Util
+open Mem
+open Btree
+
+(* Implémentation plus raffinée d'une mémoire associative à base de "bit tree" :
+ * le bit tree est un arbre binaire où les branches à gauche correspondent à des
+ * 0 dans l'adresse, et les branches à droite correspondent à des 1.
+ *
+ * Concrètement, une adresse sous forme binaire (b_1, b_2, ..., b_n) correspond
+ * à un chemin dans l'arbre. Par ex :
+ *     01100101  => G, D, D, G, G, D, G, D
+ *
+ * Lorsqu'on effectue une lecture, on emprunte le chemin correspondant à
+ * l'adresse jusqu'à tomber sur une feuille. Si on atteint cette feuille et que
+ * l'adresse est à 0 (plus aucun bit à lire ou potentiellement une suite de 0),
+ * alors on a atteint l'emplacement mémoire, et la valeur est dans la feuille.
+ *
+ * Si on tombe sur une feuille alors que l'adresse n'est pas complètement lue,
+ * c'est que l'emplacement n'existe pas, et on retourne donc la valeur par
+ * défaut.
+ *
+ * Pour l'écriture, on procède similairement, mais si la valeur n'existe pas,
+ * alors on crée le chemin depuis la racine qui correspond à l'adresse en
+ * question.
+ *)
+module TreeMemory : Memory =
+struct
+    (* La mémoire est un arbre + une taille du bus d'adressage. *)
+    type mem_type = btree
+
+    (* Un type qui contient la mémoire + la taille de son bus d'adressage *)
+    type mem = int * mem_type
+
+    let name = "tree"
+
+    (* Taille du bus d'adressage stockée dans le type lui-même *)
+    let bussize (bs, _) = bs
+
+    (* Taille maximum de la mémoire = 2^(taille du bus d'adressage) *)
+    let size (bs, _) = pow2 bs
+
+    (* Taille (approximative) en mémoire de l'arbre, pour évaluer les
+     * performance de cette implémentation.
+     *)
+    let allocsize (_, tr) = num_nodes tr
+
+    (* Occupation de l'arbre. On ne compte que les feuilles non égales à 0. *)
+    let busyness (_, tr) = num_values tr
+
+    (* La mémoire vide est celle qui ne contient aucun chemin *)
+    let clear bs = (bs, empty_btree)
+
+    (* Implémentation de read. *)
+    let read (bs, tr) addr =
+        if addr > (size (bs, tr)) then
+            raise OutOfBound
+        else
+            let addrl = bits bs addr in
+            match (search tr addrl) with
+            | c -> c
+
+    (* Implémentation de write. *)
+    let write (bs, tr) addr value =
+        if addr > (size (bs, tr)) then
+            raise OutOfBound
+        else
+            let addrl = bits bs addr in
+            (bs, (update tr value addrl))
+end

BE/util.ml

@@ -0,0 +1,24 @@
+(* pow2 : int -> int
+ * Calcul la énième puissance de 2.
+ *
+ * Paramètres :
+ *   n : int, exposant de la puissance
+ * Retour :
+ *   2^n; se base sur le left shift, donc assez rapide !
+ *
+ * Pré : n >= 0, n < 32 (64)
+ *)
+let pow2 e =
+    1 lsl e
+
+let%test "pow2-0" = pow2 0 = 1
+let%test "pow2-1" = pow2 1 = 2
+let%test "pow2-5" = pow2 5 = 32
+
+(* _0 : char
+ * Le nombre 0 sous forme de caractère.
+ * En OCaml (conrairement à C ou Java, par exemple), les types char et int sont
+ * incompatibles. On ne peut donc pas écrire "let (x : char) = 0"; on est obligé
+ * de passer par une fonction du module Char, qui transforme les int en char.
+ *)
+let _0 = Char.chr 0

BE_blanc/boa.ml

@@ -0,0 +1,29 @@
+(*
+  Interface Règle
+  
+*)
+module type Regle =
+sig
+  type tid = int
+  type td
+  val id : tid
+  val appliquer : td -> td list
+end
+
+
+
+module type ArbreReecriture =
+sig
+  (*
+  type tid = int
+  type td
+  type arbre_reecriture = ...
+
+  val creer_noeud : ...
+
+  val racine : ...
+  val fils : ..
+
+  val appartient : td -> arbre_reecriture -> bool
+  *)
+end

BE_blanc/dune

@@ -0,0 +1,5 @@
+(library
+ (name be)
+ (inline_tests)
+ (preprocess
+  (pps ppx_inline_test)))

BE_blanc/dune-workspace

@@ -0,0 +1,2 @@
+(lang dune 1.0)
+(profile release) 

BE_blanc/tests.ml

@@ -0,0 +1,29 @@
+(* Ce fichier ne sera ni lu, ni corrigé *)
+(* Ce fichier est uniquement là pour vérifier que votre architecture est *)
+(* compatible avec nos tests automatiques *)
+(* Les tests unitaires doivent être réalisé dans le fichier be.ml *)
+
+open Boa
+open ArbreReecritureBOA
+
+
+
+let%test _ = Regle1.appliquer ['B';'O'] = [['B'; 'O'; 'A']] 
+
+let%test _ = Regle2.appliquer ['B'; 'O'; 'A'] = [['B'; 'O'; 'A'; 'O'; 'A']]
+
+let%test _ = List.mem ['B'; 'A'; 'O'] (Regle3.appliquer ['B'; 'O'; 'O'; 'O'; 'O'])
+let%test _ = List.mem ['B'; 'O'; 'A'] (Regle3.appliquer ['B'; 'O'; 'O'; 'O'; 'O'])
+let%test _ = List.length (Regle3.appliquer ['B'; 'O'; 'O'; 'O'; 'O']) = 2
+
+let%test _ = Regle4.appliquer ['B';'O';'A';'A';'O'] = [['B';'O';'O']]
+
+
+let axiome = ['B';'O']
+let a1 = creer_noeud axiome []
+
+let%test _ = racine a1 = axiome
+
+let%test _ = fils a1 = []
+
+let%test _ = appartient axiome a1

TP1/pgcd.ml

@@ -0,0 +1,31 @@
+(**
+    pgcd : int -> int -> int 
+    description : renvoie le pgcd de deux entiers non nuls
+    a : entier dont on cherche le pgcd avec b
+    b : entier dont on cherche le pgcd avec a
+    returns : pgcd(a, b)
+    précondition : a > 0 et b > 0
+*)
+let rec pgcd a b =
+    if a = 0 || b = 0 then failwith "entrer deux entiers non nuls";
+    let abs x = if x < 0 then -x else x in
+    let a = abs a in
+    let b = abs b in
+    if a = b then
+        a
+    else if a > b then
+        pgcd (a - b) b
+    else
+        pgcd a (b - a)
+
+(* tests unitaires *)
+let%test _ = pgcd 1 1 = 1
+let%test _ = pgcd 10 25 = 5;;
+let%test _ = pgcd (-10) 25 = 5;;
+let%test _ = pgcd 10 (-25) = 5;;
+let%test _ = pgcd (-10) (-25) = 5;;
+(* 
+let%test _ = pgcd 0 25 = failwith "entrer deux entiers non nuls";;
+let%test _ = pgcd 10 0 = failwith "entrer deux entiers non nuls";;
+let%test _ = pgcd 0 = failwith "entrer deux entiers non nuls";;
+*)

TP2/tp2.ml

@@ -0,0 +1,163 @@
+(******* TRIS ******)
+
+(*  Tri par insertion **)
+
+(*CONTRAT
+Fonction qui ajoute un élément dans une liste triée, selon un ordre donné
+Type : ('a->'a->bool)->'a->'a list -> 'a list
+Paramètre : ordre  ('a->'a->bool), un ordre sur les éléments de la liste
+Paramètre : elt, l'élement à ajouter
+Paramètre : l, la liste triée dans laquelle ajouter elt
+Résultat : une liste triée avec les éléments de l, plus elt
+*)
+
+let rec insert ordre elt l =
+  match l with
+  | [] -> [elt]
+  | t::q ->
+    if ordre elt t then
+      elt::l
+    else
+      t::(insert ordre elt q)
+
+(* TESTS *)
+let%test _ = insert (fun x y -> x<y) 3 []=[3]
+let%test _ = insert (fun x y -> x<y) 3 [2;4;5]=[2;3;4;5]
+let%test _ = insert (fun x y -> x > y) 6 [3;2;1]=[6;3;2;1]
+
+
+(*CONTRAT
+Fonction qui trie une liste, selon un ordre donné
+Type : ('a->'a->bool)->'a list -> 'a list
+Paramètre : ordre  ('a->'a->bool), un ordre sur les éléments de la liste
+Paramètre : l, la liste à trier
+Résultat : une liste triée avec les éléments de l
+*)
+
+let tri_insertion ordre l =
+  (* List.fold_right (fun e res_q -> insert ordre e res_q) l [] *)
+  List.fold_right (insert ordre) l []
+
+(* TESTS *)
+let%test _ = tri_insertion (fun x y -> x<y) [] = []
+let%test _ = tri_insertion (fun x y -> x<y) [4;2;4;3;1] = [1;2;3;4;4]
+let%test _ = tri_insertion (fun x y -> x > y) [4;7;2;4;1;2;2;7] = [7;7;4;4;2;2;2;1]
+
+
+(*  Tri fusion **)
+
+(* CONTRAT
+Fonction qui décompose une liste en deux listes de tailles égales à plus ou moins un élément
+Paramètre : l, la liste à couper en deux
+Retour : deux listes
+*)
+
+let rec scinde l =
+  match l with
+  | [] -> ([],[])
+  | t::[] -> ([t],[])
+  | t1::t2::q -> let (la, lb) = scinde q in
+    (t1::la, t2::lb)
+    
+
+(* TESTS *)
+(* Peuvent être modifiés selon l'algorithme choisi *)
+let%test _ = scinde [1;2;3;4] = ([1;3],[2;4])
+let%test _ = scinde [1;2;3] = ([1;3],[2])
+let%test _ = scinde [1] = ([1],[])
+let%test _ = scinde [] = ([],[])
+
+
+(* Fusionne deux listes triées pour en faire une seule triée
+Paramètre : ordre  ('a->'a->bool), un ordre sur les éléments de la liste
+Paramètre : l1 et l2, les deux listes triées
+Résultat : une liste triée avec les éléments de l1 et l2
+*)
+
+let rec fusionne ordre l1 l2 =
+  match (l1,l2) with
+  | (_,[]) -> l1
+  | ([],_) -> l2
+  | (t1::q1, t2::q2) ->
+    if ordre t1 t2 then
+      t1::(fusionne ordre q1 l2)
+    else
+      t2::(fusionne ordre l1 q2)
+
+
+(*TESTS*)
+let%test _ = fusionne (fun x y -> x<y) [1;2;4;5;6] [3;4] = [1;2;3;4;4;5;6]
+let%test _ = fusionne (fun x y -> x<y) [1;2;4] [3;4] = [1;2;3;4;4]
+let%test _ = fusionne (fun x y -> x<y) [1;2;4] [3;4;8;9;10] = [1;2;3;4;4;8;9;10]
+let%test _ = fusionne (fun x y -> x<y) [] [] = []
+let%test _ = fusionne (fun x y -> x<y) [1] [] = [1]
+let%test _ = fusionne (fun x y -> x<y) [] [1] = [1]
+let%test _ = fusionne (fun x y -> x<y) [1] [2] = [1;2]
+let%test _ = fusionne (fun x y -> x>y) [1] [2] = [2;1]
+
+
+(* CONTRAT
+Fonction qui trie une liste, selon un ordre donné
+Type : ('a->'a->bool)->'a list -> 'a list
+Paramètre : ordre  ('a->'a->bool), un ordre sur les éléments de la liste
+Paramètre : l, la liste à trier
+Résultat : une liste triée avec les éléments de l
+*)
+
+let rec tri_fusion ordre l =
+  match l with
+  | [] -> []
+  | [t] -> [t]
+  | _ -> let (la,lb) = scinde l in
+    fusionne ordre (tri_fusion ordre la) (tri_fusion ordre lb)
+
+
+(* TESTS *)
+let%test _ = tri_fusion (fun x y -> x<y) [] =[]
+let%test _ = tri_fusion (fun x y -> x<y) [4;2;4;3;1] =[1;2;3;4;4]
+let%test _ = tri_fusion (fun x y -> x > y) [4;7;2;4;1;2;2;7]=[7;7;4;4;2;2;2;1]
+
+
+(*  Parsing du fichier *)
+open Lexing
+
+(* Affiche un quadruplet composé 
+- du sexe des personnes ayant reçu ce prénom : 1 pour les hommes, 2 pour les femmes
+- du prénom
+- de l'année
+- du nombre de fois où ce prénom a été donné cette année là
+*)
+let print_stat (sexe,nom,annee,nb) =
+  Printf.eprintf "%s,%s,%d,%d%!\n" (if (sexe=1) then "M" else "F") nom annee nb
+
+(* Analyse le fichier nat2016.txt (stratistique des prénoms entre 1900 et 2016) 
+ et construit une liste de quadruplet (sexe,prénom,année,nombre d'affectation)
+*)
+let listStat = 
+  (*let input = open_in "/mnt/n7fs/ens/tp_guivarch/pf/nat2016.txt" in *)
+  let input =  open_in "nat2016.txt" in
+  let filebuf = Lexing.from_channel input in
+  Parser.main Lexer.token filebuf
+  
+
+(* Analyse le fichier nathomme2016.txt (stratistique des prénoms d'homme commençant par un A ou un B entre 1900 et 2016) 
+ et construit une liste de quadruplets (sexe,prénom,année,nombre d'affectations)
+*)
+let listStatHomme = 
+  (* let input = open_in "/mnt/n7fs/ens/tp_guivarch/pf/nathomme2016.txt" in *)
+  let input =  open_in "nathomme2016.txt" in
+  let filebuf = Lexing.from_channel input in
+  Parser.main Lexer.token filebuf
+
+(*  Les contrats et les tests des fonctions suivantes sont à écrire *)
+
+let stat_insert l = tri_insertion (fun (_,_,_,nb_a) (_,_,_,nb_b) -> nb_a < nb_b) l
+let stat_fusion l = tri_fusion (fun (_,_,_,nb_a) (_,_,_,nb_b) -> nb_a < nb_b) l
+
+let tests_sorts l = 
+  let t0 = Sys.time() in
+  let list_insert_sorted = stat_insert l in
+  let t1 = Sys.time() in
+  let list_fusion_sorted = stat_fusion l in
+  let t2 = Sys.time() in
+  (t1 -. t0,t2 -. t1)

TP3/combinaison.ml

@@ -0,0 +1,23 @@
+(*** Combinaisons d'une liste ***)
+
+(* CONTRAT 
+Fonction qui génère des combinaisons
+Paramètre k : nombre d'objets que l'on souhaite combiner
+Paramètre l : liste dont l'ont souhaite les combinaisons
+Résultat : l'ensemble des k combinaisons de l
+*)
+let rec combinaison k l =
+  match k,l with
+  | 0, _ -> [[]]
+  | _, [] -> []
+  | _, t::q  ->
+    let liste1 = combinaison k q in
+    let liste2 = combinaison (k-1) q in
+    liste1@( List.map (fun x -> t::x) liste2 )
+
+(* TESTS *)
+let%test _ = combinaison 0 [1;2;3;4] = [[]]
+let%test _ = combinaison 1 [1;2;3;4] = [[4]; [3]; [2]; [1]]
+let%test _ = combinaison 2 [1;2;3;4] = [[3; 4]; [2; 4]; [2; 3]; [1; 4]; [1; 3]; [1; 2]]
+let%test _ = combinaison 3 [1;2;3;4] = [[2; 3; 4]; [1; 3; 4]; [1; 2; 4]; [1; 2; 3]] 
+let%test _ = combinaison 4 [1;2;3;4] = [[1; 2; 3; 4]] 

TP3/sourceEtu/dune

@@ -0,0 +1,5 @@
+(library
+ (name tp3)
+ (inline_tests)
+ (preprocess
+  (pps ppx_inline_test)))

TP3/sourceEtu/dune-project

@@ -0,0 +1 @@
+(lang dune 2.9)

TP3/sourceEtu/dune-workspace

@@ -0,0 +1,3 @@
+(lang dune 2.9)
+(profile dev)
+(env (dev (flags (:standard -warn-error -A)))) 

TP3/sourceEtu/tp3.ml

@@ -0,0 +1,106 @@
+(****** Algorithmes combinatoires et listes ********)
+
+
+(*** Code binaires de Gray ***)
+
+(*CONTRAT
+Fonction qui génère un code de Gray
+Paramètre n : la taille du code
+Resultat : le code sous forme de int list list
+*)
+
+
+let gray_code n = failwith "TO DO"
+
+(* TESTS *)
+let%test _ = gray_code 0 = [[]]
+let%test _ = gray_code 1 = [[0]; [1]]
+let%test _ = gray_code 2=  [[0; 0]; [0; 1]; [1; 1]; [1; 0]]
+let%test _ = gray_code 3 = [[0; 0; 0]; [0; 0; 1]; [0; 1; 1]; [0; 1; 0]; [1; 1; 0]; [1; 1; 1]; [1; 0; 1];
+ [1; 0; 0]]
+ let%test _ = gray_code 4 = [[0; 0; 0; 0]; [0; 0; 0; 1]; [0; 0; 1; 1]; [0; 0; 1; 0]; [0; 1; 1; 0];
+  [0; 1; 1; 1]; [0; 1; 0; 1]; [0; 1; 0; 0]; [1; 1; 0; 0]; [1; 1; 0; 1];
+  [1; 1; 1; 1]; [1; 1; 1; 0]; [1; 0; 1; 0]; [1; 0; 1; 1]; [1; 0; 0; 1];
+  [1; 0; 0; 0]]
+
+
+(*** Combinaisons d'une liste ***)
+
+(* CONTRAT 
+TO DO
+*)
+let combinaison k l = failwith "TO DO"
+
+(* TESTS *)
+(* TO DO *)
+
+
+
+(*** Permutations d'une liste ***)
+
+(* CONTRAT
+Fonction prend en paramètre un élément e et une liste l et qui insére e à toutes les possitions possibles dans l
+Pamaètre e : ('a) l'élément à insérer
+Paramètre l : ('a list) la liste initiale dans laquelle insérer e
+Reesultat : la liste des listes avec toutes les insertions possible de e dans l
+*)
+
+let rec insertion e l = failwith "TO DO"
+
+(* TESTS *)
+let%test _ = insertion 0 [1;2] = [[0;1;2];[1;0;2];[1;2;0]]
+let%test _ = insertion 0 [] = [[0]]
+let%test _ = insertion 3 [1;2] = [[3;1;2];[1;3;2];[1;2;3]]
+let%test _ = insertion 3 [] = [[3]]
+let%test _ = insertion 5 [12;54;0;3;78] =
+[[5; 12; 54; 0; 3; 78]; [12; 5; 54; 0; 3; 78]; [12; 54; 5; 0; 3; 78];
+ [12; 54; 0; 5; 3; 78]; [12; 54; 0; 3; 5; 78]; [12; 54; 0; 3; 78; 5]]
+ let%test _ = insertion 'x' ['a';'b';'c']=
+ [['x'; 'a'; 'b'; 'c']; ['a'; 'x'; 'b'; 'c']; ['a'; 'b'; 'x'; 'c'];
+  ['a'; 'b'; 'c'; 'x']]
+
+
+(* CONTRAT
+Fonction qui renvoie la liste des permutations d'une liste
+Paramètre l : une liste
+Résultat : la liste des permutatiions de l (toutes différentes si les élements de l sont différents deux à deux 
+*)
+
+let rec permutations l = failwith "TO DO"
+
+(* TESTS *)
+(*
+let l1 = permutations [1;2;3]
+let%test _ = List.length l1 = 6
+let%test _ = List.mem [1; 2; 3] l1 
+let%test _ = List.mem [2; 1; 3] l1 
+let%test _ = List.mem [2; 3; 1] l1 
+let%test _ = List.mem [1; 3; 2] l1 
+let%test _ = List.mem [3; 1; 2] l1 
+let%test _ = List.mem [3; 2; 1] l1 
+let%test _ = permutations [] =[[]]
+let l2 = permutations ['a';'b']
+let%test _ = List.length l2 = 2
+let%test _ = List.mem ['a';'b'] l2 
+let%test _ = List.mem ['b';'a'] l2 
+*)
+
+
+(*** Partition d'un entier ***)
+
+(* partition int -> int list
+Fonction qui calcule toutes les partitions possibles d'un entier n
+Paramètre n : un entier dont on veut calculer les partitions
+Préconditions : n >0
+Retour : les partitions de n
+*)
+
+let partition n = failwith "TO DO"
+
+
+(* TEST *)
+let%test _ = partition 1 = [[1]]
+let%test _ = partition 2 = [[1;1];[2]]
+let%test _ = partition 3 = [[1; 1; 1]; [1; 2]; [3]]
+let%test _ = partition 4 = [[1; 1; 1; 1]; [1; 1; 2]; [1; 3]; [2; 2]; [4]]
+

TP4/sourceEtu/appli_chaines.ml

@@ -0,0 +1,13 @@
+open Tp
+open Trie
+open Menu_dico
+open Chaines
+
+(******************************************************************************)
+(* Lancement de l'appli                                                       *)
+(******************************************************************************)
+
+
+let m = [ "bas"; "bât"; "de"; "la"; "lai"; "laid"; "lait"; "lard"; "le";"les"; "long"] 
+
+let () = gere_dico decompose_chaine recompose_chaine lit_chaine affiche_chaine nouveau appartient ajout retrait affiche m

TP4/sourceEtu/arbre.ml

@@ -0,0 +1,96 @@
+open Assoc
+
+type 'a arbre = Noeud of bool * ( ('a branche) list)
+and 'a branche = 'a * 'a arbre
+
+(* Pour les tests *)
+let bb = ('b',Noeud(false,[('a',Noeud(false,[('s',Noeud(true,[]));('t',Noeud(true,[]))]))]))
+let bd = ('d',Noeud(false,[('e',Noeud(true,[]))]))
+let bl = ('l',Noeud(false,[('a',Noeud(true,[('i',Noeud(true,[('d',Noeud(true,[]));('t',Noeud(true,[]))]));('r',Noeud(false,[('d',Noeud(true,[]))]))]));
+                           ('e',Noeud(true,[('s',Noeud(true,[]))]));
+                           ('o',Noeud(false,[('n',Noeud(false,[('g',Noeud(true,[]))]))]))]))
+let b1 = [bb;bd;bl]
+let arbre_sujet = Noeud(false,b1)
+
+(******************************************************************************)
+(*   fonction d'appartenance d'une liste d'éléments à un arbre                *)
+(*   signature  : appartient : 'a list -> 'a arbre -> bool                    *)
+(*   paramètres : - une liste d'éléments (caractères dans le cas d'un dico)   *)
+(*                - un arbre n-aire                                           *)
+(*   résultat   : le résultat booléen du test                                 *)
+(******************************************************************************)
+let rec appartient_arbre lc (Noeud (b,lb)) =
+  match lc with
+  (* on a épuisé la liste : le résultat est le booléen du noeud sur
+     lequel on est arrivé *)
+  | [] -> b
+  (* sinon on cherche la branche correspondant au premier
+     caractère de la liste :
+     - elle n'existe pas : le mot n'appartient pas au trie
+     - on la trouve, on relance aux avec le reste de la liste
+     et l'arbre de cette branche *)
+  | c::qlc ->
+     match recherche c lb with
+     | None -> false
+     | Some a -> appartient_arbre qlc a
+
+let%test _ = appartient_arbre ['b';'a';'s']  arbre_sujet
+let%test _ = appartient_arbre ['b';'a';'t']  arbre_sujet
+let%test _ = appartient_arbre ['d';'e']  arbre_sujet
+let%test _ = appartient_arbre ['l';'a']  arbre_sujet
+let%test _ = appartient_arbre ['l';'a';'i']  arbre_sujet
+let%test _ = appartient_arbre ['l';'a';'i';'d']  arbre_sujet
+let%test _ = appartient_arbre ['l';'a';'i';'t']  arbre_sujet
+let%test _ = appartient_arbre ['l';'a';'r';'d']  arbre_sujet
+let%test _ = appartient_arbre ['l';'e']  arbre_sujet
+let%test _ = appartient_arbre ['l';'e';'s']  arbre_sujet
+let%test _ = appartient_arbre ['l';'o';'n';'g']  arbre_sujet
+let%test _ = not (appartient_arbre ['t';'o';'t';'o'] arbre_sujet)
+let%test _ = not (appartient_arbre ['b';'a']  arbre_sujet)
+let%test _ = not (appartient_arbre ['l';'o';'n']  arbre_sujet)
+
+(******************************************************************************)
+(*   fonction d'ajout d'une liste éléments dans un arbre                      *)
+(*   signature  : ajout : 'a list -> 'a arbre -> 'a arbre                     *)
+(*   paramètres : - une liste d'éléments (caractères dans le cas d'un dico)   *)
+(*                - un arbre n-aire                                           *)
+(*   résultat   : l'arbre n-aire avec le mot ajouté                           *)
+(******************************************************************************)
+let rec ajout_arbre lc (Noeud (b, lb)) =
+  match lc with
+  (* on a épuisé la liste : le résultat est le noeud sur lequel on
+     est arrivé avec son booléen mis à vrai *)
+  | [] -> Noeud (true, lb)
+  (* sinon on cherche l'arbre arbre_c de la branche correspondant
+     au premier caractère de la liste;
+     si on ne le trouve pas, le résultat de cette recherche est un arbre
+     avec une liste de branches vide.
+
+     Le résultat de aux est le noeud en paramètre
+     que l'on met à jour en remplacant dans sa liste de branches,
+     la branche du premier caractère par la branche dont l'arbre est
+     le résultat de l'ajout du reste des caractères à l'arbre arbre_c *)
+  | c::qlc ->
+     let arbre_c =
+       let l = recherche c lb in
+       match l with
+       | None   -> Noeud (false, [])
+       | Some a -> a
+     in Noeud (b, maj c (ajout_arbre qlc arbre_c) lb)
+
+let arbre_sujet2 =
+  List.fold_right ajout_arbre
+    [['b';'a';'s']; ['b';'a';'t']; ['d';'e']; ['l';'a']; ['l';'a';'i'];
+     ['l';'a';'i';'d']; ['l';'a';'i';'t']; ['l';'a';'r';'d']; ['l';'e'];
+     ['l';'e';'s']; ['l';'o';'n';'g']]
+    (Noeud (false,[]))
+
+let arbre_sujet3 =
+  List.fold_right ajout_arbre
+    [['b';'a';'s']; ['l';'a';'i';'t']; ['b';'a';'t']; ['l';'e']; ['d';'e'];
+     ['l';'a';'i']; ['l';'a';'i';'d']; ['l';'e';'s']; ['l';'a';'r';'d'];
+     ['l';'a']; ['l';'o';'n';'g']]
+    (Noeud (false,[]))
+
+let%test _ = arbre_sujet2 = arbre_sujet
+let%test _ = arbre_sujet3 = arbre_sujet

TP4/sourceEtu/assoc.ml

@@ -0,0 +1,59 @@
+(******************************************************************************)
+(*   fonction de recherche dans une liste associative                         *)
+(*   TRIEE par valeur croissante des clés                                     *)
+(*                                                                            *)
+(*   signature  : recherche :                                                 *)
+(*                  'a -> ('a * 'b) list -> 'b option                         *)
+(*   paramètres : - une clé (caractère dans le cas des tries)                 *)
+(*                - une liste d'association (clé / valeur)                    *)
+(*                (branches dans le cas des tries, où la clé est un caractère *)
+(*                 et la valeur un sous-arbre)                                *)
+(*   résultat   : Some (la valeur correspondant à la clé),                    *)
+(*                si elle existe                                              *)
+(*                None, sinon                                                 *)
+(******************************************************************************)
+let rec recherche c lb =
+  match lb with
+  | [] -> None
+  | (tc, ta)::qlb ->
+     if c < tc then None
+     else if c = tc then Some ta
+     else recherche c qlb
+
+(* TEST *)
+let bb = ('b',1)
+let bd = ('d',2)
+let bl = ('l',3)
+let b1 = [bb;bd;bl]
+let%test _ = recherche 'b' b1 = Some 1
+let%test _ = recherche 'd' b1 = Some 2
+let%test _ = recherche 'l' b1 = Some 3
+let%test _ = recherche 'a' b1 = None
+
+(******************************************************************************)
+(*   fonction  d'ajout/mise à jour d'une valeur dans une liste associative    *)
+(*   TRIEE par valeur croissante des clés                                     *)
+(*                                                                            *)
+(*   signature  : maj :                                                       *)
+(*                 'a -> 'b -> ('a * 'b) list -> ('a * 'b) list               *)
+(*   paramètres : - une clé (un caractère dans le cas des tries)              *)
+(*                - le couple (clé,valeur) (la branche dans le cas des tries  *)
+(*                  à ajouter/modifier                                        *)
+(*                - la liste associative                                      *)
+(*   résultat   : la liste associative mise à jour                            *)
+(******************************************************************************)
+let rec maj c nouvelle_b lb =
+  match lb with
+  | [] -> [(c,nouvelle_b)]
+  | (tc, ta)::qlb ->
+     if c < tc then (c,nouvelle_b)::lb
+     else if c = tc then (c,nouvelle_b)::qlb
+     else (tc, ta)::(maj c nouvelle_b qlb)
+
+(* TESTS *)
+
+let%test _ = maj 'b' 3 b1 = [('b',3);bd;bl]
+let ba = ('a',4)
+let%test _ = maj 'a' 4 b1 = [ba;bb;bd;bl]
+let bm = ('m',5)
+let%test _ = maj 'm' 5 b1 = [bb;bd;bl;bm]

TP4/sourceEtu/chaines.ml

@@ -0,0 +1,64 @@
+(******************************************************************************)
+(*                                                                            *)
+(*      fonction de décomposition pour les chaînes de caractères              *)
+(*                                                                            *)
+(*   signature : decompose_chaine : string -> char list = <fun>               *)
+(*                                                                            *)
+(*   paramètre(s) : une chaîne de caractères                                  *)
+(*   résultat     : la liste des caractères composant la chaîne paramètre     *)
+(*                                                                            *)
+(******************************************************************************)
+let decompose_chaine s =
+  let rec decompose i accu =
+    if i < 0 then accu
+    else decompose (i-1) (s.[i]::accu)
+  in decompose (String.length s - 1) []
+
+let%test _ = decompose_chaine "" = []
+let%test _ = decompose_chaine "a" = ['a']
+let%test _ = decompose_chaine "aa" = ['a';'a']
+let%test _ = decompose_chaine "ab" = ['a';'b']
+let%test _ = decompose_chaine "abcdef" = ['a'; 'b'; 'c'; 'd'; 'e'; 'f']
+
+(******************************************************************************)
+(*                                                                            *)
+(*      fonction de recomposition pour les chaînes de caractères              *)
+(*                                                                            *)
+(*   signature : recompose_chaine : char list -> string = <fun>               *)
+(*                                                                            *)
+(*   paramètre(s) : une liste de caractères                                   *)
+(*   résultat     : la chaîne des caractères composant la liste paramètre     *)
+(*                                                                            *)
+(******************************************************************************)
+let rec recompose_chaine lc =
+  List.fold_right (fun t q -> String.make 1 t ^ q) lc ""
+
+let%test _ = recompose_chaine [] = ""
+let%test _ = recompose_chaine ['a'] = "a"
+let%test _ = recompose_chaine ['a';'a'] = "aa"
+let%test _ = recompose_chaine ['a';'b'] = "ab"
+let%test _ = recompose_chaine ['a'; 'b'; 'c'; 'd'; 'e'; 'f'] = "abcdef"
+
+(******************************************************************************)
+(*                                                                            *)
+(*      fonction de lecture d'une chaîne                                      *)
+(*                                                                            *)
+(*   signature : lit_chaine : unit -> string = <fun>                          *)
+(*                                                                            *)
+(*   paramètre(s) : aucun                                                     *)
+(*   résultat     : une chaîne                                                *)
+(*                                                                            *)
+(******************************************************************************)
+let lit_chaine = read_line
+
+(******************************************************************************)
+(*                                                                            *)
+(*      procédure d'affichage d'une chaîne                                    *)
+(*                                                                            *)
+(*   signature : affiche_chaine : string -> unit = <fun>                      *)
+(*                                                                            *)
+(*   paramètre(s) : une chaîne                                                *)
+(*   résultat     : aucun                                                     *)
+(*                                                                            *)
+(******************************************************************************)
+let affiche_chaine s = let () = print_string s in print_newline ()

TP4/sourceEtu/chaines.mli

@@ -0,0 +1,49 @@
+(*                           Module Chaines                                   *)
+
+(******************************************************************************)
+(*                                                                            *)
+(*      fonction de décomposition pour les chaînes de caractères              *)
+(*                                                                            *)
+(*   signature : decompose_chaine : string -> char list = <fun>               *)
+(*                                                                            *)
+(*   paramètre(s) : une chaîne de caractères                                  *)
+(*   résultat     : la liste des caractères composant la chaîne paramètre     *)
+(*                                                                            *)
+(******************************************************************************)
+val decompose_chaine : string -> char list
+
+(******************************************************************************)
+(*                                                                            *)
+(*      fonction de recomposition pour les chaînes de caractères              *)
+(*                                                                            *)
+(*   signature : recompose_chaine : char list -> string = <fun>               *)
+(*                                                                            *)
+(*   paramètre(s) : une liste de caractères                                   *)
+(*   résultat     : la chaîne des caractères composant la liste paramètre     *)
+(*                                                                            *)
+(******************************************************************************)
+val recompose_chaine : char list -> string
+
+(******************************************************************************)
+(*                                                                            *)
+(*      fonction de lecture d'une chaîne                                      *)
+(*                                                                            *)
+(*   signature : lit_chaine : unit -> string = <fun>                          *)
+(*                                                                            *)
+(*   paramètre(s) : aucun                                                     *)
+(*   résultat     : une chaîne                                                *)
+(*                                                                            *)
+(******************************************************************************)
+val lit_chaine : unit -> string
+
+(******************************************************************************)
+(*                                                                            *)
+(*      procédure d'affichage d'une chaîne                                    *)
+(*                                                                            *)
+(*   signature : affiche_chaine : string -> unit = <fun>                      *)
+(*                                                                            *)
+(*   paramètre(s) : une chaîne                                                *)
+(*   résultat     : aucun                                                     *)
+(*                                                                            *)
+(******************************************************************************)
+val affiche_chaine : string -> unit

TP4/sourceEtu/dune

@@ -0,0 +1,11 @@
+(executable
+ (name appli_chaines)
+ (modules appli_chaines)
+ (libraries tp))
+
+(library
+ (name tp)
+ (modules :standard \ appli_chaines)
+ (inline_tests)
+ (preprocess
+  (pps ppx_inline_test)))

TP4/sourceEtu/dune-project

@@ -0,0 +1 @@
+(lang dune 2.9)

TP4/sourceEtu/dune-workspace

@@ -0,0 +1,3 @@
+(lang dune 2.9)
+(profile dev)
+(env (dev (flags (:standard -warn-error -A)))) 

TP4/sourceEtu/menu_dico.ml

@@ -0,0 +1,53 @@
+let affiche_menu () =
+  let () = print_string "\n 0 - Quitter\n" in
+  let () = print_string " 1 - Chercher un mot\n" in
+  let () = print_string " 2 - Ajouter un mot\n" in
+  let () = print_string " 3 - Retirer un mot\n" in
+  print_string " 4 - Afficher le dictionnaire\n\n> "
+
+let gere_dico fd fr lm em nouveau appartient ajout retrait affiche mots =
+  let rec mainloop dico fin =
+    if fin then () else
+      let () = affiche_menu () in
+      let commande = read_line () in
+      let dico, fin = match commande with
+        | "0" -> dico, true;
+        | "1" ->
+           let () = print_string "\nEntrer le mot à rechercher :\n" in
+           let mot = lm () in
+           let () = print_newline () in
+           let () = print_string " -> " in
+           let () = em mot in
+           let () =
+             if appartient mot dico then print_string " présent\n\n"
+             else print_string " non présent\n\n" in
+           dico, false
+        | "2" ->
+           let () = print_string "\nEntrer le mot à ajouter :\n" in
+           let mot = lm () in
+           let dico = ajout mot dico in
+           let () = print_newline () in
+           let () = print_string " -> " in
+           let () = em mot in
+           let () = print_string " ajouté\n\n" in
+           dico, false
+        | "3" ->
+           let () = print_string "\nEntrer le mot à retirer :\n" in
+           let mot = lm () in
+           let dico = retrait mot dico in
+           let () = print_newline () in
+           let () = print_string " <- " in
+           let () = em mot in
+           let () = print_string " retiré\n\n" in
+           dico, false
+        | "4" ->
+           let () = print_string "\n------------------------------\n\n" in
+           let () = affiche em dico in
+           let () = print_string "\n------------------------------\n\n" in
+           dico, false
+        | _   ->
+           let () = print_string "\n\n**** Erreur de Saisie ****\n\n" in
+           dico, false in
+      mainloop dico fin in
+  let dico = List.fold_right ajout mots (nouveau fd fr) in
+  mainloop dico false

TP4/sourceEtu/menu_dico.mli

@@ -0,0 +1,31 @@
+open Trie
+
+(*                     Module Menu_dico                                       *)
+
+(******************************************************************************)
+(*                                                                            *)
+(*      fonction de gestion d'un dictionnaire par un menu de commandes        *)
+(*                                                                            *)
+(******************************************************************************)
+val gere_dico :
+  (* la fonction qui décompose un mot en caractères*)
+  ('a -> 'b list) ->
+  (* la fonction qui recompose un mot *)
+  ('b list -> 'a) ->
+  (* la fonction qui lit un mot *)
+  (unit -> 'a) ->
+  (* la procédure qui affiche un mot *)
+  ('a -> unit) ->
+  (* la fonction de création d'un trie *)
+  (('a -> 'b list) -> ('b list -> 'a) -> ('a, 'b) trie) ->
+  (* la fonction qui teste l'appartenance d'un mot à un trie *)
+  ('a -> ('a, 'b) trie -> bool) ->
+  (* la fonction qui ajoute un mot à un trie *)
+  ('a -> ('a, 'b) trie -> ('a, 'b) trie) ->
+  (* la fonction qui retire un mot d'un trie *)
+  ('a -> ('a, 'b) trie -> ('a, 'b) trie) ->
+  (* la procédure qui affiche un trie *)
+  (('a -> unit) -> ('a, 'b) trie -> unit) ->
+  (* la liste initiale de mots *)
+  ('a list) ->
+  unit

TP4/sourceEtu/trie.ml

@@ -0,0 +1,73 @@
+open Assoc
+open Arbre
+open Chaines
+
+(* le type trie :
+    triplet arbre,
+            fonction de décomposition mot -> liste de caractères,
+            fonction de recomposition liste de caractères -> mot *)
+type ('a,'b) trie = Trie of ('b arbre) * ('a -> 'b list) * ('b list -> 'a)
+
+(******************************************************************************)
+(*   fonction de création d'un nouveau trie                                   *)
+(*   signature  : nouveau :                                                   *)
+(*          ('a -> 'b list) -> ('b list -> 'a) -> ('a, 'b) trie = <fun>       *)
+(*   paramètres : - une fonction de décomposition                             *)
+(*                     mot -> liste de caractères                             *)
+(*                -  une fonction de recomposition                            *)
+(*                     liste de caractères -> mot                             *)
+(*   résultat     : un nouveau trie "vide"                                    *)
+(******************************************************************************)
+let nouveau fd fr = Trie(Noeud(false,[]), fd, fr)
+
+(******************************************************************************)
+(*   fonction d'appartenance d'un élément à un trie                           *)
+(*   signature  : appartient : 'a -> ('a, 'b) trie -> bool = <fun>            *)
+(*   paramètres : - un mot                                                    *)
+(*                - un trie                                                   *)
+(*   résultat   : le résultat booléen du test                                 *)
+(******************************************************************************)
+let appartient mot trie = failwith "TO DO appartient"
+
+(******************************************************************************)
+(*   fonction d'ajout d'un élément dans un trie                               *)
+(*   signature  : ajout : 'a -> ('a, 'b) trie -> ('a, 'b) trie = <fun>        *)
+(*   paramètres : - un mot                                                    *)
+(*                - un trie                                                   *)
+(*   résultat   : le trie avec le mot ajouté                                  *)
+(******************************************************************************)
+let ajout mot (Trie(arbre, decompose, recompose)) =
+  Trie (ajout_arbre (decompose mot) arbre,decompose,recompose)
+
+(*  Pour les tests *)
+let trie_sujet =
+  List.fold_right ajout
+    ["bas"; "bât"; "de"; "la"; "lai"; "laid"; "lait"; "lard"; "le"; "les"; "long"]
+    (nouveau decompose_chaine recompose_chaine)
+
+(******************************************************************************)
+(*   fonction de retrait d'un élément d'un trie                               *)
+(*   signature  : trie_retrait : 'a -> ('a, 'b) trie -> ('a, 'b) trie = <fun> *)
+(*   paramètres : - un mot                                                    *)
+(*                - un trie                                                   *)
+(*   résultat   : le trie avec le mot retiré                                  *)
+(******************************************************************************)
+let retrait mot trie = failwith "TO DO retrait"
+
+(******************************************************************************)
+(*   fonction interne au Module qui génère la liste de tous les mots          *)
+(*   d'un trie                                                                *)
+(*   signature    : trie_dico : ('a, 'b) trie -> 'a list = <fun>              *)
+(*   paramètre(s) : le trie                                                   *)
+(*   résultat     : la liste des mots                                         *)
+(******************************************************************************)
+let trie_dico trie = failwith "trie_dico"
+
+(******************************************************************************)
+(* procédure d'affichage d'un trie                                            *)
+(*   signature  : affiche : ('a -> unit) -> ('a, 'b) trie -> unit = <fun>     *)
+(*   paramètres : - une procédure d'affichage d'un mot                        *)
+(*                - un trie                                                   *)
+(*   résultat   : aucun                                                       *)
+(******************************************************************************)
+let affiche p trie = failwith "TO DO affiche"

TP4/sourceEtu/trie.mli

@@ -0,0 +1,57 @@
+(*                           Module de trie                                   *)
+
+(* type trie
+le mot est de type 'a, les "caractères" le composant de type 'b
+*)
+type ('a,'b) trie
+
+(******************************************************************************)
+(*   fonction de création d'un nouveau trie                                   *)
+(*   signature  : nouveau :                                                   *)
+(*          ('a -> 'b list) -> ('b list -> 'a) -> ('a, 'b) trie = <fun>       *)
+(*   paramètres : - une fonction de décomposition                             *)
+(*                     mot -> liste de caractères                             *)
+(*                -  une fonction de recomposition                            *)
+(*                     liste de caractères -> mot                             *)
+(*   résultat     : un nouveau trie "vide"                                    *)
+(******************************************************************************)
+val nouveau : ('a -> 'b list) -> ('b list -> 'a) -> ('a, 'b) trie
+
+(******************************************************************************)
+(*   fonction d'appartenance d'un élément à un trie                           *)
+(*   signature  : appartient : 'a -> ('a, 'b) trie -> bool = <fun>           *)
+(*   paramètres : - un mot                                                    *)
+(*                - un trie                                                   *)
+(*   résultat   : le résultat booléen du test                                 *)
+(******************************************************************************)
+val appartient : 'a -> ('a, 'b) trie -> bool
+
+(******************************************************************************)
+(*   fonction d'ajout d'un élément dans un trie                               *)
+(*   signature  : ajout : 'a -> ('a, 'b) trie -> ('a, 'b) trie = <fun>        *)
+(*   paramètres : - un mot                                                    *)
+(*                - un trie                                                   *)
+(*   résultat   : le trie avec le mot ajouté                                  *)
+(******************************************************************************)
+val ajout : 'a -> ('a, 'b) trie -> ('a, 'b) trie
+
+(******************************************************************************)
+(*   fonction de retrait d'un élément d'un trie                               *)
+(*   signature  : trie_retrait : 'a -> ('a, 'b) trie -> ('a, 'b) trie = <fun> *)
+(*   paramètres : - un mot                                                    *)
+(*                - un trie                                                   *)
+(*   résultat   : le trie avec le mot retiré                                  *)
+(******************************************************************************)
+val retrait : 'a -> ('a, 'b) trie -> ('a, 'b) trie
+
+(******************************************************************************)
+(* procédure d'affichage d'un trie                                            *)
+(*   signature  : affiche : ('a -> unit) -> ('a, 'b) trie -> unit = <fun>      *)
+(*   paramètres : - une procédure d'affichage d'un mot                        *)
+(*                - un trie                                                   *)
+(*   résultat   : aucun                                                       *)
+(******************************************************************************)
+val affiche : ('a -> unit) -> ('a, 'b) trie -> unit
+
+(*  Pour les tests *)
+val trie_sujet : (string,char) trie

TP5/dune

@@ -0,0 +1,5 @@
+(library
+ (name tp5)
+ (inline_tests)
+ (preprocess
+  (pps ppx_inline_test)))

TP5/dune-project

@@ -0,0 +1 @@
+(lang dune 2.9)

TP5/dune-workspace

@@ -0,0 +1,3 @@
+(lang dune 2.9)
+(profile dev)
+(env (dev (flags (:standard -warn-error -A)))) 

TP5/tp5.ml

@@ -0,0 +1,164 @@
+(*** Evaluation des expressions simples ***)
+
+(* Module abstrayant les expressions simples *)
+module type ExprSimple =
+sig
+  type t
+  val const : int -> t
+  val plus : t -> t -> t
+  val mult : t -> t -> t
+end
+
+(* Module réalisant l'évaluation d'une expression *)
+module EvalSimple : ExprSimple with type t = int =
+struct
+  type t = int
+  let const c = c
+  let plus e1 e2 = e1 + e2
+  let mult e1 e2 = e1 * e2
+end
+
+(* Module réalisant l'affichage d'une expression *)
+module PrintSimple : ExprSimple with type t = string =
+struct
+  type t = string
+  let const c = (string_of_int c)
+  let plus e1 e2 = "(" ^ e1 ^ "+" ^ e2 ^ ")"
+  let mult e1 e2 = "(" ^ e1 ^ "*" ^ e2 ^ ")"
+end
+
+(* Module comptant le nombre d'opérations d'une expression *)
+module CompteSimple : ExprSimple with type t = int =
+struct
+  type t = int
+  let const c = 0
+  let plus e1 e2 = e1 + e2 + 1
+  let mult e1 e2 = e1 + e2 + 1
+end
+
+(* Solution 1 pour tester *)
+(* A l'aide de foncteur *)
+
+(* Définition des expressions *)
+module ExemplesSimples (E:ExprSimple) =
+struct
+  (* 1+(2*3) *)
+  let exemple1  = E.(plus (const 1) (mult (const 2) (const 3)) )
+  (* (5+2)*(2*3) *)
+  let exemple2 =  E.(mult (plus (const 5) (const 2)) (mult (const 2) (const 3)) )
+end
+
+(* Module d'évaluation des exemples *)
+module EvalExemples = ExemplesSimples (EvalSimple)
+let%test _ = (EvalExemples.exemple1 = 7)
+let%test _ = (EvalExemples.exemple2 = 42)
+
+(* Module d'affichage des exemples *)
+module PrintExemples = ExemplesSimples (PrintSimple)
+let%test _ = (PrintExemples.exemple1 = "(1+(2*3))")
+let%test _ = (PrintExemples.exemple2 = "((5+2)*(2*3))")
+
+(* Module de comptage des exemples *)
+module CompteExemples = ExemplesSimples (CompteSimple)
+let%test _ = (CompteExemples.exemple1 = 2)
+let%test _ = (CompteExemples.exemple2 = 3)
+
+(*** Evaluation des variables aux expressions ***)
+
+(* Module abstrayant les expressions complété avec les variables *)
+module type ExprVar =
+sig
+  type t
+  type nom = string
+  val def : nom -> t -> t -> t
+  val var : nom -> t
+end
+
+(* Module abstrayant les expressions *)
+module type Expr =
+sig
+  include ExprSimple
+  include (ExprVar with type t:=t) 
+end
+
+(* Module réalisant l'affichage d'une expression complété de variables *)
+module PrintVar : ExprVar with type t = string and type nom = string =
+struct
+  type t = string
+  type nom = string
+  let def s e1 e2 = "let " ^ s ^ " = " ^ e1 ^ " in " ^ e2
+  let var e = e
+end
+
+(* Module réalisant l'affichage d'une expression complété de variables *)
+(* module EvalVar : ExprVar with type t = int and type nom = string =
+struct
+  type t = int
+  type nom = string
+  let def s e1 e2 = e2 ((s e1 env)::env)
+  let var e = List.assoc e env
+end *)
+
+(* Module réalisant le comptage des opérations d'une expression complété de variables *)
+module CompteVar : ExprVar with type t = int and type nom = string =
+struct
+  type t = int
+  type nom = string
+  let def s e1 e2 = e1 + e2 + 3
+  let var e = 0
+end
+
+(* Module réalisant le compte des opérations d'une expression *)
+module Compte : Expr with type t = int and type nom = string =
+struct
+  include CompteVar
+  include (CompteSimple:ExprSimple with type t:=t)
+end
+
+(* Module réalisant l'affichage d'une expression *)
+module Print : Expr with type t = string and type nom = string =
+struct
+  include PrintVar
+  include (PrintSimple:ExprSimple with type t:=t)
+end
+
+(* Module réalisant l'évaluation d'une expression *)
+(* module Eval : Expr with type t = string and type nom = string =
+struct
+  include EvalVar
+  include (EvalSimple:ExprSimple with type t:=t)
+end *)
+
+(* Définition des expressions avec variables *)
+module Exemples (E:Expr) =
+struct
+  (* 1+(2*3) *)
+  let exemple1  = E.(plus (const 1) (mult (const 2) (const 3)) )
+  (* (5+2)*(2*3) *)
+  let exemple2 =  E.(mult (plus (const 5) (const 2)) (mult (const 2) (const 3)) )
+  (* let x = 1+2 in x*3 *)
+  let exemple3 = E.(def "x" (plus (const 1) (const 2)) (mult (var "x") (const 3)) )
+  (* let okay = (3+4)*5 in (x*7)+x *)
+  let exemple4 = E.(def "x" (mult (plus (const 3) (const 4)) (const 5)) (plus (mult (var "x") (const 7)) (var "x")) )
+end
+
+(* Module d'affichage des exemples + test de non regression *)
+module PrintExemples2 = Exemples (Print)
+let%test _ = (PrintExemples2.exemple1 = "(1+(2*3))")
+let%test _ = (PrintExemples2.exemple2 = "((5+2)*(2*3))")
+let%test _ = (PrintExemples2.exemple3 = "let x = (1+2) in (x*3)")
+let%test _ = (PrintExemples2.exemple4 = "let x = ((3+4)*5) in ((x*7)+x)")
+
+(* Module de comptage des exemples + test de non regression*)
+module CompteExemples2 = Exemples (Compte)
+let%test _ = (CompteExemples2.exemple1 = 2)
+let%test _ = (CompteExemples2.exemple2 = 3)
+let%test _ = (CompteExemples2.exemple3 = 5)
+let%test _ = (CompteExemples2.exemple4 = 7)
+
+(* Module de d'evaluation des exemples + test de non regression*)
+(* module EvalExemples2 = Exemples (Eval)
+let%test _ = (EvalExemples2.exemple1 = 7)
+let%test _ = (EvalExemples2.exemple2 = 42)
+let%test _ = (EvalExemples2.exemple3 = 9)
+let%test _ = (EvalExemples2.exemple4 = 280) *)