321 lines
8.6 KiB
OCaml
321 lines
8.6 KiB
OCaml
#cd "/home/mysaa/Documents/Arbeiten/TIPE2021";;
|
|
Sys.command "make Math.cmo Code.cmo";;
|
|
#load "Math.cmo";;
|
|
#load "Code.cmo";;
|
|
|
|
open Math;;
|
|
open Code;;
|
|
|
|
let print_boolean b = match b with
|
|
| true -> print_string "true"
|
|
| false -> print_string "false";;
|
|
|
|
let codeh = CLineaire.systematiqueFromRedondance 4 7 [7; 3; 5; 6];;
|
|
let vecteurs = matriceAuPif 9 (8-1);;
|
|
print_matrice 4 vecteurs;;
|
|
let classes = CLineaire.genererClasses codeh;;
|
|
let test v = try
|
|
CLineaire.encoder codeh (CLineaire.decoder codeh v) <> CLineaire.decoder2 classes v
|
|
with
|
|
Code.CLineaire.PasDansLeCodeException -> (print_int v;print_endline "*\n";false) in
|
|
List.find_opt test vecteurs;;
|
|
CLineaire.decoder codeh 119;;
|
|
CLineaire.encoder codeh 1;;
|
|
CLineaire.decoder2 classes 119;;
|
|
exit 0;;
|
|
|
|
(* Test du produit de matrice *)
|
|
let matest = [0b01110; 0b00101; 0b10111];;
|
|
print_matrice 5 matest;;
|
|
produit matest 0b110;; (* -> 0b10010 = 8 *)
|
|
|
|
(* Tests des polynomes *)
|
|
let pol1 = 13 and pol2 = 67;;
|
|
print_polynome pol1;;
|
|
print_polynome pol2;;
|
|
print_polynome (polmul pol1 pol2);;
|
|
let qt,rst=(poldiveuc pol2 pol1) in
|
|
print_polynome qt;
|
|
print_polynome rst;;
|
|
|
|
(* Test des fonctions de base *)
|
|
deux_puissance 11;;
|
|
identite 3;;
|
|
changer_bit 2 6;;
|
|
respecter 7 [3];;
|
|
|
|
|
|
(* Test des Codes *)
|
|
(* Un classique : code de Hamming (4, 7)
|
|
1 0 0 0
|
|
0 1 0 0
|
|
0 0 1 0
|
|
0 0 0 1
|
|
1 1 1 0 1 0 0
|
|
1 1 0 1 0 1 0
|
|
1 0 1 1 0 0 1
|
|
-> les 4 premières colonnes : G
|
|
-> les 3 dernières lignes : H
|
|
*)
|
|
let code_hamming =
|
|
CLineaire.systematiqueFromRedondance 4 7 [7; 3; 5; 6]
|
|
;;
|
|
|
|
CLineaire.distance_minimale code_hamming;;
|
|
|
|
|
|
|
|
exception GTROUVE of matrice;;
|
|
|
|
for i=0 to 20
|
|
do
|
|
Random.self_init ();
|
|
let matPapa = matriceAuPif 9 12 in
|
|
let code_paparfait = CLineaire.systematiqueFromRedondance 12 21 matPapa in
|
|
let dst = CLineaire.distance_minimale code_paparfait in
|
|
if dst>1
|
|
then raise (GTROUVE matPapa)
|
|
done;;
|
|
|
|
|
|
print_vecteur 7 (CLineaire.encoder code_hamming 0b0100);;
|
|
CLineaire.decoder code_hamming 0b1010100;;
|
|
CLineaire.decoder code_hamming 0b0010100;;
|
|
CLineaire.decoder code_hamming 0b1110000;;
|
|
print_vecteur 7 21;;
|
|
|
|
(* Tests des codes cycliques *)
|
|
let cocycl = CCyclique.get 7 4 13;;
|
|
print_polynome cocycl.pol;;
|
|
poldiveuc ((deux_puissance 7) +1) cocycl.pol;;
|
|
print_polynome ((deux_puissance 7) +1);;
|
|
print_polynome (poldiv ((deux_puissance 7) +1) cocycl.pol);;
|
|
let cocylined = cycliqueVersLineaire cocycl;;
|
|
print_matrice 7 cocylined.g;;
|
|
print_matrice 4 cocylined.h;;
|
|
|
|
CLineaire.distance_minimale cocylined;;
|
|
|
|
print_vecteur 9 203;;
|
|
|
|
(* Essayons de générer une table d'addition *)
|
|
|
|
(**** Utilitaires ****)
|
|
|
|
let rangearray i j =
|
|
let out = Array.make (j-i+1) 0 in
|
|
for k=i to j do
|
|
out.(k-i) <- k
|
|
done;
|
|
out;;
|
|
|
|
let shuffle tab =
|
|
let n = Array.length tab in
|
|
for i=n-2 downto 1 do
|
|
let j = Random.int (i+1) in
|
|
let a,b=tab.(i),tab.(j) in
|
|
tab.(i) <- b;
|
|
tab.(j) <- a
|
|
done;;
|
|
|
|
exception EmptyException;;
|
|
let pop q = match !q with
|
|
| [] -> raise EmptyException
|
|
| e::s -> q:=s;e;;
|
|
let push q e = q:=e::!q;;
|
|
|
|
let printtbl arr=
|
|
let n = Array.length arr in
|
|
print_string "[|";
|
|
print_int arr.(0);
|
|
for i=1 to (n-1) do
|
|
print_string ";";
|
|
print_int arr.(i)
|
|
done;
|
|
print_string "|]";;
|
|
let printlst lst =
|
|
print_string "[";
|
|
match lst with
|
|
| [] -> ()
|
|
| e::s -> begin
|
|
print_int e;
|
|
let rec aux ll = match ll with
|
|
| [] -> ()
|
|
| h::t -> print_string ";";print_int h;aux t
|
|
in aux s end;
|
|
print_string "]";;
|
|
exception FoundException;;
|
|
let arrmem arr e =
|
|
let n = Array.length arr in
|
|
try
|
|
for i=0 to n-1 do
|
|
if arr.(i)=e then raise FoundException
|
|
done;
|
|
false
|
|
with FoundException -> true;;
|
|
|
|
let rec foreache lst f edd= match lst with
|
|
| [] -> edd ()
|
|
| e::s -> f e;foreache s f edd;;
|
|
|
|
let foreach lst f = foreache lst f (fun () -> ());;
|
|
|
|
|
|
(**** La zolie structure****)
|
|
let n = 7;;
|
|
|
|
type element = Zero | Ap of int;;
|
|
|
|
exception NotApException;;
|
|
let getap a = match a with
|
|
| Zero -> raise NotApException
|
|
| Ap(i) -> i;;
|
|
|
|
let add tble i j =
|
|
let n = (Array.length tble) +1 in
|
|
if i=j then Zero else
|
|
match i,j with
|
|
| Zero,x | x,Zero -> x
|
|
| (Ap(0),Ap(k)) -> tble.(k-1)
|
|
| (Ap(k),Ap(0)) -> tble.(k-1)
|
|
| (Ap(ii),Ap(jj)) -> let tt = getap (tble.(((jj-ii+n) mod n)-1)) in
|
|
Ap((tt+ii) mod n);;
|
|
|
|
let randtabl n =
|
|
let tab = rangearray 1 (n-1) in
|
|
Random.self_init ();
|
|
shuffle tab;
|
|
let rout = Array.make (n-1) Zero in
|
|
for i=0 to n-1-1 do
|
|
rout.(i) <- Ap(tab.(i))
|
|
done;
|
|
rout;;
|
|
|
|
let getphi arr k = Ap(arr.(k));;
|
|
|
|
exception PasTransitifException;;
|
|
let estTransitif tble =
|
|
let n = Array.length tble in
|
|
try
|
|
for i=1 to (n-1) do
|
|
for j=1 to (i-1) do (* i et j distincts et non nuls (transititivité évidente)*)
|
|
if (* La formule s'applique *) i<>tble.(j) && j <> tble.(i) then
|
|
let sa = j + tble.((tble.(i)-j+n) mod n) in
|
|
let sb = i + tble.((tble.(j)-i+n) mod n) in
|
|
if sa mod n <>sb mod n then raise PasTransitifException
|
|
done
|
|
done;
|
|
true
|
|
with PasTransitifException -> false;;
|
|
|
|
let printalp a = match a with
|
|
| Zero -> print_string "o"
|
|
| Ap(i) -> print_int i;;
|
|
|
|
|
|
|
|
(* Cette fonction utilise les super formules en partant de
|
|
la valeur indiquée *)
|
|
exception ContradictionException of int * int array;;
|
|
|
|
(* Renvoie la LISTE des valeurs non associées dans arr *)
|
|
(* Suppose que arr\{-1} est bijective (assurée par l'involutivité de phi) *)
|
|
(* Bien entendu, on oublie le zéro *)
|
|
let missingValues arr =
|
|
let n = Array.length arr in
|
|
let rec aux arr i l =
|
|
if i=0 then l else
|
|
if (arr.(i)=(-1)) then
|
|
aux arr (i-1) (i::l)
|
|
else aux arr (i-1) l
|
|
in aux arr (n-1) [];;
|
|
|
|
|
|
(* Remplis la table avec les valeurs qu'impliquent la valeur en k, supposée déjà
|
|
imposée par une fonction exterieure. Renvoie une ContradictionException si l'une
|
|
des implications est impossible avec une des valeurs déjà mises, ou impliquées
|
|
d'une autre manière *)
|
|
let remplis tble k =
|
|
let n = Array.length tble in
|
|
let queue = ref [k] in
|
|
while !queue<>[]
|
|
do
|
|
let el = pop queue in
|
|
(* Test de l'involutivité *)
|
|
begin
|
|
match tble.(tble.(el)) with
|
|
| -1 -> (tble.(tble.(el)) <- el;push queue tble.(el))
|
|
| x when x=el -> ()
|
|
| _ -> raise (ContradictionException(el,tble))
|
|
end;
|
|
(* Test de la formule d'opposition *)
|
|
let opv = (n+tble.(el)-el) mod n in
|
|
match tble.(n-el) with
|
|
| -1 -> (tble.(n-el) <- opv;push queue (n-el))
|
|
| x when x=opv-> ()
|
|
| _ -> raise (ContradictionException(el,tble))
|
|
done;;
|
|
|
|
(* Efface (met -1) dans les cases de tble d'index les éléments de mv (liste) *)
|
|
let rec cleanTable tble mv = match mv with
|
|
| [] -> ()
|
|
| e::s -> tble.(e) <- (-1);cleanTable tble s;;
|
|
|
|
|
|
(* Rajoute à la pile d'entrée, à partir d'un tableau représentant une fonction phi partielle (-1 pour
|
|
les valeurs encore indéfinies) l'ensemble de toutes les fonctions phi réelles
|
|
respectant la transitivité (créant donc un corps) et étendant la fonction partielle. *)
|
|
let rec exploite tble res =
|
|
let mv = missingValues tble in
|
|
match mv with
|
|
| [] -> if estTransitif tble then push res tble (* Toutes les valeurs sont fixées: pas quarante-douze solutions ...*)
|
|
| k::r -> (* On séléctionne un des éléments indéfinis. On va tester toutes les valeurs sur lui *)
|
|
let rec traite tble k mv mm res =
|
|
(* Traite à partir de la table tble, l'index de tests k, les valeurs manquantes mv,
|
|
et les valeurs manquantes pas encore essayées mm, res la pile où mettre les bons *)
|
|
begin
|
|
match mm with [] -> () (* Alors, on a testé toutes les valeurs manquantes *)
|
|
| m::rr -> (* On doit tester arr.(k)<-m, puis reste tout rr à tester *)
|
|
if k<>m then (* Un point ne peut etre son image *)
|
|
begin
|
|
cleanTable tble mv; (* Enlève toutes les valeurs des essais précedents *)
|
|
tble.(k) <- m; (* Place la bonne valeur de test s*)
|
|
begin
|
|
try
|
|
remplis tble k; (* Tente de remplir avec les implications le l'index k*)
|
|
if arrmem tble (-1) (* Si des cases restent indéterminées malgrès notre valeur arr.(k) *)
|
|
then (* On déscend d'un étage *)
|
|
(exploite tble res)
|
|
else (* Ben on sauvegarde si c'est effectivement transitif et on continue *)
|
|
if (estTransitif tble) then push res (Array.copy tble)
|
|
with ContradictionException(el,arr) -> () (* Si il y a eu une contradiction on ne stoque rien, ni n'essaye rien*)
|
|
end(*try*)
|
|
end(*if k<>m*);
|
|
traite tble k mv rr res (* Dans tous les cas, on teste le reste *)
|
|
end
|
|
in traite tble k mv mv res;; (* On applique la fonctions auxilière *)
|
|
|
|
(* Fonction faisant appel à exploite afin de renvoyer la liste-ensemble des tables créant un
|
|
corps sur {0}u{a pow k pour k dans [0,n-1] *)
|
|
let trouve n =
|
|
let arr = (Array.make n (-1)) in
|
|
arr.(0) <- 0;
|
|
let res = ref [] in
|
|
exploite arr res;
|
|
!res;;
|
|
|
|
(** Tests **)
|
|
|
|
|
|
|
|
for m=1 to 10 do
|
|
let i = (1 lsl m)-1 in
|
|
let t0 = Sys.time () in
|
|
print_int i;
|
|
foreach (trouve i) printtbl;
|
|
print_endline ";";
|
|
print_string "Temps écoulé: ";
|
|
print_float ((Sys.time ()) -. t0);
|
|
print_endline "."
|
|
done;;
|