Motus: detect if one letter in the proposition match a rule in a different locationHEADmaster

5 files changed, 70 insertions, 67 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
diff --git a/motus/js/motus.ml b/motus/js/motus.ml
index 47ea15c..c1ac754 100644
--- a/motus/js/motus.ml
+++ b/motus/js/motus.ml
@@ -77,9 +77,9 @@ let main length_id send_id dictionnary_id proposition_id rules_id table_id
 
         Elements.Transfert.get_content_from_url words
         |> E.map (fun html_response ->
-               State.App.dispatch
-                 (module Initialize)
-                 Initialize.{ length; html_response; sender; proposition }))
+            State.App.dispatch
+              (module Initialize)
+              Initialize.{ length; html_response; sender; proposition }))
       send_btn
     |> E.join
   in
@@ -161,9 +161,10 @@ let main length_id send_id dictionnary_id proposition_id rules_id table_id
     S.map
       (fun ev ->
         match
-          (ev.State.current_prop, Motus_lib.Wordlist.list_size ev.State.analysis)
+          ( ev.State.current_prop
+          , Motus_lib.Wordlist.list_size ev.State.candidates )
         with
-        | [], _ | _, 1 -> Some (Jstr.v "true")
+        | [], _ | _, 1 | _, 0 -> Some (Jstr.v "true")
         | _, _ -> None)
       ev
   in
diff --git a/motus/js/next.ml b/motus/js/next.ml
index f26aa86..721c850 100644
--- a/motus/js/next.ml
+++ b/motus/js/next.ml
@@ -10,10 +10,9 @@ let process : t -> State.state -> State.state =
   let rules = State.get_current_rules state.current_prop in
 
   (* Update the word list with the new rules *)
-  let analysis = Motus_lib.Wordlist.filter rules state.analysis in
-  Printf.printf
-    "Number of elements after filter : %d\n"
-    (Motus_lib.Wordlist.list_size analysis);
+  let candidates = Motus_lib.Wordlist.filter rules state.candidates in
+  Printf.printf "Number of elements after filter : %d\n"
+    (Motus_lib.Wordlist.list_size candidates);
 
   let rules =
     Motus_lib.Criteria.merge_lists ~init:state.rules rules
@@ -23,14 +22,13 @@ let process : t -> State.state -> State.state =
   let propositions = state.current_prop :: state.propositions
   and current_prop = [] in
 
-  let new_state = { state with propositions; current_prop; rules; analysis } in
+  let new_state =
+    { state with propositions; current_prop; rules; candidates }
+  in
 
   (* Get the new proposition if any *)
   let current_prop =
-    Initialize.get_proposition
-      ~catalog:state.catalog
-      state.length
-      analysis
+    Initialize.get_proposition ~catalog:state.catalog state.length candidates
       rules
   in
   match current_prop with
diff --git a/motus/js/reload.ml b/motus/js/reload.ml
index 912141d..2a12819 100644
--- a/motus/js/reload.ml
+++ b/motus/js/reload.ml
@@ -8,28 +8,25 @@ let process : t -> State.state -> State.state =
  fun () state ->
   (* Get the word corresponding to the proposition *)
   let word =
-    state.State.current_prop
-    |> List.to_seq
+    state.State.current_prop |> List.to_seq
     |> Seq.map (fun opt ->
-           match opt with
-           | None -> ' '
-           | Some (letter, _) -> String.get (Jstr.to_string letter) 0 )
+        match opt with
+        | None -> ' '
+        | Some (letter, _) -> String.get (Jstr.to_string letter) 0)
     |> String.of_seq
   in
 
   let new_state =
-    { state with
-      analysis = Motus_lib.Wordlist.remove_word state.analysis word
+    {
+      state with
+      candidates = Motus_lib.Wordlist.remove_word state.candidates word
     ; catalog = Motus_lib.Wordlist.remove_word state.catalog word
     }
   in
   (* Get the new proposition if any *)
   let current_prop =
-    Initialize.get_proposition
-      ~catalog:new_state.catalog
-      state.length
-      new_state.analysis
-      state.rules
+    Initialize.get_proposition ~catalog:new_state.catalog state.length
+      new_state.candidates state.rules
   in
   match current_prop with
   | None -> new_state
diff --git a/motus/js/state.ml b/motus/js/state.ml
index e2e531d..41a5875 100644
--- a/motus/js/state.ml
+++ b/motus/js/state.ml
@@ -3,18 +3,19 @@ open Motus_lib
 
 type proposition = (Jstr.t * Validity.t) option list
 
-type state =
-  { analysis : Wordlist.t
+type state = {
+    candidates : Wordlist.t
   ; catalog : Wordlist.t
   ; rules : Criteria.t list
   ; length : int
   ; propositions : proposition list
   ; current_prop : proposition
   ; fields : Brr.El.t list
-  }
+}
 
 let init () =
-  { analysis = Wordlist.empty_data ()
+  {
+    candidates = Wordlist.empty_data ()
   ; catalog = Wordlist.empty_data ()
   ; rules = []
   ; length = 0
@@ -23,7 +24,6 @@ let init () =
   ; fields = []
   }
 
-
 module App = Application.Make (struct
   type t = state
 end)
@@ -35,17 +35,15 @@ let get_current_rules : proposition -> Criteria.t list =
   List.iteri prop ~f:(fun i prop ->
       Option.iter
         (fun (letter, validity) ->
-          if Jstr.equal Jstr.empty letter
-          then ()
+          if Jstr.equal Jstr.empty letter then ()
           else
             let char = String.get (Jstr.to_string letter) 0 in
-            rules := Validity.to_criteria char i validity !rules )
-        prop );
+            rules := Validity.to_criteria char i validity !rules)
+        prop);
   List.rev !rules
 
-
 (** Compare two states *)
 let eq : state -> state -> bool =
  fun s1 s2 ->
-  (s1.length, s1.rules, s1.current_prop, s1.propositions, s1.analysis)
-  = (s2.length, s2.rules, s2.current_prop, s2.propositions, s2.analysis)
+  (s1.length, s1.rules, s1.current_prop, s1.propositions, s1.candidates)
+  = (s2.length, s2.rules, s2.current_prop, s2.propositions, s2.candidates)