From 84b8439aa90f1465d05dcba936a25eaf96f914a0 Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Sat, 26 Feb 2022 13:42:32 +0100 Subject: Use the whole dictionnary when searching for a word for a faster exploration --- motus/bin/motus.ml | 2 +- motus/js/initialize.ml | 34 +++++++++++++++++++++----------- motus/js/motus.ml | 4 ++-- motus/js/next.ml | 11 ++++++++++- motus/js/reload.ml | 11 +++++++++-- motus/js/state.ml | 2 ++ motus/lib/entropy.ml | 48 +++++++++++++++++++++++++++++++++++---------- motus/lib/validity.ml | 26 ------------------------ motus/lib/validity.mli | 4 ---- motus/test/entropy_tests.ml | 40 +++++++++++++++++++++++++++++++++++++ motus/test/motus_test.ml | 23 ++++------------------ 11 files changed, 129 insertions(+), 76 deletions(-) create mode 100644 motus/test/entropy_tests.ml diff --git a/motus/bin/motus.ml b/motus/bin/motus.ml index a8a9188..638e778 100644 --- a/motus/bin/motus.ml +++ b/motus/bin/motus.ml @@ -76,7 +76,7 @@ let rec run len filters words = Freq_analysis.analyse words |> Freq_analysis.pick_next_word words in *) - let _, next = Entropy.analyse len words in + let _, next = Entropy.analyse len ~catalog:words words in let () = Format.fprintf Format.std_formatter "Next word will be : %s@\n" next diff --git a/motus/js/initialize.ml b/motus/js/initialize.ml index 9d07a85..9375880 100644 --- a/motus/js/initialize.ml +++ b/motus/js/initialize.ml @@ -5,7 +5,7 @@ open Brr type t = { length : int - ; content : (int * Jstr.t, Jv.Error.t) result + ; html_response : (int * Jstr.t, Jv.Error.t) result ; sender : (int * Jstr.t * Validity.t) E.send ; proposition : State.proposition } @@ -18,16 +18,24 @@ type t = The rule list is used to identify the letter already fixed by the previous results. *) let get_proposition : - int -> Wordlist.t -> Criteria.t list -> State.proposition option = - fun length wordlist rules -> - Printf.printf "Number of elements : %d\n" (Wordlist.list_size wordlist); - + int + -> catalog:Wordlist.t + -> Wordlist.t + -> Criteria.t list + -> State.proposition option = + fun length ~catalog wordlist rules -> let word = - if Wordlist.list_size wordlist > 2000 + let elements = Wordlist.list_size wordlist in + if elements > 2000 then Freq_analysis.analyse wordlist |> Freq_analysis.pick_next_word wordlist - else - let _, word = Entropy.analyse length wordlist in + else if elements > 1 + then + let _, word = Entropy.analyse length ~catalog wordlist in word + else + match Wordlist.pick wordlist with + | Some w -> w + | None -> "" in match String.equal String.empty word with | true -> None @@ -56,8 +64,8 @@ let get_proposition : Some proposition -let process { sender; length; content; proposition } state = - match content with +let process { sender; length; html_response; proposition } state = + match html_response with | Ok (200, value) -> let rules = Criteria.Lenght length :: State.get_current_rules proposition @@ -68,8 +76,11 @@ let process { sender; length; content; proposition } state = |> Seq.map (fun w -> Jstr.(to_string (uppercased w))) |> Wordlist.add_words rules in + Printf.printf + "Number of elements after filter : %d\n" + (Motus_lib.Wordlist.list_size analysis); - let current_prop = get_proposition length analysis rules + let current_prop = get_proposition ~catalog:analysis length analysis rules and fields = FieldList.make length sender in ( match current_prop with | None -> state @@ -78,6 +89,7 @@ let process { sender; length; content; proposition } state = State. { analysis + ; catalog = analysis ; rules ; length ; current_prop = prop diff --git a/motus/js/motus.ml b/motus/js/motus.ml index 402e14a..5e1252a 100644 --- a/motus/js/motus.ml +++ b/motus/js/motus.ml @@ -86,10 +86,10 @@ let main let proposition = S.value initial_prop in Elements.Transfert.get_content_from_url words - |> E.map (fun content -> + |> E.map (fun html_response -> State.App.dispatch (module Initialize) - Initialize.{ length; content; sender; proposition } ) ) + Initialize.{ length; html_response; sender; proposition } ) ) send_btn |> E.join in diff --git a/motus/js/next.ml b/motus/js/next.ml index f3bb2fe..e6baf51 100644 --- a/motus/js/next.ml +++ b/motus/js/next.ml @@ -11,6 +11,9 @@ let process : t -> State.state -> State.state = (* Update the word list with the new rules *) let analysis = Motus_lib.Wordlist.filter rules state.analysis in + Printf.printf + "Number of elements after filter : %d\n" + (Motus_lib.Wordlist.list_size analysis); let rules = Motus_lib.Criteria.merge_lists ~init:state.rules rules @@ -23,7 +26,13 @@ let process : t -> State.state -> State.state = let new_state = { state with propositions; current_prop; rules; analysis } in (* Get the new proposition if any *) - let current_prop = Initialize.get_proposition state.length analysis rules in + let current_prop = + Initialize.get_proposition + ~catalog:state.catalog + state.length + analysis + rules + in match current_prop with | None -> new_state | Some prop -> diff --git a/motus/js/reload.ml b/motus/js/reload.ml index f0b581f..ee9ab37 100644 --- a/motus/js/reload.ml +++ b/motus/js/reload.ml @@ -18,11 +18,18 @@ let process : t -> State.state -> State.state = in let new_state = - { state with analysis = Motus_lib.Wordlist.remove_word state.analysis word } + { state with + analysis = Motus_lib.Wordlist.remove_word state.analysis word + ; catalog = Motus_lib.Wordlist.remove_word state.catalog word + } in (* Get the new proposition if any *) let current_prop = - Initialize.get_proposition state.length new_state.analysis state.rules + Initialize.get_proposition + ~catalog:new_state.catalog + state.length + new_state.analysis + state.rules in match current_prop with | None -> new_state diff --git a/motus/js/state.ml b/motus/js/state.ml index cbab14f..e2e531d 100644 --- a/motus/js/state.ml +++ b/motus/js/state.ml @@ -5,6 +5,7 @@ type proposition = (Jstr.t * Validity.t) option list type state = { analysis : Wordlist.t + ; catalog : Wordlist.t ; rules : Criteria.t list ; length : int ; propositions : proposition list @@ -14,6 +15,7 @@ type state = let init () = { analysis = Wordlist.empty_data () + ; catalog = Wordlist.empty_data () ; rules = [] ; length = 0 ; propositions = [] diff --git a/motus/lib/entropy.ml b/motus/lib/entropy.ml index 5b86a9d..043d0c8 100644 --- a/motus/lib/entropy.ml +++ b/motus/lib/entropy.ml @@ -1,5 +1,34 @@ +open StdLabels + type t = float * string +module CharSet = Set.Make (Char) + +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 + else + let result = + Array.init l1 ~f:(fun i -> + 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 + else Validity.Missing + in + state ) + in + Some result + + let get_entropy max_element words_number arr = let entropy = ref 0. in for idx = 0 to max_element - 1 do @@ -12,11 +41,12 @@ let get_entropy max_element words_number arr = entropy -let analyse : int -> Wordlist.t -> t = - fun base words -> +let analyse : int -> catalog:Wordlist.t -> Wordlist.t -> t = + fun base ~catalog words -> let max_element = Float.to_int @@ (Validity.elements ** Float.of_int base) in - let words_number = Float.of_int (Wordlist.list_size words) in + let words_number = Float.of_int (Wordlist.list_size catalog) in + let arr = Bigarray.Array1.create Bigarray.Int Bigarray.C_layout max_element in match Wordlist.pick words with | None -> (0., "") | Some v -> @@ -25,15 +55,13 @@ let analyse : int -> Wordlist.t -> t = (fun (score, word) word_ref -> (* Reinitialize the array (we use the same in the successive iterations *) - let set_ref = String.to_seq word_ref |> Validity.CharSet.of_seq in + let set_ref = String.to_seq word_ref |> CharSet.of_seq in - let arr = - Bigarray.Array1.create Bigarray.Int Bigarray.C_layout max_element - in + Bigarray.Array1.fill arr 0; Seq.iter (fun w2 -> - let result = Validity.compare_words ~ref:(word_ref, set_ref) w2 in + let result = compare_words ~ref:(word_ref, set_ref) w2 in match result with | None -> () | Some r -> @@ -51,5 +79,5 @@ let analyse : int -> Wordlist.t -> t = Printf.printf "Entropy for selecting %s : %.2f\n" word_ref !entropy; (!entropy, word_ref) ) else (score, word) ) - (0., v) - (Wordlist.words words) + (-0., v) + (Wordlist.words catalog) diff --git a/motus/lib/validity.ml b/motus/lib/validity.ml index 0fdc40c..3964e0b 100644 --- a/motus/lib/validity.ml +++ b/motus/lib/validity.ml @@ -57,32 +57,6 @@ let sequence : int -> t array Seq.t = 0 -module CharSet = Set.Make (Char) - -let compare_words : string -> ref:string * CharSet.t -> t array option = - fun w1 ~ref -> - let wordRef = fst ref in - let l1 = String.length w1 in - 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 state = - if Char.equal c1 c2 - then Wellplaced - else if CharSet.mem c2 (snd ref) - then Misplaced - else Missing - in - state ) - in - Some result - - let to_criteria : char -> int -> t -> Criteria.t list -> Criteria.t list = fun c i t acc -> match t with diff --git a/motus/lib/validity.mli b/motus/lib/validity.mli index a3d8ae3..3a59775 100644 --- a/motus/lib/validity.mli +++ b/motus/lib/validity.mli @@ -1,5 +1,3 @@ -module CharSet : Set.S with type elt = char - type t = | Wellplaced | Misplaced @@ -16,8 +14,6 @@ val index_of_result : t array -> int val index_to_result : base:int -> int -> t array -val compare_words : string -> ref:string * CharSet.t -> t array option - val to_criteria : char -> int -> t -> Criteria.t list -> Criteria.t list val to_criterias : string -> t array -> Criteria.t list diff --git a/motus/test/entropy_tests.ml b/motus/test/entropy_tests.ml new file mode 100644 index 0000000..675d5b5 --- /dev/null +++ b/motus/test/entropy_tests.ml @@ -0,0 +1,40 @@ +open StdLabels +open OUnit2 +open Motus_lib + +let format_validity = function + | Validity.Wellplaced -> 'W' + | Validity.Misplaced -> 'M' + | Validity.Missing -> '_' + + +let printer : Validity.t array option -> string = function + | None -> "" + | Some v -> + String.init (Array.length v) ~f:(fun i -> + format_validity @@ Array.get v i ) + + +let tests = + "entropy test suite" + >::: [ ( "Compare words 1" + >:: fun _ -> + let w = "Test" in + + let ref = (w, Entropy.CharSet.of_seq (String.to_seq w)) in + + assert_equal + ~printer + (Some Validity.[| Wellplaced; Wellplaced; Wellplaced; Wellplaced |]) + (Entropy.compare_words "Test" ~ref) ) + ; ( "Compare words 2" + >:: fun _ -> + let w = "ABC" in + let ref = (w, Entropy.CharSet.of_seq (String.to_seq w)) in + let result = Entropy.compare_words "DAC" ~ref in + + assert_equal + ~printer + (Some Validity.[| Missing; Misplaced; Wellplaced |]) + result ) + ] diff --git a/motus/test/motus_test.ml b/motus/test/motus_test.ml index 0586ffe..717db21 100644 --- a/motus/test/motus_test.ml +++ b/motus/test/motus_test.ml @@ -1,8 +1,8 @@ -module Validity = Motus_lib.Validity open StdLabels open OUnit2 +open Motus_lib -let tests = +let validiy_tests = "validity test suite" >::: [ ( "Sequence of elements" >:: fun _ -> @@ -35,23 +35,8 @@ let tests = in assert_equal 243 count ) - ; ( "Compare words 1" - >:: fun _ -> - let w = "Test" in - - let ref = (w, Validity.CharSet.of_seq (String.to_seq w)) in - - assert_equal - (Some Validity.[| Wellplaced; Wellplaced; Wellplaced; Wellplaced |]) - (Validity.compare_words "Test" ~ref) ) - ; ( "Compare words 2" - >:: fun _ -> - let w = "ABC" in - let ref = (w, Validity.CharSet.of_seq (String.to_seq w)) in - assert_equal - (Some Validity.[| Missing; Misplaced; Wellplaced |]) - (Validity.compare_words "DAC" ~ref) ) ] -let _ = run_test_tt_main tests +let _ = + run_test_tt_main ("main tests" >::: [ validiy_tests; Entropy_tests.tests ]) -- cgit v1.2.3