#use "exemples/OCaml/Rubik/cube3x3/divers/types.ml";;
#use "exemples/OCaml/Rubik/divers/divers.ml";;
#use "exemples/OCaml/Rubik/cube3x3/divers/section_marques.ml";;
#use "exemples/OCaml/Rubik/divers/couleurs.ml";;
#use "exemples/OCaml/Rubik/cube3x3/divers/graphisme.ml";;
#use "exemples/OCaml/Rubik/cube3x3/divers/boutons.ml";;

(* liste des angles *)
let angles = select est_angle indices;;
let v_angles = vect_of_list angles;;

(* liste des coins *)
let coins = select est_coin indices;;
let v_coins = vect_of_list coins;;

(* liste des milieux *)
let milieux = select est_centre indices;;
let v_milieux = vect_of_list milieux;;

(* numérotation des angles *)
let num_of_angle a =
  let i = ref 0 in
    while a <> v_angles.(!i) do
      incr i
    done;
    !i
;;

let angle_of_num i = v_angles.(i);;

(* numérotation des coins *)
let num_of_coin c =
  let i = ref 0 in
    while c <> v_coins.(!i) do
      incr i
    done;
    !i
;;
let coin_of_num i = v_coins.(i);;

(* numérotation des milieux (ou 'centres') *)
let num_of_milieu m =
  let i = ref 0 in
    while m <> v_milieux.(!i) do
      incr i
    done;
    !i
;;
let milieu_of_num i = v_milieux.(i);;

map_vect num_of_milieu v_milieux;;

