(* #use "o_sudoku.ml";; *)
open List;;
(* *) open O_sudoku;; (* *)


(* Stratégies avancées *)


(* stratégie des alignements *)

let strategie1 () =
        let res = ref [] in
        for z = 9 downto 1 do
                for i = 9 downto 1 do
                        if m.(i).(0).(z) then (
                                let i2,i3 = match i mod 3 with
                                        | 1 -> i+1, i+2
                                        | 2 -> i-1, i+1
                                        | _ -> i-2, i-1 in
                                for jj = 2 downto 0 do
                                        let ii = (i-1)/3 and jj2,jj3 = match jj with
                                                | 0 -> 1,2
                                                | 1 -> 0,2
                                                | _ -> 0,1 in
                                        if c.(ii).(jj).(z) then (
                                                let b = ref true in
        (* les possibilités pour z dans le carré ii,jj sont sur la ligne i et donc z à enlever du reste de la ligne *)
                                                if c.(ii).(jj2).(z) || c.(ii).(jj3).(z) then (
                                                        for jjj = 1 to 3 do
                                                                let j = jj*3+jjj in
                                                                if m.(i2).(j).(z) then b:= false;
                                                                if m.(i3).(j).(z) then b:= false;
                                                        done;
                                                        if !b then (
                                                                let preuve = ref [] and barre = ref [] in
                                                                for jjj = 3 downto 1 do
                                                                        let j = jj*3+jjj
                                                                        and j3 = jj3*3+jjj
                                                                        and j2 = jj2*3+jjj in
                                                                        if m.(i).(j).(z) then
                                                                                preuve:= (i,j,z) :: !preuve;
                                                                        if m.(i).(j3).(z) then
                                                                                barre:= (i,j3,z) :: !barre;
                                                                        if m.(i).(j2).(z) then
                                                                                barre:= (i,j2,z) :: !barre;
                                                                done;
                                                                if !barre <> [] then res:= (!barre,!preuve) :: !res;
                                                        );
                                                );
                                                b:= true;
        (* les possibilités pour z dans la ligne i sont dans le carré ii,jj et donc z à enlever du reste du carré *)
                                                for jjj = 1 to 3 do
                                                        let j2 = jj2*3+jjj and j3 = jj3*3+jjj in
                                                        if m.(i).(j2).(z) then b:= false;
                                                        if m.(i).(j3).(z) then b:= false;
                                                done;
                                                if !b then (
                                                        let preuve = ref [] and barre = ref [] in
                                                        for jjj = 3 downto 1 do
                                                                let j = jj*3+jjj in
                                                                if m.(i).(j).(z) then
                                                                        preuve:= (i,j,z) :: !preuve;
                                                                if m.(i3).(j).(z) then
                                                                        barre:= (i3,j,z) :: !barre;
                                                                if m.(i2).(j).(z) then
                                                                        barre:= (i2,j,z) :: !barre;
                                                        done;
                                                        if !barre <> [] then res:= (!barre,!preuve) :: !res;
                                                );
                                        );
                                done;
                        );
                done;
                for j = 9 downto 1 do
                        if m.(0).(j).(z) then (
                                let j2,j3 = match j mod 3 with
                                        | 1 -> j+1, j+2
                                        | 2 -> j-1, j+1
                                        | _ -> j-2, j-1 in
                                for ii = 2 downto 0 do
                                        let jj = (j-1)/3 and ii2,ii3 = match ii with
                                                | 0 -> 1,2
                                                | 1 -> 0,2
                                                | _ -> 0,1 in
                                        if c.(ii).(jj).(z) then (
                                                let b = ref true in
        (* les possibilités pour z dans le carré ii,jj sont sur la colonne j et donc z à enlever du reste de la colonne *)
                                                if c.(ii2).(jj).(z) || c.(ii3).(jj).(z) then (
                                                        for iii = 1 to 3 do
                                                                let i = ii*3+iii in
                                                                if m.(i).(j2).(z) then b:= false;
                                                                if m.(i).(j3).(z) then b:= false;
                                                        done;
                                                        if !b then (
                                                                let preuve = ref [] and barre = ref [] in
                                                                for iii = 3 downto 1 do
                                                                        let i = ii*3+iii
                                                                        and i3 = ii3*3+iii
                                                                        and i2 = ii2*3+iii in
                                                                        if m.(i).(j).(z) then
                                                                                preuve:= (i,j,z) :: !preuve;
                                                                        if m.(i3).(j).(z) then
                                                                                barre:= (i3,j,z) :: !barre;
                                                                        if m.(i2).(j).(z) then
                                                                                barre:= (i2,j,z) :: !barre;
                                                                done;
                                                                if !barre <> [] then res:= (!barre,!preuve) :: !res;
                                                        );
                                                );
                                                b:= true;
        (* les possibilités pour z dans la colonne j sont dans le carré ii,jj et donc z à enlever du reste du carré *)
                                                for iii = 1 to 3 do
                                                        let i2 = ii2*3+iii and i3 = ii3*3+iii in
                                                        if m.(i2).(j).(z) then b:= false;
                                                        if m.(i3).(j).(z) then b:= false;
                                                done;
                                                if !b then (
                                                        let preuve = ref [] and barre = ref [] in
                                                        for iii = 3 downto 1 do
                                                                let i = ii*3+iii in
                                                                if m.(i).(j).(z) then
                                                                        preuve:= (i,j,z) :: !preuve;
                                                                if m.(i).(j3).(z) then
                                                                        barre:= (i,j3,z) :: !barre;
                                                                if m.(i).(j2).(z) then
                                                                        barre:= (i,j2,z) :: !barre;
                                                        done;
                                                        if !barre <> [] then res:= (!barre,!preuve) :: !res;
                                                );
                                        );
                                done;
                        );
                done;
        done;
        !res;
;;


(* stratégie des cliques *)

let strategie2 () =

        let mposs m =
                let poss = Array.make_matrix 9 9 [] in
                for i = 1 to 9 do
                        for j = 1 to 9 do
                                let p = ref [] in
                                for z = 9 downto 1 do
                                        if m.(i).(j).(z) then p:= z :: !p;
                                done;
                                poss.(i-1).(j-1) <- !p;
                        done;
                done;
                poss;
        in

        let rec union k l = match k,l with
                | [], p -> p
                | p, [] -> p
                | (a::q), (b::r) when a = b -> a :: (union q r)
                | (a::q), (b::r) when a < b -> a :: (union q (b::r))
                | l,      (b::r)            -> b :: (union l r)
        in

        let rec intersect k l = match k,l with
                | [], p -> []
                | p, [] -> []
                | (a::q), (b::r) when a = b -> a :: (intersect q r)
                | (a::q), (b::r) when a < b -> intersect q (b::r)
                | l,      (b::r)            -> intersect l r
        in

        let rec base2 = function
                | 0 -> "0"
                | 1 -> "1"
                | n -> (base2 (n/2)) ^ (base2 (n mod 2))
        in

        let base2a9chiffres n =
                let s = base2 n in
                (String.make (9 - String.length s) '0') ^ s;
        in

        let rec enumerer i j = function
                | [] -> []
                | (z::q) -> (i,j,z) :: (enumerer i j q)
        in

        let rec assoc a = function
                | [] -> failwith "pas d'association"
                | ((b,c)::_) when a = b -> c
                | (_::q) -> assoc a q
        in

        let res = ref [] and mm = mposs m in
        for i = 9 downto 1 do
                if m.(i).(0).(0) then (
                        for u = 510 downto 1 do
                                let uu = base2a9chiffres u and u1 = ref [] and u2 = ref [] and uN = ref 0 in
                                for j = 1 to 9 do
                                        if uu.[j-1] = '1' then (u1:= union !u1 mm.(i-1).(j-1) ; incr uN;)
                                                          else  u2:= union !u2 mm.(i-1).(j-1);
                                done;
                                if length !u1 = !uN then (
                                        let abarrer = intersect !u1 !u2 in
                                        if abarrer <> [] then (
                                                let barre = ref [] and preuve = ref [] in
                                                for j = 1 to 9 do
                                                        if uu.[j-1] = '0' then (
                                                                let abarrer1 = intersect mm.(i-1).(j-1) abarrer in
                                                                if abarrer1 <> [] then (
                                                                        barre:= !barre @ (enumerer i j abarrer1);
                                                                );
                                                        ) else (
                                                                preuve:= !preuve @ (enumerer i j !u1);
                                                        );
                                                done;
                                                try
                                                        if length !preuve < length (assoc !barre !res) then
                                                                res:= (!barre,!preuve) :: !res;
                                                with Failure "pas d'association" ->
                                                                res:= (!barre,!preuve) :: !res;
                                        );
                                );
                        done;
                );
        done;
        for j = 9 downto 1 do
                if m.(0).(j).(0) then (
                        for u = 510 downto 1 do
                                let uu = base2a9chiffres u and u1 = ref [] and u2 = ref [] and uN = ref 0 in
                                for i = 1 to 9 do
                                        if uu.[i-1] = '1' then (u1:= union !u1 mm.(i-1).(j-1); incr uN;)
                                                          else  u2:= union !u2 mm.(i-1).(j-1);
                                done;
                                if length !u1 = !uN then (
                                        let abarrer = intersect !u1 !u2 in
                                        if abarrer <> [] then (
                                                let barre = ref [] and preuve = ref [] in
                                                for i = 1 to 9 do
                                                        if uu.[i-1] = '0' then (
                                                                let abarrer1 = intersect mm.(i-1).(j-1) abarrer in
                                                                if abarrer1 <> [] then (
                                                                        barre:= !barre @ (enumerer i j abarrer1);
                                                                );
                                                        ) else (
                                                                preuve:= !preuve @ (enumerer i j !u1);
                                                        );
                                                done;
                                                try
                                                        if length !preuve < length (assoc !barre !res) then
                                                                res:= (!barre,!preuve) :: !res;
                                                with Failure "pas d'association" ->
                                                                res:= (!barre,!preuve) :: !res;
                                        );
                                );
                        done;
                );
        done;
        for ii = 2 downto 0 do
        for jj = 2 downto 0 do
                if c.(ii).(jj).(0) then (
                        for u = 510 downto 1 do
                                let uu = base2a9chiffres u and u1 = ref [] and u2 = ref [] and uN = ref 0 in
                                for xx = 1 to 3 do
                                for yy = 1 to 3 do
                                        let i = ii*3+xx and j = jj*3+yy and k = (xx-1)*3+yy in
                                        if uu.[k-1] = '1' then (u1:= union !u1 mm.(i-1).(j-1); incr uN;)
                                                          else  u2:= union !u2 mm.(i-1).(j-1);
                                done;
                                done;
                                if length !u1 = !uN then (
                                        let abarrer = intersect !u1 !u2 in
                                        if abarrer <> [] then (
                                                let barre = ref [] and preuve = ref [] in
                                                for xx = 1 to 3 do
                                                for yy = 1 to 3 do
                                                        let i = ii*3+xx and j = jj*3+yy and k = (xx-1)*3+yy in
                                                        if uu.[k-1] = '0' then (
                                                                let abarrer1 = intersect mm.(i-1).(j-1) abarrer in
                                                                if abarrer1 <> [] then (
                                                                        barre:= !barre @ (enumerer i j abarrer1);
                                                                );
                                                        ) else (
                                                                preuve:= !preuve @ (enumerer i j !u1);
                                                        );
                                                done;
                                                done;
                                                try
                                                        if length !preuve < length (assoc !barre !res) then
                                                                res:= (!barre,!preuve) :: !res;
                                                with Failure "pas d'association" ->
                                                                res:= (!barre,!preuve) :: !res;
                                        );
                                );
                        done;
                );
        done;
        done;
        !res;
;;


let strategie = function
        | 1 -> strategie1
        | _ -> strategie2
;;

let applique_strategies () =
        let rec apl = function
                | [] -> []
                | (a::q) -> a @ (apl q)
        in
        let rec maj = function
                | [] -> ()
                | ((i,j,z)::q) -> m.(i).(j).(z) <- false ; maj q
        in
        let rec changezen0 = function
                | [] -> []
                | ((i,j,_)::q) -> (i,j,0) :: (changezen0 q)
        in
        let nncc = ref [] and n = ref 1 in
        if !nc = [] then nc:= [0,0,0];
        while !nc <> [] do
                if !nc = [0,0,0] then nc:= [];
                let nc2 = apl (map fst (strategie !n ())) in
                maj nc2;
                if !n = 2 && nc2 <> [] then n:= 1;
                nc:= changezen0 nc2;
                elimine m c nc;
                nncc:= !nncc @ !nc;
                if !nc = [] && !n = 1 then (nc:= [0,0,0] ; n:= 2);
        done;
        nc:= !nncc;
;;


(* Déductions exclusives *)

let dedexl parprof =
        let l1 = ref parprof and l2 = ref [] and ded = ref [] in
        let mm = copy_trinityx m and cc = copy_trinityx c in
        while !l1 <> [] do
                let h = hd !l1 in
                let nc1 = ref [h] and nc2 = ref (!l2 @ (tl !l1)) in
                copy_trinityx2 mm m ; copy_trinityx2 c cc;
                elimine mm cc nc1;
                copy_trinityx2 mm m ; copy_trinityx2 c cc;
                elimine mm cc nc2;
                ded:= (h, filter (fun x -> not (mem x !nc2)) !nc1) :: !ded;
                l2:= h :: !l2 ; l1:= tl !l1;
        done;
        rev !ded;
;;

let dedexl2 () =

        let isperm l1 l2 =
                let rec suppr a = function
                        | [] -> raise Exit
                        | (b::q) when a = b -> q
                        | (b::q) -> b::(suppr a q)
                in
                let rec aux k l = match k,l with
                        | [], [] -> true
                        | [], l -> false
                        | (a::q), l -> aux q (suppr a l)
                in
                try aux l1 l2 with Exit -> false
        in

        let mm = copy_trinityx m and cc = copy_trinityx c
        and m3 = copy_trinityx m and c3 = copy_trinityx c and nc0 = ref [] and s = ref [] in
        applique_strategies();
        while !nc <> [] do
                copy_trinityx2 mm m3 ; copy_trinityx2 cc c3;
                let a = hd !nc in
                let aa = ref [a] in
                elimine mm cc aa;
                aa:= filter (fun x -> not (mem x !nc0)) !aa;
                let nc1 = ref (a :: !aa) in
                let nc2 = !nc1
                and ss1 = ref [] and ss2 = ref [] in
                while !nc1 <> [] do
                        copy_trinityx2 mm m3 ; copy_trinityx2 cc c3;
                        let b = hd !nc1 in
                        let bb = ref [b] in
                        elimine mm cc bb;
                        bb:= filter (fun x -> not (mem x !nc0)) !bb;
                        if isperm (b :: !bb) nc2 then ss1:= b :: !ss1
                                                 else ss2:= b :: !ss2;
                        nc1:= tl !nc1;
                done;
                s:= ((rev !ss1), (rev !ss2)) :: !s;
                nc0:= !nc0 @ nc2;
                nc:= filter (fun x -> not (mem x nc2)) !nc;
        done;
        rev !s;
;;