TIPE2021/Math.ml

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<q)
	then (p,q)
	else (q,p);;

(* Construit la matrice identité de taille d.d *)
let identite d =
	let rec sub acc = function
		| p  when 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 *)