TIPE2021/Test.ml

#cd "/home/mysaa/Documents/Arbeiten/TIPE2021";;
#use "Codes.ml";;

(* 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 = 
	construire_code_lineaire_systematique 4 7 [7; 3; 5; 6]
;;

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 = 	construire_code_lineaire_systematique 12 21 matPapa in
	let dst = distance_minimale code_paparfait in
	if dst>1
	then raise (GTROUVE matPapa)
done;;

print_vecteur 21 (encoder code_paparfait 0b011011011001);;


print_matrice 3 (suivants 3 (suivants 3 (suivants 3 (suivants 3 [0b000]))));;

print_vecteur 7 (encoder code_hamming 0b0100);;
decoder code_hamming 0b1010100;;
decoder code_hamming 0b0010100;;
decoder code_hamming 0b1110000;;
print_vecteur 7 21;;

(* Tests des codes cycliques *)
let cocycl = {ncyc=7;kcyc=4;pol=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;;
distance_minimale cocylined;;

print_vecteur 7 (cyclencode cocycl 0b1010);;

(* Essayons de générer une table d'addition *)
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 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 randtabl n = 
	let tab = rangearray 1 (n-1) in
	Random.self_init ();
	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;
	let rout = Array.make (n-1) Zero in
	for i=0 to n-1-1 do
		rout.(i) <- Ap(tab.(i))
	done;
	rout;;

randtabl n;;
exception PasTransitifException;;
let estTransitif tble =
	let n = Array.length tble +1 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)*)
			(* On teste si (0+i)+j = (0+j)+i *)
			let sa = add tble (add tble (Ap(0)) (Ap(i))) (Ap(j)) in
			let sb = add tble (add tble (Ap(0)) (Ap(j))) (Ap(i)) in
			if sa<>sb then raise PasTransitifException
		done
	done;
	true
	with PasTransitifException -> false;;
let printalp a = match a with
	| Zero -> print_string "o"
	| Ap(i) -> print_int i;;

let arr=[|Ap(3);Ap(6);Ap(1);Ap(5);Ap(4);Ap(2)|] in
for i=0 to n-2 do printalp arr.(i) done;
print_endline"";
estTransitif arr;;
let arr=randtabl n in
for i=0 to n-2 do printalp arr.(i) done;
print_endline"";
estTransitif arr;;


let n = 15 (* alpha est racine neme de l'unité *);;
for i=0 to 100 do
let arr=randtabl n in
if estTransitif arr;
then (for i=0 to n-2 do printalp arr.(i) done;
print_endline"")
done;;

(* Cette fonction utilise les super formules en partant de 
 la valeur indiquée *)
exception ContradictionException of int * int array;;
exception EmptyException;;
let pop q = match !q with
	| [] -> raise EmptyException
	| e::s -> q:=s;e;;
let push q e = q:=e::!q;;

(* 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) [];;
	
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 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;;
	
let rec cleanTable tble mv = match mv with
	| [] -> ()
	| e::s -> tble.(e) <- (-1);cleanTable tble s;;

let rec exploiteVerbose tble =
	let mv = missingValues tble in
	print_string "Exploiting ";
	printtbl tble;
	print_string " with ";
	printlst mv;
	print_endline ".";
	match mv with [] -> print_string "Raf:";printtbl tble | k::r ->
	let rec traite tble k mv mm =
	begin
		match mm with [] -> print_endline "Fini" | m::rr ->
		if k<>m then
		begin
		cleanTable tble mv;
		tble.(k) <- m;
		print_string "m=";
		print_int m;
		print_endline ":";
		try
			remplis tble k;
			if arrmem tble (-1)
			then (* On déscend d'un étage *)
				(exploite tble;print_endline "pouf";traite tble k mv rr (* Ce n'était pas le bon ... *))
			else begin
			print_string "Gtrouvé :";
			printtbl tble;
			print_endline ""
			end
		with ContradictionException(el,arr) -> (print_string "Contradiction: ";printtbl arr;print_endline "...");
		traite tble k mv rr (* Ce n'était pas le bon ... *)
		end
		else traite tble k mv rr
	end
	in traite tble k mv mv;;

let rec exploite tble =
	let mv = missingValues tble in
	match mv with [] -> () | k::r ->
	let rec traite tble k mv mm =
	begin
		match mm with [] -> () | m::rr ->
		if k<>m then
		begin
		cleanTable tble mv;
		tble.(k) <- m;
		begin
		try
			remplis tble k;
			if arrmem tble (-1)
			then (* On déscend d'un étage *)
				(exploite tble)
			else begin
			print_string "Gtrouvé :";
			printtbl tble;
			print_endline ""
			end
		with ContradictionException(el,arr) -> ()
		end;
		end;
		traite tble k mv rr
	end
	in traite tble k mv mv;;

let trouve n = 
	let arr = (Array.make n (-1)) in
	arr.(0) <- 0;
	exploite arr;;
trouve 15;;
printtbl (Array.make 7 (-1));;
missingValues (Array.make 7 (-1));;
let rec f n = missingValues (Array.make n (-1));;
f 7;;

estTransitif [|Ap(4);Ap(8);Ap(14);Ap(1);Ap(10);Ap(13);Ap(9);Ap(2);Ap(7);Ap(5);Ap(12);Ap(11);Ap(6);Ap(3)|];;

printlst [0;1;2;3];;

for i=4 to 1000 do
trouve i;
done;;
let arr=(Array.make 7 (-1)) in
	arr.(0) <- 0;
	arr.(1) <- 3;
	remplis arr 1;;