Hide structure in motus solver

6 files changed, 76 insertions, 31 deletions

diff --git a/motus/bin/motus.ml b/motus/bin/motus.ml
index fe00a3c..0f2b17b 100644
--- a/motus/bin/motus.ml
+++ b/motus/bin/motus.ml
@@ -24,7 +24,7 @@ let show_structure :
     (Format.pp_print_list format_filter)
     filters;
 
-  Format.fprintf format "Got %d elements @\n" data.number;
+  Format.fprintf format "Got %d elements @\n" (Persistence.list_size data);
 
   Format.fprintf
     format
@@ -32,14 +32,14 @@ let show_structure :
     (Format.pp_print_list (fun f (k, v) -> Format.fprintf f "%c -> %d" k v))
     (Persistence.extract_freq data);
 
-  if data.number < 20
+  if Persistence.list_size data < 20
   then
     Format.fprintf
       format
       "Remaining words @[<v>@;%a@]@\n"
       (Format.pp_print_list ~pp_sep:Format.pp_force_newline (fun f w ->
            Format.fprintf f "%s" w ) )
-      data.element;
+      (Persistence.words data);
   Format.close_box ()
 
 
@@ -97,11 +97,7 @@ let rec run filters words =
 
   (* if the input is empty, remove the word from the list and restart *)
   match String.equal String.empty input with
-  | true ->
-      let new_words =
-        List.filter (fun w -> not (String.equal w next)) words.element
-      in
-      run filters { words with element = new_words; number = words.number - 1 }
+  | true -> run filters (Persistence.remove_word words next)
   | false ->
       let new_rules =
         Criteria.merge_lists ~init:filters (create_new_rules next input)
@@ -112,7 +108,7 @@ let rec run filters words =
         List.fold_left
           (Persistence.add_word new_rules)
           (Persistence.empty_data ())
-          words.element
+          (Persistence.words words)
       in
       run new_rules words
 
diff --git a/motus/js/motus.ml b/motus/js/motus.ml
index f2995df..a2bcbd3 100644
--- a/motus/js/motus.ml
+++ b/motus/js/motus.ml
@@ -172,7 +172,10 @@ let main
   let last_element =
     S.map
       (fun ev ->
-        match (ev.State.current_prop, ev.State.analysis.number) with
+        match
+          ( ev.State.current_prop
+          , Motus_lib.Persistence.list_size ev.State.analysis )
+        with
         | [], _ | _, 1 -> Some (Jstr.v "true")
         | _, _ -> None )
       ev
diff --git a/motus/js/next.ml b/motus/js/next.ml
index 658590d..5f24883 100644
--- a/motus/js/next.ml
+++ b/motus/js/next.ml
@@ -19,7 +19,7 @@ let process : t -> State.state -> State.state =
     List.fold_left
       ~f:(Motus_lib.Persistence.add_word rules)
       ~init:(Motus_lib.Persistence.empty_data ())
-      state.analysis.Motus_lib.Persistence.element
+      (Motus_lib.Persistence.words state.analysis)
   in
 
   let propositions = state.current_prop :: state.propositions
diff --git a/motus/js/reload.ml b/motus/js/reload.ml
index 3a461ee..cfdfa2a 100644
--- a/motus/js/reload.ml
+++ b/motus/js/reload.ml
@@ -1,3 +1,5 @@
+(** Reload the list without the current proposition *)
+
 open StdLabels
 
 type t = unit
@@ -15,15 +17,15 @@ let process : t -> State.state -> State.state =
     |> String.of_seq
   in
 
-  let element =
-    List.filter
-      ~f:(fun w -> not (String.equal w word))
-      state.State.analysis.element
+  let new_state =
+    { state with
+      analysis = Motus_lib.Persistence.remove_word state.analysis word
+    }
   in
-  let analysis = { state.analysis with element } in
-  let new_state = { state with analysis } in
   (* Get the new proposition if any *)
-  let current_prop = Initialize.get_proposition analysis state.rules in
+  let current_prop =
+    Initialize.get_proposition new_state.analysis state.rules
+  in
   match current_prop with
   | None -> new_state
   | Some prop ->
