diff options
Diffstat (limited to 'motus/lib/validity.ml')
-rw-r--r-- | motus/lib/validity.ml | 98 |
1 files changed, 98 insertions, 0 deletions
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 |