Use the whole dictionnary when searching for a word for a faster exploration

11 files changed, 129 insertions, 76 deletions

diff --git a/motus/bin/motus.ml b/motus/bin/motus.ml
index a8a9188..638e778 100644
--- a/motus/bin/motus.ml
+++ b/motus/bin/motus.ml
@@ -76,7 +76,7 @@ let rec run len filters words =
     Freq_analysis.analyse words |> Freq_analysis.pick_next_word words
   in
   *)
-  let _, next = Entropy.analyse len words in
+  let _, next = Entropy.analyse len ~catalog:words words in
 
   let () =
     Format.fprintf Format.std_formatter "Next word will be : %s@\n" next
diff --git a/motus/js/initialize.ml b/motus/js/initialize.ml
index 9d07a85..9375880 100644
--- a/motus/js/initialize.ml
+++ b/motus/js/initialize.ml
@@ -5,7 +5,7 @@ open Brr
 
 type t =
   { length : int
-  ; content : (int * Jstr.t, Jv.Error.t) result
+  ; html_response : (int * Jstr.t, Jv.Error.t) result
   ; sender : (int * Jstr.t * Validity.t) E.send
   ; proposition : State.proposition
   }
@@ -18,16 +18,24 @@ type t =
     The rule list is used to identify the letter already fixed by the previous
     results. *)
 let get_proposition :
-    int -> Wordlist.t -> Criteria.t list -> State.proposition option =
- fun length wordlist rules ->
-  Printf.printf "Number of elements : %d\n" (Wordlist.list_size wordlist);
-
+       int
+    -> catalog:Wordlist.t
+    -> Wordlist.t
+    -> Criteria.t list
+    -> State.proposition option =
+ fun length ~catalog wordlist rules ->
   let word =
-    if Wordlist.list_size wordlist > 2000
+    let elements = Wordlist.list_size wordlist in
+    if elements > 2000
     then Freq_analysis.analyse wordlist |> Freq_analysis.pick_next_word wordlist
-    else
-      let _, word = Entropy.analyse length wordlist in
+    else if elements > 1
+    then
+      let _, word = Entropy.analyse length ~catalog wordlist in
       word
+    else
+      match Wordlist.pick wordlist with
+      | Some w -> w
+      | None -> ""
   in
   match String.equal String.empty word with
   | true -> None
@@ -56,8 +64,8 @@ let get_proposition :
       Some proposition
 
 
-let process { sender; length; content; proposition } state =
-  match content with
+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
@@ -68,8 +76,11 @@ let process { sender; length; content; proposition } state =
         |> 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);
 
-      let current_prop = get_proposition length analysis rules
+      let current_prop = get_proposition ~catalog:analysis length analysis rules
       and fields = FieldList.make length sender in
       ( match current_prop with
       | None -> state
@@ -78,6 +89,7 @@ let process { sender; length; content; proposition } state =
 
           State.
             { analysis
+            ; catalog = analysis
             ; rules
             ; length
             ; current_prop = prop
diff --git a/motus/js/motus.ml b/motus/js/motus.ml
index 402e14a..5e1252a 100644
--- a/motus/js/motus.ml
+++ b/motus/js/motus.ml
@@ -86,10 +86,10 @@ let main
         let proposition = S.value initial_prop in
 
         Elements.Transfert.get_content_from_url words
-        |> E.map (fun content ->
+        |> E.map (fun html_response ->
                State.App.dispatch
                  (module Initialize)
-                 Initialize.{ length; content; sender; proposition } ) )
+                 Initialize.{ length; html_response; sender; proposition } ) )
       send_btn
     |> E.join
   in
