SHARE
TWEET

Untitled

a guest May 19th, 2019 60 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. module type TypeOrdonne =
  2.   sig
  3.     type t
  4.     val compare : t -> t -> int
  5.   end
  6.  
  7. module EntierOrdreNaturel:TypeOrdonne with type t = int =
  8.   struct
  9.     type t = int
  10.     let compare = (-)
  11.   end
  12.    
  13. module OrdreLexicographique:TypeOrdonne with type t = string =
  14.   struct
  15.     type t = string
  16.     let compare x y = String.compare x y
  17.   end
  18.  
  19. module type Ensemble =
  20.   sig
  21.     type element
  22.     type abc
  23.     val vide : abc
  24.     val estVide : abc -> bool
  25.     val estDans : element -> abc -> bool
  26.     (* val inserer : element -> abc -> abc     *)
  27.     (* val supprimer : element -> abc -> abc   *)
  28.     (* val supprimerMax : abc -> element * abc *)
  29.     (* val union : abc -> abc -> abc           *)
  30.     (* val intersection : abc -> abc -> abc                         *)
  31.     (* val difference : abc -> abc -> abc                           *)
  32.     (* val differenceSym : abc -> abc -> abc                        *)
  33.     (* val ensemble_vers_liste : abc -> element list                *)
  34.     (* val liste_vers_ensemble  : element list -> abc               *)
  35.     (* val est_inclus_dans : abc -> abc -> bool                     *)
  36.     (* val est_egal : abc -> abc -> bool                            *)
  37.     (* val appliquer_sur : (element -> 'a -> 'a) -> abc -> 'a -> 'a *)
  38.     (* val card : abc -> int                                        *)
  39.     (* val est_verifie_par_tous : (element -> bool) -> abc -> bool  *)
  40.     (* val est_verifie_par_un : (element -> bool) -> abc -> bool    *)
  41.     (* val filtrer_selon : (element -> bool) -> abc -> abc          *)
  42.     (* val separer_selon : (element -> bool) -> abc -> abc * abc    *)
  43.     (* val separer_selon_pivot : element -> abc -> abc * bool * abc *)
  44.   end
  45.  
  46. module type CoupleHashMap =
  47.     sig
  48.         type clef
  49.         val compClef : clef -> clef -> int
  50.         type valeur
  51.         val val_comp : valeur -> valeur -> int
  52.         val hash : valeur -> clef
  53.     end;;
  54.  
  55. module Couple : CoupleHashMap with type clef = int and type valeur = string =
  56.     struct
  57.         type clef = int
  58.         type valeur = string
  59.      
  60.         let compClef = (-)
  61.  
  62.         let val_comp x y =
  63.             match x with
  64.                 | x when x < y -> (-1)
  65.                 | x when x > y -> 1
  66.                 | x when x = y -> 0
  67.                 | _ -> failwith "erreur val_comp"
  68.  
  69.         let hash = String.length
  70.     end
  71.        
  72. module MakeEnsemble (O : CoupleHashMap) : Ensemble  with type element = O.valeur =
  73.   struct
  74.    
  75.         type element = O.valeur
  76.        
  77.         type couleur =
  78.             | Rouge
  79.             | Noir
  80.             | DoubleNoir ;;
  81.  
  82.         type abcS =
  83.             | VideS
  84.             | VideNoirS
  85.             | NoeudS of (element * couleur * abcS * abcS);;
  86.  
  87.     type abc =
  88.             | Vide
  89.             | VideNoir
  90.             | Noeud of ((O.clef * abcS) * couleur * abc * abc);;
  91.        
  92.         let compC x y =
  93.             O.compClef (O.hash x) (fst y);;
  94.  
  95.         let ($=$) x y = (compC x y = 0);;
  96.     let ($<$) x y = (compC x y < 0);;
  97.     let ($>$) x y = (compC x y > 0);;
  98.    
  99.         let compS x y =
  100.             O.val_comp x y;;
  101.            
  102.  
  103.     (* Noeud(x, _, ag, ad) {x} U ad U ag *)
  104.     let vide = Vide
  105.        
  106.         let estVide = function
  107.         | Vide -> true
  108.         | _ -> false;;
  109.  
  110.    
  111.     (* Un arbre est soit vide soit un noeud. Vide -> true est correct car si l'arbre est vide alors l'ensemble est vide.*)
  112.     (* Si c'est un noeud alors il contient au moins x donc renvoie false *)
  113.     let rec estDansS a x =
  114.       match a with
  115.         | VideS -> false
  116.         | NoeudS(s, _, _, _) when compS s x == 0 -> true
  117.         | NoeudS(s, _, ag, _) when compS s x == 0 -> estDansS ag x
  118.         | NoeudS(s, _, _, ad) when compS s x == 0 -> estDansS ad x
  119.         | _ -> failwith("Erreur compS");;
  120.        
  121.         let rec estDans x = function
  122.         | Vide -> false
  123.       | Noeud(r, _, ag, _) when x $<$ r -> estDans x ag
  124.       | Noeud(r, _, _, ad) when x $<$ r -> estDans x ad
  125.       | Noeud(r, _, _, _) when x $=$ r  -> estDansS (snd r) x
  126.             | _ -> failwith("Erreur estDans");;
  127.    
  128.         let rec pasDeuxRougesDeSuiteS a =
  129.         match a with
  130.         | VideS -> true
  131.         | NoeudS(_,Rouge,NoeudS(_,Rouge,_,_),_) -> false
  132.         | NoeudS(_,Rouge,_,NoeudS(_,Rouge,_,_)) -> false
  133.             | NoeudS(_,Rouge,sg,sd) -> pasDeuxRougesDeSuiteS sg && pasDeuxRougesDeSuiteS sd
  134.             | NoeudS(_,Noir,sg,sd) -> pasDeuxRougesDeSuiteS sg && pasDeuxRougesDeSuiteS sd;;
  135.  
  136.     let racineRouge = function
  137.         | Noeud(_, Rouge, _, _) -> true
  138.         | _ -> false;;
  139.        
  140.     let aUnFilsRouge = function
  141.       | Noeud(_, _, ag, ad) -> racineRouge ag || racineRouge ad
  142.       | _ -> false;;
  143.      
  144.     let rec pasDeuxRougesDeSuite = function
  145.       | Noeud(_, Rouge, _, _) as ab when aUnFilsRouge ab -> false
  146.       | Noeud(x, _, ag, ad) -> pasDeuxRougesDeSuite ag && pasDeuxRougesDeSuite ad && pasDeuxRougesDeSuiteS (snd x)
  147.       | _ -> true;;
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top