(* manipulations concernant le groupe symétrique *)

(* la liste 1..n dont on a tout le temps besoin *)
let range n=
	let rec prefixe p q= 
		if p=q
		then [q]
		else p::prefixe (p+1) q in
	prefixe 1 n
;;

(* entrée d'une permutation comme liste, transformation en une fonction de 
1..n->1..n*)
let cree_perm l=
	let tab = Array.of_list l in
	let f=fun k->tab.(k-1) in f
;;

(* affichage d'une permutation comme "matrice" Source et But *)
let affiche f n=
	let rec aff_liste l=match l with
		|[]->()
		|t::q->print_int t;print_string" "; aff_liste q in
	print_newline();
	aff_liste (range n);
	print_newline();
	aff_liste (List.map f (range n));
	print_newline()
;;

let perm_a=cree_perm [6;1;4;2;5;3];;
perm_a 4;;

let verifie f n =
	let valeurs=Sort.list (fun a b -> a<b) (List.map f (range n)) in 
	valeurs=(range n)
;;

verifie perm_a 5;;
verifie perm_a 4;;

let compose p q=fun k->p (q k);;

affiche (compose perm_a perm_a) 6;;
 
let range_vect n=Array.of_list (range n);;

	(* calcul de la permutation réciproque de p *)
let reciproque p n=
	if verifie p n
	then 	let bat = range_vect n in
		Array.iter (fun k->bat.((p k)-1)<-k) (range_vect n);
		cree_perm (Array.to_list bat); 
	else failwith "non bijectif"
;;

affiche perm_a 6;;
let bat = range_vect 6 ;;
	Array.iter (fun k->bat.((perm_a k)-1)<-k) (range_vect 6);;
	Array.to_list bat;; 

perm_a 1;;

let perm_b= reciproque perm_a 6;;

affiche (compose perm_b perm_a) 6;;

		(* confection de permutations au hasard *)
open Random;;
init (int_of_float (Sys.time()));;

(* hasard va être la liste des choix à faire pour créer la permutation, c'est la même chose que la numération en base factorielle *)
let hasard n=
	let places=Array.make (n-1) 0 in 
	for k=0 to (n-2) do places.(k)<- int (k+1) done;
	places 
;;

(* Oh la vilaine récursion non terminale! *)
let rec insere liste valeur rang=
	if rang=0 
	then valeur::liste
	else match liste with
		|[]->[valeur]
		|t::q->t::(insere q valeur (rang-1))
;;
	
(* ci-dessous un exemple *)
insere (Array.to_list (Array.make 5 0)) 8 3;;

(* aleaperm fournit une liste aléatoire de 1..n, si on veut un tableau on fera suivre aleaperm de Array.of_list *)
let aleaperm n=
	let hasa=hasard n and debut=ref [1] in 
	for k= 2 to n 
	do debut:=insere !debut k hasa.(k-2) done;
	!debut
;;

(* ci-dessous un usage typique de where *)
let compose f g=
	if Array.length f <> Array.length g
	then failwith "Ah le bon gag!"
	else let ff u=f.(u-1) in Array.map ff g
;;
	
	(*décomposition d'une permutation en produit de cycles à supports disjoints *)

(* ci-dessous de quoi extraire son premier cycle à une fonction *)
let premier_cycle q=
	let rec ajoute k resultat=
		let qk=q k in
		if List.mem qk resultat 
		then resultat else (ajoute qk (qk::resultat))
in ajoute 1 [1];;

(*map test (range 10);;
premier_cycle test;;*)


let dec_cycles p n=
	let dejavu=Array.make (n+2) false 
in	let premier_cycle =function m->
		let rec ajoute k resultat=	let pk=p k in
			if List.mem pk resultat 
			then resultat 
			else (dejavu.(pk)<-true;ajoute pk (pk::resultat))
		in dejavu.(m)<-true;ajoute m [m];
and suivant m=while dejavu.(!m) do incr m done;m
in let rec ajoute_cycle k liste=
			if k=(n+1) 
			then liste 
			else ajoute_cycle !(suivant (ref k)) ((premier_cycle k) ::liste)
in ajoute_cycle 1 [];;

let pf=cree_perm [1;2;4;3;11;10;9;8;7;6;5];;

dec_cycles pf 11;;

(* quelques utilitaires fonctionnels avant la signature *)
let rec somme =function
	|[]->0
	|[u]->u
	|t::q->t+somme q
;;

let rec produit=function 
	|[]->1
	|[u]->u
	|t::q->t*produit q
;;

let rec somme_2 =function
	|[]->0
	|[u]->(u mod 2)
	|t::q->(t+somme_2 q) mod 2
;;

let rec produit_2=function 
	|[]->1
	|[u]->(u mod 2)
	|t::q->(t*produit q) mod 2
;;

let rec longueur=function
	|[]->0
	|t::q->1+longueur q
;;

let signature p n=
	let ll=dec_cycles p n and pair= function l->1+longueur l in
	produit_2 (List.map pair ll)
;;
	
(* affichage d'une table d'un groupe de permutations *)
(* la fonction associé_de x définie ci-dessous est tirée de la page 142 de 
"Le Langage caml", elle ne sert à rien car elle est identique à la fonction 
assoc de caml standard *)
exception Pas_trouvé;;
let rec associé_de x =function
	|[] -> raise Pas_trouvé
	|(clé,valeur)::suite -> if x=clé then valeur else associé_de x suite;;
let mini_liste_test =[(5,"cinq");(8,"huit")];;
associé_de 5 mini_liste_test;;
associé_de 15 mini_liste_test;;

let s3=[([1;2;3],"I");([2;3;1],"c");([3;1;2],"c²");([1;3;2],"t1");([3;2;1],"t2");([2;1;3],"t3")];;
List.assoc [1;3;2] s3;;

(* je recopie ce que le programme code de Gray a produit *)
let p3= [[|1; 2; 3|]; [|1; 3; 2|]; [|3; 1; 2|]; [|3; 2; 1|]; [|2; 3; 1|];  [|2; 1; 3|]];;
(* ... et je le remodèle *)
let p3vect=Array.of_list(List.map Array.to_list p3);;

(* un affichage tabulé des strings *)
let ptab s= let sl = String.length s in print_string(" "^s^(String.make (6-sl) ' '));; 

let tables3= (* dans affiche_ligne p, p est un élément de p3vect *)
	let affiche_ligne p = let vp=Array.of_list p in 
		ptab (List.assoc p s3); 
		Array.iter (fun z->ptab (List.assoc (Array.to_list (compose vp (Array.of_list z))) s3)) p3vect;
		print_newline() 
	in
	(* ligne d'en tête *)
	ptab "";
	Array.iter ptab (Array.map (fun k->List.assoc k s3) p3vect);
	print_newline(); print_newline();
	(* les autres lignes *)
	Array.iter affiche_ligne p3vect;print_newline()
;;




(* à faire
- composition FAIT
- réciproque FAIT
- création de permutations au hasard FAIT
- décomposition en cycles FAIT
- signature FAIT
- affichage de la table de Sn ou de celle de An FAIT
- compte du nombre d'inversions
- dire si deux permutations sont conjuguées
- détermination des parties stables
- code de gray pour Sn FAIT
- code de Gray pour An FAIT
- promenades dans le permutoèdre
- l'exo des jeux Mathématiques et logiques 97 sur les retournements de sous listes FAIT
*)