let prl l =
  List.iter (fun n -> print_string ((string_of_int n)^" ")) l;
  print_string "\n";flush(stdout)

let rec list_rem x l =
match l with
    [] -> []
  |y::l1 -> if y=x then l1 else y::(list_rem x l1)
   
let mod2 x n =
  let a = x mod n in
    if a<0 then a+n else a

let c=ref 0;;
let sol=ref [];;

let rec explore n notes1 notes2 inter1 =
  if notes2=[]
  then (c:=(!c)+1;
	sol:=(List.rev notes1)::(!sol);
	if (!c) mod 1000=0 then print_string "+";flush(stdout)
	(*print_string ((string_of_int (!c))^":\n");
	prl (List.rev notes1);
	prl (List.rev inter1)*)
	  )
  else List.iter
    (fun x ->
       let x1=List.hd notes1 in (* la derniere note *)
       let i= mod2 (x-x1) n in
	 if (not (List.mem i inter1)) (* nouvel intervalle *)
	 then
	   explore n (x::notes1) (list_rem x notes2) (i::inter1)
    ) notes2

let rec ln n =
  if n=1 then [1] else (ln (n-1))@[n]

let joue n =
  c:=0;
  sol:=[];
  explore n [0] (ln (n-1)) [];
  !sol

let prem notes n =
   List.map (fun x -> mod2 (x*n) 12) notes

let miroir notes =
  let l = List.rev notes in
  let a = List.hd l in
    List.map (fun x -> mod2 (x-a) 12) l 

let coupe6 notes =
  let l1=ref [] in
  let l2= ref notes in
  let fini=ref false in
    while (not (!fini)) && (List.length !l2)>=2 do
      let x::(y::l3)=(!l2) in
	l1:=(!l1)@[x];
	l2:=y::l3;
	if mod2 (y-x) 12 = 6
	then fini:=true;
    done;
    let l = (!l2)@(!l1) in
    let a = List.hd l in
      List.map (fun x -> mod2 (x-a) 12) l 


let rec set l=
   match l with
       [] -> []
     |x::l1 -> if List.mem x l1 then (set l1) else x::(set l1)

let rec sett l=
   match l with
       [] -> []
     |(x,ltx)::l1 ->
	let l1=sett l1 in
	if List.mem x (List.map fst l1)
	then List.map (fun (y,lty) -> if y=x then (x,set (ltx@lty)) else (y,lty)) l1
	else (x,ltx)::l1

let compose t lt = List.map (fun t1 -> t^t1) lt

let orbite1 s =
  let ls=ref [(s,[""])] in
  let fini = ref false in
    while (not (!fini)) do
      let ls1 = sett (List.flatten
			(List.map
			   (fun (s,lt) ->
			      [(s,lt);(miroir s,compose "m" lt);
			       (coupe6 s,compose "c" lt);
			       (prem s 5,compose "5" lt);
			       (prem s 7,compose "7" lt);
			       (prem s 11,compose "11" lt)])
			   (!ls))) in
	if (List.length (!ls))=(List.length ls1)
	then fini:=true;
	ls:=ls1;
    done;
    !ls

let orbite s ls =
  let o=orbite1 s in
  let o = set o in
   (o,List.fold_right (fun s ls -> list_rem s ls) (List.map fst o) ls)

let rec orbites ls =
   match ls with
       [] -> []
     |s::ls ->
	let (o,ls1)=orbite s ls in
	  o::(orbites ls1)

  
(*
joue 12;;
let lo=orbites (!sol);;
 List.nth lo 3;;
*)

(*
for i=1 to 10 do
  print_string ("\n"^(string_of_int (joue (2*i)))^"\n");
done;;
*)
(* 
    ocamlopt boulez.ml -o boulez
 ./boulez.exe   
*)