(* identificateurs pour les numéros d'angle *)
let ah = num_of_angle [|1; 0; 1|];;
let ad = num_of_angle [|1; 1; 0|];;
let ab = num_of_angle [|1; 0; - 1|];;
let ag = num_of_angle [|1; - 1; 0|];;
let dh = num_of_angle [|0; 1; 1|];;
let pd = num_of_angle [|- 1; 1; 0|];;
let db = num_of_angle [|0; 1; - 1|];;
let gh = num_of_angle [|0; - 1; 1|];;
let pg = num_of_angle [|- 1; - 1; 0|];;
let gb = num_of_angle [|0; - 1; - 1|];;
let ph = num_of_angle [|- 1; 0; 1|];;
let pb = num_of_angle [|- 1; 0; - 1|];;

(* identificateurs pour les numéros de coins *)
let adh = num_of_coin [|1; 1; 1|];;
let adb = num_of_coin [|1; 1; - 1|];;
let agb = num_of_coin [|1; - 1; - 1|];;
let agh = num_of_coin [|1; - 1; 1|];;
let pdh = num_of_coin [|- 1; 1; 1|];;
let pdb = num_of_coin [|- 1; 1; - 1|];;
let pgb = num_of_coin [|- 1; - 1; - 1|];;
let pgh = num_of_coin [|- 1; - 1; 1|];;


(*- conversions entre les deux types de mouvements... -*)

(* rotations des angles: liste d'exposants *)
(* pour mv1_of_mv2 *)
let l_rta m =
  let rta_aux k = let f = fun_of_mv1 k in
      let indexa i = if f i = st i then 1 else 0 in
      (*(list_it (prefix +) (map indexa (angles)) 0) mod 2*)
        map indexa (angles)
  in rta_aux (ker m)
;;

(* rotations des coins: liste d'exposants *)
(* pour mv1_of_mv2 *)
let l_rtc m =
  let rtc_aux k = let f = fun_of_mv1 k in
      let indexc i = if f i = st i then 1
        else if f i = transpose (st i) then 2 else 0 in
      (*(list_it (prefix +) (map indexc (coins ())) 0) mod 3*)
        map indexc (coins)
  in rtc_aux (ker m)
;;

(* rotations des milieux: liste d'exposants *)
(* pour mv1_of_mv2 *)
let l_rtm m =
  let rtm_aux k = let f = fun_of_mv1 k in
      let indexm i = if f i = id then 0
        else if f i = rot i then 1
        else if f i = rot' i then 3
        else 2 in
      (*(list_it (prefix +) (map indexa (angles)) 0) mod 2*)
        map indexm (milieux)
  in rtm_aux (ker m)
;;

(* ...pour définir les opérations de rubik comme mouvements 'mv2'... *)
let mv2_of_mv1 mv1 =
  let ra = vect_of_list (l_rta mv1)
  and rc = vect_of_list (l_rtc mv1)
  and rm = vect_of_list (l_rtm mv1)
  and pa = vect_of_list (map num_of_angle (map (sur mv1) (angles)))
  and pc = vect_of_list (map num_of_coin (map (sur mv1) (coins)))
  in
    {rot_angles = ra; rot_coins = rc; rot_milieux = rm; perm_angles = pa; perm_coins = pc}
;;

(* ...et pour dessine_cube *)
let mv1_of_mv2 mv2 =
  let ea = fun i -> mv2.rot_angles.(num_of_angle i)
  and ec = fun i -> mv2.rot_coins.(num_of_coin i)
  and em = fun i -> mv2.rot_milieux.(num_of_milieu i)
  and pa = fun i -> angle_of_num (mv2.perm_angles.(num_of_angle i))
  and pc = fun i -> coin_of_num (mv2.perm_coins.(num_of_coin i))
  in
    nouveau_mv1 pa pc ea ec em
;;

(*- fin de conversions entre les deux types de mouvements... -*)


(*- Groupe des mouvements M -*)

(* loi de groupe pour les mouvements 'mv2' (produit semi-direct) *)
(* loi interne '$' *)
let ($) m m' =
  let na = vect_length m.rot_angles and nc = vect_length m.rot_coins and nm = vect_length m.rot_milieux
  and npa = vect_length m.perm_angles and npc = vect_length m.perm_coins
  in
    let ra = make_vect na 0
    and rc = make_vect nc 0
    and rm = make_vect nm 0
    and pa = make_vect npa 0
    and pc = make_vect npc 0
    in
      for i = 0 to na - 1 do
        ra.(i) <- (m.rot_angles.(i) + m'.rot_angles.(m.perm_angles.(i))) mod 2
      done;
      for i = 0 to nc - 1 do
        rc.(i) <- (m.rot_coins.(i) + m'.rot_coins.(m.perm_coins.(i))) mod 3
      done;
      for i = 0 to nm - 1 do
        rm.(i) <- (m.rot_milieux.(i) + m'.rot_milieux.(i)) mod 4
      done;
      for i = 0 to npa - 1 do
        pa.(i) <- m'.perm_angles.(m.perm_angles.(i))
      done;
      for i = 0 to npc - 1 do
        pc.(i) <- m'.perm_coins.(m.perm_coins.(i))
      done;
      {rot_angles = ra; rot_coins = rc; rot_milieux = rm; perm_angles = pa; perm_coins = pc}
;;

(* élément neutre *)
let e2 = {rot_angles = [|0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0|];
    rot_coins = [|0; 0; 0; 0; 0; 0; 0; 0|];
    rot_milieux = [|0; 0; 0; 0; 0; 0|];
    perm_angles = [|0; 1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11|];
    perm_coins = [|0; 1; 2; 3; 4; 5; 6; 7|]}
;;

(* permutation inverse de la permutation d'entiers i -> s.(i) *)
let perm_inverse s = let n = vect_length s in
    let t = make_vect n 0 in
      for i = 0 to n - 1 do
        t.(s.(i)) <- i
      done;
      t
;;

(* inverse d'un élément *)
let inv mv2 =
  let ra = mv2.rot_angles
  and rc = mv2.rot_coins
  and rm = mv2.rot_milieux
  and pai = perm_inverse mv2.perm_angles
  and pci = perm_inverse mv2.perm_coins in
    let ta = make_vect 12 0 and tc = make_vect 8 0 and tm = make_vect 6 0 in
      for i = 0 to 11 do
        ta.(i) <- (2 - ra.(pai.(i))) mod 2
      done;
      for i = 0 to 7 do
        tc.(i) <- (3 - rc.(pci.(i))) mod 3
      done;
      for i = 0 to 5 do
        tm.(i) <- (4 - rm.(i)) mod 4
      done;
      {rot_angles = ta; rot_coins = tc; rot_milieux = tm; perm_angles = pai; perm_coins = pci}
;;

(* test d'appartenance d'un mouvement au sous-groupe de Rubik R de M *)
(* par nullité des rotations totales et égalité des signatures *)
(* des permutations d'angles et de coins et relation entre *)
(* rotation totale des centres et signature des coins *)
let signature p =
  sign (liste (vect_length p)) (fun i -> p.(i));;


let est_dans_R mvs =
  let sum v = let s = ref 0 and n = vect_length v in
      for i = 0 to n - 1 do
        s := !s + v.(i)
      done;
      !s
  in
    let t = if (sum mvs.rot_milieux) mod 2 = 0 then 1 else - 1 in
      (sum mvs.rot_angles) mod 2 = 0 && (sum mvs.rot_coins) mod 3 = 0 && t = signature mvs.perm_coins
      && signature mvs.perm_angles = signature mvs.perm_coins
;;

(* fin de groupe des mouvements M *)


(* mouvement général aléatoire *)
#load "unix.cma";;
Random.init (int_of_float (Unix.time ()));;

let mv2_r () =
  let ra () =
    let v = make_vect 12 0 in
      for i = 0 to 11 do v.(i) <- random__int 2 done;
      v
  and rc () =
    let v = make_vect 8 0 in
      for i = 0 to 7 do v.(i) <- random__int 3 done;
      v
  and rm () =
    let v = make_vect 6 0 in
      for i = 0 to 5 do v.(i) <- random__int 4 done;
      v
  and random_vect n = vect_of_list (random_list (liste n))
  in
    let pa () = random_vect 12
    and pc () = random_vect 8
    in
      {rot_angles = ra (); rot_coins = rc (); rot_milieux = rm (); perm_angles = pa (); perm_coins = pc ()}
;;

(* mouvement de Rubik aléatoire *)
let mv2_rubik_r () =
  let mv2 = mv2_r ()
  and sum v = let s = ref 0 and n = vect_length v in
      for i = 0 to n - 1 do
        s := !s + v.(i)
      done;
      !s
  and echange v =
    let a = v.(0) in v.(0) <- v.(1); v.(1) <- a
  in
    if (sum mv2.rot_angles) mod 2 <> 0 then mv2.rot_angles.(0) <- (1 - mv2.rot_angles.(0)) mod 2;
    (let s = (sum mv2.rot_coins) mod 3 in
        if s <> 0 then mv2.rot_coins.(0) <- (mv2.rot_coins.(0) + 3 - s) mod 3);
    if signature mv2.perm_angles <> signature mv2.perm_coins then echange mv2.perm_coins;
    (
      let v = mv2.rot_milieux in
        let t = if (sum v) mod 2 = 0 then 1 else - 1 and n = signature mv2.perm_coins in
          if n <> t then (v.(0) <- (v.(0) + 1) mod 4; mv2.rot_milieux <- v)
    );
    mv2
;;

(* introduction des mouvements élémentaires de Rubik de type 'mv2' *)
let rub_a = mv2_of_mv1 (rub [|1; 0; 0|]);;
let rub_d = mv2_of_mv1 (rub [|0; 1; 0|]);;
let rub_h = mv2_of_mv1 (rub [|0; 0; 1|]);;
let rub_a' = mv2_of_mv1 (rub' [|1; 0; 0|]);;
let rub_d' = mv2_of_mv1 (rub' [|0; 1; 0|]);;
let rub_h' = mv2_of_mv1 (rub' [|0; 0; 1|]);;

let rub_p = mv2_of_mv1 (rub [|- 1; 0; 0|]);;
let rub_g = mv2_of_mv1 (rub [|0; - 1; 0|]);;
let rub_b = mv2_of_mv1 (rub [|0; 0; - 1|]);;
let rub_p' = mv2_of_mv1 (rub' [|- 1; 0; 0|]);;
let rub_g' = mv2_of_mv1 (rub' [|0; - 1; 0|]);;
let rub_b' = mv2_of_mv1 (rub' [|0; 0; - 1|]);;

let rub1 x = match vect x with
    | 1, 0, 0 -> rub_a
    | 0, 1, 0 -> rub_d
    | 0, 0, 1 -> rub_h
    | - 1, 0, 0 -> rub_p
    | 0, - 1, 0 -> rub_g
    | 0, 0, - 1 -> rub_b
    | _ -> failwith "rub1"
;;

let rub1' x = match vect x with
    | 1, 0, 0 -> rub_a'
    | 0, 1, 0 -> rub_d'
    | 0, 0, 1 -> rub_h'
    | - 1, 0, 0 -> rub_p'
    | 0, - 1, 0 -> rub_g'
    | 0, 0, - 1 -> rub_b'
    | _ -> failwith "rub1'"
;;

(* mouvements globaux du cube et conjugués *)
let cste c = mv2_of_mv1 (map (fun x -> x, c) indices);;
let conj p m = p $ m $ inv p;;
let conjc c m = conj (cste c) m;;


(*- Rubik's cube virtuel -*)

(* Initialisation du Rubik's cube : mise en place des mouvements élémentaires de Rubik *)
let nouveau_cube2 mouvement context dessine liste_mouvements =
  
  let listeops = ref []
  and dessine () = dessine context (mv1_of_mv2 mouvement.mv2)
  in
    let op_externes liste_ops =
      let fct x () =
        (*mouvement.mv2 <- mouvement.mv2 $ conjc context.matrice (rub1 x);*)
        let t = x /:/ transpose context.matrice in
          mouvement.mv2 <- mouvement.mv2 $ rub1 t;
          if liste_mouvements then (
              let t = x /:/ transpose context.matrice in
                print_string (nom_de_face t ^ " ");
                liste_ops := !liste_ops @ [nom_de_face t];
            );
          dessine ()
      and fct' x () =
        (*mouvement.mv2 <- mouvement.mv2 $ conjc context.matrice (rub1' x);*)
        let t = x /:/ transpose context.matrice in
          mouvement.mv2 <- mouvement.mv2 $ rub1' t;
          if liste_mouvements then (
              let t = x /:/ transpose context.matrice in
                print_string (nom_de_face t ^ "' ");
                liste_ops := !liste_ops @ [nom_de_face t ^ "'"];
            );
          dessine ()
      in
        let (a, d, h) = vect (map_vect fct id)
        and (a', d', h') = vect (map_vect fct' id)
        and (p, g, b) = vect (map_vect fct idm)
        and (p', g', b') = vect (map_vect fct' idm)
        in (OPS (a, d, h), OPS (a', d', h'), OPS (p, g, b), OPS (p', g', b'))
    
    and op_internes () =
      let fct x () =
        mouvement.mv2 <- mouvement.mv2 $ rub1 x;
        print_string (nom_de_face x ^ " ");
        dessine ()
      and fct' x () =
        mouvement.mv2 <- mouvement.mv2 $ rub1' x;
        if liste_mouvements then print_string (nom_de_face x ^ "' ");
        dessine ()
      in
        let (o, v, blanc) = vect (map_vect fct id)
        and (o', v', blanc') = vect (map_vect fct' id)
        and (r, b, j) = vect (map_vect fct idm)
        and (r', b', j') = vect (map_vect fct' idm)
        in (OPS (o, v, blanc), OPS (o', v', blanc'), OPS (r, b, j), OPS (r', b', j'))
    
    and op_globales () =
      let rotation pp () =
        context.matrice <- context.matrice /./ pp;
        dessine ()
      in
        let (a, d, h) = vect (map_vect rotation (map_vect rot id))
        and (a', d', h') = vect (map_vect rotation (map_vect rot' id))
        in
          (OPS (a, d, h), OPS (a', d', h'))
    
    in
      let op_ext = op_externes listeops and op_int = op_internes () in
        let op_from_strings liste_ops =
          let (OPS (orange, vert, blanc), OPS (orange', vert', blanc'), OPS (rouge,
          bleu, jaune), OPS (rouge', bleu', jaune')) = op_int
          in
            let aux s = assoc s
              [("orange", orange); ("vert", vert); ("blanc", blanc);
                ("orange'", orange'); ("vert'", vert'); ("blanc'", blanc');
                ("rouge", rouge); ("bleu", bleu); ("jaune", jaune);
                ("rouge'", rouge'); ("bleu'", bleu'); ("jaune'", jaune')]
            in
              let rec op_from_strings_aux liste_ops =
                match liste_ops with
                  t :: r -> aux t :: op_from_strings_aux r
                  | [] -> []
              in op_from_strings_aux liste_ops
        in
          {mouvement2 = mouvement; context2 = context; dessine2 = dessine;
            op_globales2 = op_globales (); op_externes2 = op_ext;
            op_internes2 = op_int; liste_ops2 = listeops;
            op_from_strings2 = op_from_strings;
            boutons2 = make_vect 1 {titre = ""; orx = 0; ory = 0; largeur = 0;
              hauteur = 0; couleur = 0; action = fun () -> ()}
          }
;;

(* Résolution par niveaux du Rubik's cube *)
exception Orienter_les_coins;;
exception Placer_angle_frontal_haut;;
exception Descendre_coin;;
exception Remonter_coin;;
exception Remonter_angle;;
exception Orienter_les_angles;;
exception Placer_les_angles;;
exception Placer_les_coins;;
exception Est_mal_oriente;;

(* nombre de quarts de tour des milieux *)
let nqt mv2 v = mv2.rot_milieux.(num_of_milieu v);;

let resoudre_le_cube cube completement =
  let
  (OPS (a, d, h), OPS (a', d', h'), OPS (p, g, b), OPS (p', g', b')) = cube.op_externes2
  and
  (OPS (_, _, h0), OPS (_, _, h0')) = cube.op_globales2
  
  and angle_reel a = num_of_angle (angle_of_num a /:/ transpose (cube.context2.matrice))
  and coin_reel c = num_of_coin (coin_of_num c /:/ transpose (cube.context2.matrice))
  and deplacement_angle a =
    let v = angle_of_num (cube.mouvement2.mv2.perm_angles.(a)) in
      num_of_angle (v /:/ cube.context2.matrice)
  and deplacement_coin c =
    let v = coin_of_num (cube.mouvement2.mv2.perm_coins.(c)) in
      num_of_coin (v /:/ cube.context2.matrice)
  
  in
    
    let niveau_superieur () =
      
      (* niveau supérieur *)
      let orienter_le_centre () =
        (* let n = nqt cube.mouvement2.mv2 cube.context2.matrice ([|0; 0; 1|]) in*)
        let n = nqt cube.mouvement2.mv2 ([|0; 0; 1|] /:/ transpose cube.context2.matrice) in
          if n = 1 then exe [h']
          else if n = 2 then exe [h; h]
          else if n = 3 then exe [h]
      
      and placer_et_orienter_les_angles () =
        let placer_angle_frontal_haut () =
          let a1 = deplacement_angle (angle_reel ah)
          in
            if a1 = ah then () else
            if a1 = ad then exe [a'] else
            if a1 = ab then exe [a; a] else
            if a1 = ag then exe [a] else
            if a1 = dh then exe [d'; a'] else
            if a1 = pd then exe [h'; d'; h] else
            if a1 = db then exe [d; a'; d'] else
            if a1 = gh then exe [g; a] else
            if a1 = pg then exe [h; g; h'] else
            if a1 = gb then exe [g'; a; g] else
            if a1 = ph then exe [p; p; b; b; a; a] else
            if a1 = pb then exe [b; b; a; a] else
              raise Placer_angle_frontal_haut
        
        and mal_oriente () = cube.mouvement2.mv2.rot_angles.(angle_reel ah) <> 0
        in
          for i = 0 to 3 do
            placer_angle_frontal_haut ();
            if mal_oriente () then exe [h'; d'; h; a'];
            exe [h0]
          done
      
      and placer_et_orienter_les_coins () =
        let descendre_coin () =
          let c1 = deplacement_coin (coin_reel adh) in
            if c1 = pdh then exe [p'; b'; p] else
            if c1 = pgh then exe [p; b; b; p'] else
            if c1 = agh then exe [g; b; g'] else
            if c1 = adh then exe [a; b; a'; b'] else
            if c1 = pdb then exe [b'] else
            if c1 = pgb then exe [b; b] else
            if c1 = agb then exe [b] else
            if c1 = adb then ()
            else raise Descendre_coin
        
        and remonter_coin () =
          let c1 = coin_reel adh in
            let c2 = deplacement_coin c1 in
              if c2 = adh && cube.mouvement2.mv2.rot_coins.(c2) = 0 then ()
              else (
                  let etat1 = cube.mouvement2.mv2 $ conjc cube.context2.matrice rub_a'
                  and etat2 = cube.mouvement2.mv2 $ conjc cube.context2.matrice rub_d in
                    if etat1.rot_coins.(c1) = 0 then exe [a'; d; a; d'] else
                    if etat2.rot_coins.(c1) = 0 then exe [d; a'; d'; a] else
                      exe [a; b'; a'; b; b; d; a'; d'; a]
                )
        in
          for i = 0 to 3 do
            descendre_coin ();
            remonter_coin ();
            exe [h0]
          done;
      
      in
        if completement then orienter_le_centre ();
        placer_et_orienter_les_angles ();
        placer_et_orienter_les_coins ();
    
    and niveau_median () =
      
      (* niveau médian *)
      
      let orienter_les_centres_lateraux () =
        let aux () =
          (*let n = nqt cube.mouvement2.mv2 cube.context2.matrice [|1; 0; 0|]*)
          let n = nqt cube.mouvement2.mv2 ([|1; 0; 0|] /:/ transpose cube.context2.matrice)
          in
            if n <> 0 then
              (
                exe [a; a; b; b];
                (
                  if n = 1 then
                    exe [a']
                  else if n = 2 then
                    exe [a; a]
                  else if n = 3 then
                    exe [a];
                );
                exe [b; b; a; a]
              )
        in
          exe [aux; h0; aux; h0; aux; h0; aux; h0]
      
      and placer_angle_frontal_droit () =
        let descendre_angle () =
          let a1 = deplacement_angle (angle_reel ad)
          and aux () = exe [b; a; b'; a'; b'; d'; b; d] in
            if a1 = ad then aux () else
            if a1 = pd then exe [h0; aux; h0'] else
            if a1 = pg then exe [h0; h0; aux; h0; h0] else
            if a1 = ag then exe [h0'; aux; h0] else
              ()
        and remonter_angle () =
          let aux_r () = exe [b'; d'; b; d; b; a; b'; a']
          and aux_l () = exe [b; a; b'; a'; b'; d'; b; d]
          and a1 = angle_reel ad in
            let a2 = deplacement_angle a1
            and r1 = conjc cube.context2.matrice rub_b in
              let etat = ref cube.mouvement2.mv2 in
                if a2 = gb then etat := !etat $ r1 else
                if a2 = pb then etat := !etat $ r1 $ r1 else
                if a2 = db then etat := !etat $ inv r1;
                etat := !etat $ conjc cube.context2.matrice rub_a';
                let b1 = (!etat).perm_angles.(a1) in
                  if (!etat).rot_angles.(b1) = 0 then (
                      if a2 = ab then aux_r () else
                      if a2 = gb then exe [b; aux_r] else
                      if a2 = pb then exe [b; b; aux_r] else
                      if a2 = db then exe [b'; aux_r]
                      else raise Remonter_angle
                    ) else (
                      if a2 = ab then exe [b; aux_l] else
                      if a2 = gb then exe [b; b; aux_l] else
                      if a2 = pb then exe [b'; aux_l] else
                      if a2 = db then aux_l ()
                      else raise Remonter_angle
                    )
        in
          
          let a1 = angle_reel ad in
            let a2 = deplacement_angle a1 in
              if a2 <> ad || cube.mouvement2.mv2.rot_angles.(a1) <> 0 then (
                  descendre_angle ();
                  remonter_angle ()
                )
      
      in
        if completement then orienter_les_centres_lateraux ();
        for i = 0 to 3 do
          placer_angle_frontal_droit ();
          exe [h0]
        done
    
    and niveau_inferieur () =
      
      (* niveau inférieur *)
      
      let orienter_les_angles () =
        let est_mal_oriente angle =
          let state = cube.mouvement2.mv2
          and r1 = ref e2
          and r2 = conjc cube.context2.matrice rub_b
          and a1 = angle_reel angle
          in
            let x = (perm_inverse state.perm_angles).(a1) and n = ref 0 in
              while (!r1).perm_angles.(x) <> a1 do
                r1 := !r1 $ r2;
                incr n;
                if !n > 4 then raise Est_mal_oriente
              done;
              state.rot_angles.(x) <> (!r1).rot_angles.(x)
        
        in
          let v = map_vect est_mal_oriente [|ab; gb; pb; db|]
          in match (v.(0), v.(1), v.(2), v.(3)) with
              | (false, false, false, false) -> ()
              | (true, true, true, true) ->
                  exe [d; b; a; b'; a'; d'; b; d; a; b; a'; b'; d']
              
              | (false, false, true, true) -> exe [h0; d; b; a; b'; a'; d']
              | (true, false, false, true) -> exe [d; b; a; b'; a'; d']
              | (true, true, false, false) -> exe [h0'; d; b; a; b'; a'; d']
              | (false, true, true, false) -> exe [h0; h0; d; b; a; b'; a'; d']
              
              | (false, _, false, _) -> exe [d; a; b; a'; b'; d']
              | (_, false, _, false) -> exe [h0; d; a; b; a'; b'; d']
              | _ -> raise Orienter_les_angles
      
      and placer_les_angles () =
        if completement then
        (* on fait en sorte que le nombre de quarts de tours soit nul modulo 4 *)
        (* la permutation des coins devrait alors être paire *)
        (* de même que la permutation des angles *)
          (
          (*let n = nqt cube.mouvement2.mv2 cube.context2.matrice ([|0; 0; - 1|]) in*)
            let n = nqt cube.mouvement2.mv2 ([|0; 0; - 1|] /:/ transpose cube.context2.matrice) in
              if n = 1 then exe [b'] else if n = 3 then exe [b] else if n = 2 then exe [b; b]
          )
        else
        (* on fait en sorte que la permutation des angles soit paire *)
          (
            if signature cube.mouvement2.mv2.perm_angles = - 1 then exe [b]
          );
        let permuter () =
          (* laisse fixe l'angle arrière et permute circulairement les autres *)
          (* dans le sens direct vu d'en bas *)
          exe [d; b; b; d'; b'; d; b'; d']
        and permuter' () =
          (* laisse fixe l'angle arrière et permute circulairement les autres *)
          (* dans le sens indirect vu d'en bas *)
          exe [d; b; d'; b; d; b; b; d']
        in
          let chercher_un_angle_bien_place () =
            let i = ref 0 in
              while !i < 4 && deplacement_angle (angle_reel pb) <> pb do
                exe [h0];
                incr i
              done;
              !i
          in
            let j = chercher_un_angle_bien_place () in
              if j = 4 (* aucun angle bien placé *) then (
                  permuter ();
                  let _ = chercher_un_angle_bien_place () in ()
                )
              else ();
              let a1 = deplacement_angle (angle_reel ab) in
                if a1 = gb then permuter () else
                if a1 = db then permuter' () else
                if a1 = ab then ()
                else raise Placer_les_angles
      
      and placer_les_coins () =
        (* à ce stade la permutation des coins devrait être paire *)
        let permuter () =
          (* laisse fixe le coin frontal droit et permute circulairement 
          les autres dans le sens direct vu d'en bas *)
          exe [b; a; b'; p'; b; a'; b'; p]
        and permuter' () =
          (* laisse fixe le coin frontal droit et permute circulairement 
          les autres dans le sens indirect vu d'en bas *)
          exe [p'; b; a; b'; p; b; a'; b']
        in
          let chercher_un_coin_bien_place () =
            let i = ref 0 in
              while !i < 4 && deplacement_coin (coin_reel adb) <> adb do
                exe [h0];
                incr i
              done;
              !i
          in
            let j = chercher_un_coin_bien_place () in
              
              if j = 4 (* aucun coin bien placé *) then (
                  permuter ();
                  let _ = chercher_un_coin_bien_place () in ()
                )
              else ();
              let c1 = deplacement_coin (coin_reel pgb) in
                if c1 = agb then permuter () else
                if c1 = pdb then permuter' () else
                if c1 = pgb then ()
                else failwith "placer_les_coins"
      
      and orienter_les_coins () =
        let faire_tourner () =
          (* fait tourner les coins frontaux inférieurs sur eux-mêmes: 
          le coin gauche dans le sens direct, le coin droit en sens inverse *)
          exe [p'; b'; p; b'; p'; b; b; p];
          exe [a; b; a'; b; a; b; b; a']
        and faire_tourner' () =
          (* fait tourner les coins frontaux inférieurs sur eux-mêmes:
          le coin droit dans le sens direct, le coin gauche en sens inverse *)
          exe [a; b; b; a'; b'; a; b'; a'];
          exe [p'; b'; b'; p; b; p'; b; p]
        and rot_coin coin = (* coin supposé en place *)
          let m = cube.mouvement2.mv2 in
            m.rot_coins.(m.perm_coins.(coin_reel coin))
        
        in
          let orienter_frontal_inferieur_droit () =
            let n = rot_coin adb in
              if n = 0 then () else
              if n = 1 then faire_tourner' () else
              if n = 2 then faire_tourner () else
                raise Orienter_les_coins
          in
            for i = 0 to 2 do
              orienter_frontal_inferieur_droit ();
              exe [h0']
            done;
      
      in
        orienter_les_angles ();
        placer_les_angles ();
        placer_les_coins ();
        orienter_les_coins ()
    in
      cube.liste_ops2 := [];
      try
        let ctx = cube.context2.matrice in
          niveau_superieur ();
          niveau_median ();
          niveau_inferieur ();
          cube.context2.matrice <- ctx;
          cube.dessine2 ();
          !(cube.liste_ops2)
      with
      | Orienter_les_coins ->
            print_string "erreur dans orienter_les_coins\n"; !(cube.liste_ops2)
        | Placer_les_coins ->
            print_string "erreur dans placer_les_coins\n"; !(cube.liste_ops2)
        | Placer_les_angles ->
            print_string "erreur dans placer_les_angles\n"; !(cube.liste_ops2)
        | Orienter_les_angles ->
            print_string "erreur dans orienter_les_angles\n"; !(cube.liste_ops2)
        | Est_mal_oriente ->
            print_string "erreur dans est_mal_orienté\n"; !(cube.liste_ops2)
;;

(* mélange du cube *)
let melanger cube =
  let (OPS (a, d, h), OPS (a', d', h'), OPS (p, g, b), OPS (p', g', b')) = cube.op_externes2
  and s = vect_of_list (random_list (liste 12))
  and v = make_vect 12 (fun () -> ()) in
    v.(s.(0)) <- a; v.(1) <- d; v.(2) <- h; v.(s.(3)) <- a'; v.(s.(4)) <- d'; v.(s.(5)) <- h';
    v.(s.(6)) <- p; v.(s.(7)) <- g; v.(s.(8)) <- b; v.(s.(9)) <- p'; v.(s.(10)) <- g'; v.(s.(11)) <- b';
    let t = make_vect 30 (fun () -> ()) in
      for i = 0 to 29 do
        t.(i) <- v.(random__int 12);
      done;
      exe (list_of_vect t)
;;

(* cube muet invisible dans l'état 'mv1'  orienté de façon standard *)
(* utilisé par la fonction 'est_rubik' *)
let nouveau_cube2_muet mv1 =
    nouveau_cube2 mv1 {matrice = id} (fun _ _ -> ()) false
;;

(* cube invisible dans l'état 'mv1' orienté de façon standard *)
(* écrivant les mouvements de ses faces - quarts de tours - *)
(* et les renvoyant sous forme de liste *)
let nouveau_cube2_verbeux mv1 =
  nouveau_cube2 mv1 {matrice = id} (fun _ _ -> ()) true
;;

(* cube avec affichage graphique dans l'état 'mv1' orienté de façon standard *)
(* suppose l'ouverture préalable de la fenêtre graphique pour fonctionner *)
let nouveau_cube2_graphique mv1 =
  nouveau_cube2 mv1 {matrice = id} dessine_cube true
;;

(*- fin de Rubik's cube virtuel *)


(* test d'appartenance d'un mouvement au sous-groupe R *)
(* fondé sur la résolution par niveaux *)
let est_rubik mv2 =
  let mouvement = {mv2 = mv2} in
    let _ = resoudre_le_cube (nouveau_cube2_muet mouvement) true
    in
      mouvement.mv2 = e2
;;

(* EXEMPLES *)

let mv2 = mv2_rubik_r ();;
est_dans_R mv2;;
est_rubik mv2;;

let cube = nouveau_cube2_graphique {mv2 = mv2};;

boucle2 cube
(
  fun () -> cube.mouvement2.mv2 <- mv2_rubik_r (); cube.dessine2 ()
)
(
  fun () -> let n = list_length (resoudre_le_cube cube false) in
          (printf__printf "\nnombre de mouvements: %d\n" n;
            print_newline ()
          )
)
(
  fun () -> let n = list_length (resoudre_le_cube cube true) in
          (printf__printf "\nnombre de mouvements: %d\n" n;
            print_newline ()
          )
)
;;

let cube = nouveau_cube2_verbeux {mv2 = mv2};;
resoudre_le_cube cube true;;

(*-------------------------------------------------------------------------------------------------------------------------*)

(* Pour utiliser directement ce qui suit, interrompre la boucle ci-dessus et procéder par lignes entières.
   Sélectionner et envoyer ensemble les 6 lignes suivantes (let cube = ...) ...

let cube = nouveau_cube2_graphique {mv2 = mv2};;
Graphics.open_graph " 612x612";;
cube.dessine2();;
let (OPS (a0, d0, h0), OPS(a0', d0', h0')) = cube.op_globales2;;
let (OPS (a, d, h), OPS(a', d', h'), OPS(p, g, b), OPS(p', g', b')) = cube.op_externes2;;
let (OPS (orange, vert, blanc), OPS(orange', vert', blanc'), OPS(rouge, bleu, jaune), OPS(rouge', bleu', jaune')) = cube.op_internes2;;

... puis exécuter une par une certaines des commandes qui suivent : (sélectionner une ligne puis l'envoyer)


a0();;
a0'();;

h0();;
h0'();;

d0();;
d0'();;


a();;
a'();;

p();;
p'();;

d();;
d'();;

g();;
g'();;

h();;
h'();;

b();;
b'();;



orange();;
orange'();;

rouge();;
rouge'();;

vert();;
vert'();;

bleu();;
bleu'();;

blanc();;
blanc'();;

jaune();;
jaune'();;

*)


(*----------------- Quelques formules utilisées pour résoudre le cube --------------------*)

(*

  (* NIVEAU SUPÉRIEUR face haute, blanche en principe *)

  (* placement du coin supérieur frontal droit à partir d'en dessous: face blanche *)      
  (* vers le bas : [a,b']b[d a'] *)
exe [a;b';a';b;b;d;a';d';a];;
  (* mouvement inverse *)
exe (rev[a';b;a;b;b;d';a;d;a']);;

  (* placement du coin supérieur frontal droit à partir de : face blanche frontale *)
  (* avec autre face correcte *)
exe [d;a';d';a];;
  (* mouvement inverse *)
exe [a';d;a;d'];;

  (* placement du coin supérieur frontal droit à partir de : face blanche à droite *)
  (* avec autre face correcte *)
exe [a';d;a;d'];;


  (* NIVEAU MÉDIAN *)

  (* montée des angles *)
  
  (* [b,a][b',d'] montée vers la gauche *)
exe [b;a;b';a';b';d';b;d];;
  (* mouvement inverse *)
exe (rev [b';a';b;a;b;d;b';d']);;

  (* [b',d'][b,a] montée vers la droite *)
exe [b';d';b;d;b;a;b';a'];;
  (* mouvement inverse *)
exe (rev [b;d;b';d';b';a';b;a]);;


  (* NIVEAU INFÉRIEUR (les précédents déjà faits) *)

  (* ORIENTER LES ANGLES *)

  (* aucune face jaune d'angle bien orientée *)
  (* d.[b,a].b *)
exe [d;b;a;b';a';d';b;d;a;b;a';b';d'];;
  (* mouvement inverse *)
exe (rev [d';b';a';b;a;d;b';d';a';b';a;b;d]);;

  (* deux faces jaunes à se suivre bien orientées: gauche et arrière *)
  (* d.[b,a] *)
exe [d;b;a;b';a';d'];;
  (* mouvement inverse *)
exe (rev [d';b';a';b;a;d]);;

  (* deux faces jaunes alignées avec le centre: face et arrière *)
  (* d.[a,b] *)
exe [d;a;b;a';b';d'];;
  (* mouvement inverse *)
exe (rev [d';a';b';a;b;d]);;

  (* PERMUTER LES ANGLES *)

  (* laisse fixe l'angle inférieur arrière et permute circulairement les trois autres *)
  (* (db).[b,d'] *)
exe [d;b;b;d';b';d;b';d'];;
  (* mouvement inverse *)
exe (rev [d';b';b';d;b;d';b;d]);;

  (* échange des angles arrière et droit *)
  (* (db).[b,d']b' *)
exe [d;b;b;d';b';d;b';d';b'];;
  (* mouvement inverse *)
exe (rev [d';b';b';d;b;d';b;d;b]);;

  (* PERMUTER LES COINS *)

  (* laisse fixe le coin frontal droit et permute circulairement les autres : *)
  (* [p' b.a] *)
exe [p';b;a;b';p;b;a';b'];;
  (* mouvement inverse *)
exe (rev [p;b';a';b;p';b';a;b]);;

  (* ORIENTER LES COINS *)

  (* fait tourner les coins frontaux sur eux-mêmes: le coin gauche *)
  (* dans le sens des aiguilles d'une montre le coin droit en sens inverse *)
  (* (ab).[b,a'] (p'b').[b',p] *)

exe [a;b;b;a';b';a;b';a'];;
exe [p';b';b';p;b;p';b;p];;
  (* mouvement inverse *)
exe [p';b';p;b';p';b;b;p];;
exe [a;b;a';b;a;b;b;a'];;

*)
