![[Télécharger]](/extension/ag_design/design/light/images/html/icon_world_link.png "Télécharger"){kind=icon}
Passer en vue forum
Version d'archive
- Ce site est en lecture seule. Certains liens dynamiques peuvent ne pas fonctionner correctement.
Jouons avec du (vrai) code OCaml
1 commentaires
Ce billet a pour but de tester la coloration du code OCaml sur Aerie's Guard. En grandeur nature.
Certains d'entre vous ont expérimenté avec Haskell .
Certains d'entre vous ont expérimenté avec OCaml ou suivent des cours OCaml .
Peut-être que certains d'entre vous suivent des cours Caml-Light .
Quoiqu'il en soit, avant de me lancer dans le grand bain, j'essaye d'abord le petit bassin.
En OCaml un module peut être un module-fonction , c'est-à-dire qu'il peut être paramétrable par un (ou plusieurs) module-argument (s) d'un certain module-type (s).
Donc la 1ière chose que nous allons faire c'est déclarer un module-type .
Il s'agit du type des ensembles totalement ordonnés implémentés comme des arbres binaires de recherche .
Mais on ne précise pas s'ils sont mutables ou immutables (on le fera plus tard).
(* Totally ordered Sets *)
module type OrderedSet =
sig
type 'a set =
'a non_empty_set option
and 'a non_empty_set =
private
{mutable left: 'a set; item: 'a; mutable right: 'a set}
val empty : 'a set
val make : 'a set -> 'a -> 'a set -> 'a non_empty_set
val with_left : 'a non_empty_set -> 'a set -> 'a non_empty_set
val with_right : 'a non_empty_set -> 'a set -> 'a non_empty_set
end
La 2ième chose c'est que l'on veut 2 modules-valeurs de ce module-type .
On veut un module-argument pour les ensembles totalement ordonnés immutables .
Spoiler (Sélectionnez le texte dans le cadre pointillé pour le faire apparaître)
(* Immutable totally ordered Sets *)
module PureOrderedSet : OrderedSet =
struct
type 'a set =
'a non_empty_set option
and 'a non_empty_set =
{mutable left: 'a set; item: 'a; mutable right: 'a set}
let empty = None
let make l x r = {left=l; item=x; right=r}
let with_left s l = {s with left=l}
let with_right s r = {s with right=r}
end
On veut un module-argument pour les ensembles totalement ordonnés mutables .
Spoiler (Sélectionnez le texte dans le cadre pointillé pour le faire apparaître)
(* Mutable totally ordered Sets *)
module MutableOrderedSet : OrderedSet =
struct
type 'a set =
'a non_empty_set option
and 'a non_empty_set =
{mutable left: 'a set; item: 'a; mutable right: 'a set}
let empty = None
let make l x r = {left=l; item=x; right=r}
let with_left s l = s.left <- l; s
let with_right s r = s.right <- r; s
end
La 3ième chose c'est que la récursion c'est compliqué. On peut se tromper et si on se trompe il faudra déboguer, soit parce que le calcul ne termine pas ou bien parce que la valeur retournée est incorrecte.
Déboguer c'est du temps perdu pour rien .
Alors on va régler le problème une fois pour toutes en encapsulant la récursion sur les ensembles totalement ordonnés .
Spoiler (Sélectionnez le texte dans le cadre pointillé pour le faire apparaître)
(* Recursing upon totally ordered Sets *)
module OrderedSetRecursors(S:OrderedSet) =
struct
include S
(* strict catamorphism *)
type ('a,'b) fold =
<empty: 'a; node: 'a -> 'b -> 'a -> 'a>
let rec fold s (case:('a,'b) fold) =
match s with
| None -> case#empty
| Some n -> case#node (fold n.left case) n.item (fold n.right case)
(* lazy catamorphism *)
type ('a,'b) cata =
<empty: 'a; node: (unit -> 'a) -> 'b -> (unit -> 'a) -> 'a>
let rec cata s (case:('a,'b) cata) () =
match s with
| None -> case#empty
| Some n -> case#node (cata n.left case) n.item (cata n.right case)
(* strict paramorphism *)
type ('a,'b) recu =
<empty: 'b;
node: 'a non_empty_set -> 'b -> 'b -> 'b>
let rec recu s (case:('a,'b) recu) =
match s with
| None ->
case#empty
| Some n ->
case#node n (recu n.left case) (recu n.right case)
(* lazy paramorphism *)
type ('a,'b) para =
<empty: 'b;
node: 'a non_empty_set -> (unit -> 'b) -> (unit -> 'b) -> 'b>
let rec para s (case:('a,'b) para) () =
match s with
| None ->
case#empty
| Some n ->
case#node n (para n.left case) (para n.right case)
let para_non_empty n (case:('a,'b) para) () =
case#node n (para n.left case) (para n.right case)
end
On veut une dernière chose :
Pouvoir créer des ensembles totalement ordonnés mutables ou immutables
Les équiper de toutes les opérations ensemblistes, à savoir e ∈ S, A ∪ B, A ∩ B, A ⊃ B, A - B, A = B, ∀ e ∈ S on a P(e), {e ∈ S, P(e)}
Que toutes ces opérations soient performantes, qu'elles utilisent le fait que les ensembles sont ordonnées. Par exemple il est hors de question d'ajouter les éléments de A un-par-un à l'ensemble B pour calculer A ∪ B.
Spoiler (Sélectionnez le texte dans le cadre pointillé pour le faire apparaître)
(* Build a concrete totally ordered Set *)
module MakeSet(S:OrderedSet)
=
struct
(* general *)
include
OrderedSetRecursors(S)
let cardinal s =
fold s (
object
method empty = 0
method node l _ r = l + 1 + r
end )
let for_all cond s =
cata s (
object
method empty = true
method node l y r =
l() && cond y && r()
end ) ()
(* binary tree set *)
let member x s =
cata s (
object
method empty = false
method node l y r =
if x < y then l()
else if x > y then r()
else true
end ) ()
let insert x s =
para s (
object
method empty =
make None x None
method node n l r =
let y = n.item in
if x < y then with_left n (Some (l()))
else if x > y then with_left n (Some (r()))
else n
end ) ()
let minimum s =
para_non_empty s (
object
method empty = s
method node n l r =
if n.left = empty then n
else l()
end ) ()
let remove_minimum s =
para_non_empty s (
object
method empty = empty
method node n l r =
if n.left = empty then n.right
else Some (with_left n (l()))
end ) ()
(* concatenation of sa + sb where max(sa) < min(sb) *)
let concat sa sb =
if sa = empty then sb else
match sb with
| None -> sa
| Some n ->
let m = minimum n
and r = remove_minimum n
in Some (with_right (with_left m sa) r)
let remove x s =
para s (
object
method empty =
empty
method node n l r =
let y = n.item in
if x < y then Some (with_left n (l()))
else if x > y then Some (with_right n (r()))
else concat n.left n.right
end ) ()
let split x s =
para s (
object
method empty =
empty,false,empty
method node n l r =
let y = n.item in
if x < y then
let a,b,c = l() in
a,b,Some (with_left n c)
else if x > y then
let a,b,c = r() in
Some (with_right n a),b,c
else
n.left,true,n.right
end ) ()
let filter cond s =
recu s (
object
method empty =
empty
method node n l r =
if cond n.item then
Some (with_right (with_left n l) r)
else
concat l r
end )
let union sa sb =
recu sa (
object
method empty s =
s
method node m l r s =
Some (
match s with
| None -> m
| Some n ->
let a,b,c = split m.item s in
with_right (with_left m (l a)) (r c))
end ) sb
let intersection sa sb =
recu sa (
object
method empty s =
empty
method node m l r s =
match s with
| None -> empty
| Some n ->
let a,b,c = split m.item s in
if b then
Some (with_right (with_left m (l a)) (r c))
else
concat (l a) (r c)
end ) sb
(* sa - sb *)
let difference sa sb =
recu sa (
object
method empty s =
empty
method node m l r s =
match s with
| None ->
Some m
| Some n ->
let a,b,c = split m.item s in
if b then
concat (l a) (r c)
else
Some (with_right (with_left m (l a)) (r c))
end ) sb
let subset sa sb =
recu sa (
object
method empty s =
true
method node m l r s =
match s with
| None -> false
| Some n ->
if m.item < n.item then
(l n.left) && member m.item n.left && (r s)
else if m.item > n.item then
(l s) && member m.item n.right && (r n.right)
else
(l n.left) && (r n.right)
end ) sb
let equal sa sb =
subset sa sb && subset sb sa
end
Désormais, pour créer un module ensemble totalement ordonné immutable :
module PSet = MakeSet(PureOrderedSet)
Désormais, pour créer un module ensemble totalement ordonné mutable :
module MSet = MakeSet(MutableOrderedSet)
Les fonctions ont toutes le type approprié. Par exemple il est impossible de retirer un élément d'un ensemble vide parce que la fonction remove est du type :
val remove : 'a -> 'a non_empty_set -> 'a set
Réciproquement, lorsque l'on insère un élément dans un ensemble quelconque, on obtient forcément un ensemble non vide :
val insert : 'a -> 'a set -> 'a non_empty_set
Les derniers commentaires
J'ai du mal à comprendre le fond de cet article, mais je constate que la coloration syntaxique marche bien, c'est déjà ça 
|
|
Ertaï il y a plus de 11 ans