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
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
|
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 : @[<v>%a@]@\n"
(Format.pp_print_list format_filter)
filters;
Format.fprintf format "Got %d elements @\n" data.number;
Format.fprintf
format
"Frequencies : @[<v>%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 @[<v>@;%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 <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 (Persistence.empty_data ()) initial_filter
in
close_in words_channel;
run initial_filter words
|
