diff options
Diffstat (limited to 'motus')
| -rw-r--r-- | motus/bin/motus.ml | 45 | ||||
| -rw-r--r-- | motus/js/initialize.ml | 12 | ||||
| -rw-r--r-- | motus/js/next.ml | 7 | ||||
| -rw-r--r-- | motus/lib/freq_analysis.ml | 68 | ||||
| -rw-r--r-- | motus/lib/freq_analysis.mli | 12 | ||||
| -rw-r--r-- | motus/lib/wordlist.ml | 95 | ||||
| -rw-r--r-- | motus/lib/wordlist.mli | 33 |
7 files changed, 132 insertions, 140 deletions
diff --git a/motus/bin/motus.ml b/motus/bin/motus.ml index 2ee058d..e32adca 100644 --- a/motus/bin/motus.ml +++ b/motus/bin/motus.ml @@ -25,12 +25,6 @@ let show_structure : Format.formatter -> Wordlist.t -> Criteria.t list -> unit = Format.fprintf format "Got %d elements @\n" (Wordlist.list_size data); - Format.fprintf - format - "Frequencies : @[<v>%a@]@\n" - (Format.pp_print_list (fun f (k, v) -> Format.fprintf f "%c -> %d" k v)) - (Wordlist.extract_freq data); - if Wordlist.list_size data < 20 then Format.fprintf @@ -38,22 +32,20 @@ let show_structure : Format.formatter -> Wordlist.t -> Criteria.t list -> unit = "Remaining words @[<v>@;%a@]@\n" (Format.pp_print_list ~pp_sep:Format.pp_force_newline (fun f w -> Format.fprintf f "%s" w ) ) - (Wordlist.words data); + (List.of_seq @@ Wordlist.words data); Format.close_box () (** Get the initial list *) -let rec get_list : in_channel -> Wordlist.t -> Criteria.t list -> Wordlist.t = - fun channel data filters -> - let word = - try Some (String.lowercase_ascii (Stdlib.input_line channel)) with +let get_list : in_channel -> Criteria.t list -> Wordlist.t = + fun channel filters -> + let read channel = + try Some (String.lowercase_ascii (Stdlib.input_line channel), channel) with | End_of_file -> None in - match word with - | None -> data - | Some word -> - let data = Wordlist.add_word filters data word in - get_list channel data filters + + let s = Seq.unfold read channel in + Wordlist.add_words filters s (** Compare the proposed word and the result from the user in order to identify @@ -79,15 +71,12 @@ let create_new_rules word result = let rec run filters words = let () = show_structure Format.std_formatter words filters in - let freq = Wordlist.extract_freq words in - let next, score = Wordlist.pick_next_word words freq in + let next = + Freq_analysis.analyse words |> Freq_analysis.pick_next_word words + in let () = - Format.fprintf - Format.std_formatter - "Next word will be : %s (%d)@\n" - next - score + Format.fprintf Format.std_formatter "Next word will be : %s@\n" next in let input = Stdlib.read_line () in @@ -100,13 +89,7 @@ let rec run filters words = Criteria.merge_lists ~init:filters (create_new_rules next input) |> List.sort_uniq Stdlib.compare in - - let words = - List.fold_left - (Wordlist.add_word new_rules) - (Wordlist.empty_data ()) - (Wordlist.words words) - in + let words = Wordlist.filter new_rules words in run new_rules words @@ -134,6 +117,6 @@ let () = let initial_filter = Criteria.Lenght !length :: !rules in let words_channel = open_in (List.hd !dict) in - let words = get_list words_channel (Wordlist.empty_data ()) initial_filter in + let words = get_list words_channel initial_filter in close_in words_channel; run initial_filter words diff --git a/motus/js/initialize.ml b/motus/js/initialize.ml index 82f1288..a088a0e 100644 --- a/motus/js/initialize.ml +++ b/motus/js/initialize.ml @@ -21,7 +21,7 @@ let get_proposition : Wordlist.t -> Criteria.t list -> State.proposition option = fun analysis rules -> let word = - Wordlist.extract_freq analysis |> Wordlist.pick_next_word analysis |> fst + Freq_analysis.analyse analysis |> Freq_analysis.pick_next_word analysis in match String.equal String.empty word with | true -> None @@ -58,13 +58,11 @@ let process { sender; length; content; proposition } state = in let words = Jstr.cuts ~sep:(Jstr.v "\n") value in let analysis = - List.fold_left - ~f:(fun a w -> - let upper = Jstr.uppercased w in - Wordlist.add_word rules a (Jstr.to_string upper) ) - ~init:(Wordlist.empty_data ()) - words + List.to_seq words + |> Seq.map (fun w -> Jstr.(to_string (uppercased w))) + |> Wordlist.add_words rules in + let current_prop = get_proposition analysis rules and fields = FieldList.make length sender in ( match current_prop with diff --git a/motus/js/next.ml b/motus/js/next.ml index 72db9e4..104b3e6 100644 --- a/motus/js/next.ml +++ b/motus/js/next.ml @@ -15,12 +15,7 @@ let process : t -> State.state -> State.state = in (* Update the word list with the new rules *) - let analysis = - List.fold_left - ~f:(Motus_lib.Wordlist.add_word rules) - ~init:(Motus_lib.Wordlist.empty_data ()) - (Motus_lib.Wordlist.words state.analysis) - in + let analysis = Motus_lib.Wordlist.filter rules state.analysis in let propositions = state.current_prop :: state.propositions and current_prop = [] in diff --git a/motus/lib/freq_analysis.ml b/motus/lib/freq_analysis.ml new file mode 100644 index 0000000..12f5fef --- /dev/null +++ b/motus/lib/freq_analysis.ml @@ -0,0 +1,68 @@ +open StdLabels + +let () = Random.self_init () + +type t = (char * int) list + +let update_freq : (char, int) Hashtbl.t -> char -> unit = + fun freq c -> + match Hashtbl.find_opt freq c with + | None -> Hashtbl.add freq c 1 + | Some value -> Hashtbl.replace freq c (value + 1) + + +(** Evaluate the score for each char (lower is better) *) +let analyse : Wordlist.t -> (char * int) list = + fun data -> + let freq = Hashtbl.create 26 in + Seq.iter + (fun word -> String.iter word ~f:(update_freq freq)) + (Wordlist.words data); + + let number_2 = Wordlist.list_size data / 2 in + Hashtbl.fold (fun k v acc -> (k, abs (v - number_2)) :: acc) freq [] + + +(** 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) *) +let pick_next_word : Wordlist.t -> (char * int) list -> string = + fun data scores -> + let list_size = Wordlist.list_size data / 2 in + + 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 + ~f:(fun (scores, score) c -> + match List.assoc_opt c scores with + | None -> + (* if the character has no score associated, we consider that it + does not provide any more information, and give it the max + score available *) + (scores, score + list_size) + | Some v -> + let new_scores = + List.filter ~f:(fun (c', _) -> not (Char.equal c c')) scores + in + (new_scores, score + v) ) + ~init:(scores, 0) + word + in + match prec with + | 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 Seq.fold_left p' None (Wordlist.words data) with + | None -> "" + | Some (words, _) -> + (* Pick a reandom word from the list *) + let elements = List.length words in + let number = Random.int elements in + List.nth words number diff --git a/motus/lib/freq_analysis.mli b/motus/lib/freq_analysis.mli new file mode 100644 index 0000000..bd7f1d8 --- /dev/null +++ b/motus/lib/freq_analysis.mli @@ -0,0 +1,12 @@ +type t + +val analyse : Wordlist.t -> t +(** Evaluate the score for each char (lower is better) *) + +val pick_next_word : Wordlist.t -> t -> string +(** 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) *) diff --git a/motus/lib/wordlist.ml b/motus/lib/wordlist.ml index 45fc73a..7c400bb 100644 --- a/motus/lib/wordlist.ml +++ b/motus/lib/wordlist.ml @@ -1,90 +1,25 @@ open StdLabels +module S = Set.Make (String) -let () = Random.self_init () +type t = S.t -type t = - { number : int - ; element : string list - } +let empty_data () = S.empty -let empty_data () = { number = 0; element = [] } +let add_words : Criteria.t list -> string Seq.t -> t = + fun filters words -> + Seq.filter + (fun word -> List.for_all ~f:(Criteria.check_filter word) filters) + words + |> S.of_seq -let update_freq : (char, int) Hashtbl.t -> char -> unit = - fun freq c -> - match Hashtbl.find_opt freq c with - | None -> Hashtbl.add freq c 1 - | Some value -> Hashtbl.replace freq c (value + 1) +let filter : Criteria.t list -> t -> t = + fun filters t -> + S.filter (fun word -> List.for_all ~f:(Criteria.check_filter word) filters) t -(** Evaluate the score for each char (lower is better) *) -let extract_freq : t -> (char * int) list = - fun data -> - let freq = Hashtbl.create 26 in - List.iter data.element ~f:(fun word -> - String.iter word ~f:(fun c -> update_freq freq c) ); - let number_2 = data.number / 2 in - Hashtbl.fold (fun k v acc -> (k, abs (v - number_2)) :: acc) freq [] - (* Sort the list for a pretty printing *) - |> List.sort ~cmp:(fun v1 v2 -> snd v1 - snd v2) +let words = S.to_seq +let list_size = S.cardinal -let add_word : Criteria.t list -> t -> string -> t = - fun filters data word -> - match List.for_all ~f:(Criteria.check_filter word) filters with - | true -> { number = data.number + 1; element = word :: data.element } - | false -> data - - -(** 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) *) -let pick_next_word : t -> (char * int) list -> string * int = - fun data scores -> - 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 - ~f:(fun (scores, score) c -> - match List.assoc_opt c scores with - | None -> - (* if the character has no score associated, we consider that it - does not provide any more information, and give it the max - score available *) - (scores, score + (data.number / 2)) - | Some v -> - let new_scores = - List.filter ~f:(fun (c', _) -> not (Char.equal c c')) scores - in - (new_scores, score + v) ) - ~init:(scores, 0) - word - in - match prec with - | 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 ~f:p' ~init:None data.element with - | None -> ("", 0) - | 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 - { element; number = t.number - 1 } - - -let words : t -> string list = fun { element; _ } -> element - -let list_size : t -> int = fun { number; _ } -> number +let remove_word t w = S.remove w t diff --git a/motus/lib/wordlist.mli b/motus/lib/wordlist.mli index 766fbdf..a56cab3 100644 --- a/motus/lib/wordlist.mli +++ b/motus/lib/wordlist.mli @@ -1,25 +1,26 @@ +(** The dictionnary *) + type t -val words : t -> string list +val empty_data : unit -> t +(** Create an empty dictionnary. The resulting dictionnay cannot be used, it is + juste here if required for initialisation *) + +val words : t -> string Seq.t +(** Load all the words *) val list_size : t -> int (** Number of words in the list *) -val empty_data : unit -> t - -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 remove_word : t -> string -> t -(** Remove a word from this list *) +val add_words : Criteria.t list -> string Seq.t -> t +(** Create a word list from an initial sequence. -val extract_freq : t -> (char * int) list -(** Evaluate the score for each char (lower is better) *) + Checks 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. +val filter : Criteria.t list -> t -> t +(** Remove all the words that does not match the criterias. *) -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 +(** Remove a word from this list. This function is called when a proposition + from the application is not recognized by the game. *) |