From c2bd6982e5ed845293a38ae600c239cd50924d76 Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Thu, 24 Feb 2022 08:59:44 +0100 Subject: Update code, added tests --- motus/bin/motus.ml | 41 ++++++++---------- motus/js/fieldList.ml | 20 ++++----- motus/js/initialize.ml | 22 ++++------ motus/js/motus.ml | 5 +-- motus/js/next.ml | 6 +-- motus/js/reload.ml | 4 +- motus/js/state.ml | 23 ++-------- motus/js/updateProposition.ml | 2 +- motus/lib/dune | 1 + motus/lib/persistence.ml | 95 ----------------------------------------- motus/lib/persistence.mli | 24 ----------- motus/lib/validity.ml | 98 +++++++++++++++++++++++++++++++++++++++++++ motus/lib/validity.mli | 20 +++++++++ motus/lib/wordlist.ml | 90 +++++++++++++++++++++++++++++++++++++++ motus/lib/wordlist.mli | 25 +++++++++++ motus/test/dune | 3 ++ motus/test/motus_test.ml | 51 ++++++++++++++++++++++ 17 files changed, 336 insertions(+), 194 deletions(-) delete mode 100644 motus/lib/persistence.ml delete mode 100644 motus/lib/persistence.mli create mode 100644 motus/lib/validity.ml create mode 100644 motus/lib/validity.mli create mode 100644 motus/lib/wordlist.ml create mode 100644 motus/lib/wordlist.mli create mode 100644 motus/test/dune create mode 100644 motus/test/motus_test.ml diff --git a/motus/bin/motus.ml b/motus/bin/motus.ml index 0f2b17b..2ee058d 100644 --- a/motus/bin/motus.ml +++ b/motus/bin/motus.ml @@ -15,8 +15,7 @@ let format_filter : Format.formatter -> Criteria.t -> unit = (** Display the informations about the structure *) -let show_structure : - Format.formatter -> Persistence.t -> Criteria.t list -> unit = +let show_structure : Format.formatter -> Wordlist.t -> Criteria.t list -> unit = fun format data filters -> Format.fprintf format @@ -24,28 +23,27 @@ let show_structure : (Format.pp_print_list format_filter) filters; - Format.fprintf format "Got %d elements @\n" (Persistence.list_size data); + Format.fprintf format "Got %d elements @\n" (Wordlist.list_size data); Format.fprintf format "Frequencies : @[%a@]@\n" (Format.pp_print_list (fun f (k, v) -> Format.fprintf f "%c -> %d" k v)) - (Persistence.extract_freq data); + (Wordlist.extract_freq data); - if Persistence.list_size data < 20 + if Wordlist.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 ) ) - (Persistence.words data); + (Wordlist.words data); Format.close_box () (** Get the initial list *) -let rec get_list : - in_channel -> Persistence.t -> Criteria.t list -> Persistence.t = +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 @@ -54,7 +52,7 @@ let rec get_list : match word with | None -> data | Some word -> - let data = Persistence.add_word filters data word in + let data = Wordlist.add_word filters data word in get_list channel data filters @@ -66,24 +64,23 @@ let create_new_rules word result = for i = 0 to max_length - 1 do match (String.get word i, String.get result i) with (* A space means that the letter is not present *) - | c, ' ' -> rules := Criteria.NotContain (c, None) :: !rules + | c, ' ' -> rules := Criteria.(add (NotContain (c, None))) !rules (* The same letter means that the we found the right caracter *) | c, c' when Char.equal c c' -> - rules := Criteria.Contain (c, Some i) :: !rules + rules := Criteria.(add (Contain (c, Some i)) !rules) (* Anything else, we got the letter, but at the wrong place *) | c, _ -> rules := - Criteria.Contain (c, None) - :: Criteria.NotContain (c, Some i) - :: !rules + Criteria.( + add (Contain (c, None)) (add (NotContain (c, Some i)) !rules)) done; !rules let rec run filters words = let () = show_structure Format.std_formatter words filters in - let freq = Persistence.extract_freq words in - let next, score = Persistence.pick_next_word words freq in + let freq = Wordlist.extract_freq words in + let next, score = Wordlist.pick_next_word words freq in let () = Format.fprintf @@ -97,7 +94,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 -> run filters (Persistence.remove_word words next) + | true -> run filters (Wordlist.remove_word words next) | false -> let new_rules = Criteria.merge_lists ~init:filters (create_new_rules next input) @@ -106,9 +103,9 @@ let rec run filters words = let words = List.fold_left - (Persistence.add_word new_rules) - (Persistence.empty_data ()) - (Persistence.words words) + (Wordlist.add_word new_rules) + (Wordlist.empty_data ()) + (Wordlist.words words) in run new_rules words @@ -137,8 +134,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 (Persistence.empty_data ()) initial_filter - in + let words = get_list words_channel (Wordlist.empty_data ()) initial_filter in close_in words_channel; run initial_filter words diff --git a/motus/js/fieldList.ml b/motus/js/fieldList.ml index 85755aa..428f364 100644 --- a/motus/js/fieldList.ml +++ b/motus/js/fieldList.ml @@ -10,13 +10,13 @@ type elements = Brr.El.t list If no class is specified, consider the letter is at the right position. *) -let get_validity_from_element : El.t -> State.letter_validity = +let get_validity_from_element : El.t -> Motus_lib.Validity.t = fun el -> if El.class' (Jstr.v "missing") el - then State.Missing + then Missing else if El.class' (Jstr.v "misplaced") el - then State.Misplaced - else State.Wellplaced + then Misplaced + else Wellplaced let get_rules : elements -> State.proposition = @@ -32,14 +32,14 @@ let get_rules : elements -> State.proposition = t -let get_class : State.letter_validity -> Jstr.t = function +let get_class : Motus_lib.Validity.t -> Jstr.t = function | Wellplaced -> Jstr.v "wellplaced" | Misplaced -> Jstr.v "misplaced" | _ -> Jstr.v "missing" (** Create the field list modifiied by the user *) -let make : int -> (int * Jstr.t * State.letter_validity) E.send -> elements = +let make : int -> (int * Jstr.t * Motus_lib.Validity.t) E.send -> elements = fun len change_sender -> List.init ~len ~f:(fun i -> let input = @@ -66,9 +66,9 @@ let make : int -> (int * Jstr.t * State.letter_validity) E.send -> elements = (fun _ -> let validity = match get_validity_from_element input with - | State.Missing -> State.Misplaced - | State.Misplaced -> State.Wellplaced - | State.Wellplaced -> State.Missing + | Missing -> Motus_lib.Validity.Misplaced + | Misplaced -> Motus_lib.Validity.Wellplaced + | Wellplaced -> Motus_lib.Validity.Missing in change_sender (i, El.prop El.Prop.value input, validity) ) (El.as_target input); @@ -139,7 +139,7 @@ let build : El.t -> int S.t -> State.proposition S.t = if Jstr.equal Jstr.empty value then (i, None) else - let validity = State.Wellplaced in + let validity = Motus_lib.Validity.Wellplaced in (i, Some (Jstr.uppercased value, validity)) ) input ) elements diff --git a/motus/js/initialize.ml b/motus/js/initialize.ml index 7dd7544..82f1288 100644 --- a/motus/js/initialize.ml +++ b/motus/js/initialize.ml @@ -6,7 +6,7 @@ open Brr type t = { length : int ; content : (int * Jstr.t, Jv.Error.t) result - ; sender : (int * Jstr.t * State.letter_validity) E.send + ; sender : (int * Jstr.t * Validity.t) E.send ; proposition : State.proposition } @@ -16,16 +16,12 @@ type t = which can be edited by the user. The rule list is used to identify the letter already fixed by the previous - results. - - *) -let get_proposition : - Persistence.t -> Criteria.t list -> State.proposition option = + results. *) +let get_proposition : Wordlist.t -> Criteria.t list -> State.proposition option + = fun analysis rules -> let word = - Persistence.extract_freq analysis - |> Persistence.pick_next_word analysis - |> fst + Wordlist.extract_freq analysis |> Wordlist.pick_next_word analysis |> fst in match String.equal String.empty word with | true -> None @@ -44,8 +40,8 @@ let get_proposition : incr i; let validity = match wellplaced with - | true -> State.Wellplaced - | _ -> State.Missing + | true -> Validity.Wellplaced + | _ -> Validity.Missing in Some (Jstr.of_char c, validity) ) @@ -65,8 +61,8 @@ let process { sender; length; content; proposition } state = List.fold_left ~f:(fun a w -> let upper = Jstr.uppercased w in - Persistence.add_word rules a (Jstr.to_string upper) ) - ~init:(Persistence.empty_data ()) + Wordlist.add_word rules a (Jstr.to_string upper) ) + ~init:(Wordlist.empty_data ()) words in let current_prop = get_proposition analysis rules diff --git a/motus/js/motus.ml b/motus/js/motus.ml index a2bcbd3..402e14a 100644 --- a/motus/js/motus.ml +++ b/motus/js/motus.ml @@ -150,7 +150,7 @@ let main List.map props ~f:(fun proposition -> List.map proposition ~f:(fun prop -> let letter, validity = - Option.value ~default:(Jstr.empty, State.Missing) prop + Option.value ~default:(Jstr.empty, Validity.Missing) prop in let input = El.input @@ -173,8 +173,7 @@ let main S.map (fun ev -> match - ( ev.State.current_prop - , Motus_lib.Persistence.list_size ev.State.analysis ) + (ev.State.current_prop, Motus_lib.Wordlist.list_size ev.State.analysis) with | [], _ | _, 1 -> Some (Jstr.v "true") | _, _ -> None ) diff --git a/motus/js/next.ml b/motus/js/next.ml index 5f24883..72db9e4 100644 --- a/motus/js/next.ml +++ b/motus/js/next.ml @@ -17,9 +17,9 @@ let process : t -> State.state -> State.state = (* Update the word list with the new rules *) let analysis = List.fold_left - ~f:(Motus_lib.Persistence.add_word rules) - ~init:(Motus_lib.Persistence.empty_data ()) - (Motus_lib.Persistence.words state.analysis) + ~f:(Motus_lib.Wordlist.add_word rules) + ~init:(Motus_lib.Wordlist.empty_data ()) + (Motus_lib.Wordlist.words state.analysis) in let propositions = state.current_prop :: state.propositions diff --git a/motus/js/reload.ml b/motus/js/reload.ml index cfdfa2a..2756b74 100644 --- a/motus/js/reload.ml +++ b/motus/js/reload.ml @@ -18,9 +18,7 @@ let process : t -> State.state -> State.state = in let new_state = - { state with - analysis = Motus_lib.Persistence.remove_word state.analysis word - } + { state with analysis = Motus_lib.Wordlist.remove_word state.analysis word } in (* Get the new proposition if any *) let current_prop = diff --git a/motus/js/state.ml b/motus/js/state.ml index 57a3794..cbab14f 100644 --- a/motus/js/state.ml +++ b/motus/js/state.ml @@ -1,15 +1,10 @@ open StdLabels open Motus_lib -type letter_validity = - | Wellplaced - | Misplaced - | Missing - -type proposition = (Jstr.t * letter_validity) option list +type proposition = (Jstr.t * Validity.t) option list type state = - { analysis : Persistence.t + { analysis : Wordlist.t ; rules : Criteria.t list ; length : int ; propositions : proposition list @@ -18,7 +13,7 @@ type state = } let init () = - { analysis = Persistence.empty_data () + { analysis = Wordlist.empty_data () ; rules = [] ; length = 0 ; propositions = [] @@ -42,17 +37,7 @@ let get_current_rules : proposition -> Criteria.t list = then () else let char = String.get (Jstr.to_string letter) 0 in - - match validity with - | Missing -> - rules := Criteria.add (Criteria.NotContain (char, None)) !rules - | Misplaced -> - rules := - Criteria.add (Criteria.NotContain (char, Some i)) !rules; - rules := Criteria.add (Criteria.Contain (char, None)) !rules - | Wellplaced -> - rules := Criteria.add (Criteria.Contain (char, Some i)) !rules - ) + rules := Validity.to_criteria char i validity !rules ) prop ); List.rev !rules diff --git a/motus/js/updateProposition.ml b/motus/js/updateProposition.ml index ab10db3..7a4608f 100644 --- a/motus/js/updateProposition.ml +++ b/motus/js/updateProposition.ml @@ -7,7 +7,7 @@ open StdLabels type t = { position : int ; letter : Jstr.t - ; validity : State.letter_validity + ; validity : Motus_lib.Validity.t } let process { position; letter; validity } state = diff --git a/motus/lib/dune b/motus/lib/dune index b958922..a892e2b 100644 --- a/motus/lib/dune +++ b/motus/lib/dune @@ -2,6 +2,7 @@ (name motus_lib ) + (preprocess (pps ppx_deriving.enum)) ) diff --git a/motus/lib/persistence.ml b/motus/lib/persistence.ml deleted file mode 100644 index 6116653..0000000 --- a/motus/lib/persistence.ml +++ /dev/null @@ -1,95 +0,0 @@ -open StdLabels - -let () = Random.self_init () - -type t = - { number : int - ; element : string list - ; freq : (char, int) Hashtbl.t - } - -let empty_data () = { number = 0; element = []; freq = Hashtbl.create 26 } - -(** Evaluate the score for each char (lower is better) *) -let extract_freq : t -> (char * int) list = - fun data -> - 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 ~cmp:(fun v1 v2 -> snd v1 - snd v2) - - -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 add_word : Criteria.t list -> t -> string -> t = - fun filters data word -> - match List.for_all ~f:(Criteria.check_filter word) filters with - | true -> - let len = String.length word in - let chars = - List.init ~len ~f:(fun n -> String.get word n) - |> List.sort_uniq ~cmp:Char.compare - in - - List.iter ~f:(update_freq data.freq) chars; - { data with 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 - { 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 deleted file mode 100644 index f5625e4..0000000 --- a/motus/lib/persistence.mli +++ /dev/null @@ -1,24 +0,0 @@ -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 diff --git a/motus/lib/validity.ml b/motus/lib/validity.ml new file mode 100644 index 0000000..ae85f04 --- /dev/null +++ b/motus/lib/validity.ml @@ -0,0 +1,98 @@ +open StdLabels + +(* Enclose the type definition into a warning removval in order to hide some + auto-generated values *) +[@@@warning "-32"] + +type t = + | Wellplaced + | Misplaced + | Missing +[@@deriving enum] + +[@@@warning "+32"] + +let m = Float.of_int (1 + max) + +(** Get the index of a validity result *) +let index_of_result : t array -> int = + fun elems -> + let _, value = + Array.fold_left elems ~init:(0., 0.) ~f:(fun (pos, acc) content -> + let v = Float.of_int (to_enum content) in + let acc' = acc +. (v *. (m ** pos)) in + (pos +. Float.one, acc') ) + in + Float.to_int value + + +let index_to_result : base:int -> int -> t array = + fun ~base n -> + let rec _f acc n i = + let next = Float.round (n /. m) + and rem = Float.(to_int @@ rem n m) in + + match (rem, i) with + | _, 0 -> Array.of_list acc + | n, _ -> + ( match of_enum n with + | None -> Array.of_list acc + | Some v -> _f (v :: acc) next (i - 1) ) + in + _f [] (Float.of_int n) base + + +(** Build a sequence of all the possible status for a given number of letters *) +let sequence : int -> t array Seq.t = + fun base -> + let max_element = Float.to_int @@ (m ** Float.of_int base) in + + Seq.unfold + (fun n -> + if n < max_element then Some (index_to_result ~base n, n + 1) else None ) + 0 + + +let compare_words : string -> ref:string -> t array option = + fun w1 ~ref -> + let l1 = String.length w1 in + if l1 <> String.length ref + then None + else + let result = + Array.init l1 ~f:(fun i -> + let c1 = String.get w1 i + and c2 = String.get ref i in + + let state = + if Char.equal c1 c2 + then Wellplaced + else if String.contains ref c1 + 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 + | Wellplaced -> Criteria.add (Criteria.Contain (c, Some i)) acc + | Missing -> Criteria.add (Criteria.NotContain (c, None)) acc + | Misplaced -> + Criteria.add + (Criteria.NotContain (c, Some i)) + (Criteria.add (Criteria.Contain (c, None)) acc) + + +let to_criterias : string -> t array -> Criteria.t list = + fun word t -> + let l, _ = + Array.fold_left t ~init:([], 0) ~f:(fun (acc, i) t -> + let acc = to_criteria (String.get word i) i t acc in + (acc, i + 1) ) + in + + List.rev l diff --git a/motus/lib/validity.mli b/motus/lib/validity.mli new file mode 100644 index 0000000..dfd876c --- /dev/null +++ b/motus/lib/validity.mli @@ -0,0 +1,20 @@ +type t = + | Wellplaced + | Misplaced + | Missing + +val sequence : int -> t array Seq.t +(** Build a sequence of all the possible status for a given number of letters *) + +val index_of_result : t array -> int +(** Get the index of a validity result *) + +val index_to_result : base:int -> int -> t array + +val compare_words : string -> ref:string -> t array option + +val to_criteria : char -> int -> t -> Criteria.t list -> Criteria.t list + +val to_criterias : string -> t array -> Criteria.t list +(** Convert the validity result into a Criteria list, in the context of a given + word *) diff --git a/motus/lib/wordlist.ml b/motus/lib/wordlist.ml new file mode 100644 index 0000000..45fc73a --- /dev/null +++ b/motus/lib/wordlist.ml @@ -0,0 +1,90 @@ +open StdLabels + +let () = Random.self_init () + +type t = + { number : int + ; element : string list + } + +let empty_data () = { number = 0; element = [] } + +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 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 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 diff --git a/motus/lib/wordlist.mli b/motus/lib/wordlist.mli new file mode 100644 index 0000000..766fbdf --- /dev/null +++ b/motus/lib/wordlist.mli @@ -0,0 +1,25 @@ +type t + +val words : t -> string list + +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 extract_freq : t -> (char * int) list +(** Evaluate the score for each char (lower is better) *) + +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) *) diff --git a/motus/test/dune b/motus/test/dune new file mode 100644 index 0000000..04fe199 --- /dev/null +++ b/motus/test/dune @@ -0,0 +1,3 @@ +(test + (name motus_test) + (libraries ounit2 motus_lib)) diff --git a/motus/test/motus_test.ml b/motus/test/motus_test.ml new file mode 100644 index 0000000..4ea952e --- /dev/null +++ b/motus/test/motus_test.ml @@ -0,0 +1,51 @@ +module Validity = Motus_lib.Validity +open StdLabels +open OUnit2 + +let tests = + "validity test suite" + >::: [ ( "Sequence of elements" + >:: fun _ -> + assert_equal + 243 + ( Validity.sequence 5 + |> List.of_seq + |> List.sort_uniq ~cmp:Stdlib.compare + |> List.length ) ) + ; ( "Index of element" + >:: fun _ -> + assert_equal 0 Validity.(index_of_result [| Wellplaced; Wellplaced |]) + ) + ; ( "Bijection for all the elements" + >:: fun _ -> + (* Create an array of 243 elements*) + let arr = Array.make 243 false in + let seq = Validity.sequence 5 in + (* Populate the array *) + Seq.iter + (fun v -> + let idx = Validity.index_of_result v in + Array.set arr idx true ) + seq; + + (* Now count the elements set to true *) + let count = + Array.fold_left arr ~init:0 ~f:(fun acc value -> + if value then acc + 1 else acc ) + in + + assert_equal 243 count ) + ; ( "Compare words 1" + >:: fun _ -> + assert_equal + (Some Validity.[| Wellplaced; Wellplaced; Wellplaced; Wellplaced |]) + (Validity.compare_words "Test" ~ref:"Test") ) + ; ( "Compare words 2" + >:: fun _ -> + assert_equal + (Some Validity.[| Missing; Misplaced; Wellplaced |]) + (Validity.compare_words "DAC" ~ref:"ABC") ) + ] + + +let _ = run_test_tt_main tests -- cgit v1.2.3