From 3802f3e43da3a374009a38a93cf38d8e245c3764 Mon Sep 17 00:00:00 2001 From: Mysaa Date: Wed, 24 Mar 2021 19:29:53 +0100 Subject: [PATCH] =?UTF-8?q?R=C3=A9organisation=20et=20embellissement=20des?= =?UTF-8?q?=20fonctions=20de=20g=C3=A9n=C3=A9ration=20de=20la=20table=20d'?= =?UTF-8?q?addition,=20avec=20l'algorithme=20explicitant=20la=20fonction?= =?UTF-8?q?=20phi?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Maths.ml | 1 - Test.ml | 260 +++++++++++++++++++++++++------------------------------ 2 files changed, 120 insertions(+), 141 deletions(-) diff --git a/Maths.ml b/Maths.ml index 7a3816f..d74ce3f 100644 --- a/Maths.ml +++ b/Maths.ml @@ -141,4 +141,3 @@ let polrst (p:polynome) (q:polynome) : polynome = snd (poldiveuc p q);; - diff --git a/Test.ml b/Test.ml index 7670d65..217fc68 100644 --- a/Test.ml +++ b/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;; \ No newline at end of file + +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;; \ No newline at end of file