Ensembles et Relations binaires avec CAML

(* ---------------------------------------------------------------------------------------
---------------------------- E N S E M B L E S ----------------------------------------
 -------------------------------------------------------------------------------------  *)
 
 
 
type 'a ens =
  | Vide 
  | Ens of ('a * 'a ens);;
 
 
 
exception Ensemble_vide;;
 
 
let rec ensemble_of_liste liste =
  match liste with
  |[] -> Vide
  |t::q -> Ens(t,ensemble_of_liste q);;
 
(* attention au symbole = ne fonctionne que pour des types simples... *)
let rec appartient el ensemble =
  match ensemble with
    |Vide -> false
    |Ens(t,q) ->
      if t = el then true
      else appartient el q;;
 
 
let ajoute el ens =
  if appartient el ens then ens
  else Ens(el,ens);;
 
let (@+) el ens = ajoute el ens;;
 
let rec union ens1 ens2 =
  match ens1 with
    |Vide -> ens2
    |Ens(t,q) -> t @+ (union q ens2) ;;
 
let (@|) ens1 ens2 = union ens1 ens2;;
 
 
 
let rec cardinal = function
    | Vide -> 0
    | Ens(t,q) -> if appartient t q then cardinal q else 1 + cardinal q;;
 
let rec applique f ens =
  match ens with
    |Vide -> Vide
    |Ens(t,q) -> Ens(f(t),applique f q);;
 
 
 
let rec parties  = function
  |Vide ->  Ens(Vide,Vide)
  |Ens(t,q) ->  (parties q) @| (applique (ajoute t) (parties q));;
 
 
 
 
let rec liste_el = function
    |Vide -> []
    |Ens(a,e) -> a::liste_el(e);; 
 
let rec ens_of_list = function
  |[] -> Vide
  |t::q -> t @+ (ens_of_list q);;
 
let rec retire el ens  =
  match ens with
    |Vide -> Vide
    |Ens(t,q) ->
      if t = el then q
      else Ens(t, retire el q);;
 
let rec selec pred ens =
  match ens with
    |Vide -> Vide
    |Ens(t,q) ->
      if pred t then Ens(t,selec pred q)
      else selec pred q;;
 
 
 
let rec parties_taille_n ens n =
  selec (fun x -> cardinal x = n) (parties ens);; 
 
 
 
let rec existe pred ens =
  match ens with
    |Vide -> false
    |Ens(t,q) ->
      if pred t then true
      else existe pred q;;
 
let rec pour_tout pred ens =
  match ens with
    |Vide -> true
    |Ens(t,q) ->
      if pred t then pour_tout pred q
      else false;;
 
let positif nb  =
  nb >= 0;;
 
 
let ensemble_1 = Ens(-1,Ens(1,Ens(2,Ens(3,Vide))));;
 
pour_tout positif ensemble_1;;  
 
 
let partition pred ens  = 
  let  rec temp pred ens e1 e2 =
  match ens with
    |Vide -> (e1,e2)
    |Ens(t,q) ->
      if pred t then temp pred q (Ens(t,e1)) e2
      else temp pred q e1 (Ens(t,e2))
  in temp pred ens Vide Vide;;
 
 
let trouve_tout pred ens  = 
  let  rec remplit pred ens panier =
  match ens with
    |Vide -> panier
    |Ens(t,q) ->
      if pred t then remplit pred q (ajoute t panier) 
      else remplit pred q panier
  in remplit pred ens Vide ;;
 
 
 
 
 
let projection rang couple =
  match couple with
    |(a,b) -> if rang = 0 then a else b;;
 
let p0 (a,b) = a;;
 
let p1 (a,b) = b;;
 
let rec couples el ens =
  match ens with
    |Vide -> Vide
    |Ens(t,q) -> Ens((el,t),couples el q);;
 
 
let rec produit_cart ens1 ens2 =
  match ens1 with
    |Vide -> Vide
    |Ens(t,q) -> union (couples t ens2) (produit_cart q ens2);;
 
 
let rec inter ens1 ens2 =
  match ens1 with
    |Vide -> Vide
    |Ens(t,q) ->
      if appartient t ens2 then Ens(t,inter q ens2)
      else inter q ens2;;
 
 
let rec complement ens univers =
  match univers with
    |Vide -> Vide
    |Ens(t,q) ->
      if appartient t ens then complement ens q
      else Ens(t,complement ens q );;
 
