aboutsummaryrefslogtreecommitdiff
path: root/motus/lib/validity.ml
blob: ae85f04fd70e9116adeb64572c93fc58bfb31785 (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
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
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