aboutsummaryrefslogtreecommitdiff
path: root/motus
diff options
context:
space:
mode:
Diffstat (limited to 'motus')
-rw-r--r--motus/bin/motus.ml14
-rw-r--r--motus/js/motus.ml5
-rw-r--r--motus/js/next.ml2
-rw-r--r--motus/js/reload.ml16
-rw-r--r--motus/lib/persistence.ml46
-rw-r--r--motus/lib/persistence.mli24
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
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-10 16:23:01 +0000