let rec difference ens1 ens2 =
    match ens1 with
      |Vide -> Vide
      |Ens(t,q) ->
        if appartient t ens2 then difference q ens2
        else Ens(t,difference q ens2);;
 
 
let est_inclus ens1 ens2 =
  if inter ens1 ens2 = ens1 then true
  else false;;
 
let est_egal ens1 ens2 =
  (est_inclus ens1 ens2) && (est_inclus ens2 ens1);;
 
 
let max2 a b =
  if a >= b then a else b;;
 
let rec max ens =
  match ens with
    |Vide -> raise Ensemble_vide
    |Ens(t,Vide) -> t
    |Ens(t,q) -> max2 t (max q);;
 
exception Cle_inconnue;;
 
let rec assoc cle ens =
  match ens with
    |Vide -> raise Cle_inconnue
    |Ens(t,q) ->
      if fst t = cle then snd t
      else assoc cle q;;
 
let rec ens_assoc cle ens =
  match ens with
    |Vide -> Vide
    |Ens(t,q) ->
      if fst t = cle then Ens(snd t,ens_assoc cle q)
      else ens_assoc cle q;;
 
(*
----------------------------------------------------------------------------------------------
-------------- R E L A T I O N S -------------------------------------------------------------
----------------------------------------------------------------------------------------------
*)
 
(*-- Crée des relations avec le type ens
   --*)
 
type ('a,'b) relation =
  Rel of ('a * 'b ens)  ens ;;
 
let r =  Rel
   (Ens
      ((1, Ens ('a', Ens ('b', Vide))),
       Ens((2, Ens ('c', Vide)),
           Ens((3, Ens ('b', Vide)),
               Ens((4, Vide),
                   Ens ((5, Ens ('b', Vide)),
                        Vide))))));;
 
 
let s = Rel
  (Ens
     (('a',Ens(1,Vide)),
      Ens(('b',Ens(1,Ens(2,Vide))),
          Ens(('b',Ens(1,Ens(2,Vide))),
              Ens(('c',Ens(2,Vide)),
                  Ens(('d',Vide),
                      Ens(('e',Ens(2,Ens(4,Vide))),
                          Vide))))))
                );;
 
r;;
 
s;;
 
 
 
