aboutsummaryrefslogtreecommitdiff
path: root/motus/lib/validity.ml
blob: 3964e0bcac7e1eebb34216aba0e149c74b783770 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
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 elements = Float.of_int (1 + max)

(** Get the index of a validity result *)
let index_of_result : t array -> int =
 fun elems ->
  (* This seems to be more efficient than a foldLeft *)
  let value = ref 0. in
  Array.iteri
    ~f:(fun pos content ->
      let pos = Float.of_int pos in
      let v = Float.of_int (to_enum content) in
      let acc' = !value +. (v *. (elements ** pos)) in
      value := acc' )
    elems;
  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 /. elements)
    and rem = Float.(to_int @@ rem n elements) 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 @@ (elements ** Float.of_int base) in

  Seq.unfold
    (fun n ->
      if n < max_element then Some (index_to_result ~base n, succ n) else None
      )
    0


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, succ i) )
  in

  List.rev l