Added a motus solver

1 files changed, 75 insertions, 0 deletions

diff --git a/motus/lib/persistence.ml b/motus/lib/persistence.ml
new file mode 100644
index 0000000..1bc20ad
--- /dev/null
+++ b/motus/lib/persistence.ml
@@ -0,0 +1,75 @@
+type t =
+  { number : int
+  ; element : string list
+  ; freq : (char, int) Hashtbl.t
+  }
+
+let empty_data () = { number = 0; element = []; freq = Hashtbl.create 26 }
+
+(** Evaluate the score for each char (lower is better) *)
+let extract_freq : t -> (char * int) list =
+ fun data ->
+  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)
+
+
+let update_freq : (char, int) Hashtbl.t -> char -> unit =
+ fun freq c ->
+  match Hashtbl.find_opt freq c with
+  | None -> Hashtbl.add freq c 1
+  | Some value -> Hashtbl.replace freq c (value + 1)
+
+
+let add_word : Criteria.t list -> t -> string -> t =
+ fun filters data word ->
+  match List.for_all (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
+      in
+
+      List.iter (update_freq data.freq) chars;
+      { data with number = data.number + 1; element = word :: data.element }
+  | false -> data
+
+
+(** 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) *)
+let pick_next_word : t -> (char * int) list -> string * int =
+ fun data scores ->
+  let p' : (string * int) option -> string -> (string * int) option =
+   fun prec word ->
+    (* evaluate the score for this word *)
+    let _, eval =
+      String.fold_left
+        (fun (scores, score) c ->
+          match List.assoc_opt c scores with
+          | None ->
+              (* if the character has no score associated, we consider that it
+                 does not provide any more information, and give it the max
+                 score available *)
+              (scores, score + (data.number / 2))
+          | Some v ->
+              let new_scores =
+                List.filter (fun (c', _) -> not (Char.equal c c')) scores
+              in
+              (new_scores, score + v) )
+        (scores, 0)
+        word
+    in
+    match prec with
+    | None -> Some (word, eval)
+    | Some (_, prec_score) when eval < prec_score -> Some (word, eval)
+    | _ -> prec
+  in
+  match List.fold_left p' None data.element with
+  | None -> ("", 0)
+  | Some r -> r