type vecteur = int;; type matrice = int list;; type polynome = int;; (***************** AFFICHAGE *****************) (* Zolie fonction d'affichage (h=nombre de lignes) *) (* L'algorithme est moche, mais y a pas trop d'autre solution que de arrayiser la liste, c'est stoqué dans le mauvais sens *) let nthOfBinarint i n = if ((0b1 lsl n) land i)=0 then "0" else "1";; let print_matrice h (matl:matrice) :unit = let mat = Array.of_list matl in let l = Array.length mat in print_string "┌"; for i=0 to (l-1) do print_string (nthOfBinarint mat.(i) 0) done; print_endline "┐"; for j=1 to (h-2) do print_string "│"; for i=0 to (l-1) do print_string (nthOfBinarint mat.(i) j) done; print_endline "│"; done; print_string "└"; for i=0 to (l-1) do print_string (nthOfBinarint mat.(i) (h-1)) done; print_endline "┘";; let print_vecteur h x = print_matrice h [x];; let print_polynome pol = let rec aux pol i preums = match pol with | 0 -> print_endline "" | pol when pol mod 2 = 0 -> aux (pol lsr 1) (i+1) preums | _ -> begin begin match (preums,i) with | true,0 -> print_string "1" | true,_ -> (print_string "X^";print_int i) | false,_ -> (print_string " + X^";print_int i) end;aux (pol lsr 1) (i+1) false end in aux pol 0 true;; (***************** MATRICES *****************) (* Effectue le produit matriciel 'matrice' . 'vecteur' *) let produit (matrice:matrice) (vecteur:vecteur) :vecteur = let rec auxiliaire resultat_partiel masque = function | [] -> resultat_partiel | colonne :: reste -> let resultat = if masque mod 2 = 1 then (lxor) colonne resultat_partiel else resultat_partiel in auxiliaire resultat (masque lsr 1) reste in auxiliaire 0 vecteur matrice ;; (* Ne calcul papy *) let deux_puissance = (lsl) 1;; let orderize p q = if (p= 0 -> sub ((deux_puissance p) :: acc) (p-1) | _ -> acc in sub [] (d-1) ;; (* Change l'état du 'i'-eme bit *) let changer_bit i = (lxor) (deux_puissance i);; (* Décalage gauche avec entier relatif *) let rec decagauche x = function | n when n < 0 -> x lsr (-n) | n when n > 0 -> x lsl n | n -> x ;; (* Vérifie que 'y' respecte toutes les contraintes de 'cs' *) (* Est-ce que pour tout P dans cs, P(y) ? *) let respecter y cs = let ny = (lnot) y in List.fold_right (fun c b -> b && (land) c ny > 0) cs true ;; (* Sort une matrice binaire au hazard *) let matriceAuPif l h = let filtre = (deux_puissance (h+1))-1 in let rec aux l h tmp = match l with | 0 -> tmp | l -> aux (l-1) h (((Random.bits ()) land filtre)::tmp) in aux l h [];; (***************** POLYNOMES *****************) let polmul (p_in:polynome) (q_in:polynome) : polynome = let (p,q) = orderize p_in q_in in let rec sub pa qa somme = if pa=0 then somme else sub (pa lsr 1) (qa lsl 1) (if (pa mod 2=0) then somme else (somme lxor qa)) in sub p q 0 ;; let degre (p:polynome) :int = let rec aux p d = match p with | 0 -> -1 | 1 -> d | _ -> aux (p lsr 1) (d+1) in aux p 0;; let poldiveuc (p:polynome) (q:polynome) : (polynome * polynome) = let dq = degre q in let rec sub quotient reste = let dr = degre reste in let d = dr - dq in if d >= 0 then sub (quotient lxor (deux_puissance d)) (reste lxor (q lsl d)) else (quotient, reste) in sub 0 p;; let poldiv (p:polynome) (q:polynome) : polynome = fst (poldiveuc p q);; let polrst (p:polynome) (q:polynome) : polynome = snd (poldiveuc p q);; (***************** Arbres de recherche de 'vecteurs' *****************) type 'a binabr = BNoeud of 'a binabr * 'a binabr | BVal of 'a * 'a binabr | BFeuille;; let isEmpty babr = babr=BFeuille;;(* Ne renvoie que les biens fondés, c'est à dire sans Noeud vide*) exception NoSuchKeyException;; let rec get ba (k:vecteur) = match (ba,k) with | (BNoeud(_,_) ,0) | (BFeuille ,_) -> raise NoSuchKeyException | (BVal(v,rr) ,0) -> v | (BVal(v,rr) ,_) -> get rr k | (BNoeud(t0,t1),_) -> match k mod 2 with | 0 -> get t0 (k lsr 1) | 1 -> get t1 (k lsr 1) | _ -> failwith "Félicitations, vous avez cassé les maths";; let rec putWho ba (k:vecteur) v keepNew = match (ba,k) with | (BVal(old,rr) ,0) -> if keepNew then BVal(v,rr) else BVal(old,rr) | (BFeuille ,0) | (BNoeud(_,_) ,0) -> BVal(v,ba) | (BVal(o,rr) ,_) -> BVal(o,putWho rr k v keepNew) | (BFeuille ,_) -> putWho (BNoeud(BFeuille,BFeuille)) k v keepNew (*match k mod 2 with | 0 -> BNoeud(putWho BFeuille (k lsr 1) v keepNew, BFeuille) | 1 -> BNoeud(BFeuille, putWho BFeuille (k lsr 1) v keepNew) | _ -> failwith "Ich gratuliere Sie. Sie haben Mathe zerbrochen" end*) | (BNoeud(t0,t1),_) -> match k mod 2 with | 0 -> BNoeud(putWho t0 (k lsr 1) v keepNew, t1) | 1 -> BNoeud(t0, putWho t1 (k lsr 1) v keepNew) | _ -> failwith "99 7'4 c0mp1373m3n7 c4553 135 m47h5. 7u 73 23nd5 c0mp73 ?!";; let put ba k v = putWho ba k v true;; (* Par défaut, on garde le nouveau *)