TIPE2021/Test.ml

#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 [3;6;9;12];;
let vecteurs = matriceAuPif 99 (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 "*";false)
	 | CLineaire.IndecodableException -> (print_int v;print_endline "-";false) in
List.find_opt test vecteurs;;
CLineaire.decoder codeh 49;;
CLineaire.encoder codeh 1;;
CLineaire.decoder2 classes 49;;
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;;







(****** Construction des classes cyclotomiques pour un degré n ******)

let classes n = 
	let rech = Array.make n false in
	let lsts = ref [] in
	for i=1 to (n-1)
	do
	if not rech.(i)
	then
	begin
		let v = ref (i lsl 1) in
		let lst = ref [i] in
		rech.(i) <- true;
		while !v<>i
		do
			rech.(!v) <- true;
			lst := !v::!lst;
			v := (!v lsl 1) mod n(*Fois 2*)
		done;
		lsts := !lst::!lsts
	end
	done;
	!lsts;;

let clzLst = let e::s = classes 31 in e;;
let tbleLst = let e::s = trouve 31 in e;;

let clz = List.map (fun x -> Ap(x)) clzLst;;
let tble = Array.map (fun x -> Ap(x)) tbleLst;;

(* Multiplie le polynome arr par chaque élément de la classe. On a deg(out)=d*)
let rec mulan tble arr clz d = 
	match clz with
	| [] -> ()
	| a::rr -> 
		mulan tble arr rr (d-1);
		arr.(d) <- arr.(d-1);
		for i=d-1 downto 1
		do
			arr.(i) <- add tble arr.(i-1) (mul tble a arr.(i))
		done;
		arr.(0) <- mul tble a arr.(0)
	;;

let pols clz tble =
	let len = List.length clz in
	let poly = Array.make (len+1) Zero in
	poly.(0) <- Ap(0);
	mulan tble poly clz (len);
	poly;;

let rec polof tble p a =
	if p=0 then Zero else
	let cst = if (p mod 2=0) then Zero else Ap(0) in
	let q = p lsr 1 in
	add tble cst (mul tble a (polof tble q a));;

let pomin tble a =
	if a=Zero then 2 else
	let i = ref 1 in
	while polof tble !i a <> Zero
	do
	incr i;
	incr i
	done;
	!i;;

polof tble 4 (Ap(2));;
for i=0 to 31 do
print_int i;
print_string "->";
print_polynome (pomin tble (Ap(i)))
done;;
pols clz tble;;








(* Essayons de générer une table d'addition *)
(* ABORT MISSION *)

(**** 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 mul tble i j = 
	let n = (Array.length tble)+1 in
	match i,j with
		| Zero,_ | _,Zero -> Zero
		| Ap(i),Ap(j) -> Ap((i+j) 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;;

(**** CRIBLE DE POLYNOMSTENE ****)

let polynomstene pp : polynome list=
	let n=degre pp in
	let irrs = Array.make (1 lsl (n+1)) true in (* irrs.(p)=true si p est irréductible *)
	let p = ref pp in (* Le «gros» polynome va diminuer *)
	(* Marque les multiples de q comme non irréductibles, si leur degré est inferieur à celui de p*)
	let annuleMultiples q p =
		let t = ref 2 in (* On commence par multiplier par X *)
		let r = ref (polmul !t q) in
		while !r < p
		do
			irrs.(!r) <- false;
			incr t;
			r := polmul !t q
		done
	in
	
	let q = ref 2 in
	let divs = ref [] in
	
	while (!p<>1)
	do
		if irrs.(!q)
		then begin
			annuleMultiples !q !p;
			let (d0,r0) = poldiveuc !p !q in
			let d = ref d0 and r = ref r0 in
			while (!r=0)
			do (* q divise p *)
				divs := !q::!divs;
				p := !d;
				let (d0,r0) = poldiveuc !p !q in
				d := d0;
				r := r0
			done
		end;
		incr q
	done;
	!divs;;

let naifostene pp =
	let p = ref pp in (* Le «gros» polynome va diminuer *)
	let q = ref 2 in
	let divs = ref [] in
	
	while (!p<>1)
	do
		let (d0,r0) = poldiveuc !p !q in
		let d = ref d0 and r = ref r0 in
		while (!r=0)
		do (* q divise p *)
			divs := !q::!divs;
			p := !d;
			let (d0,r0) = poldiveuc !p !q in
			d := d0;
			r := r0
		done;
		incr q
	done;
	!divs;;

let pol = (1 lsl 61) lxor 1;;
print_polynome pol;;
let lst = naifostene pol;;
List.iter (function p -> print_polynome p) lst;;

print_polynome (List.fold_left polmul 1 lst);;


(*** Test de recherche du polynome minimal de alpha ***)

type complexe = float*float;;

let cmul x y = 
	let (a,b)=x and (c,d)=y in
	(a*.c-.b*.d,b*.c+.a*.d);;
let cadd x y =
	let (a,b)=x and (c,d)=y in
	(a+.c,b+.d);;

let rec polymise p z =
	if p=0 then (0.,0.)
	else
	let a = if p mod 2 = 0 then (0.,0.) else (1.,0.) in
	let q = p lsr 1 in
	cadd a (cmul z (polymise q z));;

let n = 21;;
let alpha = 
	let th = 2.*.3.14159265358979/.(float_of_int n) in
	(cos th,sin th);;

let isNull z = 
	let epsilon = 0.00001 in
	let (a,b)=z in
	-.epsilon<a && a<epsilon && -.epsilon<b && b<epsilon;;

for p=1 to 2 lsl 21
do
	if isNull (polymise p alpha)
	then(
		print_int p;
		print_polynome p)
done;;