(*code de gray avec des tableaux*)

(*confection de range (pour p<q)*)
let rec range_list p q=
	if q=p 
	then [q]
	else p::(range_list (p+1) q)
;;
let range_tab p q=Array.of_list (range_list p q);;

(*celui qui suit est très laid mais il marche pour tous les cas de p,q *)
let range p q=
	if q==p 
	then [|p|]
	else 	if q>p
		then let nul=Array.make (q-p+1) 0 in 
		     for k=0 to (q-p) do nul.(k)<-(k+p) done; nul
		else let nul = Array.make (p-q+1) 0 in
		     for k=0 to (p-q) do nul.(k)<-(p-k) done; nul
	;;


(*-----------------------------------------------------------------------------------------*)
(* somme de deux tableaux *)
let ajoute l1 l2=
	let m=range_tab 0 (Array.length l1-1) in
	let somme k=l1.(k)+l2.(k) in 
	Array.map somme m;;

(*------------------------------------------------------------------------------------------*)
(* un fonction d'échange des valeurs de  termes contigüs dans un tableau
tout le tableau est renvoyé *)
let echange k t=
	let prov=t.(k-1) in
	t.(k-1)<-t.(k);t.(k)<-prov;
	t
;;

(*----------------------------------------------------------------------------------------*)
(* une procédure d'échange des valeurs de  termes contigüs dans un tableau*)
let echange2 k t=
	let prov=t.(k-1) in
	t.(k-1)<-t.(k);t.(k)<-prov;
	(*t*) (* aucune valeur n'est renvoyée *)
;;

(*-----------------------------------------------------------------------------------------*)
(* Join de deux tableaux: peut-être le passage par des listes .... ? *)
let joins a b=
	let longa=Array.length a in
	let longb=Array.length b in 
	let long=longa+longb in
	let double=Array.make long 0 in
	for k=0 to (longa-1) do double.(k)<-a.(k) done ;  for k=longa to (long-1) do double.(k)<-b.(k-longa) done;
double ;;

let rejoins a b= Array.append a b ;;
(*for k=1 to 100 do joins (range 10 200) (range 10 1000) done;; 3sec *)
(* avec rejoins c'est juste pareil *)
(*-----------------------------------------------------------------------------------------*)
(* tressage n-uple de deux tableaux *)
let rec alterne a b n= 
	match n with
	0-> [||]
	|p->joins (joins a b) (alterne a b (p-1))
;;

(*-----------------------------------------------------------------------------------------*)
(* truquage des valeurs d''un tableau: ajout de 1 aux rangs impairs *)
let truque t=
	let zero_un=Array.make (Array.length t) 0 in
	let impair k = if (k mod 2==0) then 0 else 1 in
	ajoute (Array.map impair zero_un) t;;

(*-----------------------------------------------------------------------------------------*)
(* le codage du code de gray *)
let rec codecode  n= match n with
	2 -> [|1;1|]
	|n-> 	let cg = codecode (n-1) in
		let monte = range 1 (n-1) in
		let descend = range (n-1) 1 in
		let tresse =  alterne  (joins descend [|n-1|]) (joins monte [|1|]) ((Array.length cg)/2) in
		tresse;;

(*-----------------------------------------------------------------------------------------*)
let affiche x= print_string " ";print_int x;print_string" ";;
let aff_tab t=print_newline();Array.iter affiche t;;

(*--------itére et affiche------------------------------*)
let rec fold_aff f  l a=match l with
	[]->print_newline()
	|p::q->aff_tab a; fold_aff f q (f p a)
;;

(*-------------------------------itère et empile----------------------------------------*)
let rec fold_aff_tas f  l a=let long=Array.length a in
	match l with
	|[]->[]
	|p::q->let prov=(range_tab 1 long) in 
		for k=0 to (long -1)  do prov.(k)<-a.(k) done;
		prov::(fold_aff_tas f q (f p a))
;;

(*-------itère et affiche, f est une procédure-------------------------------*)
let rec fold_aff_proc f  l a=match l with
	|[]->print_newline()
	|p::q->aff_tab a;f p a; fold_aff_proc f q a
;;

(*--------------------------------------*)
(* passage de codecode au Code de Gray*)
(*-------utilise le fold_aff fonctionnel-------------------------------*)
let cg n=
	let coco=codecode n in
	let perm=range_tab 1 n in
	fold_aff echange (Array.to_list coco) perm
;;	

(*-------utilise le fold_aff_tas: renvoie un int array list ----------------------------*)
let cg_tas n=
	let coco=codecode n in
	let perm=range_tab 1 n in
	fold_aff_tas echange (Array.to_list coco) perm
;;	

(*-----------utilise le fold_aff_proc---------------------------*)
let cg_proc n=
	let coco=codecode n in
	let perm=range_tab 1 n in
	fold_aff_proc echange (Array.to_list coco) perm
;;