Skip to content
Snippets Groups Projects
Commit ef53b1ff authored by COQUERY EMMANUEL's avatar COQUERY EMMANUEL
Browse files

Merge remote-tracking branch 'refs/remotes/origin/main'

parents ea9549ad b687b6f6
No related branches found
No related tags found
No related merge requests found
......@@ -18,7 +18,7 @@ Le plugin OCaml permet d'exécuter un code sélectionné avec les touches `[Shif
Lancer l'interpréteur `ocaml` avec la commande
```bash
rlwrap ocaml
utop
```
ou simplement
......@@ -27,7 +27,7 @@ ou simplement
ocaml
```
si `rlwrap` n'est pas installé.
si `utop` n'est pas installé.
### 1.1. Types de base
......
(**********************************************************************)
(**********************************************************************)
(* 1.1 *)
(**
Concatène 2 listes
@param l1 la première liste à concaténer
@param l2 la deuxième liste
@return la liste résultant de la concaténation de l1 avec l2
*)
let rec concatene (l1 : int list) (l2 : int list) : int list =
match l1 with [] -> l2 | x :: l1' -> x :: concatene l1' l2
;;
(* Quelques tests *)
concatene [ 1; 2; 3 ] [ 4; 5; 6 ] = [ 1; 2; 3; 4; 5; 6 ];;
concatene [] [ 4; 5; 6 ] = [ 4; 5; 6 ];;
concatene [ 1; 2; 3 ] [] = [ 1; 2; 3 ];;
concatene [] [] = []
(**********************************************************************)
(* 1.2 *)
(**
applatit prend une liste de liste et renvoie la liste resultant de la concatenation des sous-listes
@param ll la liste contenant les liste à concatener
@return la liste contenant les élements des sous-listes
*)
let rec applatit (ll : int list list) : int list =
match ll with [] -> [] | l :: ll' -> concatene l (applatit ll')
;;
(* Quelques tests *)
applatit [ [ 1; 2 ]; [ 3; 4; 5 ]; []; [ 6 ] ] = [ 1; 2; 3; 4; 5; 6 ];;
applatit [ [ 1 ] ] = [ 1 ];;
applatit [ [] ] = [];;
applatit [] = []
(**
applatit2 prend une liste de liste et renvoie la liste resultant de la concatenation des sous-listes.
applatit2 n'utilise pas concatene
@param ll la liste contenant les liste à concatener
@return la liste contenant les élements des sous-listes
*)
let rec applatit2 (ll : int list list) : int list =
match ll with
| [] -> []
| [] :: ll' -> applatit2 ll'
| (n :: l') :: ll' -> n :: applatit2 (l' :: ll')
;;
(* Quelques tests *)
applatit2 [ [ 1; 2 ]; [ 3; 4; 5 ]; []; [ 6 ] ] = [ 1; 2; 3; 4; 5; 6 ];;
applatit2 [ [ 1 ] ] = [ 1 ];;
applatit2 [ [] ] = [];;
applatit2 [] = []
(**********************************************************************)
(**********************************************************************)
(* 2 *)
(**
Renverse une liste.
@param l la liste à renverse.
@return la liste renversée
*)
let renverse =
(*
Cette fonction concatène son premier argument renversé à son second
@param lr la liste à renverser
@param lc la liste à laquelle on veut concaténer des éléments
@return la concaténation de lr renversée et de lc
*)
let rec renverse_ajoute (lr : int list) (lc : int list) : int list =
match lr with
| [] -> lc
| n :: lr' ->
(* on ajoute n en tête de la liste lc et on fait l'appel récursif
qui ajoutera les autres éléments devant *)
renverse_ajoute lr' (n :: lc)
in
fun (l : int list) -> renverse_ajoute l []
(**********************************************************************)
(**********************************************************************)
(* 3.1 *)
(* Insersion dans une liste triée *)
(**
Insère un entier dans une liste triée.
@param n la valeur à insérer
@param l la liste dans laquelle on fait l'insertion
@return une nouvelle liste contenant les élément de l et n et elle-même
*)
let rec insertion (n : int) (l : int list) : int list =
match l with
| [] -> [ n ] (* on aurait pu écrire [n] *)
| k :: l' ->
if k >= n (* on veut placer n en tête de liste *) then n :: l
(* attention c'est n :: l et pas n :: l'
on aurait aussi pu écrire n :: k :: l' *)
else k :: insertion n l'
;;
(* Quelques tests*)
insertion 3 [ 1; 2; 4; 5 ] = [ 1; 2; 3; 4; 5 ];;
insertion 3 [ 1; 2; 3; 4; 5 ] = [ 1; 2; 3; 3; 4; 5 ];;
insertion 3 [ 4; 5 ] = [ 3; 4; 5 ];;
insertion 3 [ 1; 2 ] = [ 1; 2; 3 ];;
insertion 3 [] = [ 3 ]
(**********************************************************************)
(* 3.2 *)
(**
Trie une liste en utilisant l'algorithme de tri par insertion
@param l la liste à trier
@return la liste contenant les éléments de l triés
*)
let rec tri_insertion (l : int list) : int list =
match l with
| [] -> []
| n :: l' ->
(* Ici, on insère dans le reste de la liste triée *)
insertion n (tri_insertion l')
;;
(* Quelques tests *)
tri_insertion [ 1; 4; 2; 3 ] = [ 1; 2; 3; 4 ];;
tri_insertion [ 1; 2; 3; 4 ] = [ 1; 2; 3; 4 ];;
tri_insertion [ 4; 3; 2; 1 ] = [ 1; 2; 3; 4 ];;
tri_insertion [ 1 ] = [ 1 ];;
tri_insertion [] = []
(**********************************************************************)
(**********************************************************************)
(* 4.1 *)
(**
Résultat d'une recherche
*)
type resultat =
(* une valeur a été trouvée,
on associe la donnée de cette valeur au constructeur,
elle a donc le type string*)
| Trouve of string
(* On a rien trouvé, pas de donnée associée *)
| Rien
(* 4.2 *)
(**
Cherche la valeur associée à une clé dans une liste de paires (clé,valeur).
@param cle la clé
@param la la liste d'association
@return Trouve v si la paire (cle,v) est dans la liste, Rien sinon
*)
let rec cherche (cle : int) (la : (int * string) list) : resultat =
match la with
| [] -> Rien
| (cle', v) :: la' ->
if cle' = cle (* si on a trouvé la clé *) then Trouve v
else (* on cherche dans le reste de la liste *)
cherche cle la'
;;
(* Quelques tests *)
cherche 3 [ (1, "a"); (3, "b"); (5, "c") ] = Trouve "b";;
cherche 3 [ (3, "b"); (5, "c") ] = Trouve "b";;
cherche 3 [ (1, "a"); (3, "b") ] = Trouve "b";;
cherche 3 [ (5, "b"); (1, "a") ] = Rien;;
cherche 3 [] = Rien
(**********************************************************************)
(**********************************************************************)
(**
Type représentant les opérateurs binaires.
*)
type binop = Plus | Moins | Mult | Div
(**
Type représentant les morceaux d'expression.
*)
type elt_expr = Op of binop | Cst of int
(**
Type représentant les résultats.
*)
type resultat =
| Ok of int
| ErrDivZero
| ErrExpr
(**
Évalue le résultat d'une opération binaire.
Prend l'opération en argument ainsi que deux résultats.
S'il l'un des arguments est une erreur, cette (une de ces)
erreur est renvoyée comme résultat.
@param op l'opération à effectuer
@param a1 la première valeur à passer à op
@param a2 la deuxième valeur à passer à op
@return le réultat de l'opération ou une erreur le cas échéant
*)
(* 5.1 *)
let eval_op (op : binop) (a1 : resultat) (a2 : resultat) : resultat =
match (a1, a2) with
| Ok v1, Ok v2 -> (
match op with
| Plus -> Ok (v1 + v2)
| Moins -> Ok (v1 - v2)
| Mult -> Ok (v1 * v2)
| Div -> if v2 = 0 then ErrDivZero else Ok (v1 / v2))
| Ok _, err -> err
| err, _ -> err
;;
(* Quelques tests *)
eval_op Plus (Ok 1) (Ok 2) = Ok 3;;
eval_op Moins (Ok 2) (Ok 3) = Ok (-1);;
eval_op Div (Ok 3) (Ok 0) = ErrDivZero;;
eval_op Div (Ok 5) (Ok 2) = Ok 2;;
eval_op Mult (Ok 7) (Ok 6) = Ok 42;;
eval_op Plus ErrDivZero (Ok 5) = ErrDivZero;;
eval_op Mult ErrExpr (Ok 4) = ErrExpr;;
eval_op Div (Ok 5) ErrExpr = ErrExpr;;
eval_op Moins (Ok 4) ErrDivZero = ErrDivZero;;
eval_op Plus ErrDivZero ErrExpr = ErrDivZero
(**********************************************************************)
(* 5.2 *)
(**
Évalue une suite d'expressions et donne la liste des résultats
@param la liste d'éléments d'expression formant la liste suite d'expressions
@return le résultat de l'évaluation des expressions
*)
let rec eval_expr (le : elt_expr list) : resultat list =
match le with
| [] -> []
| Cst n :: le' -> Ok n :: eval_expr le'
| Op op :: le' -> (
match eval_expr le' with
| r1 :: r2 :: rl -> eval_op op r1 r2 :: rl
| _ -> [ ErrExpr ])
;;
(* Quelques tests *)
eval_expr [ Cst 3 ] = [ Ok 3 ];;
eval_expr [ Op Mult; Cst 3; Cst 2 ] = [ Ok 6 ];;
eval_expr [ Op Div; Cst 7; Cst 3 ] = [ Ok 2 ];;
eval_expr [ Op Moins; Cst 3; Cst 1 ] = [ Ok 2 ];;
eval_expr [ Op Plus; Op Div; Cst 7; Cst 3 ] = [ ErrExpr ];;
eval_expr [ Op Plus; Op Div; Cst 7; Cst 3; Cst 5 ] = [ Ok 7 ];;
eval_expr [ Op Plus; Op Div; Cst 7; Op Moins; Cst 2; Cst 2; Cst 3 ]
= [ ErrDivZero ]
;;
eval_expr [ Op Plus; Cst 3; Cst 5; Op Moins; Cst 2; Cst 7 ] = [ Ok 8; Ok (-5) ]
(* LIFPF TP3 Récursion sur les arbres *)
(**********************************************************************)
(* Arbres binaires *)
(**********************************************************************)
(**
Arbres binaires avec feuilles vides,
le contenu est seulement sur les noeuds.
*)
type arbre_bin = ABVide | ABNoeud of int * arbre_bin * arbre_bin
(* Quelques arbres pour tester *)
let ab1 = ABNoeud (3, ABVide, ABVide)
let ab2 = ABNoeud (5, ab1, ABVide)
let ab3 = ABNoeud (7, ABVide, ab1)
let ab4 = ABNoeud (11, ab2, ab3)
(**
Taille d'un arbre binaire.
@param a l'arbre dont on veut calculer la taille
@return le nombre d'int stockés dans l'arbre
*)
let rec taille_ab (a : arbre_bin) : int =
match a with
| ABVide -> 0
| ABNoeud (_, fg, fd) -> 1 + taille_ab fg + taille_ab fd
;;
assert (taille_ab ab1 = 1);;
assert (taille_ab ab2 = 2);;
assert (taille_ab ab3 = 2);;
assert (taille_ab ab4 = 5)
(**
Fait le produit des éléments d'un arbre binaire.
Un arbre vide aura 1 comme produit
@param a l'arbre dont on veut faire le produit des éléments
@return le produit (1 pour l'arbre vide)
*)
let rec produit_ab (a : arbre_bin) : int =
match a with
| ABVide -> 1
| ABNoeud (n, fg, fd) -> n * produit_ab fg * produit_ab fd
;;
assert (produit_ab ABVide = 1);;
assert (produit_ab ab1 = 3);;
assert (produit_ab ab2 = 15);;
assert (produit_ab ab3 = 21);;
assert (produit_ab ab4 = 3465)
(**
Construit la liste des éléments d'un arbre binaire. Les éléments sont produits
dans l'ordre de parcours infix, c'est à dire les éléments du fils gauche puis
l'élément du noeud puis ceux fils droit.
@param a l'arbre binaire dont on veut les éléments
@return la liste des éléments de l'arbre
*)
let rec list_of_arbre_bin (a : arbre_bin) : int list =
match a with
| ABVide -> []
| ABNoeud (n, fg, fd) ->
(* On peut aussi utiliser la fonction concatene du TP2 *)
list_of_arbre_bin fg @ (n :: list_of_arbre_bin fd)
;;
assert (list_of_arbre_bin ABVide = []);;
assert (list_of_arbre_bin ab1 = [ 3 ]);;
assert (list_of_arbre_bin ab2 = [ 3; 5 ]);;
assert (list_of_arbre_bin ab3 = [ 7; 3 ]);;
assert (list_of_arbre_bin ab4 = [ 3; 5; 11; 7; 3 ])
(**
Insère un élément dans un arbre binaire de recherche.
@param e l'élément à insérer
@param a l'arbre dans lequel on fait l'insersion
@return un arbre binaire de recherche contenant les éléments de a ainsi que e
*)
let rec insere_arbre_bin_recherche (e : int) (a : arbre_bin) : arbre_bin =
match a with
| ABVide -> ABNoeud (e, ABVide, ABVide)
| ABNoeud (x, fg, fd) ->
if e < x then ABNoeud (x, insere_arbre_bin_recherche e fg, fd)
else ABNoeud (x, fg, insere_arbre_bin_recherche e fd)
let abr1 = insere_arbre_bin_recherche 7 ABVide
let abr2 = insere_arbre_bin_recherche 5 abr1
let abr3 = insere_arbre_bin_recherche 3 abr2
let abr4 = insere_arbre_bin_recherche 11 abr3;;
assert (list_of_arbre_bin abr1 = [ 7 ]);;
assert (list_of_arbre_bin abr2 = [ 5; 7 ]);;
assert (list_of_arbre_bin abr3 = [ 3; 5; 7 ]);;
assert (list_of_arbre_bin abr4 = [ 3; 5; 7; 11 ])
(**
Créée un arbre binaire de recherche contenant les éléments de la liste
@param l la liste contenant les éléments à placer dans l'arbre à créer
@return l'arbre binaire de recherche contenant les éléments de l
*)
let rec arbre_bin_rech_of_int_list (l : int list) : arbre_bin =
match l with
| [] -> ABVide
| x :: l' -> insere_arbre_bin_recherche x (arbre_bin_rech_of_int_list l')
;;
assert (list_of_arbre_bin (arbre_bin_rech_of_int_list []) = []);;
assert (list_of_arbre_bin (arbre_bin_rech_of_int_list [ 3 ]) = [ 3 ]);;
assert (list_of_arbre_bin (arbre_bin_rech_of_int_list [ 3; 5 ]) = [ 3; 5 ]);;
assert (list_of_arbre_bin (arbre_bin_rech_of_int_list [ 5; 3 ]) = [ 3; 5 ]);;
assert (
list_of_arbre_bin (arbre_bin_rech_of_int_list [ 1; 2; 3; 4 ]) = [ 1; 2; 3; 4 ])
;;
assert (
list_of_arbre_bin (arbre_bin_rech_of_int_list [ 4; 2; 1; 3 ]) = [ 1; 2; 3; 4 ])
(**
Trie une list d'int en utilisant un arbre binaire de recherche
@param l la liste à trier
@return la liste triée
*)
let tri_abr (l : int list) : int list =
list_of_arbre_bin (arbre_bin_rech_of_int_list l)
;;
assert (tri_abr [] = []);;
assert (tri_abr [ 3 ] = [ 3 ]);;
assert (tri_abr [ 3; 5 ] = [ 3; 5 ]);;
assert (tri_abr [ 5; 3 ] = [ 3; 5 ]);;
assert (tri_abr [ 1; 2; 3; 4 ] = [ 1; 2; 3; 4 ]);;
assert (tri_abr [ 4; 2; 1; 3 ] = [ 1; 2; 3; 4 ])
(**********************************************************************)
(* Expressions arithmétiques et variables *)
(**********************************************************************)
(**
Type représentant les opérateurs binaires.
*)
type binop = Plus | Moins | Mult | Div
(**
Expressions arithmétiques + let
*)
type expr =
| Cst of int
| Binop of binop * expr * expr
| Var of string
| Let of string * expr * expr
(** affichage **)
let rec string_of_expr (e : expr) : string =
let string_of_binop (b : binop) =
match b with Plus -> " + " | Moins -> " - " | Mult -> " * " | Div -> " / "
in
match e with
| Cst n -> string_of_int n
| Binop (op, l, r) ->
"(" ^ string_of_expr l ^ string_of_binop op ^ string_of_expr r ^ ")"
| Var x -> x
| Let (v, e1, e2) ->
"(let " ^ v ^ " = " ^ string_of_expr e1 ^ " in " ^ string_of_expr e2 ^ ")"
(** Erreurs *)
type eval_err = DivZero | VarNonDef
(** Résultats: int ou erreur *)
type resultat = Ok of int | Err of eval_err
(**
Évalue une expression dans un environnement
*)
let rec eval_expr (e : expr) (env : (string * int) list) : resultat =
match e with
| Cst n -> Ok n
| Binop (op, e1, e2) -> (
match (eval_expr e1 env, eval_expr e2 env) with
| Ok v1, Ok v2 -> (
match op with
| Plus -> Ok (v1 + v2)
| Moins -> Ok (v1 - v2)
| Mult -> Ok (v1 * v2)
| Div -> if v2 = 0 then Err DivZero else Ok (v1 / v2))
| Err e, _ -> Err e
| _, Err e -> Err e)
| Var x -> (
match List.assoc_opt x env with None -> Err VarNonDef | Some n -> Ok n)
| Let (x, e1, e2) -> (
match eval_expr e1 env with
| Ok v1 -> eval_expr e2 ((x, v1) :: env)
| Err e -> Err e)
let e1 = Cst 3
let e2 = Binop (Plus, Cst 3, Cst 5)
let e3 = Binop (Div, Cst 3, Cst 0)
let e4 = Let ("a", Cst 3, Binop (Moins, Var "a", Cst 3))
let e5 = Let ("a", Cst 3, Var "b");;
assert (eval_expr e1 [] = Ok 3);;
assert (eval_expr e2 [] = Ok 8);;
assert (eval_expr e3 [] = Err DivZero);;
assert (eval_expr e4 [] = Ok 0);;
assert (eval_expr e5 [] = Err VarNonDef);;
assert (eval_expr e5 [ ("b", 11) ] = Ok 11)
(**********************************************************************)
(**********************************************************************)
(* Arbres n-aires *)
(**********************************************************************)
(** Arbre avec un nombre quelconque de fils *)
type 'a arbre_n = Feuille of 'a | Noeud of 'a arbre_n list
let a1 = Feuille 1
let a2 = Feuille 2
let a3 = Noeud []
let a4 = Noeud [ a1 ]
let a5 = Noeud [ a1; a2 ]
let a6 = Noeud [ a1; a2; a3; a4; a5 ]
let a_vide_1 = Noeud []
let a_vide_2 = Noeud [ Noeud [] ]
(* Le type de ces arbres vide est 'a arbre_n. En effet, comme ces arbres ne
contiennent pas d'éléments ils peuvent être vus comme des arbresavec ce qu'on
veut comme type d'élément. *)
let rec hauteur (a : 'a arbre_n) : int =
match a with Feuille _ -> 1 | Noeud l -> hauteur_foret l + 1
and hauteur_foret (l : 'arbre_n list) : int =
match l with
| [] -> 0
| a :: l' -> max (hauteur a) (hauteur_foret l')
;;
assert (hauteur a1 = 1);;
assert (hauteur a3 = 1);;
assert (hauteur a4 = 2);;
assert (hauteur a5 = 2);;
assert (hauteur a6 = 3)
(**
Renvoie une liste contenant tous les éléments de l'arbre
@param a: l'arbre
@return la liste de ses éléments
*)
let list_of_arbre (a : 'a arbre_n) : 'a list =
let rec list_of_arbre_aux (a : 'a arbre_n) (acc : 'a list) : 'a list
=
match a with
| Feuille x -> x :: acc
| Noeud f -> list_of_foret f acc
and list_of_foret (f : 'a arbre_n list) (acc : 'a list) : 'a list =
match f with
| [] -> acc
| a :: f' -> list_of_arbre_aux a (list_of_foret f' acc)
in
list_of_arbre_aux a []
;;
assert (list_of_arbre a1 = [ 1 ]);;
assert (list_of_arbre a4 = [ 1 ]);;
assert (list_of_arbre a5 = [ 1; 2 ]);;
assert (list_of_arbre a6 = [ 1; 2; 1; 1; 2 ])
(**
[minimum arbre] est le plus grand élément de arbre si arbre en contient au moins 1.
@param arbre l'arbre dans lequel on cherche le minimum
@return None si l'arbre ne contient pas d'élément, ou sinon Some m avec m le plus grand élément de l'arbre
*)
let rec minimum (arbre : 'a arbre_n) : 'a option =
match arbre with
| Feuille x -> Some x
| Noeud la -> minimum_foret la
(**
[minimum_foret l] donne l'élément minimal que l'on peut trouver dans une forêt
@param l la forêt
@return None si la forêt ne contient pas d'élément ou sinon Some m où m est le plus grand élément de la forêt
*)
and minimum_foret (la : 'a arbre_n list) : 'a option =
match la with
| [] -> None
| a :: la' -> (
match minimum_foret la' with
| None -> minimum a
| Some n -> (
match minimum a with
| None -> Some n
| Some n' -> Some (min n n')))
;;
assert (minimum a1 = Some 1);;
assert (minimum a3 = None);;
assert (minimum a4 = Some 1);;
assert (minimum a5 = Some 1);;
assert (minimum a6 = Some 1)
(**
[reduce f a] renvoie:
- None si a ne contient aucun élément
- Some x si a contient un seul élément x
- Some x où x est le résultat de la combinaison des éléments de a en utilisant f
@param f la fonction de combinaison des éléments
@param a l'arbre qui contient les éléments
*)
let rec reduce (f : 'a -> 'a -> 'a) (arbre : 'a arbre_n) : 'a option =
match arbre with Feuille x -> Some x | Noeud l -> reduce_foret f l
(**
[reduce_foret f l] renvoie:
- None si l (en tant que forêt) ne contient aucun élément
- Some x si l contient un seul élément x
- Some x où x est le résultat de la combinaison des éléments de l en utilisant f
@param f la fonction de combinaison des éléments
@param la forêt qui contient les éléments
*)
and reduce_foret (f : 'a -> 'a -> 'a) (la : 'a arbre_n list) :
'a option =
match la with
| [] -> None
| a :: la' -> (
match reduce_foret f la' with
| None -> reduce f a
| Some n -> (
match reduce f a with
| None -> Some n
| Some n' -> Some (f n n')))
;;
assert (reduce min a1 = Some 1);;
assert (reduce min a3 = None);;
assert (reduce min a4 = Some 1);;
assert (reduce min a5 = Some 1);;
assert (reduce min a6 = Some 1);;
assert (reduce ( + ) a1 = Some 1);;
assert (reduce ( + ) a3 = None);;
assert (reduce ( + ) a5 = Some 3);;
assert (reduce ( + ) a6 = Some 7)
(**********************************************************************)
(* Files (FIFO) implémentées avec deux listes *)
(**********************************************************************)
type 'a fifo = Fifo of ('a list * 'a list)
(** File vide *)
let empty_fifo : 'a fifo = Fifo ([], [])
(**
[push_fifo e f] Ajoute e dans f
@param e l'élément a ajouter
@param f la fifo dans laquelle on veut ajouter l'élément
@return la fifo contenant les éléments de f puis e
*)
let push_fifo (e : 'a) (f : 'a fifo) : 'a fifo =
match f with Fifo (l1, l2) -> Fifo (e :: l1, l2)
let f1 = push_fifo 1 empty_fifo
let f2 = push_fifo 2 f1
let f3 = push_fifo 3 f2
let f4 = push_fifo 4 f3;;
assert (f1 = Fifo ([ 1 ], []));;
assert (f2 = Fifo ([ 2; 1 ], []));;
assert (f3 = Fifo ([ 3; 2; 1 ], []));;
assert (f4 = Fifo ([ 4; 3; 2; 1 ], []))
(**
[push_list_fifo l f] ajoute les éléments de l à la file f
@param l les éléments à ajouter
@param f la file dans laquelle ajouter les éléments
@return la file contenant les éléments de f puis les éléments de l
*)
let rec push_list_fifo (l : 'a list) (f : 'a fifo) : 'a fifo =
match l with
| [] -> f
| x :: l' -> push_list_fifo l' (push_fifo x f)
;;
assert (push_list_fifo [] empty_fifo = empty_fifo);;
assert (push_list_fifo [] f2 = f2);;
assert (push_list_fifo [ 1 ] empty_fifo = f1);;
assert (push_list_fifo [ 3; 4 ] f2 = f4);;
assert (push_list_fifo [ 1; 2; 3; 4 ] empty_fifo = f4)
(**
Fonction utilitaire transférant tous les éléments de la liste de gauche dans
celle de droite en en renversant l'ordre au passage.
*)
let rec transfert_fifo (f : 'a fifo) : 'a fifo =
match f with
| Fifo ([], l2) -> Fifo ([], l2)
| Fifo (x :: l1, l2) -> transfert_fifo (Fifo (l1, x :: l2))
;;
assert (transfert_fifo f4 = Fifo ([], [ 1; 2; 3; 4 ]));;
assert (transfert_fifo f1 = Fifo ([], [ 1 ]))
(**
[pop_fifo f] renvoie le premier élément de f s'il y en a un, ainsi que la file contenant le reste des éléments de f.
@param f la file dans laquelle on veut prendre un élément
@return (f',r) où
- f' est la file contenant les éléments de f sauf le premier
- r est Some x si f a pour premier élément x ou bien None si f est vide
*)
let pop_fifo (f : 'a fifo) : 'a fifo * 'a option =
match f with
| Fifo (l1, []) -> (
match transfert_fifo f with
| Fifo (_, []) -> (Fifo ([], []), None)
| Fifo (_, x :: l2') -> (Fifo ([], l2'), Some x))
| Fifo (l1, x :: l2') -> (Fifo (l1, l2'), Some x)
;;
assert (pop_fifo empty_fifo = (empty_fifo, None));;
assert (pop_fifo f1 = (empty_fifo, Some 1));;
assert (pop_fifo f2 = (Fifo ([], [ 2 ]), Some 1));;
assert (pop_fifo (fst (pop_fifo f2)) = (empty_fifo, Some 2))
(**
Renvoie tous les éléments de la file dans l'ordre de celle-ci
@param f la file dont on veut les éléments
@return une liste contenant les éléments de f dans l'ordre
*)
let rec pop_all_fifo (f : 'a fifo) : 'a list =
match pop_fifo f with
| _, None -> []
| f', Some x -> x :: pop_all_fifo f'
;;
assert (pop_all_fifo empty_fifo = []);;
assert (pop_all_fifo f1 = [ 1 ]);;
assert (pop_all_fifo f4 = [ 1; 2; 3; 4 ]);;
(* Un test mélangeant les opérations de push et de pop de la file *)
assert (
pop_all_fifo (push_list_fifo [ 3; 4 ] (fst (pop_fifo f2)))
= [ 2; 3; 4 ])
(**********************************************************************)
(* 1 Arbre n-aires: recodage *)
(**********************************************************************)
(**********************************************************************)
(* 1.1. Recodage de quelques fonctions de base avec la bibliothèque
standard OCaml *)
type 'a arbre_n = Feuille of 'a | Noeud of 'a arbre_n list
(**
Calcule la hauteur d'un arbre.
@param a l'arbre dont on veut calculer la hauteur
@return la hauteur de l'arbre
*)
let rec hauteur_arbre (a : 'a arbre_n) : int =
match a with
| Feuille _ -> 1
| Noeud foret ->
let hauteurs = List.map hauteur_arbre foret in
let h_max = List.fold_left max 0 hauteurs in
h_max + 1
(**
Extrait les éléments d'un arbre dans une liste
@param l'arbre dont on veut les éléments
@return la liste des éléments de l'arbre obtenue par un parcours en profondeur.
*)
let list_of_arbre : 'a arbre_n -> 'a list =
(*
Ajoute les éléments de l'arbre à la liste.
@param a l'arbre dont on veut extraires les éléments
@param acc la liste à laquelle on veut ajouter les éléments.
*)
let rec list_of_arbre_aux (a : 'a arbre_n) (acc : 'a list) :
'a list =
match a with
| Feuille x -> x :: acc
| Noeud foret ->
List.fold_left
(fun acc2 fils -> list_of_arbre_aux fils acc2)
acc foret
in
fun a -> list_of_arbre_aux a []
(**********************************************************************)
(* 1.2. Gestion d'option, fold et minimum *)
(**
[lift_option_2 f] choisi son deuxième argument si son premier argument est None.
Sinon utilise f pour produire une valeur avec ses deux arguments.
@param f la fonction utilisée pour combiner les arguments
@param x une option
@param y la valeur à combiner à la valeur de x ou à prendre si x est None
@return Some de la combinaison des valeurs de x et y, ou bien y si x est None
*)
let lift_option_2 (f : 'a -> 'a -> 'a) :
'a option -> 'a -> 'a option =
fun x y ->
match x with None -> Some y | Some x' -> Some (f x' y)
(**
aggrège une valeur en utilisant un accumulateur et une fonction appelée pour
mettre à jour l'accumulateur en fonction de l'élément de l'arbre rencontrée.
Appelle la fonction en utilisant les un après les autres tous les éléments de
l'accumulateur.
@param f la fonction de mise à jour de l'accumulateur
@param init la valeur de départ de l'accumulateur
@param a l'arbre à parcourir
@return la valeur de l'accumulateur résultant des mises à jour
successives par les appels à f sur les éléments de a.
*)
let rec fold_left_arbre (f : 'b -> 'a -> 'b) (init : 'b)
(a : 'a arbre_n) : 'b =
match a with
| Feuille x -> f init x
| Noeud foret -> List.fold_left (fold_left_arbre f) init foret
(* Pour le dernier cas on aurait pu écrire
List.fold_left (fun acc fils -> fold_left_arbre f acc fils) init foret
mais c'est plus long
*)
(**
Aggrège une valeur en utilisant une fonction de combinaison de valeurs
@param f la fonction de combinaison de valeurs
@param a l'arbre dont on veut combiner les valeurs
@return Some du résultat de la combinaisons des valeurs de a par f,
ou None si a n'a pas d'élément
*)
let reduce (f : 'a -> 'a -> 'a) (a : 'a arbre_n) : 'a option =
fold_left_arbre (lift_option_2 f) None a
(**
Extrait les éléments d'un arbre dans une liste
@param l'arbre dont on veut les éléments
@return la liste des éléments de l'arbre obtenue par un parcours en profondeur.
*)
let list_of_arbre' : 'a arbre_n -> 'a list =
fold_left_arbre (fun l e -> e :: l) []
File deleted
(**********************************************************************)
(* Calculatrice programmable *)
(**********************************************************************)
(**
Type représentant les opérateurs binaires.
*)
type binop = Plus | Moins | Mult | Div
(**
Expressions arithmétiques + let + fun + app
*)
type expr =
| Cst of int
| Binop of binop * expr * expr
| Var of string
| Let of string * expr * expr
| Fun of string * expr
| App of expr * expr
(** affichage **)
let rec string_of_expr (e : expr) : string =
let string_of_binop (b : binop) =
match b with
| Plus -> " + "
| Moins -> " - "
| Mult -> " * "
| Div -> " / "
in
match e with
| Cst n -> string_of_int n
| Binop (op, l, r) ->
"(" ^ string_of_expr l ^ string_of_binop op
^ string_of_expr r ^ ")"
| Var x -> x
| Let (v, e1, e2) ->
"(let " ^ v ^ " = " ^ string_of_expr e1 ^ " in "
^ string_of_expr e2 ^ ")"
| Fun (x, e) -> "(fun " ^ x ^ " -> " ^ string_of_expr e ^ ")"
| App (e1, e2) ->
"(" ^ string_of_expr e1 ^ " " ^ string_of_expr e2 ^ ")"
(** Erreurs *)
type eval_err = DivZero | VarNonDef | PasUneFonction | PasUnInt
(** Résultats: int ou erreur ou fermeture*)
type resultat =
| Int of int
| Err of eval_err
| Fermeture of string * expr * (string * resultat) list
(**
Évalue une expression dans un environnement
*)
let rec eval_expr (e : expr) (env : (string * resultat) list) :
resultat =
match e with
| Cst n -> Int n
| Binop (op, e1, e2) -> (
match (eval_expr e1 env, eval_expr e2 env) with
| Int v1, Int v2 -> (
match op with
| Plus -> Int (v1 + v2)
| Moins -> Int (v1 - v2)
| Mult -> Int (v1 * v2)
| Div -> if v2 = 0 then Err DivZero else Int (v1 / v2))
| Fermeture _, _ -> Err PasUnInt
| _, Fermeture _ -> Err PasUnInt
| Err e, _ -> Err e
| _, Err e -> Err e)
| Var x -> (
match List.assoc_opt x env with
| None -> Err VarNonDef
| Some r -> r)
| Let (x, e1, e2) -> (
match eval_expr e1 env with
| Err e -> Err e
| v1 -> eval_expr e2 ((x, v1) :: env))
| Fun (x, e) -> Fermeture (x, e, env)
| App (f, a) -> (
match eval_expr f env with
| Err e -> Err e
| Int _ -> Err PasUneFonction
| Fermeture (x, e, env_f) -> (
match eval_expr a env with
| Err e -> Err e
| v -> eval_expr e ((x, v) :: env_f)))
let e1 = Cst 3
let e2 = Binop (Plus, Cst 3, Cst 5)
let e3 = Binop (Div, Cst 3, Cst 0)
let e4 = Let ("a", Cst 3, Binop (Moins, Var "a", Cst 3))
let e5 = Let ("a", Cst 3, Var "b")
let e6 =
Let
( "f1",
Fun ("x", Binop (Plus, Var "x", Cst 3)),
Let
( "f2",
Fun ("y", Binop (Mult, App (Var "f1", Var "y"), Cst 5)),
App (Var "f2", Cst 2) ) )
let e7 =
Let
( "f",
Fun
( "x",
Fun
( "y",
Binop (Mult, Var "x", Binop (Plus, Var "y", Cst 3))
) ),
App (App (Var "f", Cst 5), Cst 3) )
;;
assert (eval_expr e1 [] = Int 3);;
assert (eval_expr e2 [] = Int 8);;
assert (eval_expr e3 [] = Err DivZero);;
assert (eval_expr e4 [] = Int 0);;
assert (eval_expr e5 [] = Err VarNonDef);;
assert (eval_expr e5 [ ("b", Int 11) ] = Int 11);;
assert (eval_expr e6 [] = Int 25);;
assert (eval_expr e7 [] = Int 30)
(**********************************************************************)
(**********************************************************************)
(* Calculatrice programmable, pour aller plus loin *)
(**********************************************************************)
(**
Expressions arithmétiques + let + fun + app
*)
type expr =
| Cst of int
| Var of string
| Let of string * expr * expr
| Fun of string * expr
| App of expr * expr
(** affichage **)
let rec string_of_expr (e : expr) : string =
match e with
| Cst n -> string_of_int n
| Var x -> x
| Let (v, e1, e2) ->
"(let " ^ v ^ " = " ^ string_of_expr e1 ^ " in "
^ string_of_expr e2 ^ ")"
| Fun (x, e) -> "(fun " ^ x ^ " -> " ^ string_of_expr e ^ ")"
| App (e1, e2) ->
"(" ^ string_of_expr e1 ^ " " ^ string_of_expr e2 ^ ")"
(** Erreurs *)
type eval_err = DivZero | VarNonDef | PasUneFonction | PasUnInt
(** Résultats: int ou erreur ou fermeture*)
type resultat =
| Int of int
| Err of eval_err
| Fermeture of string * expr * (string * resultat) list
| Native of (resultat -> resultat)
(**
Évalue une expression dans un environnement
*)
let rec eval_expr (e : expr) (env : (string * resultat) list) :
resultat =
match e with
| Cst n -> Int n
| Var x -> (
match List.assoc_opt x env with
| None -> Err VarNonDef
| Some r -> r)
| Let (x, e1, e2) -> (
match eval_expr e1 env with
| Err e -> Err e
| v1 -> eval_expr e2 ((x, v1) :: env))
| Fun (x, e) -> Fermeture (x, e, env)
| App (f, a) -> (
match eval_expr f env with
| Err e -> Err e
| Int _ -> Err PasUneFonction
| Fermeture (x, e, env_f) -> (
match eval_expr a env with
| Err e -> Err e
| v -> eval_expr e ((x, v) :: env_f))
| Native f -> f (eval_expr a env))
let native_binop_res (f : int -> int -> resultat) : resultat =
Native
(fun (a : resultat) ->
Native
(fun (b : resultat) ->
match (a, b) with
| Err e, _ -> Err e
| _, Err e -> Err e
| Int va, Int vb -> f va vb
| _, _ -> Err PasUnInt))
let native_binop (f : int -> int -> int) : resultat =
native_binop_res (fun a b -> Int (f a b))
let builtins =
[
("+", native_binop ( + ));
("-", native_binop ( - ));
("*", native_binop ( * ));
( "/",
native_binop_res (fun x y ->
if y = 0 then Err DivZero else Int (x / y)) );
]
let e1 = Cst 3
let e2 = App (App (Var "+", Cst 3), Cst 5)
let e3 = App (App (Var "/", Cst 3), Cst 0)
let e4 = Let ("a", Cst 3, App (App (Var "-", Var "a"), Cst 3))
let e5 = Let ("a", Cst 3, Var "b")
let e6 =
Let
( "f1",
Fun ("x", App (App (Var "+", Var "x"), Cst 3)),
Let
( "f2",
Fun
( "y",
App (App (Var "*", App (Var "f1", Var "y")), Cst 5)
),
App (Var "f2", Cst 2) ) )
let e7 =
Let
( "f",
Fun
( "x",
Fun
( "y",
App
( App (Var "*", Var "x"),
App (App (Var "+", Var "y"), Cst 3) ) ) ),
App (App (Var "f", Cst 5), Cst 3) )
;;
assert (eval_expr e1 builtins = Int 3);;
assert (eval_expr e2 builtins = Int 8);;
assert (eval_expr e3 builtins = Err DivZero);;
assert (eval_expr e4 builtins = Int 0);;
assert (eval_expr e5 builtins = Err VarNonDef);;
assert (eval_expr e5 (("b", Int 11) :: builtins) = Int 11);;
assert (eval_expr e6 builtins = Int 25);;
assert (eval_expr e7 builtins = Int 30)
(**********************************************************************)
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment