diff --git a/Test.ml b/Test.ml index 44d3841..7670d65 100644 --- a/Test.ml +++ b/Test.ml @@ -79,6 +79,7 @@ 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;; @@ -147,10 +148,172 @@ print_endline""; estTransitif arr;; -let n = 7 (* alpha est racine neme de l'unité *);; -for i=0 to 100_000 do +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;; \ No newline at end of file +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;; \ No newline at end of file