Update the entropy evaluation in the sutom application

1 files changed, 106 insertions, 57 deletions

diff --git a/motus/lib/entropy.ml b/motus/lib/entropy.ml
index 5fcef6c..b192f16 100644
--- a/motus/lib/entropy.ml
+++ b/motus/lib/entropy.ml
@@ -9,53 +9,111 @@ 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
+  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 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
+            if Char.equal c1 c2 then Validity.Wellplaced
+            else if CharSet.mem c1 (snd ref) then Validity.Misplaced
             else Validity.Missing
           in
-          state )
+          state)
     in
     Some result
 
+(** The module provide the entropy evaluation *)
+module E : sig
+  type t
 
-let get_entropy max_element words_number arr =
-  let entropy = ref 0. in
-  for idx = 0 to max_element - 1 do
-    let content = Float.of_int (Bigarray.Array1.get arr idx) in
-    if content > 0.
-    then
-      let ratio = content /. words_number in
-      entropy := !entropy -. (ratio *. Float.log2 ratio)
-  done;
-  !entropy
+  val create : cardinal:int -> length:int -> t
+  (** Create a new evaluation for the entropy evaluation. 
 
+  [cardinal] is the number of elements in the set 
+  [length] is the number of criteria to check with *)
 
+  val reset : t -> unit
+  (** Reinitialize the state (we use the same in the successive
+       iterations) *)
+
+  val copy : t -> t
+  (** Create a copy of the evaluation *)
+
+  val add_element : t:t -> f:('a -> int Seq.t) -> 'a -> unit
+  (** Add an element in the evaluation. The function provided should give the
+      index list match by this element *)
+
+  val get_entropy : t -> float
+  (** Get the entropy for the evaluation *)
+end = struct
+  type t = {
+      arr : (int, Bigarray.int_elt, Bigarray.c_layout) Bigarray.Array1.t
+    ; cardinal : float
+  }
+
+  let reset t = Bigarray.Array1.fill t.arr 0
+
+  let copy t =
+    let arr =
+      Bigarray.Array1.create Bigarray.Int Bigarray.C_layout
+        (Bigarray.Array1.dim t.arr)
+    in
+    Bigarray.Array1.blit t.arr arr;
+    { t with arr }
+
+  let create : cardinal:int -> length:int -> t =
+   fun ~cardinal ~length ->
+    {
+      arr = Bigarray.Array1.create Bigarray.Int Bigarray.C_layout length
+    ; cardinal = Float.of_int cardinal
+    }
+
+  (**  [get_entropy] will evaluate the entropy of the values in an array.  
+
+     The function return the quantity of information in the state.
+  *)
+  let get_entropy : t -> float =
+   fun t ->
+    let entropy = ref 0. in
+    for idx = 0 to Bigarray.Array1.dim t.arr - 1 do
+      let content = Float.of_int (Bigarray.Array1.get t.arr idx) in
+      if content > 0. then
+        let ratio = content /. t.cardinal in
+        entropy := !entropy -. (ratio *. Float.log2 ratio)
+    done;
+    !entropy
+
+  let add_element : t:t -> f:('a -> int Seq.t) -> 'a -> unit =
+   fun ~t ~f element ->
+    Seq.iter
+      (fun idx ->
+        let content = Bigarray.Array1.get t.arr idx in
+        Bigarray.Array1.set t.arr idx (succ content))
+      (f element)
+end
+
+(**  Get the word and the highest score by picking the next word from the
+     list.
+
+     [analyse ~catalog base words] will check each word from [words] and see if
+     it give a good score. This score is matched against each words from
+     [catalog]
+
+     The [base] argument is the number of letters in each word. *)
 let analyse : int -> catalog:Wordlist.t -> Wordlist.t -> t =
  fun base ~catalog words ->
   (* If we have only two elements, just pick one of them *)
-  if Wordlist.list_size words <= 2
-  then (0.5, Option.get @@ Wordlist.pick words)
+  if Wordlist.list_size words <= 2 then (0.5, Option.get @@ Wordlist.pick words)
   else
-    let words_number = Float.of_int (Wordlist.list_size catalog) in
-
     (* Each result from the game is stored as an integer, and we create an
        array with as many elements as we have possibilities. *)
     let max_element =
       Float.to_int @@ (Validity.elements ** Float.of_int base)
     in
     let arr =
-      Bigarray.Array1.create Bigarray.Int Bigarray.C_layout max_element
+      E.create ~length:max_element ~cardinal:(Wordlist.list_size catalog)
     in
     match Wordlist.pick words with
     | None -> (0., "")
@@ -65,45 +123,36 @@ let analyse : int -> catalog:Wordlist.t -> Wordlist.t -> t =
             (fun (score, word, already_picked) word_ref ->
               (* Reinitialize the array (we use the same in the successive
                  iterations) *)
-              Bigarray.Array1.fill arr 0;
+              E.reset arr;
 
               let set_ref = String.to_seq word_ref |> CharSet.of_seq in
-              Seq.iter
-                (fun w2 ->
-                  let result = compare_words ~ref:(word_ref, set_ref) w2 in
-                  match result with
-                  | None -> ()
-                  | Some r ->
-                      let idx = Validity.index_of_result r in
-
-                      let content = Bigarray.Array1.get arr idx in
-                      Bigarray.Array1.set arr idx (succ content) )
-                (Wordlist.words words);
-
-              let entropy = get_entropy max_element words_number arr in
-
-              (* If get more information that we had, use this word. Choose this
-                 word to if it belongs to the final list (it gives a small chance
-                 to pick the right one…) *)
+              E.add_element ~t:arr set_ref ~f:(fun set_ref ->
+                  Seq.filter_map
+                    (fun w2 ->
+                      let result = compare_words ~ref:(word_ref, set_ref) w2 in
+                      Option.map Validity.index_of_result result)
+                    (Wordlist.words words));
+              let entropy = E.get_entropy arr in
+
+              (* If we get more information that we had, use this word.
+
+                 If this word does not add more informations that we already
+                 had, choose it anyway if it belongs to the final list (it gives
+                 a small chance to pick the right one…) *)
               let is_better, already_picked =
-                if entropy > score
-                then (true, false)
-                else if (not already_picked)
-                        && entropy == score
-                        && Wordlist.mem word_ref words
+                if entropy > score then (true, false)
+                else if
+                  (not already_picked) && entropy == score
+                  && Wordlist.mem word_ref words
                 then (true, true)
                 else (false, already_picked)
               in
 
-              if is_better
-              then (
-                Printf.printf
-                  "Q. of information when selecting %s : %f\n"
-                  word_ref
-                  entropy;
-                (entropy, word_ref, already_picked) )
-              else (score, word, already_picked) )
-            (-0., v, false)
-            (Wordlist.words catalog)
+              if is_better then (
+                Printf.printf "Q. of information when selecting %s : %f\n"
+                  word_ref entropy;
+                (entropy, word_ref, already_picked))
+              else (score, word, already_picked))
+            (-0., v, false) (Wordlist.words catalog)
         in
         (score, word)