(*********************************BLOC DE FONCTION EN VRAC (REUTILISABLES)*************************************)
let string_of_char = fun a ->
    String.make 1 a;;

let rec aux2 l elem res2 = match l with
    []->res2
    |h::t-> aux2 t elem ((elem^h)::res2) ;;

let produitCartesien l1 l2 =
    let rec aux l1 l2 res = match l1 with
        []->res
        |h::t-> aux t l2 res@(aux2 l2 h [])
    in aux l1 l2 [] ;;

(*let concatFiltrage l1 l2 = (* TODO concat 2 liste en évitant doubles nécessite let equaltMot m1 m2*)
    let rec aux ltmp res = match ltmp with
        []->res
        |h::t-> begin
                    match l2 with
                        []-> aux t (h::res)
                        |h2::t2-> if (h=h2) then aux t res
                end
    in aux l1 l1 ;;*)

(**********************************BLOC DE LECTURE ET D ANALYSE DES VARIABLES**********************************)
let rec appartient l arg = match l with
    []->false
    |h::t-> if h=arg then true
            else appartient t arg
    ;;

let lecture s =
    let rec aux s2 var = match s2 with    (*compte le nombre de variable*)
        ""-> var
        |a-> if ((String.get a 0)!='+' && (String.get a 0)!='.' && (String.get a 0)!='!') then(*pas un opérateur*)
                    if (appartient var (String.get a 0)) then aux (String.sub a 1 ((String.length a)-1)) var (*h € var go *)
                    else aux (String.sub a 1 ((String.length a)-1)) (var@[(String.get a 0)]) (*on rajoute h à var *)
                else aux (String.sub a 1 ((String.length a)-1)) var
        in aux s [] ;;

let lectureString s = List.map (string_of_char) (lecture s) ;;

(**********************************BLOC DE GESTION DE COMPLETION D UN MOT**********************************)

(************SOUS BLOC DE DETECTION DES VARIABLES MANQUANTES
             ET CREATION DES LISTES CORRESPONDANTES***********)
let soustraction mot var =
    let rec aux mot var res = match var with
        []->res
        |h::t-> if (String.contains mot h) then aux mot t res (*rentre toujours ici*)
                else aux mot t (h::res)
    in aux mot var [] ;;

let preparation manquants = (*prends liste de char manquants et renvoit liste de liste(binome) contenant une var et son opposé
                             ex ['a';'b']->[ ["a";"!a"] ; ["b";"!b"] ]*)
    let rec aux l res = match l with
        []->res
        |h::t-> aux t (((String.make 1 h)::("!"^(String.make 1 h))::[])::res)
    in aux manquants [] ;;


(************SOUS BLOC DE CREATION DES PERMUTATIONS***********)

let rec permutationBinaire l =
    let rec aux l2 res = match l2 with
        []->[]
        |h::t-> if (t!=[]) then aux t ((produitCartesien res (List.hd t)))
                else res
    in aux l (List.hd l) ;;
(* permutationBinaire [ ["a";"!a"] ; ["b";"!b"] ; ["c";"!c"] ]
<=>(produitCartesien ["c";"!c"] (produitCartesien ["a";"!a"] ["b";"!b"])) ;;
=> renvoit une string list de toutes les permutations binaires *)

(********SOUS BLOC D ASSEMBLAGE DU MOT ET DES PERMS****)

let add s l = (*concat d'une string sur tout les elements d'une list -> renvoit une liste de mot a ajouté à la phrase *)
    let rec aux l2 res = match l2 with
        []->res
        |h::t-> aux t ((h^s)::res)
    in aux l [] ;;

(*********ASSEMBLAGE DE TOUT LES SOUS BLOCS************)

let completion mot var = (* prends en entrée le tableau de chars des variables, et une string correspondant au mot à compléter *)
    add mot (permutationBinaire (preparation (soustraction mot var) ) ) ;;
(* utilisation: completion "a" ['a';'b';'c';'d'] ;; *)




(**********************************BLOC DE COMPLETION DE LA PHRASE**************************************)

let rec appartenance s l = match l with (*vérifie que toutes les caractères de l ou leurs négations sont dans s *)
    []->true
    |h::t-> if (String.contains s h=false) then false
         else appartenance s t

