Un nouveau programme, plus optimisé
This commit is contained in:
parent
d028d4ca46
commit
f243db2b84
370
TIPE2021.ml
370
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 (* "#*+<=>^`~ <Tab> <Line Feed> *) (*"*)
|
||||
| 32 -> SW (* <Space> *)
|
||||
| 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;;
|
||||
construireArbre testListe;;
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user