open Motus_lib (** Represent a decision rule *) let format_filter : Format.formatter -> Criteria.t -> unit = fun formatter f -> match f with | Lenght l -> Format.fprintf formatter "Doit etre de longueur %d" l | Contain (c, None) -> Format.fprintf formatter "Doit contenir un %c" c | Contain (c, Some i) -> Format.fprintf formatter "Doit contenir un %c a la position %d" c i | NotContain (c, None) -> Format.fprintf formatter "Ne doit pas contenir un %c" c | NotContain (c, Some i) -> Format.fprintf formatter "Ne doit pas contenir un %c a la position %d" c i (** Display the informations about the structure *) let show_structure : Format.formatter -> Persistence.t -> Criteria.t list -> unit = fun format data filters -> Format.fprintf format "Filtres en cours : @[%a@]@\n" (Format.pp_print_list format_filter) filters; Format.fprintf format "Got %d elements @\n" data.number; Format.fprintf format "Frequencies : @[%a@]@\n" (Format.pp_print_list (fun f (k, v) -> Format.fprintf f "%c -> %d" k v)) (Persistence.extract_freq data); if data.number < 20 then Format.fprintf format "Remaining words @[@;%a@]@\n" (Format.pp_print_list ~pp_sep:Format.pp_force_newline (fun f w -> Format.fprintf f "%s" w ) ) data.element; Format.close_box () (** Get the initial list *) let rec get_list : in_channel -> Persistence.t -> Criteria.t list -> Persistence.t = fun channel data filters -> let word = try Some (String.lowercase_ascii (Stdlib.input_line channel)) with | End_of_file -> None in match word with | None -> data | Some word -> let data = Persistence.add_word filters data word in get_list channel data filters (** Compare the proposed word and the result from the user in order to identify the future rules to apply *) let create_new_rules word result = let rules = ref [] and max_length = min (String.length word) (String.length result) in for i = 0 to max_length - 1 do match (String.get word i, String.get result i) with (* A space means that the letter is not present *) | c, ' ' -> rules := Criteria.NotContain (c, None) :: !rules (* The same letter means that the we found the right caracter *) | c, c' when Char.equal c c' -> rules := Criteria.Contain (c, Some i) :: !rules (* Anything else, we got the letter, but at the wrong place *) | c, _ -> rules := Criteria.Contain (c, None) :: Criteria.NotContain (c, Some i) :: !rules done; !rules let rec run filters words = let () = show_structure Format.std_formatter words filters in let freq = Persistence.extract_freq words in let next, score = Persistence.pick_next_word words freq in let () = Format.fprintf Format.std_formatter "Next word will be : %s (%d)@\n" next score in let input = Stdlib.read_line () in (* if the input is empty, remove the word from the list and restart *) match String.equal String.empty input with | true -> let new_words = List.filter (fun w -> not (String.equal w next)) words.element in run filters { words with element = new_words; number = words.number - 1 } | false -> let new_rules = Criteria.merge_lists ~init:filters (create_new_rules next input) |> List.sort_uniq Stdlib.compare in let words = List.fold_left (Persistence.add_word new_rules) (Persistence.empty_data ()) words.element in run new_rules words let init_rule rules word = String.iteri (fun p c -> match c with | ' ' -> () | _ -> rules := Criteria.Contain (c, Some p) :: !rules ) word let () = let length = ref 5 and dict = ref [] in let rules = ref [] in let anon_fun filename = dict := filename :: !dict in let speclist = [ ("-n", Arg.Set_int length, "Nombre de lettres") ; ("-p", Arg.String (init_rule rules), "Motif initial") ] in let () = Arg.parse speclist anon_fun "motus [-n ] dictionnaire" in let initial_filter = Criteria.Lenght !length :: !rules in let words_channel = open_in (List.hd !dict) in let words = get_list words_channel (Persistence.empty_data ()) initial_filter in close_in words_channel; run initial_filter words