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
99
100
101
102
103
104
105
|
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
module CharSet = Set.Make (Char)
let compare_words : string -> ref:string * CharSet.t -> t array option =
fun w1 ~ref ->
let wordRef = fst ref in
let l1 = String.length w1 in
if l1 <> String.length wordRef
then None
else
let result =
Array.init l1 ~f:(fun i ->
let c1 = String.get w1 i
and c2 = String.get wordRef i in
let state =
if Char.equal c1 c2
then Wellplaced
else if CharSet.mem c2 (snd ref)
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, succ i) )
in
List.rev l
|
