blob: a99e023e524ff2c74e599c7dc966a0f030b49fc7 (
plain)
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
|
open StdLabels
open Note
open Motus_lib
open Brr
type t = {
length : int
; html_response : (int * Jstr.t, Jv.Error.t) result
; sender : (int * Jstr.t * Validity.t) E.send
; proposition : State.proposition
}
(** Pick the next word from the dictionnary, and return it as a proposition.
If the word is empty (no word) return [None], else return a proposition
which can be edited by the user.
The rule list is used to identify the letter already fixed by the previous
results. *)
let get_proposition :
int
-> catalog:Wordlist.t
-> Wordlist.t
-> Criteria.t list
-> State.proposition option =
fun length ~catalog wordlist rules ->
let word =
let elements = Wordlist.list_size wordlist in
if elements > 2000 then
Freq_analysis.analyse wordlist |> Freq_analysis.pick_next_word wordlist
else if elements = 0 then String.empty
else
let _, word = Entropy.analyse length ~catalog wordlist in
word
in
match String.equal String.empty word with
| true -> None
| false ->
let i = ref 0 in
let proposition =
word |> String.to_seq
|> Seq.map (fun c ->
let contain = Criteria.Contain (c, Some !i) in
let wellplaced = List.mem contain ~set:rules in
let misplaced =
List.exists
~f:(fun rule ->
match rule with
| Criteria.Contain (c', _) when Char.equal c' c -> true
| _ -> false)
rules
in
incr i;
let validity =
match (wellplaced, misplaced) with
| true, _ -> Validity.Wellplaced
| false, true -> Validity.Misplaced
| _ -> Validity.Missing
in
Some (Jstr.of_char c, validity))
|> List.of_seq
in
Some proposition
let process { sender; length; html_response; proposition } state =
match html_response with
| Ok (200, value) -> (
let rules =
Criteria.Lenght length :: State.get_current_rules proposition
in
let words = Jstr.cuts ~sep:(Jstr.v "\n") value in
let candidates =
List.to_seq words
|> Seq.map (fun w -> Jstr.(to_string (uppercased w)))
|> Wordlist.add_words rules
in
Printf.printf "Number of elements after filter : %d\n"
(Motus_lib.Wordlist.list_size candidates);
let current_prop =
get_proposition ~catalog:candidates length candidates rules
and fields = FieldList.make length sender in
match current_prop with
| None -> state
| Some prop ->
FieldList.set_with_props prop fields rules;
State.
{
candidates
; catalog = candidates
; rules
; length
; current_prop = prop
; propositions = []
; fields
})
| _ ->
Console.(log [ Jstr.v "No words found" ]);
state
|