(* écriture d'une relation à partir d'une liste de couples (som,liste d'images) *)
 
 
let rec relation liste =
  match liste with
  |[] -> Rel(Vide)
  |tete::queue -> rel_union (Rel(Ens((fst tete,ensemble_of_liste (snd tete)),Vide))) (relation queue);;
 
let r = relation ([
                (1,['a';'b']);
                (2,['c']);
                (3,['b']);
                (4,[]);
                (5,['b'])
                ]);;
 
 
let s = relation ([
                ('a',[1]);
                ('b',[1;2]);
                ('c',[2]);
                ('d',[]);
                ('e',[2;4])
                ]);;
 
 
 
(* Lecture d'une relation sous forme d'une liste *)
 
let rec liste_of_ensemble = function
  |Vide -> []
  |Ens(t,q) -> t::(liste_of_ensemble q);;
 
 
let rec liste_of_relation rel =
  match rel with
  |Rel(Vide) -> []
  |Rel(Ens(tete,queue)) -> (fst tete,liste_of_ensemble (snd tete))::(liste_of_relation (Rel(queue)));;
 
 
 
liste_of_relation r;;
 
 
 
 
(*-- donne le domaine de r --*)
 
let rec domaine  = function
  |Rel(Vide) -> Vide
  |Rel(Ens(el,queue)) ->
    if (snd el) = Vide
    then domaine (Rel(queue))
    else ajoute (fst el) (domaine (Rel(queue)));;
 
let rec codomaine  = function
  |Rel(Vide) -> Vide
  |Rel(Ens(el,queue)) -> union (snd el) (codomaine (Rel(queue)));;
 
 
 
(*-- l'ensemble des  images de a par r --*)
 
let rec ens_images rel a =
  match rel with
  |Rel(Vide) -> Vide
  |Rel(Ens(tete,queue)) ->
    if (fst tete) = a
    then (snd tete)
    else ens_images (Rel(queue)) a ;;
 
ens_images r 1;;
ens_images r 4;;
 
 
 
(*-- teste si un arc relie som1 à som2 dans r privilégiant l'antécédent
     mem el liste teste si el appartient à liste --*)
 
let a_image rel som1 som2  =
  appartient som2 (ens_images rel som1);;
 
(*-- variante privilégiant l'image --*)
 
let a_antecedent rel som2 som1 =
  appartient som2 (ens_images rel som1);;
 
a_image r 1 'a' ;;
 
a_antecedent r 'a' 1 ;;
 
 
(* ajoute un couple à un ensemble de couples *)
 
let rec fusionne_image_ens couple ens_couples =
  match ens_couples with
  |Vide -> Ens(couple,Vide)
  |Ens(t,q) ->
    if fst t = fst couple then Ens((fst t,union (snd t) (snd couple)) ,q)
    else Ens(t,fusionne_image_ens couple q);;
  
 
(* ajoute  une image à l'ens_images d'un sommet dans relation*)
 
 
let fusionne_image_rel couple relation =
    match relation with
    |Rel(Vide) -> Rel(Ens(couple,Vide))
    |Rel(Ens(a,b)) ->   Rel(fusionne_image_ens couple (Ens(a,b)));;
 
 
 
 
(* union de deux relations *)
 
exception Relations_non_compatibles;;
 
let rec rel_union r1 r2 =
    match r1 with
    |Rel(Vide) -> r2
    |Rel(Ens(tete,queue)) -> rel_union (Rel(queue)) (fusionne_image_rel tete r2);;
 
 
(*-- crée un opérateur infixe de l'union --*)
 
let (+@) r1 r2 = rel_union r1 r2;;
 
 
 
 
 
(*-- renvoie l'ens  des images des éléments d'un ens par r --*)
 
let rec images_d_un_ens rel ens =
  match ens  with
    |Vide -> Vide
    |Ens(tete,queue) -> union (ens_images rel tete)  (images_d_un_ens rel queue);;
 
images_d_un_ens r (Ens(1,Ens(2,Ens(3,Vide)))) ;;
 
 
 
 
(*-- renvoie la  relation r suivie de s --*)
 
let  rec suivie_de r s =
  match r with
  |Rel(Vide) -> Rel(Vide)
  |Rel(Ens(tete,queue)) -> fusionne_image_rel (fst tete, images_d_un_ens s (ens_images r (fst tete)) ) (suivie_de (Rel(queue)) s);;
 
 
suivie_de r s;;
 
 
liste_of_relation (suivie_de r s);;
 
 
let (@@) r s = suivie_de r s;;
 
r @@ s;;
 
 
let rec iter_compo r  n =
  match n with
    |1 -> r
    |n -> r @@ (iter_compo r (n-1));;
 
 
 
let u = relation ([
                (1,[1]);
                (2,[1;2]);
                (3,[2]);
                (4,[]);
                (5,[2;4])
                ]);;
 
iter_compo u 5;;
 
 
(*-- fermeture transitive : renvoie r+ = Uri pour 1<=i<=card E --*)
 
let r_plus r =
  let n = cardinal (domaine r) in
  let rec loop  = function
    |1 -> r
    |k -> rel_union (iter_compo r k)  (loop (k-1))
  in loop n;;
    
r_plus u;;
 
 
 
 
 
(*-- renvoie la relation identité de même taille que r --*)
 
let id r =
  let rec loop = function
    | Vide -> Vide
    | Ens(tete,queue) -> Ens((tete,Ens(tete,Vide)),(loop queue))
  in Rel(loop (domaine r));;
 
id r;;
 
(*-- fermeture transitive et reflexive : revoie r* = id U r+ --*)
 
let r_star r =
  rel_union (id r)  (r_plus r);;
 
r_star u;;
 
 
 
 
(*-- teste si r1 est incluse dans r2 (opérateur infixe)--*)
 
let (<@) r1 r2 =
  est_inclus (produit_cart (domaine r1) (codomaine r1)) (produit_cart (domaine r2) (codomaine r2)) ;;  
 
 
 
 
(*--teste la transitivité avec r^2 incluse dans r  --*)
 
let est_transitive r =
  (r @@ r)  <@ r;;
 
 
est_transitive u;;
 
est_transitive (r_plus u);;
 
(*-- teste si une relation est reflexive  --*)
 
let est_reflexive1 r =
  let test a =  appartient a (ens_images r a) in
  pour_tout test (domaine r);;
 
(*-- ou bien si Id incluse dans r --*)
 
let est_reflexive r =
  (id r) <@ r;;
 
est_reflexive u;;
 
 
(*-- teste si une relation est symétrique :
     a appartient à la liste des images de ses images par r --*)
 
let est_symetrique r =
  let test a =  appartient a (images_d_un_ens r (ens_images r a)) in
  pour_tout test (domaine r);;
 
 
est_symetrique u;;
 
 
let v = relation ([
                (1,[1;2]);
                (2,[1;2;3;5]);
                (3,[2]);
                (4,[5]);
                (5,[2;4])
                ]);;
 
 
 
est_symetrique v;;
 
 
(*-- teste si une relation est antisymétrique  :
     aucun a n'appartient à la liste des images de ses images par r --*)
 
let est_antisymetrique r =
  let test a = not ( appartient a (images_d_un_ens r (ens_images r a))) in
  pour_tout test (domaine r);;
 
 
est_antisymetrique v;;
 
let w = relation ([
                (1,[2]);
                (2,[3;5]);
                (3,[1]);
                (4,[5]);
                (5,[1;3])
                ]);;
 
est_antisymetrique w;;
 
 
 
(*-- transposée d'une relation : on parcourt les sommets et on teste quels sont
     les antécédents de ce sommet avec trouve_tout :
     trouve_tout pred ens renvoie l'ensemble de tous les éléments de ens vérifiant pred --*)
 
let transposee1 r =
  let dom = domaine r in
  let rec recherche = function
    |Vide -> Vide 
    |Ens(tete,queue) ->
        let test_ante s = a_antecedent r tete s in
        try Ens((tete,trouve_tout test_ante dom), recherche queue)
        with Not_found -> Vide
  in Rel(recherche dom);;
 
 
let transposee r =
  let rec recherche_antecedents ens =
    match ens with
    |Vide -> Rel(Vide)
    |Ens(tete,queue) ->
      fusionne_image_rel (tete, trouve_tout (a_antecedent r tete) (domaine r)) (recherche_antecedents queue)
  in recherche_antecedents (codomaine r);;
 
transposee w;;
 
(*-- teste si une relation est une fonction : la longueur de l'ensemble des images de chaque élément du domaine  est <= 1--*)
 
let est_fonction r =
  let test s = cardinal (ens_images r s) <= 1 in
  pour_tout test (domaine r);; 
 
est_fonction w;;
 
 
let r' = relation ([
                (1,[2]);
                (2,[3]);
                (3,[1]);
                (4,[]);
                (5,[1])
                ]);;
 
 
 
est_fonction r';;
 
 
(*-- teste si une relation est totale : (transposée f)of est reflexive--*)
 
let est_totale r =
  est_reflexive (r @@ (transposee r));;
 
est_totale r';;
 
(*-- teste si une relation est une application version 1:
     tout élément a exactement une image --*)
 
let est_application1 r =
  let test s = cardinal (ens_images r s) = 1 in
  pour_tout test (domaine r);;
 
(*-- teste si une relation est une application version 2:
     c'est une fonction totale --*)
 
let est_application r =
  (est_fonction r) && (est_totale r);;
 
est_application1 r';;
 
est_application r';;
 
 
let r2 = relation ([
                (1,[2]);
                (2,[3]);
                (3,[1]);
                (4,[4]);
                (5,[1])
                ]);;
 
 
est_application r2;;
 
(*-- teste si une relation est injective : sa transposée est une fonction --*)
 
let est_injective r =
  est_fonction (transposee r);;
 
est_injective r2;;
 
 
let r3 = relation ([
                (1,[2]);
                (2,[3;5]);
                (3,[1]);
                (4,[4]);
                (5,[])
                ]);;
 
est_injective r3;;
 
(*-- teste si une relation est surjective : sa transposée est totale --*)
 
let est_surjective r =
  est_totale (transposee r);;
 
est_surjective r2;;
 
est_surjective r3;;
 
(*-- variante : ro(transposee r) est reflexive --*)
 
let est_surjective2 r =
  est_reflexive ( (transposee r) @@ r);;
 
est_surjective2 r2;;
 
est_surjective2 r3;;
 
(*-- teste si une relation est bijective : fonction surjective et bijective --*)
 
let est_bijective r =
  (est_fonction r) && (est_injective r) && (est_surjective r);;
 
est_bijective r3;;
 
 
let r4 = relation ([
                (1,[2]);
                (2,[3]);
                (3,[1]);
                (4,[5]);
                (5,[4])
                ]);;
 
est_bijective r4;;