1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
|
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 -> Wordlist.t -> Criteria.t list -> unit =
fun format data filters ->
Format.fprintf
format
"Filtres en cours : @[<v>%a@]@\n"
(Format.pp_print_list format_filter)
filters;
Format.fprintf format "Got %d elements @\n" (Wordlist.list_size data);
if Wordlist.list_size data < 20
then
Format.fprintf
format
"Remaining words @[<v>@;%a@]@\n"
(Format.pp_print_list ~pp_sep:Format.pp_force_newline (fun f w ->
Format.fprintf f "%s" w ) )
(List.of_seq @@ Wordlist.words data);
Format.close_box ()
(** Get the initial list *)
let get_list : in_channel -> Criteria.t list -> Wordlist.t =
fun channel filters ->
let read channel =
try Some (String.lowercase_ascii (Stdlib.input_line channel), channel) with
| End_of_file -> None
in
let s = Seq.unfold read channel in
Wordlist.add_words filters s
(** 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.(add (NotContain (c, None))) !rules
(* The same letter means that the we found the right caracter *)
| c, c' when Char.equal c c' ->
rules := Criteria.(add (Contain (c, Some i)) !rules)
(* Anything else, we got the letter, but at the wrong place *)
| c, _ ->
rules :=
Criteria.(
add (Contain (c, None)) (add (NotContain (c, Some i)) !rules))
done;
!rules
let rec run filters words =
let () = show_structure Format.std_formatter words filters in
let next =
Freq_analysis.analyse words |> Freq_analysis.pick_next_word words
in
let () =
Format.fprintf Format.std_formatter "Next word will be : %s@\n" next
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 -> run filters (Wordlist.remove_word words next)
| false ->
let new_rules =
Criteria.merge_lists ~init:filters (create_new_rules next input)
|> List.sort_uniq Stdlib.compare
in
let words = Wordlist.filter new_rules words 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 <nb>] 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 initial_filter in
close_in words_channel;
run initial_filter words
|