(*let conversionDijonctive sDepart =
    let rec aux var s mot res = match s with
        ""->res
        |a->begin
            match (String.get a 0 ) with
                '+'-> begin
                        match (appartenance mot var) with
                            true->(* Si mot Contient toutes les vars/leurs négations *)
                                aux var ( String.sub s 1 ((String.length s)-1) ) (* <=>reste de s *)  ""(* on démarre un nouveau mot=>nouvelle String *) (mot::res)(* on ajoute le mot à res *)
                            |false-> aux var ( String.sub s 1 ((String.length s)-1) )(* <=>reste de s *)  ""(* on démarre un nouveau mot=>nouvelle String *) (concatFiltrage (completion mot var) res)(* pas de (completion mot var)@res car il faut filtrer les doubles aussi *)(*complétion du mot*)
                      end
                |'!'-> aux var ( String.sub s 2 ((String.length s)-2) )(* <=>reste de s *) (mot^(String.sub a 0 1)^(String.sub a 1 1))(* on continue de construire le mot en prenant deux lettres car on tombe sur une négation *) res
                |_-> aux var ( String.sub s 1 ((String.length s)-1) )(* <=>reste de s *) (mot^(String.sub a 0 1))(* on continue de construire le mot *) res
            end
    in aux (lecture sDepart) (sDepart^"+") "" [] ;; (* sDepart^"+" pour gérer le cas abcd+a sinon a ne sera pas compléter*)
*)





        let string_of_char = fun a ->
    String.make 1 a;;

    let exclusive_or = fun a b ->
    if a=b
            then "0"
            else "1"
    ;;

    (*conversion de décimal en binaire*)
    let rec bin_of_dec_root = fun nb_dec ->
            if nb_dec = 0 then
                    ""
                    else
                    (bin_of_dec_root (nb_dec/2))^(string_of_int (nb_dec mod 2));;

    let rec add_zeros = fun string nb_of_zeros ->
            if nb_of_zeros = 0 then string
            else
            add_zeros ("0"^string) (nb_of_zeros-1)
            ;;
    let bin_of_dec = fun nb_bt nb_dec ->
            let result = bin_of_dec_root nb_dec in
            add_zeros result (nb_bt-(String.length result))
            ;;


    let gray_of_bin = fun bin_string ->
    let rec aux = fun index gray_string ->
                    if index>=(String.length bin_string) then gray_string
                    else
                    aux (index+1) (gray_string^(exclusive_or (String.get bin_string (index-1)) (String.get bin_string index)))
    in aux 1 (string_of_char(String.get bin_string 0))
    ;;

    let gray_of_dec = fun nb_dec nb_bit->
            gray_of_bin (bin_of_dec nb_bit nb_dec)
            ;;

    (*placer ici fst de split list_arg ou snd de split list_arg*)
    let rec get_gray = fun word list_arg ->
            match list_arg with
            [] -> ""
            |h::t -> let  index = (String.index word (String.get h 0)) in
                                    if index>0 then
                                            if (String.get word (index-1))='!'
                                                    then "0"^(get_gray word t)
                                                    else "1"^(get_gray word t)
                                            else "1"^(get_gray word t)
    ;;

    let bin_of_gray = fun gray_string ->
    let rec aux = fun index bin_string ->
                    if index>=(String.length gray_string) then bin_string
                    else
                    aux (index+1) (bin_string^(exclusive_or (String.get bin_string (index-1)) (String.get gray_string index)))
    in aux 1 (string_of_char(String.get gray_string 0))
    ;;

    let rec int_of_bin = fun bin_string ->
            if (String.length bin_string)>=1
                    then
                    if ((String.get bin_string 0)='1')
                            then
                            (int_of_float (2.**(float_of_int ((String.length bin_string)-1))))+int_of_bin ( String.sub bin_string 1 ((String.length bin_string)-1))
                            else
                            int_of_bin ( String.sub bin_string 1 ((String.length bin_string)-1))
            else 0
    ;;

    let get_index = fun word list_arg ->
            int_of_bin( bin_of_gray ( get_gray word list_arg));;


    (*récupération en utilisant des coordonnées*)
    let get_expr = fun nb_gray list_arg ->
            let rec aux = fun ret nb list_arg ->
                    if nb="" then
                            ret
                            else
                                    let variable =  (if (String.get nb 0)='1' then "" else "!") in
                                    aux (ret^variable^(List.hd list_arg)) (String.sub nb 1 ((String.length nb)-1)) (List.tl list_arg)
            in aux "" nb_gray list_arg;;
    (*attention liste d'arguments splittée*)
    (*récupère un mot en utilisant des coordonnées*)
    let get_word = fun coord list_arg ->
    (get_expr (gray_of_dec(fst coord) (List.length (fst list_arg))) (fst list_arg))^(get_expr (gray_of_dec(snd coord) (List.length (snd list_arg))) (snd list_arg))
    ;;
    (*affect en utilisant du code gray*)

    let affect2 = fun word list_arg table ->
            let rec aux = fun index table ->
                    if index = 0 then
                            match table with
                            [h] -> [1]
                            |h::t -> 1::t
                    else
                            (List.hd table) :: (aux (index-1) (List.tl table))
            in aux (get_index word (snd list_arg)) table
    ;;
    let affect = fun word list_arg table ->
            let rec aux = fun index table ->
                    if index = 0 then
                            (affect2 word list_arg (List.hd table))::(List.tl table)
                            else

                            (List.hd table) :: (aux (index -1) (List.tl table))
                    in aux (get_index word (fst list_arg)) table;;

    let rec create_table = fun list_word list_arg table ->
            match list_word with
                    []->table
                    |h::t-> create_table t  list_arg (affect h list_arg table)
    ;;

    (*nombre de colonnes et de lignes en fonction du nombre d'arguments*)
    let rec create_column = fun nb_lignes content ->
            if nb_lignes = 0
                    then
                    []
                    else
                    [content]@create_column (nb_lignes-1) content
    ;;

    let init_tab = fun list_arg content ->
            let rec aux = fun nb_colonnes nb_lignes content ->
                    if nb_colonnes = 0
                            then
                            []
                            else
                            (create_column nb_lignes content) :: aux (nb_colonnes-1) nb_lignes content
            in
            let     nb_colonnes = int_of_float (2.**(float_of_int((List.length list_arg)/2))) in
            let nb_lignes =         if ((List.length list_arg) mod 2) = 0
                                                    then
                                                    int_of_float (2.**(float_of_int((List.length list_arg)/2)))
                                                    else
                                                    int_of_float (2.**(float_of_int(((List.length list_arg)/2)-1)))
            in
                    aux nb_colonnes nb_lignes content
            ;;



    let decompose = fun s ->
            let rec aux = fun s return ->
                    if (String.contains s '+') then
                    let borne = (String.index s '+') in aux (String.sub s (borne+1) ((String.length s)-(borne+1))) (return@[(String.sub s 0 borne)])
                    else
                    return@[s]
            in aux s []
    ;;

    let split = fun li ->
    let length = List.length li in let enum = (length/2)+((mod) length 2) in
    let rec aux = fun li li2 it ->
            if it = 0 then (li, li2) else aux (li@[(List.hd li2)]) (List.tl li2) (it-1)
    in aux [] li enum;;

    let rec print_line = fun list->
    match list with
    []->"\n"
    |h::t-> h^" "^(print_line t);;

    let print_table = fun table ->
    let rec aux = fun table s ->
    match table with
    []->print_string s
    |h::t -> aux t (s^(print_line h))
    in aux table "";;

    let get_value = fun coord table ->
            List.nth (List.nth table (fst coord)) (snd coord);;

    (*sondageV*)
    let sonde_verticale = fun coord table ->
            let rec aux = fun coord looped ret ->
                    if (snd coord) >= (List.length (List.hd table)) then
                            if (looped) then ret
                                    else aux ((fst coord), 0) true ret
                            else
                                    if (get_value coord table)=1 then aux ((fst coord),((snd coord)+1)) looped (ret+1)
                                            else ret
            in let line = aux coord false 0 in
                    if line<(List.length (List.hd table)) then line
                            else (List.length (List.hd table));;
    (*sondageH*)
    let sonde_horizontal = fun coord table ->
            let rec aux = fun coord looped ret ->
                    if (fst coord) >= (List.length table) then
                            if (looped) then ret
                                    else aux (0, (snd coord)) true ret
                            else
                                    if (get_value coord table)=1 then aux (((fst coord)+1),(snd coord)) looped (ret+1)
                                            else ret
            in let line = aux coord false 0 in
                    if line<(List.length table) then line
                            else (List.length table);;



    (*partie explore*)
     let pow = fun nb ->
            let rec aux = fun i tmp ->
        if (  (2.0 ** ( float_of_int((tmp+1)) )) > (float_of_int i)  )
            then tmp
        else aux i (tmp+1)
            in aux nb 0;;
    let pow2 = fun nb -> int_of_float (2.0**(float_of_int (pow nb))) ;;

    let min_list = fun list ->
            let rec aux = fun min list ->
                    match list with
                            [] -> min
                            |h::t -> let min_loc = (if (min < h) then min else h) in aux min_loc t
            in aux (List.hd list) list;;

    let get_liste = fun coord it taille_table->
            let rec aux = fun coord it ret ->
                    if it = 0
                            then ret
                            else let new_coord = ((fst coord), (if ((snd coord)+1)=taille_table then 0 else (snd coord)+1)) in
                                    aux new_coord (it-1) (ret@[new_coord])
            in aux coord (it-1) [coord];;

    let vary_col = fun coord nb_col taille->
            let rec aux = fun list nb_col->
                    if (nb_col = 0)
                            then
                                    list
                            else let x = if ((fst (List.hd list))+1)<taille then (fst (List.hd list))+1 else 0 in
                             aux (( x, snd (List.hd list))::list) (nb_col-1)
            in aux [coord] nb_col;;

    let vary_line = fun coord nb_ligne taille->
            let rec aux = fun list nb_ligne->
                    if (nb_ligne = 0)
                            then
                                    list
                            else let y = (if ((snd (List.hd list))+1)<taille then (snd (List.hd list))+1 else 0) in
                            aux (((fst (List.hd list)), y)::list) (nb_ligne-1)
            in aux [coord] nb_ligne;;

    let explore = fun coord table list_arg-> (*groupe*)
            let line = sonde_verticale coord table in
                    if line > 0 then
                            let liste = get_liste coord (pow2 line) (List.length (List.hd table)) in
                                    let min_h = min_list (List.map pow2 (List.map (fun x->sonde_horizontal x table) liste)) in
                                            let min_v = pow2 line in
                                                    let list_coord = List.map (fun x -> vary_col x (min_h-1) (List.length table)) (vary_line coord (min_v-1)(List.length (List.hd table))) in
                                                            List.map (fun x-> get_word x list_arg) (List.flatten list_coord)

                    else [];;




     let rec truc i tmp =
    if (  (2.0 ** ( float_of_int((tmp+1)) )) > (float_of_int i)  )
        then tmp
    else truc i (tmp+1) ;;
(*
let min_list = fun list ->
    let rec aux = fun min list ->
        match list with
            [] -> min
            |h::t -> let min_loc = (if min<h) then min else h) in aux min_loc t
    in aux (List.hd list) list;;
*)

let min_list = fun list ->
    let rec aux = fun min list ->
            match list with
                    [] -> min
                    |h::t -> let min_loc = (if (min < h) then min else h) in aux min_loc t
    in aux (List.hd list) list;;

let head = fun nb list ->
    let rec aux = fun nb list ret ->
        if nb = 0
            then ret
            else aux (nb -1) (List.tl list) (ret@[(List.hd list)])
    in aux nb list []






(*
let rec filtrageAux3 mot lres b = match lres with(* renvoie vrai si mot trouvé *)
    []->b
    |h::t-> if (h=mot)
                then true
                else filtrageAux3 mot t b ;;

let rec filtrageAux2 lres lretour b = match lretour with (* prends une liste de string provenant de lres et la liste de string lretour provenant de explore *) (*renvoi vrai si tout les mots de lretour trouvé dans lres *)
    []->b
    |h::t-> if ( filtrageAux3 h lres false )
                then filtrageAux2 lres t b
                else false ;;

let rec filtrageAux tres lretour b = match tres with (* prends en parametre gRes (une list de list de string) et le retour de explorer (une liste de string) retourne un boolen false si chacun des membres du retour se trouvent dans un meme membre de gRes *) (*renvoit true si lretour n'est pas trouvé <=> renvoit true si on peut ajouter*)
    []-> b
    |h::t-> if ( filtrageAux2 h lretour true)
                then filtrageAux t lretour false
                else filtrageAux t lretour b ;;

let filtrage = fun lres lretour -> filtrageAux lres lretour true ;;


let rec postTraitementAux tab tabtmp res = match tabtmp with
    |[]->res
    |h::t-> if ( filtrage (tabtmp@t) h ) (* tabtmp <=> tab - le membre en train d'etre scanné pour éviter qu'il ne se retrouve lui meme lors du filtrage *)
                then postTraitementAux tab (tabtmp::h) (h::res)
                else postTraitementAux tab (tabtmp::h) res ;;

let postTraitement t = postTraitementAux (parcours t 0 0) (parcours t 0 0) [] ;;
*)
let rec is_in = fun element list ->
   match list with
   []->false
   |h::t -> if h=element then true else is_in element t;;

let rec equals2 = fun list1 list2->
   match list1 with
   []-> true
   |h::t -> (is_in h list2)&&(equals2 t list2);;

let rec contained = fun list element ->
   match list with
      []->false
      |h::t-> if (equals2 h element) then true else contained t element;;

let clear_list = fun list ->
   let rec aux = fun ret_list buffer->
      match buffer with
         [] -> ret_list
         |h::t-> aux (if contained ret_list h then ret_list else (h::ret_list)) t
   in aux [] list;;







let rec removeVoid = fun list ->
    match list with
        []->[]
        |h::t->if h=[]
                then removeVoid t
                else (h::(removeVoid t)) ;;

let rec pick element list =
    match list with
        []->[]
        |h::t->if h=element
                   then t
                   else h::(pick element t);;

let rec contains = fun elem list ->
    match list with
        []->false
        |h::t->if (h=elem)
                    then true
                    else contains elem t ;;

let rec inclusAux = fun list1 list2 ->
    match list1 with
        []->true
        |h::t->(contains h list2) && (inclusAux t list2) ;;

let rec inclus = fun list1 list2 ->
    match list2 with
        []->false
        |h::t->(inclusAux list1 h) || (inclus list1 t) ;;

let filtrage tab =
    let rec aux tabtmp res =
        match tabtmp with
            []->res
            |h::t->if (inclus h (pick h tab))
                      then aux t res
                      else aux t (h::res)
    in aux tab [] ;;








let firstLetter mot =(* fonction qui renvoit la 1 ere lettre d'un mot *)
    if (String.get mot 0)='!'
        then "!"^(String.make 1 (String.get mot 1))
        else (String.make 1 (String.get mot 0))
    ;;

let containsLetter = fun lettre string ->
   if (String.length lettre) = 1 then
      if (String.contains string (String.get lettre 0))
        then if (String.index string (String.get lettre 0))>0
            then
                not( (String.get string (((String.index string (String.get lettre 0)))-1)) = '!')
            else true
        else false
   else
      let rec aux = fun string ->
         if String.contains string '!' then
            ((String.get string ((String.index string '!')+1)) = (String.get lettre 1))||aux (String.sub string 1 ((String.length string)-1))
            else false
      in aux string;;


let rec appartient firstLetterHtmp autreMots b =
    match autreMots with
    |[]-> b
    |h2::t2-> if (containsLetter firstLetterHtmp h2)
                then appartient firstLetterHtmp t2 true
                else appartient firstLetterHtmp t2 b
;;

let rec partieCommuneAux l premierMot res = match premierMot with
    ""-> res
    |a-> if (appartient (firstLetter a) (List.tl l) false)
            then partieCommuneAux l ( String.sub a (String.length (firstLetter a)) ((String.length a)-(String.length (firstLetter a))) )(*a-firstLetter a*) res^(firstLetter a)
            else partieCommuneAux l ( String.sub a (String.length (firstLetter a)) ((String.length a)-(String.length (firstLetter a))) ) (*a-firstLetter a*) res
;;


let partieCommune l = List.map (fun x -> partieCommuneAux x (List.hd x) "") l ;;

let rec listToStringSimplification  l = String.concat "+" (partieCommune l);;











         let get_all_coord = fun tableau -> List.flatten (List.map (fun x -> vary_line x ((List.length tableau)-1) (List.length tableau)) (vary_col (0,0) ((List.length(List.hd tableau))-1) (List.length(List.hd tableau))))

    let parcours = fun tableau list_def->
        List.map (fun x-> explore x tableau list_def) (get_all_coord tableau);;

    (* exemples prérentrés *)
        let tableauA = "!ab!c+ab!c+abc+a!bc" ;;
        let tableauB = "!ab!c!d+ab!c!d+a!b!c!d+!ab!cd+ab!cd+a!b!cd+!abcd+abcd+!abc!d+abc!d" ;;
        let tableauC = "!a!b!c!d+!ab!c!d+!ab!cd+!a!bcd+!abcd+a!b!c!d+a!bc!d";
        let tableauD = "!a!b!c!d+a!b!c!d+!ab!cd+ab!cd+a!b!cd+!abcd+abcd+a!bcd+!a!bc!d+a!bc!d" ;;
        let tableauCorners ="!a!b!c!d+a!b!c!d+!a!bc!d+a!bc!d" ;;

    (*procédure à compléter*)

    let main2 = fun string ->
        let list_arg = lectureString string in
            let list_word = decompose string in
                let tab_initial = init_tab list_arg 0 in
                    let list_def = split list_arg in
                        let tableau_de_karnaugh = create_table list_word list_def tab_initial in
                            let list_group = parcours tableau_de_karnaugh list_def in
                                let list_group_filtered = filtrage (clear_list (removeVoid list_group)) in
                                    listToStringSimplification (list_group_filtered);;
    let main() = print_string (main2 (read_line()));;


    main();;