diff options
| -rw-r--r-- | motus/js/initialize.ml | 67 | ||||
| -rw-r--r-- | motus/js/motus.ml | 11 | ||||
| -rw-r--r-- | motus/js/next.ml | 16 | ||||
| -rw-r--r-- | motus/js/reload.ml | 21 | ||||
| -rw-r--r-- | motus/js/state.ml | 22 |
5 files changed, 70 insertions, 67 deletions
diff --git a/motus/js/initialize.ml b/motus/js/initialize.ml index 6a277df..a99e023 100644 --- a/motus/js/initialize.ml +++ b/motus/js/initialize.ml @@ -3,17 +3,17 @@ open Note open Motus_lib open Brr -type t = - { length : int +type t = { + length : int ; html_response : (int * Jstr.t, Jv.Error.t) result ; sender : (int * Jstr.t * Validity.t) E.send ; proposition : State.proposition - } +} -(** Pick the next word from the dictionnary, and return it as a proposition. +(** Pick the next word from the dictionnary, and return it as a proposition. If the word is empty (no word) return [None], else return a proposition - which can be edited by the user. + which can be edited by the user. The rule list is used to identify the letter already fixed by the previous results. *) @@ -26,8 +26,9 @@ let get_proposition : fun length ~catalog wordlist rules -> let word = let elements = Wordlist.list_size wordlist in - if elements > 2000 - then Freq_analysis.analyse wordlist |> Freq_analysis.pick_next_word wordlist + if elements > 2000 then + Freq_analysis.analyse wordlist |> Freq_analysis.pick_next_word wordlist + else if elements = 0 then String.empty else let _, word = Entropy.analyse length ~catalog wordlist in word @@ -37,56 +38,64 @@ let get_proposition : | false -> let i = ref 0 in let proposition = - word - |> String.to_seq + word |> String.to_seq |> Seq.map (fun c -> - let contain = Criteria.Contain (c, Some !i) in - let wellplaced = List.mem contain ~set:rules in - incr i; - let validity = - match wellplaced with - | true -> Validity.Wellplaced - | _ -> Validity.Missing - in + let contain = Criteria.Contain (c, Some !i) in + let wellplaced = List.mem contain ~set:rules in + let misplaced = + List.exists + ~f:(fun rule -> + match rule with + | Criteria.Contain (c', _) when Char.equal c' c -> true + | _ -> false) + rules + in + incr i; + let validity = + match (wellplaced, misplaced) with + | true, _ -> Validity.Wellplaced + | false, true -> Validity.Misplaced + | _ -> Validity.Missing + in - Some (Jstr.of_char c, validity) ) + Some (Jstr.of_char c, validity)) |> List.of_seq in Some proposition - let process { sender; length; html_response; proposition } state = match html_response with - | Ok (200, value) -> + | Ok (200, value) -> ( let rules = Criteria.Lenght length :: State.get_current_rules proposition in let words = Jstr.cuts ~sep:(Jstr.v "\n") value in - let analysis = + let candidates = List.to_seq words |> 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); + Printf.printf "Number of elements after filter : %d\n" + (Motus_lib.Wordlist.list_size candidates); - let current_prop = get_proposition ~catalog:analysis length analysis rules + let current_prop = + get_proposition ~catalog:candidates length candidates rules and fields = FieldList.make length sender in - ( match current_prop with + match current_prop with | None -> state | Some prop -> FieldList.set_with_props prop fields rules; State. - { analysis - ; catalog = analysis + { + candidates + ; catalog = candidates ; rules ; length ; current_prop = prop ; propositions = [] ; fields - } ) + }) | _ -> Console.(log [ Jstr.v "No words found" ]); state diff --git a/motus/js/motus.ml b/motus/js/motus.ml index 47ea15c..c1ac754 100644 --- a/motus/js/motus.ml +++ b/motus/js/motus.ml @@ -77,9 +77,9 @@ let main length_id send_id dictionnary_id proposition_id rules_id table_id Elements.Transfert.get_content_from_url words |> E.map (fun html_response -> - State.App.dispatch - (module Initialize) - Initialize.{ length; html_response; sender; proposition })) + State.App.dispatch + (module Initialize) + Initialize.{ length; html_response; sender; proposition })) send_btn |> E.join in @@ -161,9 +161,10 @@ let main length_id send_id dictionnary_id proposition_id rules_id table_id S.map (fun ev -> match - (ev.State.current_prop, Motus_lib.Wordlist.list_size ev.State.analysis) + ( ev.State.current_prop + , Motus_lib.Wordlist.list_size ev.State.candidates ) with - | [], _ | _, 1 -> Some (Jstr.v "true") + | [], _ | _, 1 | _, 0 -> Some (Jstr.v "true") | _, _ -> None) ev in diff --git a/motus/js/next.ml b/motus/js/next.ml index f26aa86..721c850 100644 --- a/motus/js/next.ml +++ b/motus/js/next.ml @@ -10,10 +10,9 @@ let process : t -> State.state -> State.state = let rules = State.get_current_rules state.current_prop in (* 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 candidates = Motus_lib.Wordlist.filter rules state.candidates in + Printf.printf "Number of elements after filter : %d\n" + (Motus_lib.Wordlist.list_size candidates); let rules = Motus_lib.Criteria.merge_lists ~init:state.rules rules @@ -23,14 +22,13 @@ let process : t -> State.state -> State.state = let propositions = state.current_prop :: state.propositions and current_prop = [] in - let new_state = { state with propositions; current_prop; rules; analysis } in + let new_state = + { state with propositions; current_prop; rules; candidates } + in (* Get the new proposition if any *) let current_prop = - Initialize.get_proposition - ~catalog:state.catalog - state.length - analysis + Initialize.get_proposition ~catalog:state.catalog state.length candidates rules in match current_prop with diff --git a/motus/js/reload.ml b/motus/js/reload.ml index 912141d..2a12819 100644 --- a/motus/js/reload.ml +++ b/motus/js/reload.ml @@ -8,28 +8,25 @@ let process : t -> State.state -> State.state = fun () state -> (* Get the word corresponding to the proposition *) let word = - state.State.current_prop - |> List.to_seq + state.State.current_prop |> List.to_seq |> Seq.map (fun opt -> - match opt with - | None -> ' ' - | Some (letter, _) -> String.get (Jstr.to_string letter) 0 ) + match opt with + | None -> ' ' + | Some (letter, _) -> String.get (Jstr.to_string letter) 0) |> String.of_seq in let new_state = - { state with - analysis = Motus_lib.Wordlist.remove_word state.analysis word + { + state with + candidates = Motus_lib.Wordlist.remove_word state.candidates word ; catalog = Motus_lib.Wordlist.remove_word state.catalog word } in (* Get the new proposition if any *) let current_prop = - Initialize.get_proposition - ~catalog:new_state.catalog - state.length - new_state.analysis - state.rules + Initialize.get_proposition ~catalog:new_state.catalog state.length + new_state.candidates state.rules in match current_prop with | None -> new_state diff --git a/motus/js/state.ml b/motus/js/state.ml index e2e531d..41a5875 100644 --- a/motus/js/state.ml +++ b/motus/js/state.ml @@ -3,18 +3,19 @@ open Motus_lib type proposition = (Jstr.t * Validity.t) option list -type state = - { analysis : Wordlist.t +type state = { + candidates : Wordlist.t ; catalog : Wordlist.t ; rules : Criteria.t list ; length : int ; propositions : proposition list ; current_prop : proposition ; fields : Brr.El.t list - } +} let init () = - { analysis = Wordlist.empty_data () + { + candidates = Wordlist.empty_data () ; catalog = Wordlist.empty_data () ; rules = [] ; length = 0 @@ -23,7 +24,6 @@ let init () = ; fields = [] } - module App = Application.Make (struct type t = state end) @@ -35,17 +35,15 @@ let get_current_rules : proposition -> Criteria.t list = List.iteri prop ~f:(fun i prop -> Option.iter (fun (letter, validity) -> - if Jstr.equal Jstr.empty letter - then () + if Jstr.equal Jstr.empty letter then () else let char = String.get (Jstr.to_string letter) 0 in - rules := Validity.to_criteria char i validity !rules ) - prop ); + rules := Validity.to_criteria char i validity !rules) + prop); List.rev !rules - (** Compare two states *) let eq : state -> state -> bool = fun s1 s2 -> - (s1.length, s1.rules, s1.current_prop, s1.propositions, s1.analysis) - = (s2.length, s2.rules, s2.current_prop, s2.propositions, s2.analysis) + (s1.length, s1.rules, s1.current_prop, s1.propositions, s1.candidates) + = (s2.length, s2.rules, s2.current_prop, s2.propositions, s2.candidates) |