Réorganisation et embellissement des fonctions de génération de la table d'addition, avec l'algorithme explicitant la fonction phi
This commit is contained in:
parent
0f9e8c73c6
commit
3802f3e43d
1
Maths.ml
1
Maths.ml
@ -141,4 +141,3 @@ let polrst (p:polynome) (q:polynome) : polynome = snd (poldiveuc p q);;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
260
Test.ml
260
Test.ml
@ -54,7 +54,6 @@ do
|
||||
then raise (GTROUVE matPapa)
|
||||
done;;
|
||||
|
||||
print_vecteur 21 (encoder code_paparfait 0b011011011001);;
|
||||
|
||||
|
||||
print_matrice 3 (suivants 3 (suivants 3 (suivants 3 (suivants 3 [0b000]))));;
|
||||
@ -79,6 +78,69 @@ 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;;
|
||||
@ -98,72 +160,42 @@ let add tble i j =
|
||||
| (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;
|
||||
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;;
|
||||
|
||||
randtabl n;;
|
||||
let getphi arr k = Ap(arr.(k));;
|
||||
|
||||
exception PasTransitifException;;
|
||||
let estTransitif tble =
|
||||
let n = Array.length tble +1 in
|
||||
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)*)
|
||||
(* 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
|
||||
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;;
|
||||
|
||||
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) *)
|
||||
@ -176,38 +208,12 @@ let missingValues arr =
|
||||
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;;
|
||||
|
||||
|
||||
(* 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
|
||||
@ -228,92 +234,66 @@ let remplis tble k =
|
||||
| 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;;
|
||||
|
||||
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 =
|
||||
(* 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 [] -> () | k::r ->
|
||||
let rec traite tble k mv mm =
|
||||
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 [] -> () | m::rr ->
|
||||
if k<>m then
|
||||
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;
|
||||
tble.(k) <- m;
|
||||
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;
|
||||
if arrmem tble (-1)
|
||||
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)
|
||||
else begin
|
||||
print_string "Gtrouvé :";
|
||||
printtbl tble;
|
||||
print_endline ""
|
||||
end
|
||||
with ContradictionException(el,arr) -> ()
|
||||
end;
|
||||
end;
|
||||
traite tble k mv rr
|
||||
(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;;
|
||||
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;
|
||||
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;;
|
||||
let res = ref [] in
|
||||
exploite arr res;
|
||||
!res;;
|
||||
|
||||
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)|];;
|
||||
(** Tests **)
|
||||
|
||||
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;;
|
||||
|
||||
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;;
|
||||
Loading…
x
Reference in New Issue
Block a user