API tools faq
paste
Advertisement
Guest User

Untitled

a guest
Mar 10th, 2017
80
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
OCaml 16.52 KB | None | 0 0
raw download clone embed print report
  1. (* -------------------------------------------------------------------------- *)
  2. (* ----------------------- TP1 - IFT-3000 - Hiver 2017 ---------------------- *)
  3. (* -------------------------------------------------------------------------- *)
  4. (* Matricule étudiant: .........                                              *)
  5. (* -------------------------------------------------------------------------- *)
  6. (* -- PRINCIPALE FICHIER DU TP: FONCTIONS À COMPLÉTER ----------------------- *)
  7. (* -------------------------------------------------------------------------- *)
  8.  
  9. #use "utiles.ml";;
  10.  
  11. (******************************************************************************)
  12. (* Spécification                                                              *)
  13. (******************************************************************************)
  14.  
  15. module type D_ARBO = sig
  16.   type arbre
  17.  
  18.   val creer_branche : char list -> arbre
  19.   val parcours : arbre -> char list -> char list * char list * arbre
  20.   val nbr_arcs : arbre -> int
  21.   val creer : string list -> arbre
  22.   val de_fichier : string -> arbre
  23.   val ajouter : arbre -> string -> unit
  24.   val liste_mots : arbre -> string list
  25.   val liste_par_prefixe : arbre -> string -> string list
  26.   val membre : arbre -> string -> bool
  27.   val supprimer : arbre -> string -> unit
  28.   val supprimer_mots : arbre -> string list -> unit
  29.   val sous_arbre : ?h_limit:int option -> arbre -> string -> arbre
  30.   val show : arbre -> unit
  31.   val ratio : arbre -> float
  32.   val print_ratio : arbre -> unit
  33.  
  34.   end;;
  35.  
  36. (******************************************************************************)
  37. (* Implantation                                                               *)
  38. (******************************************************************************)
  39. module D_Arbo (* : D_ARBO *) = struct
  40.  
  41.   open List
  42.   open Utiles
  43.  
  44.   exception Non_Implante of string
  45.  
  46.   (* Principale structure de données utilisée par le dictionnaire arbo.       *)
  47.   (****************************************************************************)
  48.   type arbre =  Noeud of bool ref  * (char * arbre) list ref
  49.  
  50.  (* Fonction retournant un arbre vide                                         *)
  51.   let vide () = Noeud(ref false,ref[])
  52.  
  53.   (* -- À IMPLANTER/COMPLÈTER (10 PTS) -------------------------------------- *)
  54.   (* @Fonction      : creer_branche : char list -> arbre                      *)
  55.   (* @Description   : retourne un arbre correspondant à  une branche formant
  56.                       un mots                                                 *)
  57.   (* @Precondition  : aucune                                                  *)
  58.   (* @Postcondition : l'arbre retourné correspond à  une branche et est correct*)
  59.   let rec creer_branche lc =
  60.  try
  61.     let firstChar = List.hd lc in
  62.       if (List.length lc = 1) then
  63.         Noeud(ref false, ref [(firstChar, Noeud(ref true, ref[]))])
  64.       else
  65.         Noeud(ref false, ref [(firstChar, creer_branche(List.tl lc))])
  66.  with
  67.   _ -> Noeud(ref true, ref[]);;
  68.  
  69.  
  70.   (* -- À IMPLANTER/COMPLÈTER (10 PTS) -------------------------------------- *)
  71.   (* @Fonction      : parcours : arbre -> char list ->
  72.                                  char list * char list * arbre                *)
  73.   (* @Description   : Parcourt un arbre à  partir d'une liste de caractères.
  74.                       Retourne: 1- la liste des caractères que l'on n'a pu
  75.                       rejoindre (n'existent pas dans le chemin tracée par la
  76.                       liste de caractères donnée en entrée. 2- la liste de
  77.                       caractères parcourus (visités). 3- et le sous-arbre
  78.                       atteint à  la fin du parcours.                           *)
  79.   (* @Precondition  : aucune                                                  *)
  80.   (* @Postcondition : l'arbre retourné est un sous-arbre de l'arbre en entrée *)
  81.   let parcours a lc =
  82.    let rec aux a lc visited = match a,lc with
  83.       | Noeud(_,_), [] -> ([], [], a)
  84.       | Noeud(_,tl), head::tail ->
  85.         try
  86.           let node = List.assoc head !tl in
  87.             let(cantjoin, joined, subtree) = aux node tail (visited@[head]) in (cantjoin, head::joined, subtree)
  88.         with
  89.           Not_found -> (lc, [], a)
  90. in aux a lc [];;
  91.  
  92.   (* ------------------------------------------------------------------------ *)
  93.   (* @Fonction      : nbr_arcs : arbre -> int                                 *)
  94.   (* @Description   : Retourne nombre arcs dans arbre                         *)
  95.   (* @Precondition  : aucune                                                  *)
  96.   (* @Postcondition : le nombre retourné est correct                          *)
  97.   let rec nbr_arcs a = match a with
  98.     | Noeud(_,l) when l = ref [] -> 0
  99.     | Noeud(_,l) ->
  100.       (length !l) + fold_right (+) (map (fun (_,a) -> nbr_arcs a) !l) 0
  101.  
  102.  
  103.   (* ------------------------------------------------------------------------ *)
  104.   (* @Fonction      : haut_limite : arbre -> int -> arbre                     *)
  105.   (* @Description   : À partir d'un arbre, retourne la partir de l'arbre
  106.                       limitée à  une hauteur n                                 *)
  107.   (* @Precondition  : n >= 0                                                  *)
  108.   (* @Postcondition : l'arbre retourné est un sous-arbre de celui en argument *)
  109.   let rec haut_limite a n = match a,n with
  110.     | Noeud(b,_),_ when n <= 0 -> Noeud(b,ref [])
  111.     | Noeud(_,l),_ when l = ref [] -> a
  112.     | Noeud(b,l),_ -> Noeud(b,ref (map (fun (c,a) -> c,haut_limite a (n-1)) !l))
  113.  
  114.  
  115.   (* -- À IMPLANTER/COMPLÉTER (10 PTS) -------------------------------------- *)
  116.   (* @Fonction      : ajouter : arbre -> string -> unit                       *)
  117.   (* @Description   : Ajoute un mot à  l'arbre                                 *)
  118.   (* @Precondition  : aucune                                                  *)
  119.   (* @Postcondition : effet de bord: l'arbre passé en argument comprend
  120.                       désormais le mot                                        *)
  121.   let ajouter a mot =
  122.     let rec aux a' listchar found =
  123.       (if ((implode found) = mot) then (let Noeud(b,_) = a' in b := true) else
  124.         (let Noeud(_,arr2) = (creer_branche listchar) in let Noeud(b,arr) = a' in arr := !arr@(!arr2);
  125.           if (List.length !arr) <= 0 then b := true))
  126.     in
  127.       let pastrouve, trouve, sousarbre = parcours a (explode mot) in aux sousarbre pastrouve trouve;;
  128.  
  129.  
  130.   (* -- À IMPLANTER/COMPLÉTER (15 PTS) -------------------------------------- *)
  131.   (* @Fonction      : liste_mots : arbre -> string list                       *)
  132.   (* @Description   : Retourne la liste des mots de l'arbre                   *)
  133.   (* @Precondition  : aucune                                                  *)
  134.   (* @Postcondition : la liste retournée est correcte                         *)
  135.   let liste_mots a =
  136.   let sort_and_remove_duplicates l =
  137.     let sl = List.sort compare l in
  138.     let rec go l acc =
  139.      match l with
  140.       | [] -> List.rev acc
  141.       | [x] -> List.rev (x::acc)
  142.       | (x1::x2::xs) ->
  143.         if x1 = x2
  144.         then go (x2::xs) acc
  145.         else go (x2::xs) (x1::acc)
  146.    in go sl []
  147.  in
  148.    let rec fold l =
  149.      let rec iter head_list =
  150.       match head_list with
  151.        | [] -> []
  152.        | head::tail -> head@(iter tail)
  153.      in
  154.       match l with
  155.        | [] -> []
  156.        | head::tail -> (iter head)@(fold tail)
  157.    in
  158.    let rec aux a' acc liste =
  159.     match a' with
  160.       | Noeud(b,tl) when tl = ref [] -> if !b then !liste@[(implode acc)] else !liste
  161.       | Noeud(b,tl) -> sort_and_remove_duplicates (fold [(List.map (fun (c,a2) -> (aux a2 (acc@[c]) (if !b then (ref (!liste@[(implode acc)])) else liste))) !tl)])
  162. in aux a [] (ref []);;
  163.  
  164.  
  165.   (* -- À IMPLANTER/COMPLÉTER (8 PTS) --------------------------------------- *)
  166.   (* @Fonction      : creer : string list -> arbre                            *)
  167.   (* @Description   : Crée un arbre à  partir d'une liste de mots              *)
  168.   (* @Precondition  : aucune                                                  *)
  169.   (* @Postcondition : l'arbre retourné est correct                            *)
  170.  
  171. let creer l =
  172.  let rec ajoutermot a lm =
  173.   match a, lm with
  174.    | Noeud(_,_), [] -> a
  175.    | Noeud(b,_), [""] -> b := true; a
  176.    | Noeud(b,tl), head::tail ->
  177.    if (List.length !tl) > 0 then ((ajouter a head) ; (ajoutermot a tail)) else (ajoutermot (creer_branche (explode head)) tail)
  178.  in
  179.   ajoutermot (vide ()) l;;
  180.  
  181.  
  182.  
  183.   (* ------------------------------------------------------------------------ *)
  184.   (* @Fonction      : de_fichier : string -> arbre                            *)
  185.   (* @Description   : Crée un arbre à  partir des mots présents dans un fichier*)
  186.   (* @Precondition  : Chaque ligne du fichier comprend un mot                 *)
  187.   (* @Postcondition : l'arbre retourné est correct                            *)
  188.   let de_fichier f =
  189.     creer (read_lines_file f)
  190.  
  191.  
  192.   (* -- À IMPLANTER/COMPLÉTER (7 PTS) --------------------------------------- *)
  193.   (* @Fonction      : membre: arbre -> string -> bool                         *)
  194.   (* @Description   : Teste si un mot est dans un arbre                       *)
  195.   (* @Precondition  : aucune                                                  *)
  196.   (* @Postcondition : vrai si mot existe; faux, sinon                         *)
  197.   let membre a mot =
  198.     let notfound, found, tree = parcours a (explode mot) in
  199.       if ((implode found) = mot) && (let Noeud(b,_) = tree in !b = true) then
  200.         true
  201.       else
  202.         false
  203.  
  204.  
  205.   (* -- À IMPLANTER/COMPLÉTER (15 PTS) -------------------------------------- *)
  206.   (* @Fonction      : supprimer : arbre -> string -> unit                     *)
  207.   (* @Description   : Supprime un mot d'un arbre                              *)
  208.   (* @Precondition  : Mot existe das l'arbre; autrement exception Not_found   *)
  209.   (* @Postcondition : effet de bord: l'arbre passé en argument ne comprend
  210.                       désormais plus le mot                                   *)
  211.    let supprimer a mot =
  212.       let get_node a letters = let (_, _, node) = parcours a letters in node in
  213.       let remove_last lst = if (List.length lst) > 0 then List.rev (List.tl (List.rev lst)) else [] in
  214.       let rm_char_in_list li le = List.filter (fun (c, _) -> (c <> le)) li in
  215.       let rec aux root letters i =
  216.         if (List.length (explode mot)) = (i+1) then (let Noeud(b, _) = get_node root letters in b := false; aux root (remove_last letters) (i-1))
  217.       else if i > 0 then (let Noeud(b, arr) = get_node root letters in let len = (List.length !arr) in arr := (rm_char_in_list !arr (List.nth letters (i-1))); if !b = false && len <= 1 then (aux root (remove_last letters) (i-1)))
  218.     in if not (membre a mot) then raise Not_found else aux a (explode mot) ((List.length (explode mot)) - 1)
  219.  
  220.  
  221.   (* -- À IMPLANTER/COMPLÉTER (5 PTS) --------------------------------------- *)
  222.   (* @Fonction      : supprimer_mots : arbre -> string list -> unit           *)
  223.   (* @Description   : Supprime une liste de mots d'un arbre                   *)
  224.   (* @Precondition  : Mots existent das l'arbre; autrement exception Not_found*)
  225.   (* @Postcondition : effet de bord: l'arbre passé en argument ne comprend
  226.                       désormais plus les mots                                 *)
  227.   let supprimer_mots a l =
  228.    let rec aux a' l' =
  229.     match l' with
  230.      | [] -> ()
  231.      | head::tail -> supprimer a' head; aux a' tail
  232.    in aux a l;;
  233.  
  234.  
  235.   (* -- À IMPLANTER/COMPLÉTER (10 PTS) -------------------------------------- *)
  236.   (* @Fonction      : sous_arbre: ?h_limit:int option -> arbre -> string ->
  237.                                   arbre                                       *)
  238.   (* @Description   : À partir d'un mot, retourne le sous-arbre qui suit les
  239.                       caractères formant ce mot; si h_limit=None, retourne
  240.                       tout le sous-arbre; sinon, Some(n), retourne le sous-
  241.                       arbre limité à  une hauteur = n                          *)
  242.   (* @Precondition  : Mot existe dans l'arbre; autrement exception Not_found  *)
  243.   (* @Postcondition : l'arbre retourné est un sous-arbre de celui en argument *)
  244.   let sous_arbre ?(h_limit = None) a mot =
  245.     let (a', _, _) = (parcours a (explode mot)) in
  246.       if not (a' = []) then raise Not_found
  247.       else let notfound, found, sousarbre = parcours a (explode mot) in
  248.             if h_limit = None then sousarbre else haut_limite sousarbre (match h_limit with Some c -> c | None -> 0);;
  249.  
  250.  
  251.  
  252.   (* -- À IMPLANTER/COMPLÉTER (10 PTS) -------------------------------------- *)
  253.   (* @Fonction      : liste_par_prefixe: arbre -> string -> string list       *)
  254.   (* @Description   : Étant donné un arbre, et un prefixe (mot), retourne tous
  255.                       les mots de l'arbre ayant ce prefixe; la liste des mots
  256.                       retournée est triée, par ordre croissant, selon la taille
  257.                       de ces mots                                             *)
  258.   (* @Precondition  : aucune                                                  *)
  259.   (* @Postcondition : la liste retournée est correcte                         *)
  260.   let liste_par_prefixe a m =
  261.    match m with
  262.     | "" -> liste_mots a
  263.     | e -> let notfound, found, tree = parcours a (explode m) in if not (notfound = []) then raise Not_found else List.map (fun x -> m ^ x) (liste_mots tree);;
  264.  
  265.  
  266.   (* ------------------------------------------------------------------------ *)
  267.   (* @Fonction      : show: arbre -> unit                                     *)
  268.   (* @Description   : Affiche un arbre sous forme graphique, grâce à  l'outil
  269.                       dotty (http://www.graphviz.org/)                        *)
  270.   (* @Precondition  : aucune                                                  *)
  271.   (* @Postcondition : aucune                                                  *)
  272.   let show (Noeud(b,_) as a) =
  273.     let format x y c =
  274.       Printf.sprintf "%s -- %s [ label = \"%c\" ];\n" x y c in
  275.     let init n s =
  276.       let s' = ref "" in
  277.       for i = 1 to n do s' := !s' ^ s ^ (string_of_int i) ^ "; " done;
  278.       !s'
  279.         in
  280.         let node b cf ct = match !b with
  281.           | true -> "t" ^ (string_of_int !ct)
  282.           | false -> "f" ^ (string_of_int !cf)
  283.         in
  284.         let rec show_tree (Noeud(b,l)) cf ct =
  285.           let node_b = node b cf ct in
  286.       fold_left (fun (s,cf,ct) (c,(Noeud(b',_) as a)) ->
  287.         let _ = if !b' then incr ct else incr cf in
  288.         let node_b' = node b' cf ct in
  289.         let (s',cf',ct') = show_tree a cf ct in
  290.           (s ^ (format node_b node_b' c) ^ s', cf', ct')
  291.       ) ("",cf,ct) !l
  292.         in
  293.         let (cf,ct) = if !b then (ref 0,ref 1) else (ref 1,ref 0) in
  294.         let (body,cf,ct) = show_tree a cf ct in
  295.         let graphviz =
  296.           "graph G {\n" ^
  297.           "node [shape=none]; {node [label=\"false\"] " ^
  298.       (init !cf "f") ^
  299.             "}\nnode [shape=none]; {node [label=\"true\" fontcolor=blue] " ^
  300.       (init !ct "t") ^
  301.       "}\n\n" ^ body ^ "\n}\n"
  302.         in
  303.         let file = "graph.gv" in
  304.         let fout = open_out file in
  305.           output_string fout graphviz;
  306.           close_out fout;
  307.           ignore (Sys.command ("xdot " ^ file));
  308.           ()
  309.  
  310.  
  311.   (* ------------------------------------------------------------------------ *)
  312.   (* @Fonction      : ratio: arbre -> float                                   *)
  313.   (* @Description   : retourne le ratio entre le nombre total de caractères
  314.                       présent dans tous les mots du dictionnaire et le nombre
  315.                       de caractères (arcs) effectivement présent dans l'arbre *)
  316.   (* @Precondition  : aucune                                                  *)
  317.   (* @Postcondition : aucune                                                  *)
  318.   let ratio a =
  319.     let n1 = fold_right (fun x acc -> (String.length x) + acc) (liste_mots a) 0
  320.     and n2 = nbr_arcs a in
  321.     abs_float((1.0 -. (float(n2) /. float(n1)))) *. 100.0
  322.  
  323.  
  324.   (* ------------------------------------------------------------------------ *)
  325.   (* @Fonction      : print_ratio: arbre -> unit                              *)
  326.   (* @Description   : Affiche le ratio de (gain en) stockage                  *)
  327.   (* @Precondition  : aucune                                                  *)
  328.   (* @Postcondition : aucune                                                  *)
  329.   let print_ratio a =
  330.     print_endline
  331.       ("Ratio de stockage : " ^ string_of_int(int_of_float(ratio a)) ^ "%")
  332.  
  333. end;;
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
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
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!