diff --git a/motus/lib/persistence.ml b/motus/lib/persistence.ml
index 1bc20ad..6116653 100644
--- a/motus/lib/persistence.ml
+++ b/motus/lib/persistence.ml
@@ -1,3 +1,7 @@
+open StdLabels
+
+let () = Random.self_init ()
+
 type t =
   { number : int
   ; element : string list
@@ -12,7 +16,7 @@ let extract_freq : t -> (char * int) list =
   let number_2 = data.number / 2 in
   Hashtbl.fold (fun k v acc -> (k, abs (v - number_2)) :: acc) data.freq []
   (* Sort the list for a pretty printing *)
-  |> List.sort (fun v1 v2 -> snd v1 - snd v2)
+  |> List.sort ~cmp:(fun v1 v2 -> snd v1 - snd v2)
 
 
 let update_freq : (char, int) Hashtbl.t -> char -> unit =
@@ -24,15 +28,15 @@ let update_freq : (char, int) Hashtbl.t -> char -> unit =
 
 let add_word : Criteria.t list -> t -> string -> t =
  fun filters data word ->
-  match List.for_all (Criteria.check_filter word) filters with
+  match List.for_all ~f:(Criteria.check_filter word) filters with
   | true ->
       let len = String.length word in
       let chars =
-        List.init len (fun n -> String.get word n)
-        |> List.sort_uniq Char.compare
+        List.init ~len ~f:(fun n -> String.get word n)
+        |> List.sort_uniq ~cmp:Char.compare
       in
 
-      List.iter (update_freq data.freq) chars;
+      List.iter ~f:(update_freq data.freq) chars;
       { data with number = data.number + 1; element = word :: data.element }
   | false -> data
 
@@ -45,12 +49,12 @@ present many times, we consider that succeding letters does not give any more
 informations (do not consider the position here) *)
 let pick_next_word : t -> (char * int) list -> string * int =
  fun data scores ->
-  let p' : (string * int) option -> string -> (string * int) option =
+  let p' : (string list * int) option -> string -> (string list * int) option =
    fun prec word ->
     (* evaluate the score for this word *)
     let _, eval =
       String.fold_left
-        (fun (scores, score) c ->
+        ~f:(fun (scores, score) c ->
           match List.assoc_opt c scores with
           | None ->
               (* if the character has no score associated, we consider that it
@@ -59,17 +63,33 @@ let pick_next_word : t -> (char * int) list -> string * int =
               (scores, score + (data.number / 2))
           | Some v ->
               let new_scores =
-                List.filter (fun (c', _) -> not (Char.equal c c')) scores
+                List.filter ~f:(fun (c', _) -> not (Char.equal c c')) scores
               in
               (new_scores, score + v) )
-        (scores, 0)
+        ~init:(scores, 0)
         word
     in
     match prec with
-    | None -> Some (word, eval)
-    | Some (_, prec_score) when eval < prec_score -> Some (word, eval)
+    | None -> Some ([ word ], eval)
+    | Some (_, prec_score) when eval < prec_score -> Some ([ word ], eval)
+    | Some (w, prec_score) when eval = prec_score -> Some (word :: w, eval)
     | _ -> prec
   in
-  match List.fold_left p' None data.element with
+  match List.fold_left ~f:p' ~init:None data.element with
   | None -> ("", 0)
-  | Some r -> r
+  | Some (words, score) ->
+      (* Pick a reandom word from the list *)
+      let elements = List.length words in
+      let number = Random.int elements in
+      (List.nth words number, score)
+
+
+let remove_word : t -> string -> t =
+ fun t word ->
+  let element = List.filter ~f:(fun w -> not (String.equal w word)) t.element in
+  { t with element; number = t.number - 1 }
+
+
+let words : t -> string list = fun { element; _ } -> element
+
+let list_size : t -> int = fun { number; _ } -> number
diff --git a/motus/lib/persistence.mli b/motus/lib/persistence.mli
new file mode 100644
index 0000000..f5625e4
--- /dev/null
+++ b/motus/lib/persistence.mli
@@ -0,0 +1,24 @@
+type t
+
+val words : t -> string list
+
+val list_size : t -> int
+(** Number of words in the list *)
+
+val empty_data : unit -> t
+
+val extract_freq : t -> (char * int) list
+(** Evaluate the score for each char (lower is better) *)
+
+val add_word : Criteria.t list -> t -> string -> t
+(** Add a new word in the list. Check are made against the differents criteria in order to ensure that the word is valid *)
+
+val pick_next_word : t -> (char * int) list -> string * int
+(** Get the word which with the most information in it.
+
+The information is the score given to each character, representing each
+frequency in the whole word list (lower is better). If the same letter is
+present many times, we consider that succeding letters does not give any more
+informations (do not consider the position here) *)
+
+val remove_word : t -> string -> t