From 82bb54622a47bb092094c8efab8200b12817c5b4 Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Fri, 11 Feb 2022 09:22:18 +0100 Subject: Hide structure in motus solver --- motus/bin/motus.ml | 14 +++++--------- motus/js/motus.ml | 5 ++++- motus/js/next.ml | 2 +- motus/js/reload.ml | 16 +++++++++------- motus/lib/persistence.ml | 46 +++++++++++++++++++++++++++++++++------------- motus/lib/persistence.mli | 24 ++++++++++++++++++++++++ 6 files changed, 76 insertions(+), 31 deletions(-) create mode 100644 motus/lib/persistence.mli 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 @[@;%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 -- cgit v1.2.3