aboutsummaryrefslogtreecommitdiff
path: root/motus
diff options
context:
space:
mode:
authorSébastien Dailly <sebastien@dailly.me>2022-02-26 13:42:32 +0100
committerSébastien Dailly <sebastien@dailly.me>2022-02-26 15:19:51 +0100
commit84b8439aa90f1465d05dcba936a25eaf96f914a0 (patch)
treeeb50a0a305d14d8591acb51e5ab745dcdd3e1f88 /motus
parent4eff667b92ff7ef4c3542650509c03fb0de5cbce (diff)
Use the whole dictionnary when searching for a word for a faster exploration
Diffstat (limited to 'motus')
-rw-r--r--motus/bin/motus.ml2
-rw-r--r--motus/js/initialize.ml34
-rw-r--r--motus/js/motus.ml4
-rw-r--r--motus/js/next.ml11
-rw-r--r--motus/js/reload.ml11
-rw-r--r--motus/js/state.ml2
-rw-r--r--motus/lib/entropy.ml48
-rw-r--r--motus/lib/validity.ml26
-rw-r--r--motus/lib/validity.mli4
-rw-r--r--motus/test/entropy_tests.ml40
-rw-r--r--motus/test/motus_test.ml23
11 files changed, 129 insertions, 76 deletions
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 ])