diff --git a/motus/js/next.ml b/motus/js/next.ml
index f3bb2fe..e6baf51 100644
--- a/motus/js/next.ml
+++ b/motus/js/next.ml
@@ -11,6 +11,9 @@ let process : t -> State.state -> State.state =
 
   (* 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 rules =
     Motus_lib.Criteria.merge_lists ~init:state.rules rules
@@ -23,7 +26,13 @@ let process : t -> State.state -> State.state =
   let new_state = { state with propositions; current_prop; rules; analysis } in
 
   (* Get the new proposition if any *)
-  let current_prop = Initialize.get_proposition state.length analysis rules in
+  let current_prop =
+    Initialize.get_proposition
+      ~catalog:state.catalog
+      state.length
+      analysis
+      rules
+  in
   match current_prop with
   | None -> new_state
   | Some prop ->
diff --git a/motus/js/reload.ml b/motus/js/reload.ml
index f0b581f..ee9ab37 100644
--- a/motus/js/reload.ml
+++ b/motus/js/reload.ml
@@ -18,11 +18,18 @@ let process : t -> State.state -> State.state =
   in
 
   let new_state =
-    { state with analysis = Motus_lib.Wordlist.remove_word state.analysis word }
+    { state with
+      analysis = Motus_lib.Wordlist.remove_word state.analysis word
+    ; catalog = Motus_lib.Wordlist.remove_word state.catalog word
+    }
   in
   (* Get the new proposition if any *)
   let current_prop =
-    Initialize.get_proposition state.length new_state.analysis state.rules
+    Initialize.get_proposition
+      ~catalog:new_state.catalog
+      state.length
+      new_state.analysis
+      state.rules
   in
   match current_prop with
   | None -> new_state
diff --git a/motus/js/state.ml b/motus/js/state.ml
index cbab14f..e2e531d 100644
--- a/motus/js/state.ml
+++ b/motus/js/state.ml
@@ -5,6 +5,7 @@ type proposition = (Jstr.t * Validity.t) option list
 
 type state =
   { analysis : Wordlist.t
+  ; catalog : Wordlist.t
   ; rules : Criteria.t list
   ; length : int
   ; propositions : proposition list
@@ -14,6 +15,7 @@ type state =
 
 let init () =
   { analysis = Wordlist.empty_data ()
+  ; catalog = Wordlist.empty_data ()
   ; rules = []
   ; length = 0
   ; propositions = []
diff --git a/motus/lib/entropy.ml b/motus/lib/entropy.ml
index 5b86a9d..043d0c8 100644
--- a/motus/lib/entropy.ml
+++ b/motus/lib/entropy.ml
@@ -1,5 +1,34 @@
+open StdLabels
+
 type t = float * string
 
+module CharSet = Set.Make (Char)
+
+let compare_words : string -> ref:string * CharSet.t -> Validity.t array option
+    =
+ fun w1 ~ref ->
+  let wordRef = fst ref in
+  let l1 = String.length w1 in
+  if l1 <> String.length wordRef
+  then None
+  else
+    let result =
+      Array.init l1 ~f:(fun i ->
+          let c1 = String.get w1 i
+          and c2 = String.get wordRef i in
+
+          let state =
+            if Char.equal c1 c2
+            then Validity.Wellplaced
+            else if CharSet.mem c1 (snd ref)
+            then Validity.Misplaced
+            else Validity.Missing
+          in
+          state )
+    in
+    Some result
+
+
 let get_entropy max_element words_number arr =
   let entropy = ref 0. in
   for idx = 0 to max_element - 1 do
@@ -12,11 +41,12 @@ let get_entropy max_element words_number arr =
   entropy
 
 
-let analyse : int -> Wordlist.t -> t =
- fun base words ->
+let analyse : int -> catalog:Wordlist.t -> Wordlist.t -> t =
+ fun base ~catalog words ->
   let max_element = Float.to_int @@ (Validity.elements ** Float.of_int base) in
-  let words_number = Float.of_int (Wordlist.list_size words) in
+  let words_number = Float.of_int (Wordlist.list_size catalog) in
 
+  let arr = Bigarray.Array1.create Bigarray.Int Bigarray.C_layout max_element in
   match Wordlist.pick words with
   | None -> (0., "")
   | Some v ->
@@ -25,15 +55,13 @@ let analyse : int -> Wordlist.t -> t =
         (fun (score, word) word_ref ->
           (* Reinitialize the array (we use the same in the successive
              iterations *)
-          let set_ref = String.to_seq word_ref |> Validity.CharSet.of_seq in
+          let set_ref = String.to_seq word_ref |> CharSet.of_seq in
 
-          let arr =
-            Bigarray.Array1.create Bigarray.Int Bigarray.C_layout max_element
-          in
+          Bigarray.Array1.fill arr 0;
 
           Seq.iter
             (fun w2 ->
-              let result = Validity.compare_words ~ref:(word_ref, set_ref) w2 in
+              let result = compare_words ~ref:(word_ref, set_ref) w2 in
               match result with
               | None -> ()
               | Some r ->
@@ -51,5 +79,5 @@ let analyse : int -> Wordlist.t -> t =
             Printf.printf "Entropy for selecting %s : %.2f\n" word_ref !entropy;
             (!entropy, word_ref) )
           else (score, word) )
-        (0., v)
-        (Wordlist.words words)
+        (-0., v)
+        (Wordlist.words catalog)
diff --git a/motus/lib/validity.ml b/motus/lib/validity.ml
index 0fdc40c..3964e0b 100644
--- a/motus/lib/validity.ml
+++ b/motus/lib/validity.ml
@@ -57,32 +57,6 @@ let sequence : int -> t array Seq.t =
     0
 
 
-module CharSet = Set.Make (Char)
-
-let compare_words : string -> ref:string * CharSet.t -> t array option =
- fun w1 ~ref ->
-  let wordRef = fst ref in
-  let l1 = String.length w1 in
-  if l1 <> String.length wordRef
-  then None
-  else
-    let result =
-      Array.init l1 ~f:(fun i ->
-          let c1 = String.get w1 i
-          and c2 = String.get wordRef i in
-
-          let state =
-            if Char.equal c1 c2
-            then Wellplaced
-            else if CharSet.mem c2 (snd ref)
-            then Misplaced
-            else Missing
-          in
-          state )
-    in
-    Some result
-
-
 let to_criteria : char -> int -> t -> Criteria.t list -> Criteria.t list =
  fun c i t acc ->
   match t with
diff --git a/motus/lib/validity.mli b/motus/lib/validity.mli
index a3d8ae3..3a59775 100644
--- a/motus/lib/validity.mli
+++ b/motus/lib/validity.mli
@@ -1,5 +1,3 @@
-module CharSet : Set.S with type elt = char
-
 type t =
   | Wellplaced
   | Misplaced
@@ -16,8 +14,6 @@ val index_of_result : t array -> int
 
 val index_to_result : base:int -> int -> t array
 
-val compare_words : string -> ref:string * CharSet.t -> t array option
-
 val to_criteria : char -> int -> t -> Criteria.t list -> Criteria.t list
 
 val to_criterias : string -> t array -> Criteria.t list
diff --git a/motus/test/entropy_tests.ml b/motus/test/entropy_tests.ml
new file mode 100644
index 0000000..675d5b5
--- /dev/null
+++ b/motus/test/entropy_tests.ml
@@ -0,0 +1,40 @@
+open StdLabels
+open OUnit2
+open Motus_lib
+
+let format_validity = function
+  | Validity.Wellplaced -> 'W'
+  | Validity.Misplaced -> 'M'
+  | Validity.Missing -> '_'
+
+
+let printer : Validity.t array option -> string = function
+  | None -> ""
+  | Some v ->
+      String.init (Array.length v) ~f:(fun i ->
+          format_validity @@ Array.get v i )
+
+
+let tests =
+  "entropy test suite"
+  >::: [ ( "Compare words 1"
+         >:: fun _ ->
+         let w = "Test" in
+
+         let ref = (w, Entropy.CharSet.of_seq (String.to_seq w)) in
+
+         assert_equal
+           ~printer
+           (Some Validity.[| Wellplaced; Wellplaced; Wellplaced; Wellplaced |])
+           (Entropy.compare_words "Test" ~ref) )
+       ; ( "Compare words 2"
+         >:: fun _ ->
+         let w = "ABC" in
+         let ref = (w, Entropy.CharSet.of_seq (String.to_seq w)) in
+         let result = Entropy.compare_words "DAC" ~ref in
+
+         assert_equal
+           ~printer
+           (Some Validity.[| Missing; Misplaced; Wellplaced |])
+           result )
+       ]
diff --git a/motus/test/motus_test.ml b/motus/test/motus_test.ml
index 0586ffe..717db21 100644
--- a/motus/test/motus_test.ml
+++ b/motus/test/motus_test.ml
@@ -1,8 +1,8 @@
-module Validity = Motus_lib.Validity
 open StdLabels
 open OUnit2
+open Motus_lib
 
-let tests =
+let validiy_tests =
   "validity test suite"
   >::: [ ( "Sequence of elements"
          >:: fun _ ->
@@ -35,23 +35,8 @@ let tests =
          in
 
          assert_equal 243 count )
-       ; ( "Compare words 1"
-         >:: fun _ ->
-         let w = "Test" in
-
-         let ref = (w, Validity.CharSet.of_seq (String.to_seq w)) in
-
-         assert_equal
-           (Some Validity.[| Wellplaced; Wellplaced; Wellplaced; Wellplaced |])
-           (Validity.compare_words "Test" ~ref) )
-       ; ( "Compare words 2"
-         >:: fun _ ->
-         let w = "ABC" in
-         let ref = (w, Validity.CharSet.of_seq (String.to_seq w)) in
-         assert_equal
-           (Some Validity.[| Missing; Misplaced; Wellplaced |])
-           (Validity.compare_words "DAC" ~ref) )
        ]
 
 
-let _ = run_test_tt_main tests
+let _ =
+  run_test_tt_main ("main tests" >::: [ validiy_tests; Entropy_tests.tests ])