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;;

(* 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 7 (cyclencode cocycl 0b1010);;

(* 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;;