aboutsummaryrefslogtreecommitdiff
path: root/motus/js/initialize.ml
diff options
context:
space:
mode:
Diffstat (limited to 'motus/js/initialize.ml')
-rw-r--r--motus/js/initialize.ml67
1 files changed, 38 insertions, 29 deletions
diff --git a/motus/js/initialize.ml b/motus/js/initialize.ml
index 6a277df..a99e023 100644
--- a/motus/js/initialize.ml
+++ b/motus/js/initialize.ml
@@ -3,17 +3,17 @@ open Note
open Motus_lib
open Brr
-type t =
- { length : int
+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.
+(** 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.
+ which can be edited by the user.
The rule list is used to identify the letter already fixed by the previous
results. *)
@@ -26,8 +26,9 @@ let get_proposition :
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
+ 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
@@ -37,56 +38,64 @@ let get_proposition :
| false ->
let i = ref 0 in
let proposition =
- word
- |> String.to_seq
+ word |> String.to_seq
|> Seq.map (fun c ->
- let contain = Criteria.Contain (c, Some !i) in
- let wellplaced = List.mem contain ~set:rules in
- incr i;
- let validity =
- match wellplaced with
- | true -> Validity.Wellplaced
- | _ -> Validity.Missing
- in
+ 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) )
+ 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) ->
+ | 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 analysis =
+ 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 analysis);
+ Printf.printf "Number of elements after filter : %d\n"
+ (Motus_lib.Wordlist.list_size candidates);
- let current_prop = get_proposition ~catalog:analysis length analysis rules
+ let current_prop =
+ get_proposition ~catalog:candidates length candidates rules
and fields = FieldList.make length sender in
- ( match current_prop with
+ match current_prop with
| None -> state
| Some prop ->
FieldList.set_with_props prop fields rules;
State.
- { analysis
- ; catalog = analysis
+ {
+ candidates
+ ; catalog = candidates
; rules
; length
; current_prop = prop
; propositions = []
; fields
- } )
+ })
| _ ->
Console.(log [ Jstr.v "No words found" ]);
state