(*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=vect_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=make_vect (q-p+1) 0 in 
		     for k=0 to (q-p) do nul.(k)<-(k+p) done; nul
		else let nul = make_vect (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 (vect_length l1-1) in
	let somme k=l1.(k)+l2.(k) in 
	map_vect 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=vect_length a in
	let longb=vect_length b in 
	let long=longa+longb in
	let double=make_vect 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= vect_of_list ((list_of_vect a)@(list_of_vect 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=make_vect (vect_length t) 0 in
	let impair k = if (k mod 2==0) then 0 else 1 in
	ajoute (map_vect 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|]) (div_int (vect_length cg) 2) in
		tresse;;

(*-----------------------------------------------------------------------------------------*)
let affiche x= print_string " ";print_int x;print_string" ";;
let aff_tab t=print_newline();do_vect 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=vect_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 (list_of_vect coco) perm
;;	

(*-------utilise le fold_aff_tas: renvoie un int vect list ----------------------------*)
let cg_tas n=
	let coco=codecode n in
	let perm=range_tab 1 n in
	fold_aff_tas echange (list_of_vect 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 (list_of_vect coco) perm
;;
(* ci-dessous, d'anciens résidus *)


(*-------version 0 -------------------------------
let rec fold_list f l a=match l with
	[]->[]
	|z::[]->[f z a]
	|x::y->let u=fold_list f y a in 
		(f x (hd u))::u
;;*)
(* voir la réponse de P.Weiss 
(*--------------------------------------*)
let rec fold_list f l a=match l with
	[]->[]
	|z::[]->[f z a]
	|x::y->let u=f x a in 
		u::(fold_list  f y u)
;;

(* ce fold_list marche 
pour a de type integer, list, string, vecteur 
pour toutes les f (y compris par exemple une qui double un vecteur etc)
 mais avec f_l echange [.....] vec les termes de la liste finale sont égaux*)
*)

(*
let rec fold_list f l a=match l with
	[]->[a]
	|p::q->a::fold_list f q (f p a);;
*)