From f243db2b84a303d6f706f3cfefa3b0c17f3f5a2e Mon Sep 17 00:00:00 2001 From: MysaaJava Date: Thu, 12 Nov 2020 17:55:02 +0100 Subject: [PATCH] =?UTF-8?q?Un=20nouveau=20programme,=20plus=20optimis?= =?UTF-8?q?=C3=A9?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- TIPE2021.ml | 370 +++++++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 351 insertions(+), 19 deletions(-) diff --git a/TIPE2021.ml b/TIPE2021.ml index fecbce3..79b2d3f 100644 --- a/TIPE2021.ml +++ b/TIPE2021.ml @@ -196,19 +196,288 @@ let filesize filename = let s = ref 0 and chan = open_in filename in (*###############################################################*) (*# WordMaker-input #*) (*###############################################################*) +(*Fréquences de sinnogrammes: https://lingua.mtsu.edu/chinese-computing/statistics/char/list.php?Which=MO*) let getMotsFromLine = Str.split (Str.regexp " ");; +(* Caractères qui, enlèvent l'espace à la fin d'un mot: ['- /\@&] exemple: chauve-souris*) +(* Caractères qui, enlèvent l'espace avant et en placent un après: [:.;,?!%] exemple: Quoi? Vraiment?*) + +let ctrlchar = Char.chr 17 ;; +let ctrl str = (String.make 1 ctrlchar)^str;; + +type schartype = SE|SB|SA|CW|SW|Maj|Min|Dig;; +let getCharType chr = let c=Char.code chr in + match c with + | c when List.mem c [39;45;47;92;64;38;95;124] -> SE (* '-/\@&_| *) + | c when List.mem c [40;91;123] -> SB (* ([{ *) + | c when List.mem c [58;59;46;44;33;63;37;36;41;93;125] -> SA (* :.;,?!%$)]} *) + | c when List.mem c [34;35;42;43;60;61;62;94;96;126;9;10] -> CW (* "#*+<=>^`~ *) (*"*) + | 32 -> SW (* *) + | c when 65 <=c && c<=90 -> Maj + | c when 97 <=c && c<=122 -> Min + | c when 48 <=c && c<=57 -> Dig + | _ -> CW;; + +exception NotALetterException;; +let getMin chr = let ct = getCharType chr in + String.make 1 ( + match ct with + | Min|Dig -> chr + | Maj -> Char.chr ((Char.code chr)+32) + | _ -> raise NotALetterException + );; + +let getMaj chr = let ct = getCharType chr in + String.make 1 ( + match ct with + | Min -> Char.chr ((Char.code chr)-32) + | _ -> chr + );; +let getMajChar chr = let ct = getCharType chr in + match ct with + | Min -> Char.chr ((Char.code chr)-32) + | _ -> chr;; + + +(*** +(* Renvoie les caractères lc et rc de types respectifs lt et rt formatés pret au rajout *) +(* La nouvelle chaine concaténée est prete pour un nouveau mot.*) +let ajoutSchar ch lt lc rt rc = + match (lt,rt) with + | SE,_ +;; +***) + +(*** +let getMotsFromLine str = let mots=ref [] + and lmot = ref "" + and maj = ref false (* Tout est-il en majuscules *) + and majed = ref false (* La premiere lettre est-elle en majuscule *) + and inMot = ref false + and spaceBefore = ref false + and spaceRequested = ref false + and lc = nullchar + and i = ref 0 in +while !i < (String.length str) do + if !spaceRequested && getCharType.str[i] <> CW + then begin + (* Si on a demandé un espace et qu'il n'y en a pas *) + (* Du coup on écris le caractère avec NOSPACE avant de continuer au traitement normal. *) + (* Le cas ou la requete est satisfaite est dans le match ci-dessous *) + (* Ben je ne suis pas un espace, alors bon ? on force avec NOSPACE*) + inMot := false; + mots := (String.make 1 !lc)::(ctrl "NOSPACE")::!mots; + lmot := ""; + spaceBefore := false; + spaceRequested := false (* Ben plus maintenant du coup *) + end; + + match getCharType str.[i] in + | SW -> (* Un espace en fait *) + if !inMot + then + inMot := false; + mots := !lmot::!mots; + lmot := ""; + spaceBefore := true + else + if !spaceRequested + then + mots := (String.make 1 !lc)::!mots; + spaceRequested := false + spaceBefore := true + inMot := false + else + ### + | SE -> + if !inMot + then + lc := str.[i]; + inMot := false + else + ### + | SA -> + if !inMot + then + lc := str.[i]; + inMot := false; + spaceRequested := true + else + ### + | SB -> + if !inMot + then + ### + else + if !spaceBefore + then + mots := (String.make 1 str.[i])::!mots; + spaceRequested := false; + spaceBefore := false; + inMot := false + else + ### + | CW -> + if !inMot + then + (* Terminer le mot prématurement et rajouter le mot du caractère CW en espérant un espace *) + inMot := false; + mots := !lmot::(ctrl "NOSPACE")::(String.make 1 str.[i])::!mots; + lmot := ""; + spaceBefore := false; + spaceRequested := true; + else + if !spaceBefore + then + (* OK pour l'instant, on prépare le caractère en espérant un espace*) + lc := str.[i]; + inMot := false; + spaceRequested := true + else + (* D'après le if préléminaire, on a spaceRequested=false *) + (* On a un CW avec une chaine qui devait etre finie *) + ### + | Maj,Min,Dig -> + if !inMot + then + spaceBefore := false; + lmot := !lmot^str.[i] + else + match !lc with + | SB | SE -> + mots := (String.make 1 !lc)::!mots; + lc := nullchar + spaceRequested := false + spaceBefore := false + inMot := true + | _ -> + ### + inMot := true + + ; + i := i+1 +done; +;;**) + +let finDeMot lst lmot majed fullmaj nospace = + match (majed,fullmaj,nospace) with + | (true,_,true) -> (ctrl "NOSPACE")::lmot::(ctrl "FULLMAJ")::lst + | (true,_,false) -> lmot::(ctrl "MAJED")::lst + | (false,true,true) -> (ctrl "NOSPACE")::lmot::(ctrl "FULLMAJ")::lst + | (false,true,false) -> lmot::(ctrl "FULLMAJ")::lst + | (false,false,true) -> (ctrl "NOSPACE")::lmot::lst + | (false,false,false) -> lmot::lst ;; + +let getMotsFromLine str = let mots=ref [] + and lmot = ref "" + and fullmaj = ref false (* Tout est-il en majuscules *) + and majed = ref false (* La premiere lettre est-elle en majuscule *) + and dansmot = ref false (* As-t-on commencé un mot ? *) in +for i=0 to (String.length str-1) do + match (getCharType str.[i]) with + | Maj -> + if !dansmot (* Si on ne commence pas un mot *) + then + if !fullmaj (* Si il n'y a que des majs jusque là *) + then + begin + majed := false; (* Il n'y a pas QUE la première lettre qui est en maj *) + lmot := (!lmot)^(getMin str.[i]) (* On rajoute la lettre *) + end + else (* La précédente est une minuscule *) + begin + (* Donc on termine le mot et on met nospace *) + mots := finDeMot !mots !lmot !majed !fullmaj true; + (* Puis on commence un nouveau mot avec une majuscule *) + lmot := getMin str.[i]; + fullmaj := true; + majed := true; + dansmot := true + end + else + begin + (* Ben on commence un mot avec une majuscule *) + lmot := getMin str.[i]; + fullmaj := true; + majed := true; + dansmot := true + end + | Min -> + if !dansmot (* Si on ne commence pas un mot *) + then + begin + fullmaj := false; (* Il n'y a pas que des majuscules *) + lmot := !lmot^(getMin str.[i]) (* On rajoute la lettre *) + end + else + begin + (* On commence un mot avec une minuscule *) + lmot := getMin str.[i]; + majed := false; + fullmaj := false; + dansmot := true + end + (* | Dig -> On verra plus tard *) + | SW -> + if !dansmot + then + begin + (* Ben on finit le mot avec un espace (normal quoi) *) + mots := finDeMot !mots !lmot !majed !fullmaj false; + dansmot := false; + lmot := "" + (* Et on passe, le caractère a été rajouté par l'absence de nospace *) + end + else + begin + (* On vire le précédent si c'était un NOSPACE, sinon, on rajoute un mot vide, sans NOSPACE*) + match (!mots) with + | e::l -> (* TODO #001 éviter de vider mots, préférer rajouter un booléen *) + if e=(ctrl "NOSPACE") then mots := l else mots := ""::!mots + | _ -> + mots := ""::!mots + end + | _ -> + if !dansmot + then + begin + (* On finit le mot, mais avec nospace, puisque le caractère est collé *) + mots := finDeMot !mots !lmot !majed !fullmaj true; + dansmot := false; + lmot := ""; + (* Puis on rajoute le caractère, avec NOSPACE *) + mots := (ctrl "NOSPACE")::(String.make 1 str.[i])::!mots (* TODO #001 *) + end + else + begin + (* Idem, mais on a pas le mot à finir *) + mots := (ctrl "NOSPACE")::(String.make 1 str.[i])::!mots (* TODO #001 *) + end + done; + mots := finDeMot !mots !lmot !majed !fullmaj false; + + !mots +;; let getMotsFromFile filename = let mots = ref [] and chan = open_in filename in try while true; do - mots := (getMotsFromLine (input_line chan)) @ !mots + mots := (ctrl "NEWLINE")::((getMotsFromLine (input_line chan)) @ !mots) done; !mots with End_of_file -> close_in chan; !mots (* A l'envers mais on s'en fiche *);; +let getBytesFromFile filename = + let bits = ref (Bytes.create 0) and chan = open_in filename in + try + while true; do + bits := Bytes.cat (Bytes.of_string (input_line chan)) !bits + done; !bits + with End_of_file -> + close_in chan; + !bits (* A l'envers mais on s'en fiche *);; @@ -253,6 +522,8 @@ let arbreToDict abre = let dumpDict dict = Dict.iter (fun k v -> printf "\"%s\" -> %s\n" k (bitstringToString v)) dict;; + +(* Renvoie une taille du dictionnaire en stockage *) let dictSize dict = Dict.fold (fun str bs v -> v+(String.length str)*8+8+(bitSize bs)+8) dict 0;; @@ -267,50 +538,111 @@ let encodeMots mots dict = (*# Décodeurs #*) (*###############################################################*) +type bstate = {mutable majed:bool ; mutable fullmaj:bool ; mutable nospace:bool};; + +let gstr state mot = + let start = if state.nospace then "" else " " in + if state.fullmaj + then (start^(String.map getMajChar mot)) + else + if state.majed + then + match (String.length mot) with + | 0 -> start + | 1 -> (start^(getMaj mot.[0])) + | n -> (start^(String.make 1 (getMajChar mot.[0]))^(String.sub mot 1 (n-1))) + else start^mot;; +let resetstate buffer = + buffer.fullmaj <- false; + buffer.majed <- false; + buffer.nospace <- false;; (* A changer pour les mots spéciaux*) let addMotToBuffer mot buffer = add_string buffer mot;add_string buffer " ";; -let rec binarintReader arbre0 abre buffer n i = +let addMotToBuffer mot buffer state = + match mot with + | l when l=(ctrl "NOSPACE") -> state.nospace <- true + | l when l=(ctrl "MAJED") -> state.majed <- true + | l when l=(ctrl "FULLMAJ") -> state.fullmaj <- true + | l when l=(ctrl "NEWLINE") -> add_string buffer (gstr state "\n");resetstate state;state.nospace <- true + | _ -> add_string buffer (gstr state mot);resetstate state;; + +let rec binarintReader arbre0 abre buffer state n i = match abre with | Feuille(m,p) -> - addMotToBuffer m buffer;print_endline "f"; - binarintReader arbre0 arbre0 buffer n i + addMotToBuffer m buffer state;print_endline "f"; + binarintReader arbre0 arbre0 buffer state n i | Noeud(p,a,b) -> print_endline (string_of_int i); if i>=isize then abre(* On est au bout du binarint, on peut renvoyer l'état actuel*) else match (ithBit n i) with - | Zero -> binarintReader arbre0 b buffer n (i+1) - | Un -> binarintReader arbre0 a buffer n (i+1) ;; + | Zero -> binarintReader arbre0 b buffer state n (i+1) + | Un -> binarintReader arbre0 a buffer state n (i+1) ;; -let rec reader arbre0 toReadL buffer= - print_endline (string_of_int (Buffer.length buffer)); +let rec reader arbre0 toReadL buffer state= match toReadL with | [] -> arbre0 (* C'est vide, rien à ajouter*) - | next::reste -> let abre = reader arbre0 reste buffer in(* On lit d'abord les binarints suivants *) - binarintReader arbre0 abre buffer next 0;; + | next::reste -> let abre = reader arbre0 reste buffer state in(* On lit d'abord les binarints suivants *) + binarintReader arbre0 abre buffer state next 0;; exception DecodeException;; -let decodeBitstring arbre bs = let buffer = Buffer.create 100 in(*TODO mettre la capacité initiale en paramètre et essayer de la "déduire" de la taille du fichier*) +let decodeBitstring arbre bs = let buffer = Buffer.create 100 (*TODO mettre la capacité initiale en paramètre et essayer de la "déduire" de la taille du fichier*) + and state = {majed=false;fullmaj=false;nospace=true} in match bs with | (i,[]) -> "" - | (i,last::toRead) -> let abre = reader arbre toRead buffer in - let abreFin = binarintReader arbre abre buffer (last >>> (isize-i)) (isize-i) in + | (i,last::toRead) -> let abre = reader arbre toRead buffer state in + let abreFin = binarintReader arbre abre buffer state (last >>> (isize-i)) (isize-i) in if abreFin != arbre then raise (DecodeException) else let out = Buffer.contents buffer in Buffer.reset buffer; out;; -;; +(*###############################################################*) +(*# Ligne de commande #*) +(*###############################################################*) + +let args = Sys.argv;; +match Array.length args with + | 1 -> + print_endline "Coucou ! " + | 2 -> + let livreFilename = args.(1) in + let mots = List.rev (getMotsFromFile livreFilename) in + let countmap = motsToCountmap mots in + let motpList = countmapToMotsPList countmap in + let harbre = construireArbre motpList in + let dict = arbreToDict harbre in + let encode = encodeMots mots dict in + let s = bitSize encode and fs = filesize livreFilename and ds = dictSize dict in + printf "%i bits, soit %i octets dont %i pour le dictionnaire sur un fichier de %i octets (%f %% de taux de compression)" + (s+ds) ((s+ds)/8) (ds/8) fs (100. *. ((float_of_int (s+ds))/. 8. /. (float_of_int fs))) + | 3 -> + let livreFilename = args.(1) in + (*let outName = args.(2) in*) + let mots = List.rev (getMotsFromFile livreFilename) in + let countmap = motsToCountmap mots in + let motpList = countmapToMotsPList countmap in + let harbre = construireArbre motpList in + let dict = arbreToDict harbre in + let encode = encodeMots mots dict in + let s = bitSize encode and fs = filesize livreFilename and ds = dictSize dict in + printf "%i bits, soit %i octets dont %i pour le dictionnaire sur un fichier de %i octets (%f %% de taux de compression)" + (s+ds) ((s+ds)/8) (ds/8) fs (100. *. ((float_of_int (s+ds))/. 8. /. (float_of_int fs))); + let decode = decodeBitstring harbre encode in + print_endline (decode); + print_endline "La, je suis censé écrire dans un fichier ?" + | _ -> + print_endline "Ça fait beaucoup d'arguments ?";; (*###############################################################*) (*# Procédure #*) (*###############################################################*) -let livreFilename = "/home/mysaa/Documents/HistoireDesNombresEtDeLaNumerationNumerique.txt";; -let mots = getMotsFromFile livreFilename;; +let livreFilename = "/home/mysaa/Documents/Spigot/merged.java";; +let mots = List.rev (getMotsFromFile livreFilename);; let countmap = motsToCountmap mots;; CountMap.find "un" countmap;; let motpList = countmapToMotsPList countmap;; @@ -385,13 +717,13 @@ done;; (* Test de rapidité *) let t0=Sys.time () in let a = of_int 6745678876567878 and b = 12 in - for i=0 to 500_000_000 do + for i=0 to 500_000 do shift_right a b done; print_endline (string_of_float((Sys.time ())-. t0)); let t0=Sys.time () in let a = 79066342487687576 and b = 12 in - for i=0 to 500_000_000 do + for i=0 to 500_000 do a lsr b done; print_endline (string_of_float ((Sys.time ())-. t0));; @@ -408,4 +740,4 @@ done;; let testListe = [("a",35);("b",10);("c",19);("d",25);("e",06);("f",05)];; let out = List.fold_left motMerger (Feuille(("de",3))) testListe;; -construireArbre testListe;; \ No newline at end of file +construireArbre testListe;;